From 3a27bda68ce2dbbd5f8f2e6b5e6b9ead7b0244c1 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 12 Jul 2023 17:07:02 +0000 Subject: [PATCH 001/232] Migrated FSI changes to 4.0.0-dev Existing branch at https://github.com/gantech/OpenFAST/tree/f/br_fsi_2 This commit extends the C++ API --- CMakeLists.txt | 1 + cmake/FindNetCDF.cmake | 124 + docs/_static/references.bib | 122 + docs/source/dev/cppapi/api.rst | 11 + docs/source/dev/cppapi/files/FAST_Prog.cpp | 54 + .../files/actuatorLine_illustrationViz.pdf | Bin 0 -> 251323 bytes .../dev/cppapi/files/css_actuatorline.pdf | Bin 0 -> 202965 bytes .../files/thrustXActuatorForcePoints.png | Bin 0 -> 41122 bytes .../files/torqueXActuatorForcePoints.png | Bin 0 -> 29483 bytes docs/source/dev/cppapi/index.rst | 205 + docs/source/dev/index.rst | 11 + docs/source/user/cppapi/files/cDriver.i | 67 +- docs/source/user/cppapi/index.rst | 34 +- docs/source/zrefs.rst | 6 + glue-codes/openfast-cpp/CMakeLists.txt | 11 +- glue-codes/openfast-cpp/src/FAST_Prog.cpp | 267 +- glue-codes/openfast-cpp/src/OpenFAST.H | 728 +- glue-codes/openfast-cpp/src/OpenFAST.cpp | 3622 ++++++-- glue-codes/simulink/CMakeLists.txt | 5 +- modules/beamdyn/src/BeamDyn.f90 | 5 + modules/beamdyn/src/BeamDyn_Types.f90 | 54 + modules/beamdyn/src/Registry_BeamDyn.txt | 1 + modules/elastodyn/src/ElastoDyn.f90 | 2 +- modules/elastodyn/src/ElastoDyn_Registry.txt | 2 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 10 +- modules/externalinflow/CMakeLists.txt | 3 +- modules/extloads/CMakeLists.txt | 39 + modules/extloads/src/ExtLoads.f90 | 931 ++ modules/extloads/src/ExtLoadsDX_Registry.txt | 44 + modules/extloads/src/ExtLoadsDX_Types.f90 | 2674 ++++++ modules/extloads/src/ExtLoadsDX_Types.h | 57 + modules/extloads/src/ExtLoads_Registry.txt | 103 + modules/extloads/src/ExtLoads_Types.f90 | 4274 +++++++++ modules/nwtc-library/src/NWTC_IO.f90 | 34 + modules/openfast-library/CMakeLists.txt | 1 + modules/openfast-library/src/FAST_Library.f90 | 783 +- modules/openfast-library/src/FAST_Library.h | 35 +- modules/openfast-library/src/FAST_Mods.f90 | 2 + .../openfast-library/src/FAST_Registry.txt | 208 +- modules/openfast-library/src/FAST_Solver.f90 | 454 +- modules/openfast-library/src/FAST_Subs.f90 | 2836 +++++- modules/openfast-library/src/FAST_Types.f90 | 7656 ++++++++++++++--- 42 files changed, 23198 insertions(+), 2278 deletions(-) create mode 100644 cmake/FindNetCDF.cmake create mode 100644 docs/_static/references.bib create mode 100644 docs/source/dev/cppapi/api.rst create mode 100644 docs/source/dev/cppapi/files/FAST_Prog.cpp create mode 100644 docs/source/dev/cppapi/files/actuatorLine_illustrationViz.pdf create mode 100644 docs/source/dev/cppapi/files/css_actuatorline.pdf create mode 100644 docs/source/dev/cppapi/files/thrustXActuatorForcePoints.png create mode 100644 docs/source/dev/cppapi/files/torqueXActuatorForcePoints.png create mode 100644 docs/source/dev/cppapi/index.rst create mode 100644 docs/source/zrefs.rst create mode 100644 modules/extloads/CMakeLists.txt create mode 100644 modules/extloads/src/ExtLoads.f90 create mode 100644 modules/extloads/src/ExtLoadsDX_Registry.txt create mode 100644 modules/extloads/src/ExtLoadsDX_Types.f90 create mode 100644 modules/extloads/src/ExtLoadsDX_Types.h create mode 100644 modules/extloads/src/ExtLoads_Registry.txt create mode 100644 modules/extloads/src/ExtLoads_Types.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 1ae72886d1..305226269f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -173,6 +173,7 @@ set(OPENFAST_MODULES nwtc-library version inflowwind + extloads aerodyn aerodyn14 servodyn diff --git a/cmake/FindNetCDF.cmake b/cmake/FindNetCDF.cmake new file mode 100644 index 0000000000..f3d64cdeff --- /dev/null +++ b/cmake/FindNetCDF.cmake @@ -0,0 +1,124 @@ +# +# This file was copied from the VTK repository: +# https://github.com/Kitware/VTK/blob/master/CMake/FindNetCDF.cmake +# VTK is distributed under the OSI-approved BSD 3-clause License. +# +# +# - Find NetCDF +# Find the native NetCDF includes and library +# +# NETCDF_INCLUDE_DIR - user modifiable choice of where netcdf headers are +# NETCDF_LIBRARY - user modifiable choice of where netcdf libraries are +# +# Your package can require certain interfaces to be FOUND by setting these +# +# NETCDF_CXX - require the C++ interface and link the C++ library +# NETCDF_F77 - require the F77 interface and link the fortran library +# NETCDF_F90 - require the F90 interface and link the fortran library +# +# Or equivalently by calling FindNetCDF with a COMPONENTS argument containing one or +# more of "CXX;F77;F90". +# +# When interfaces are requested the user has access to interface specific hints: +# +# NETCDF_${LANG}_INCLUDE_DIR - where to search for interface header files +# NETCDF_${LANG}_LIBRARY - where to search for interface libraries +# +# This module returns these variables for the rest of the project to use. +# +# NETCDF_FOUND - True if NetCDF found including required interfaces (see below) +# NETCDF_LIBRARIES - All netcdf related libraries. +# NETCDF_INCLUDE_DIRS - All directories to include. +# NETCDF_HAS_INTERFACES - Whether requested interfaces were found or not. +# NETCDF_${LANG}_INCLUDE_DIRS/NETCDF_${LANG}_LIBRARIES - C/C++/F70/F90 only interface +# +# Normal usage would be: +# set (NETCDF_F90 "YES") +# find_package (NetCDF REQUIRED) +# target_link_libraries (uses_everthing ${NETCDF_LIBRARIES}) +# target_link_libraries (only_uses_f90 ${NETCDF_F90_LIBRARIES}) + +#search starting from user editable cache var +if (NETCDF_INCLUDE_DIR AND NETCDF_LIBRARY) + # Already in cache, be silent + set (NETCDF_FIND_QUIETLY TRUE) +endif () + +set(USE_DEFAULT_PATHS "NO_DEFAULT_PATH") +if(NETCDF_USE_DEFAULT_PATHS) + set(USE_DEFAULT_PATHS "") +endif() + +find_path (NETCDF_INCLUDE_DIR netcdf.h + HINTS "${NETCDF_DIR}/include") +mark_as_advanced (NETCDF_INCLUDE_DIR) +set (NETCDF_C_INCLUDE_DIRS ${NETCDF_INCLUDE_DIR}) + +find_library (NETCDF_LIBRARY NAMES netcdf + HINTS "${NETCDF_DIR}/lib") +mark_as_advanced (NETCDF_LIBRARY) + +set (NETCDF_C_LIBRARIES ${NETCDF_LIBRARY}) + +#start finding requested language components +set (NetCDF_libs "") +set (NetCDF_includes "${NETCDF_INCLUDE_DIR}") + +get_filename_component (NetCDF_lib_dirs "${NETCDF_LIBRARY}" PATH) +set (NETCDF_HAS_INTERFACES "YES") # will be set to NO if we're missing any interfaces + +macro (NetCDF_check_interface lang header libs) + if (NETCDF_${lang}) + #search starting from user modifiable cache var + find_path (NETCDF_${lang}_INCLUDE_DIR NAMES ${header} + HINTS "${NETCDF_INCLUDE_DIR}" + HINTS "${NETCDF_${lang}_ROOT}/include" + ${USE_DEFAULT_PATHS}) + + find_library (NETCDF_${lang}_LIBRARY NAMES ${libs} + HINTS "${NetCDF_lib_dirs}" + HINTS "${NETCDF_${lang}_ROOT}/lib" + ${USE_DEFAULT_PATHS}) + + mark_as_advanced (NETCDF_${lang}_INCLUDE_DIR NETCDF_${lang}_LIBRARY) + + #export to internal varS that rest of project can use directly + set (NETCDF_${lang}_LIBRARIES ${NETCDF_${lang}_LIBRARY}) + set (NETCDF_${lang}_INCLUDE_DIRS ${NETCDF_${lang}_INCLUDE_DIR}) + + if (NETCDF_${lang}_INCLUDE_DIR AND NETCDF_${lang}_LIBRARY) + list (APPEND NetCDF_libs ${NETCDF_${lang}_LIBRARY}) + list (APPEND NetCDF_includes ${NETCDF_${lang}_INCLUDE_DIR}) + else () + set (NETCDF_HAS_INTERFACES "NO") + message (STATUS "Failed to find NetCDF interface for ${lang}") + endif () + endif () +endmacro () + +list (FIND NetCDF_FIND_COMPONENTS "CXX" _nextcomp) +if (_nextcomp GREATER -1) + set (NETCDF_CXX 1) +endif () +list (FIND NetCDF_FIND_COMPONENTS "F77" _nextcomp) +if (_nextcomp GREATER -1) + set (NETCDF_F77 1) +endif () +list (FIND NetCDF_FIND_COMPONENTS "F90" _nextcomp) +if (_nextcomp GREATER -1) + set (NETCDF_F90 1) +endif () +NetCDF_check_interface (CXX netcdfcpp.h netcdf_c++) +NetCDF_check_interface (F77 netcdf.inc netcdff) +NetCDF_check_interface (F90 netcdf.mod netcdff) + +#export accumulated results to internal varS that rest of project can depend on +list (APPEND NetCDF_libs "${NETCDF_C_LIBRARIES}") +set (NETCDF_LIBRARIES ${NetCDF_libs}) +set (NETCDF_INCLUDE_DIRS ${NetCDF_includes}) + +# handle the QUIETLY and REQUIRED arguments and set NETCDF_FOUND to TRUE if +# all listed variables are TRUE +include (FindPackageHandleStandardArgs) +find_package_handle_standard_args (NetCDF + DEFAULT_MSG NETCDF_LIBRARIES NETCDF_INCLUDE_DIRS NETCDF_HAS_INTERFACES) diff --git a/docs/_static/references.bib b/docs/_static/references.bib new file mode 100644 index 0000000000..34192e55d0 --- /dev/null +++ b/docs/_static/references.bib @@ -0,0 +1,122 @@ +%% This BibTeX bibliography file was created using BibDesk. +%% http://bibdesk.sourceforge.net/ + +%% Created for Vijayakumar, Ganesh at 2016-12-07 16:45:28 -0700 + + +%% Saved with string encoding Unicode (UTF-8) + +@inbook{churchfield2012, + Annote = {doi:10.2514/6.2012-537}, + Author = {Churchfield, Matthew and Lee, Sang and Moriarty, Patrick and Martinez, Luis and Leonardi, Stefano and Vijayakumar, Ganesh and Brasseur, James}, + Booktitle = {50th AIAA Aerospace Sciences Meeting including the New Horizons Forum and Aerospace Exposition}, + Doi = {doi:10.2514/6.2012-537}, + Month = {2017/07/18}, + Publisher = {American Institute of Aeronautics and Astronautics}, + Title = {A Large-Eddy Simulation of Wind-Plant Aerodynamics}, + Title1 = {Aerospace Sciences Meeting}, + Ty = {CHAP}, + Url = {https://doi.org/10.2514/6.2012-537}, + Year = {2012}} + + +@techreport{beamdynManual, + Author = {Wang, Q and Jonkman, Jason and Sprague, Michael A, and Jonkman, Bonnie}, + Date-Added = {2016-12-07 23:35:57 +0000}, + Date-Modified = {2016-12-07 23:37:15 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {March}, + Title = {BeamDyn User's Guide and Theory Manual}, + Year = {2016}} + +@article{martinez2016, + Author = {Luis A. Martinez-Tossas and Matthew J. Churchfield and Charles Meneveau}, + Journal = {Journal of Physics: Conference Series}, + Number = {8}, + Pages = {082014}, + Title = {A Highly Resolved Large-Eddy Simulation of a Wind Turbine using an Actuator Line Model with Optimal Body Force Projection}, + Url = {http://stacks.iop.org/1742-6596/753/i=8/a=082014}, + Volume = {753}, + Year = {2016}} + +@techreport{fastProgrammersHandbook, + Author = {B.J. Jonkman and J. Michalakes and J.M. Jonkman and M.L. Buhl and Jr. and A. Platt and and M.A. Sprague}, + Institution = {National Renewable Energy Laboratory}, + Month = {July}, + Title = {NWTC Programmer's Handbook: A Guide for Software Development Within the FAST Computer-Aided Engineering Tool}, + Year = {2013}} + +@techreport{aerodynV15Manual, + Author = {J.M. Jonkman}, + Institution = {National Renewable Energy Laboratory}, + Month = {April}, + Title = {AeroDyn v15 User's Guide and Theory Manual}, + Year = {2016}} + +@techreport{naluDoc, + Address = {https://github.com/spdomin/NaluDoc}, + Author = {Stefan Domino}, + Institution = {Sandia National Laboratories Unclassified Unlimited Release (UUR)}, + Number = {SAND2015-3107W}, + Title = {Sierra Low Mach Module: Nalu Theory Manual 1.0}, + Year = {2015}} + +@techreport{fastv8AlgorithmsExamples, + Author = {Michael A. Sprague and Jason M. Jonkman and Bonnie J. Jonkman}, + Institution = {National Renewable Energy Laboratory}, + Month = {January}, + Number = {NREL/CP-2C00-63203}, + Title = {FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples}, + Year = {2015}} + +@techreport{fastv8ModFramework, + Author = {Jason M. Jonkman}, + Date-Added = {2016-07-21 19:25:11 +0000}, + Date-Modified = {2016-07-21 19:26:24 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {January}, + Number = {NREL/CP-5000-57228}, + Title = {The New Modularization Framework for the FAST Wind Turbine CAE Tool}, + Year = {2013}} + +@techreport{fastv8, + Author = {Jason M. Jonkman and Bonnie J. Jonkman}, + Date-Added = {2016-07-21 19:15:10 +0000}, + Date-Modified = {2016-07-21 19:28:31 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {April}, + Title = {FAST v8: Changelog}, + Year = {2016}} + +@techreport{fastv7, + Author = {Jason M. Jonkman and Marshall L. Buhl Jr.}, + Date-Added = {2016-07-21 18:11:47 +0000}, + Date-Modified = {2016-07-21 18:13:07 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {August}, + Number = {NREL/EL-500-38230}, + Title = {FAST User's Guide}, + Year = {2005}} + +@techreport{fleming2013, + Author = {Paul Fleming and Sang Lee and Matthew J. Churchfield and Andrew Scholbrock and John Michalakes and Kathryn Johnson and and Patrick Moriarty}, + Date-Added = {2016-07-21 18:05:29 +0000}, + Date-Modified = {2016-07-21 19:30:03 +0000}, + Institution = {National Renewable Energy Laboratory}, + Month = {January}, + Number = {NREL/CP-5000-57175}, + Title = {The SOWFA Super-Controller: A High-Fidelity Tool for Evaluating Wind Plant Control Approaches}, + Year = {2013}} + +@misc{MPI-3.1, + Author = {MPI Forum}, + Month = {June}, + Note = {available at: http://www.mpi-forum.org (Jun. 2015)}, + Title = {MPI: A Message-Passing Interface Standard. Version 3.1}, + Year = {2015}} + +@misc{hdf5, + Author = {The HDF Group}, + Note = {http://www.hdfgroup.org/HDF5/}, + Title = {Hierarchical Data Format, version 5}, + Year = {1997}} diff --git a/docs/source/dev/cppapi/api.rst b/docs/source/dev/cppapi/api.rst new file mode 100644 index 0000000000..063d97d035 --- /dev/null +++ b/docs/source/dev/cppapi/api.rst @@ -0,0 +1,11 @@ +C++ API Documentation +===================== + +OpenFAST +-------- + +.. doxygenclass:: fast::OpenFAST + :members: + :protected-members: + :undoc-members: + diff --git a/docs/source/dev/cppapi/files/FAST_Prog.cpp b/docs/source/dev/cppapi/files/FAST_Prog.cpp new file mode 100644 index 0000000000..91a21447b8 --- /dev/null +++ b/docs/source/dev/cppapi/files/FAST_Prog.cpp @@ -0,0 +1,54 @@ +#include "OpenFAST.H" +#include "yaml-cpp/yaml.h" +#include +#include + +void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { + //Read turbine data for a given turbine using the YAML node +} + +void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, double * tEnd) { + //Read input data for a given turbine using the YAML node +} + +int main() { + int iErr; + int nProcs; + int rank; + + iErr = MPI_Init(NULL, NULL); + iErr = MPI_Comm_size( MPI_COMM_WORLD, &nProcs); + iErr = MPI_Comm_rank( MPI_COMM_WORLD, &rank); + + double tEnd ; // This doesn't belong in the OpenFAST - C++ API + int ntEnd ; // This doesn't belong in the OpenFAST - C++ API + + std::string cDriverInputFile="cDriver.i"; + fast::OpenFAST FAST; + fast::fastInputs fi ; + readInputFile(fi, cDriverInputFile, &tEnd); + ntEnd = tEnd/fi.dtFAST; //Calculate the last time step + + FAST.setInputs(fi); + // In a parallel simulation, multiple turbines have to be allocated to processors. + // The C++ API can handle any allocation of turbines on an arbitrary number of processors + FAST.allocateTurbinesToProcsSimple(); // Use this for a simple round robin allocation of turbines to processors. + // Or allocate turbines to procs by calling "setTurbineProcNo(iTurbGlob, procId)" for each turbine. + + FAST.init(); + if (FAST.isTimeZero()) { + FAST.solution0(); + } + + if( !FAST.isDryRun() ) { + for (int nt = FAST.get_ntStart(); nt < ntEnd; nt++) { + FAST.step(); + } + } + + FAST.end() ; + MPI_Finalize() ; + + return 0; + +} diff --git a/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.pdf b/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.pdf new file mode 100644 index 0000000000000000000000000000000000000000..fbb1fd5b4b6dee4ff40c4020ccc4b72661fdf82f GIT binary patch literal 251323 zcmeEuX&{t;_cx+MM92@(P$aUHtqjtFvS%%fB_X?PgT_`#DO-%SL9%2U*_UBPN!iAd zkaZBoJ`B=ecrN$-zn^EWp8M_d?s>QWvG=SVX_fkY^V2 z*Ry)Qd}Wb`$U;2tyRfLJKxA|sJe+(VLKJ|Hj36?a&ThUA-oS4+J70&J4)&f893X0H zEIz*84tDM=0rZV&9Ug+;IG=B=b2px~dpNq)aVg%uiT=rD4o;aT7hZGmDXI@AO`mP; zn>8g<6>4sf5X8Ny@hjc9mBqKP!tut?MeL)i_1!k1%qtt8 zn0B@%zX(x-zI8d8*Z9wjm1JakjBTwzp;EQ-5<4!-{(i3J;lawM2t3IBhRr~?9_;)AurR>=+4mxwKF4m9?JVWo^yq}K8 zE*S`mCE%vi%sXDEt3JQ}p0jLwp@Ee|{IE$4s)3iTszxQHteQ?gh)JS*)K&G>g!jrS zqx6?*ALd7u$7ac+u7Y;jJ_7HypEVK}TyLE3USThW#pkGMo~vVdQ^y}}CEm{zQ~W0> z;``%ffq&G#SmY%P7_Bh)r)X{E)_!*+%@`>9jT5!suJOsVg~SYfE3Ua+Z&c9{U*YOv z?BSzTG3lMk%EFCdPWdqt^YG9wRHZ6$GE%ZZ8gh(Y?%UL3cy8yAlg839=EoV@yecp7 zTtDA1i?;1vX4fdY*OO^a3MYPX*=iz_$c)nqw>TfuH}?j4H!q4X zDa{U~e``PV@HOX#Rf`tSs{MFayPH9iTr_u{x|y&5H-hJSiq2Q}{6jKlItyl|pSUTk zCMx=!=9KK*ja%fi&O5gjG~qB&5k|*puyy$(_3%%{bLvmy9M}crU!M<4=(*1;vC60) z9Z>UJ*2>n{IVYYgTy-!>beOJ*DMz&Phuo#FuNR-o7|&*F6{|2Ox5@;lv=$%Tr<2Ss zJt`i3mSg539dA*QirIy9Z{MV!`9~XlOhQ^y)aIm0p29CIdZW(pn+&#HQJ59ak$v^1RLErhqP*z!o*X9KUvlh6Osl%X3YFj3HE-Tvt&&iQM=~na4rV>Lx_oB-l%7H?;kT=`|(fwL*bBB?PxB^ z^A4#|Uibh)JRL)s9)rl}nR~ap*T{;7%#b&4@7{QlA$KCID(!^kduB7+4@}qn<}P}j zRd>D3R}vm(a@2jrxC_E=h`h-Z-JVy)n%REnLEG)s-x4W*vJ4-EpSw7E>*?LpiL9Hy z{8#C69u<zV*Y8nb5n=3ZRx>wE`B*s*=7{nbh%^__!)#uNCWYM!29O&zH9aGY{ zl(P&SWW~A$*>Uux>RM}m**d@DV1&l~Haxy!}S>R{w3gx5qR#EAJ2oEl*WM+}G?iy!3qK=AX};-@Yn3 zA9)~$w!>kl(l^(dZr;un(9=Bp=h<3T(5uG9CEe4KV?&ym?I-$gjdXRIYcza8e>v%G z3?CJ?k2@z`Ua005Pqiqj6iu>rR`=8FtJqMe{#s!`q&P2UWlBEK_WttL?WD-fXJl{x zItv4VxdwWAQ_&CC-mR$?=aVzj-khJhLphZDsIKlUlW?{v>aed<7l%^X@ZoF4<0*8q z<_^j9pK|7y*z$i%9Sv=J+AjLOx$%%yWR@F)?HK_jn{y@6{YNbXdh~+c2D81P7oNSx znKA=QW}VSt`-v2yhm1A`obnE7q>qydg9%?y29yD z#TLm`4mey7IQw>dVB^B*$iUK2{{26>V$bHU=+1nid%&f(97mfAYhK)j!z4lMfk=Y-hC7FYR!j%GNX{v&OTB zZ-iL!9Zt^Vdsu9zTZZ*i6XA$*K2u>i9OQU<1n;o^$^BZY$vNC7`v=%tY*{$F=u3%w z$XkBe5WJl0mkWGfe^|{Qt93#!#Jn`FdXkN)6cD<3WHR-#6K3FHC$B+S-kFCX@*g=7 zEjg*IA!(a*=B=y?57C@*s`VEc%M0GDnlTsJT{Va>F^O3FoRszDZRNOCrJcrdkC~`= z(i7X|%k28@UKJ9yn8Pt;w*)slwYbeKE~f>Bh-jb3m1iwj#ZF(lAa`q_{G@AV_Q#WB z$6u<~B|g`Iz3~=TF*c4dsD%7_?xOkLRN)?Xv(q4pt-GCkDFna65jou&k-2y*ORm4rKhQ0jW z%or^vA0ho-mwq}hLSgp4lw}B0N`_Ff=q=dbPX$?dF0GLEu$A;S$DwZXDgD`_j_M8H z`F|<$tuFEJ3?;FYi=S;5(~V5Ib?WdlsQhv0#Y5gt^#;;A4*%fzI`N*uv^;C_PAcuy zJFfTqc{X{TyB4?;QQHi?X_+qU20(4u!W9>Zk(H)vD`p_ z{7L+~R*etql~n7y8rpWc!s){A2Tv`3QlP7piaNX)ocLyC56XqwMz5hVy;|q(voBHs} ztVL^v@*zXBISsm(nk{#K-K&>tdNq1*6Sab{SPhf71E)eqjf38XN$ zhFoSJeoP4A<}tBlxv*1UL-5S_m>Jh{C5^>iXfR^ zSI%$i=89(@>yQE1+4kh}YOD*gA`nGYBWCo4jUzVkdUA zW4`Qe6BkXh&QiCVV0D-RHg+%068Km-F`ezg_mJzushoF5kBnW^Krv)JC)aW`}~IU3VyYj4*~jJ$Bk-Al6Y=PN~kc z&vZ*6$n^Q2fKU#l5j*}aub(T&H`$McVkkG15|K`Gml{u-RWfJ0C*0LGPW%3I*jriX z%7_-F7uzg~;2z4EtRc*u5G$>HR=2v}Et*~7sPgDltJW1|9|>HVujcnJu2Aec+NMp$ z_GQSE*!J{MmPZ`byKwg0qvDO@hUA&3H!{^sHPQ`3!c|X~Y@jRSGAU{7x)-5}Opxmz z5iZC0;}vf+rpfo^R<7IjIPI~rtcpJOxYedzwwl8b6>+un{$4{{W5@4b)#RDYo3+01 zO^lM#U{7>iU6CHfe1vKLbnl~Qxo59Uv%b+K<|UrRoWHvBx;fz2M6^w)UkI9do-X%w z+SeMp_`J@_$@qwBlRpo${acx~vTrn=O@=1xNQcBnoF$!M6+C>+OYKy`qsb^lo^aJW zI>OZL&v_kK&8rQilK~@IWS@){abfnO(o*4MUIQ}Z+({zwG}x+p%Jf`N)7Z99d@E)19EQOi}YmO*>lHZThLA~ zzDaeXNi{e9+f*b~1L6a}OeGmdKb1bs=Wr!)r}mkZ_@J1?nVOdOb6<~?wyZDC*KYi* z5uU!)s@UASrE02iIP4?miQf_ATbdu=RR({%yxOH?u!NhW4lUF=lq-1ZneUc#C9$Zv zP3|pMmpi=-b(0)P3bqT~#(9?J=ZUJei$Lp!H`{q%P5@P)|zyN)(;@bUEXws-J>DE|9{8=fA%z;z$U zLG29`+IkKTob9fA20$!jfe(Q9OUpy#6lGy7K(+lpD;+%fpDNwZ+tc3I!53l)EO%2A zB4gqZ;0uwt?G7w`{eOPn_@CdmAux!{4No^uZ(}bzdk4rtk$=PIB1Gw6Vc_*ZaSzDy zua8YkEG@*y&J4eq-**#G;|ZTCx%iwB|svfg&T2)X>9yZ(=S|GNAi0sn_a zxOnm3kNjIR|9PQ|vEO~)f9dL95<_InogV<4!^Ml2*IkHjwXF=^lDmOJk#LOhl7-kaa~?BlC-nV3R;yjY65Hb?l^ zP&BrdgPCCr_m!3KxUh>t3Z)#UXXH?)`~N@wzYhK%*#UEY(^e^|Ind6Ehk+RqM)#i| zvbPu_5P4P-hyb|qEna+;$p5(n{3XoYO1#u^U7u6t+2B`EVbHZhXE>tWY7zM_28+!P z&(_x&f+UByF}%EaAz4RqbiQ@wk{w0`eFS9P|NIl4Lxxo&N#*n5bso~(po`4u>Jofc zJK%M?5~<81Jl?9b5{EU}GUpf_l_Bu>P^=VFUmXAH=Ys^@p#Fi;%q+>|V~3-W$380L zBzedXCd~WvfA9HV8^@kEZ4VdX;m$3}5g4P3rAO8Rd}YxYMK?iC`1uUSOSjr>m@J{} zrksjWisUt#%i-aiFEkaa_VpL#EGb>Z-De4GomAp=P8u7As4%SEl}{l>X~;1dJd#l{ zZ$;AR9+2aya8Cv)#ar#4Efi?!@YSQ@gxo`maxh-Jl{6PtawZCd58+;{4~tN3@O!19 zd6}ev0kh`dNh`ts9O}Q$iQ^Kz48fsm23mFZjtxEzc0L)bfoGQL6zK&0*{(rSBFU&N zpjPH>(G8mI(KB8bn;=4KF7;8*5+atQeXh_dnIkB?prGx+rHr;56P#R|elzD1f{_fH z^Hk-1L91wCuDd~HKa)t>C5Ug#4RK?x(jYtdEVX+7(Wm0>jYW9GDT?$c94tflN0tlL zNhI#IO0|S-*j-QM!3f%yzvI4Z2`i(T8o95N+^{;4e*dedwcv0wB#$W&p(o$fOB1Pf{3wFETPQ0Q>2l)&wjVp$%5Z+1-!pYs_TaVlWL19 z8CJWZXb!R_yOSR&(s`Sy=n&pccpw>;LQ)xgPJ2{#TrV`vv@ueo-D;4FATOflu9YAZ z#3gq-+|9faW^+`Uk5oB##lgn4n(wY;b2hK2!!D1ZV%7Q-jDrhpLpeKG4 z9Og^C&kGoUZ9?@N;A>SzM}K#3Y!}6mf>vT4T?dOf!%%kj%O-#_F!nDMpiAnR%)kzo z5YMU+-?lr|>cZcOfmWV4YK0`-&1^Ggq*WfroJ_dDI!sOL6>_gW_pKD|BgZ~8MN_1K zEA&(suOZsSdYl-PW-c~$K#{JpG{_iHKoS&;#+p|?`~hJ zX(DN0aBzF+&1D$K#%v)>=r(v%z%(X&*T}0Ev}iKJAQ6L*Zr<+1Hk7`V2Z@?NNAXx) zxnlmB*4!q!YlR6j6+cLy1Ao;?(5}Ob3M0cV@pb1U4Cxleb-Q%KR$GY`Wq0L$dGSo( z2q(r_Id$w}h7<{8!OXkb;duO} zz!t&z(d^f++odX!YOElCQ=h12Sf;F$Q<&S~>C>2zc5)Eysi{v49snByRqj>9TR69m zhG2x1aAyB5v~g)LgEtd|&dd-mC?GscEje0K(Q^yi!2j1ugDk!&r2D5&1HFP(gz+uM=V zx>x8xw+{O-+^Aj`7p;B{-wQ)1wZb!9LE%L9s8uS-3UD^SH59?F@$TdcO$CC=WVh0w zk*;U3qw7n+7;gmc*IlO7FLNva(E5+pSeRzhBZ)CSqO=lon1#oXVHpVCft_wYTBWK7 zFj`?d4v0|B$2xpV7MSQ&F!# zY{i+?4+ORW^Y9`Knqv)D<9*R0GH>$P@@>Ivs(-L!LCPTKsYmF|)H=7q?ownQtsdwZ zKVPt2M-3tJ+n60Mf9|KCjijIRJ#hu6q1#rF_!qgx$wX-BvqAnx*y`$G;$ZtcEz$r0 zaq`v|cdRi{S8hmU(adrCD*goC4BMyQD0{=pomM$v>Y1!onIzq#rAU&Z;=s8BjzFUJpoOa7V2KXu)9v(=+S1Fhda}dz zaUd;%5E!LFX0;7dH$HAfUAaJDQY4^?2rU4%li=y=wAu}q1&sVN0$!&`yT5|}!L+hAOPKczZME`UN&K9kVZkW;TTxJS!V6R+-e zO+y7%TH&g}>zA+43aJi($SNu?kYUp4?9MIY)imDGK74j_O%_ ze{!eZAxTm06#aF40b%nuetL=at+rV}26-rWr!Ii@70mHKP*3*^3E78@mvk4K>J)b$ z>m8dlqJ0uDQ{#jLX@WzAb4ioiW_PFSqdfL>Qq&TTbzLb8f4CEiv%|9`utG$VNk{X)ar|V;mGsgD43oS$^cROvSEjvp65VAT&`xvCB z6mS!0^esbd-~FzTMw2d3X3oJ})%5u@B61U&Oqwct_(8Q61Yhb|HcaSN_(G=hb`j&C zQ#~SC_shrkYd#iE=H9?t&^NZ_p-0^f3hZsXuE#J*|~DKHU9zfJVvn}G_fncyUA zCz<`*uTZ4bzuo|;E$bYU2a5E)Eu(>5pM_Qz9RK*zlgF|`57mayKEV7+-D`g=dQook ziToz!<7g225baaf#Xg>#E4_|o9m3Ce)1HED79(K0ewezuptqGZ)ghdSXHxc3i9`Zr zozojI-Zk@Z9a>NaqJ%6(T1YSd&5+wLUI`~bm8eoIP0gP&7}GZ9R&G(^|6clmUtdo zcvWv@lE%Z4mnhQHTc{3@U4Ls$Wk z9AJF_oD+*9bxuQZA^D4ujw{hMyvxqm1i9xW~@aj_2k80zR+TW5ol zqv-Rf>KUvqz|YT~dA0y;Y5@tv%(zER#xbtL>K;U`0`aWDA2obxipJqTPMPN}0Se+-0f) zY<+zn`1q(IOKxcTO9nk)0A#?sW!F`Ad55e}aR=!C<48GcW;{($0r;}b3Y0lU; zq{BO}n)+#lP$#gyj)~D!R6@7IL)L&WK_ECw(C6c*JWJ{EF`qpPh%d}+91H}lov9r4K4s=xaFCo z6EA<7lG@fmfs2j-XFc&9VP2Amw#b|(!xYoS2-NNLmUCdi27v@s-*{PmzpJEs=`5ja ze}&&P1Vqjujr=E&dT}Bz{nz_dfl|Jv?vXRrH3dP8f@=o?s=^v0RKPE51ag=LGE5?HXuDHq9fk7j+U{I5 zrGN{;)kUV2I8vonEMjYs#GMIZznQIMKGxPw^plo$F}9(|jx7R`Rhm%nseO~w=}GH% zz;TA;0>spp;%?nq%Iqh^;D^Ul)9SRnJxuxRnK)9&4BJ!%Ezr<~vonQ22%^fn%+}zt z7_!RB=z%1e^cKB6NceCQd#juv<*Mg1$XH*{Jn+fu&3M)bx4J}`WR@zI+vy~Ef|aD) z@*RT958s~%^B;7+o94ZlzT12a?6e-rp`NvKz&HDvVqMc-0D03M+awoQI4DbT@r7^q z<8_tqwK|!m^pQJUa_^QRO&g%*IM*4BOKwi`e9I5gig;HhElkldjB)ntLV;`+Xx%(= z%(XIkQjx$}dAS1Jk~(7PCm1y9X5uHlT@adg(&y6YcTlBgaN6RNo^eGSpub-YZ^J(I zlcGG5h&8&I#b%HxUcB0x3V2i~>9y9WuD^Hn3VvE`?Ni(|8kuTK)=CdxHbV zNshTEP2XR&xROyL2;y%7tP}q7@+L-l^u+iHkT|soVIA;1oVMCxnp0tjlM*4d4Iu2H z@5ovpF`87FAMT-M&oHi|{D1nTklwufqx$yZ>6d>&O={EU-3Bu1`4D9j15mTirwVXU z08NI)=q3`u=e5HL#5fl+N^_XfjF%Z8$)Emo5TAkiON=nqt@_ItWUS#GjMB6JPFsKk z51_!$lflJ-*FHl>hm1&kv@KPi;!$LmR%A77)6xwu+{!h2xr3wY0>hVj6UzlDsp=Vw zW8(rDMNsJr%>w!@Q0!&Urqw-J9;!XT!*65u(H|(YB`v9r&0|CFsBnCcB!TCLO~f|L zbKI~Cl=2=nQ>S>?+e;x|Cr1S;d{Az85KiX+5C0ta?JuIbsL5vkcTH|CZ`oWPkS{co(iCba z9!{7^LCa`V$@2`~O=#oSW!(D^-T|4z;Ko?+xz+B_y^a}-$)(8w0AROQ#JoS#Za6HA z(Sjm9MMm-4Z&Ox^1M(#@Y;djvCS%YdLhexLw=HInSBab`Y%gJY|R#QbnxYzj*Rhj`29+ zS;wH0NBXQp9xm$M+xdP{r47J~9UnK=KT0dZVdIJ3_gbG2=2DM$NS)82BPu>M{nr7f zbLsa60F1kQNH<7!toAP!a*#2RH0$UzvH*|rHlM~kFCxT~f|k|1)xgU5O<-DtBfZOp zKBOTAB}P!C2Z>baqfLxe(zc+D2q=ZlI>#8ILMSOM+4zF=Istl5lP&A(=$ONcKw%qL z7Q!n&nYxW)Z_KkUdbp2TfNv9Rxx6<)52zaeof|3X&Yc}n17c8qQSNDx{Fpa>xkLw` zXiVl_N=}{y`{}2X|M2r0VPD-;1lm2LEr=S-*v8fr04EU$Mb20@MPYMLR?NKd49HK; zc^vxtls+~^Aj~iAkQjg^fpqMlTrE&Nj~yq_kApq)&lLuH`}d2kMd6#Nii9Bw^KfXs z7tkt@^;?dC4=Eei?6>@!1F4>6o+Ztl>LNhJL^T4C~I4+CsQcIx~FWfKV5$D7vk zK`Ll6I7r)sUezMZi!x>~W2o7ovN12?6K>cd425|blZlWEfPxNS;s_&9l_#(R-J%lC zqlJW2AXu84EZGOo9{>6G%e%P)wl@l9(=iAA6N`{}F#?K*WYRj~0ff{%DCw_+#Vs5& zi%GM=0Tk)got%KHpk?X8Em?JSUl)b&zS1mD{h_dlX?n3_BYcy}g|2B*mwTay(PqGs>;-nd`z@RJ6cW#1?IGPS5BeX-gg> z8(j!8#*Sbsfdcvs$wRVhkruA#!dDKAP^J+WW-xu;*WevpX-wkwGh7oWtW@op>Kxea z)Gh%+!^wyK#2*3XpdA1@VFnVZhQt@&b`kl}e$yCBX0j3JmMkRz4PSlBZimmjDIfr` zDvfQ^{Jd)p!zO0DHsLK3?aq$Xhmps=e`lS+__mjHUvTlFm{sIyq_|7UZFakt2Ii%P znwOeN%w!KZ&6XE;pW5)`90ZwrBLrxqL|~e((3VmMy%(Kf9xK$YX;~-`s5qT#)8}uNZ#_AzI>@A z*hC<<FSG$M#KlEA6A#fv$JJnDW(ea0gaBOD^1X9roV+3#H|t7oR^ghYIE| zrLB^H&CeyNOA<5^dwD3f; z)`a7Llj36gBZ;5OKbuWgmgHsw8=Jb}+md9M)6WJ_0Opv>2F{fH{gpb_I22hyg_{#G z727BvsZO1nI!_(|X`7BgkXct(cT|d?AfRwis1MT1$$%57dg-3qSXZeoH^u>{fi^e{ zr-b+`=@9@pF89g+aFX7G0jjPR`(Cq9r0u?LDUJoOzQ)kEe6-dF={b>-kzrv8yMyfr zq{@w~!z4%R{L|2ZdGnbCo2k)38ta@a5msU-m&Vike<^+<1mME9es$%8L;O|CFvM1c zMj#kTfSVm1^UTeYxE=u%yh-O^p{P{DXn8XpUM=7rxtLi%s4ng9{HV4b;&D0?M7lHo zVJIZjA(HVqR@jPlyt@-}ozg{k0nA*qKV8DDUkn711I(lEfo!tvX6G~paJ?~r9|5Lh z;X#c?!c^0hHFh$n#~v2Om6Doa4TI^6O#!}Y^v+C5Nx)R}a?K^5t@0BYC4_#SLw<7x zEEG4zgs-4p1c&-W2va8j^Xp?tLkRditnpe`DS<+Xp~ANw3s8K)&VU0Ft;I!Gi_Fw+ zhpv8-bT@o&7gLW4by|mA0|JB~K@@zy8q)z0VwFU40eCGuT<|wQTZ|E5(-mM0+uz$d zz5hqc5-9sB_gBaWryZy5O-xz|;Q%kTffVSEBG{d_Bv-d^`@wc0(zR;q055V}>my!{ zN(Hj*oyKs4GRQC{j_z)jhFYd%0;K-;f@dQK!kP-2?4C^Xc$t?>+Gub_drK2|^r$g= zsfYp)G=%SP2mF}`Z-b``&O#HG03!)({^JJTA`5*wX;!*~fLbgr@4t+r0Fjs{>o4A5 zG@*%v+ecI3aDc;-nl%Xpx;Jti+ntZ=BM=ur!rB7dcv8|y7}i*~Zx;%T2Dq=I97X5& z;6D#)6)o&9S5PmHc_XSR;oJ=+B9!ej>ohc1WzZ(~PN^Yo5h>6XNQJVj4C}p;AGticd48@j$^&h zwLyj<5%5fEiBx zQA`p-?8U;oF(4e-cmmKQI(Z?0t0761Kgsv8KK7iunY_T98qf{n^$;V1T3C_sbU>lZ9P#9xARtZFt zKWr5JW;`CjIC8b(9>F6`D!>K(eW5fP;WSHNlNaFyKe7=PmPzuySFykH=71kP;=z>< z5|DXRTvmCZqR&mEPLcfp0->qEks$~KvFd(3Jv>T5zrb=gajQ+XS0L}o_vx*qb zoN1Pn)G2syouc1@v8c*HOjpJJlAv5eP>I(LD!H(vh9G+lJ`ije{ z?7BG&&0?%9P)0vwG=#fEG1SHqYUA?Li82z^xO=fiI}~c^r}5b+o(dNXTE7H3xGYPC zgzikw;?mqVkMNfbvBs*>aU_dLG|!^dK*glT<50M(XMRC$dek!wGOT9hI0;O}`APtE zw#jw8Y2|mLS90(gfp(85@5m!iiqJK4Z5DXQ} zzFO*3xxoRmH*EoBaenEf${PJo__LViF?*jS!PBX~&U&Rdv2U?&!4C)ktWi8-5H-?_ z0fz!XR^8X>2;Nu?6I_wGj-{S4&e%(CvWwMs=iIlQ{Jlr_g%)ztnAnE>4?9= zGK>?5jNi9)H@klTOc)uK6+nyx7RJhnst5qHnH7>wU(>l+{M zT7Z`z;1@^hMAKZFvqjTtDC*YWgM#$%gg@FezX!Yh<$Xj0;c5liG!Bou15X6HmR3MQ0T73-0*{1R;r`gVdvAwqFMpP53%mjn5ZK$=TA3MEZii&@dSu8W zg)`s?)SoqDECT+|htVqS0FOs`0N0wZ(4M-M_m}c(0LIDE+B)i6HU;r@2D4mJZw3q6 zAyu+h@XU4YK_3IQ2ggr!Qr#N^?CqBoPq(^)a0i$#5|LF_2Bg&&)x{R2Y@@dA4wF&l zbx__FD<>W(pIy;C0YSd`|GM%&e0;qKpU{1vuQlGkt&0nFED9m=JEmn?6b07iPob2Z zT#SV9rXEl6;6=lwS%AqMGE7Ctk80XQ9@~o$6NMNM$|(J+cEGexHvDviLsK zlJKkKFL{+u0!3TfLi-ScaRw??XF}~lu2yz;5km8iNUxnAtwZEb!3t7Hf8Gax$GXDQ zd6_cQf`PFCwdCHMr*&DWUT+3r(Roq?KC>jS(S6hH?Qrv8nA zi;GKS8*HWg$8H^XNS)0BR3E-tkEf-; zh6&KW9~r$%T9{v({mYyLSyUcx|L6u%JnKa{J?cs!!s*-id4lt$&t~t>1XRcWNZ?-%|ruNrt1Qa@mQLI00b;l>a3=W_=H6CK#RPAvDfg&JM&Gus z3}NVGniEQHtJ-AD*oOxg73#oi#R~ZY@$PRzxQGE55&>Ea4Ppf6mb?M?`dNu#ME576|`tgu}On3HO(M28N=`WIhokhLG>e7%L{v$Beu?vi349}jaZ3h^U z;lO-CVE_>*x?i=RGX(yM+>o9+U=F3-%fh*U3U^xPtX|~zCIU?+MS}CvSkg$Kc_|V} zx-|b|X-W6LE(sW_uQUOf=CAhT`=|m%Kb5JVNs>`zlYvB0|I))k!pdtF{^XJ{K+b$AF*>zH3Zi%KJJfE`@ zpn(C+x}eM5)14#^7xHy%4=+4Df+I{N1c1X%n7R^>Y|qX*{wjMRlCHGBQjVy>)yxo~ z3g)---xL*fjH$?sgXdz@C;Wj*RO5_*huV`M`!p(igpH|wVq2GLtkGDasVCDji_ukX zTg8lATmOs7>|hWh;Jd^Lbrhfp9q5eht7Vkx0@67NJ{v2mIdZ|;@4p2|9SxoXziwFW{&*4 ztMizGo+FQ87c=Ldr<2@)Q6pD$_G~KuQ}iVBx=#g6O<^3=!v#vhlMFX*+zkc=Cn{VT)-Rcrf;A(K4t%ZX*QWjNDc8}FO}clb{+N` zP;5!tY{O>$6qEKE$R9Nuvp0YN zjJ3H9fTP7cb`5}oa`*VtD_CuG{MCBu7Wb0XJ-iLtk33EvA^eir<*i0APi?pb=21 zu1a9e4UymS*2hQA(^_yYAh>>?9I*Art4PPGb>#01OuXjvD zR)62Uv62>DfvBnIH>~xEOpgWl!KDpiY^g6|dzJhPV=UMnl(_C8PhQuj(+71xWVw|xE>aJ$w{-s(d2OdAdaJ(ag{W>NaJwMrPaj$w-Y1$#?Fy z;A}W_=_;PJ^Ht-oS4QJRrBFl=mC`I}x;EZ;<@=7!cCX4`u)1o@$Wk}G;&1wRhI?@w zr@FVXx6wfyR8E}tMeJ{nU*(>|?g#!h*g{CIo!@8#a_2AVf;MWYzhYx0emCxIO!gnq zXc*Kw@;ExvyQ|?S2z0{K)79%z#zqPXc%wcio857d%FRw?_1NG0eeGK)Hu#5~(0<^` z!wAe40o!oZrbP~^hFsR2S$Thjd&T#|v#mY+TF0-(YOaY)ka7TM)s^Zl>Hkr#YyMGA0qT>2$p7^V>US@Y zGFdX$bam`Ix-TC9 zt}h|0XBgt~{Xtb9aU+HkM)!csXA|n4XspGJS^ch|(oa&O?sUgW5YP8HbLK_+IbO?S zH~zS;G*o3~j}3i16$AIwH~HAN_PYwu)h+^#sO>9G4xOH+Sb{u_j@|~69^HF1~@E#_}g2V^4UF8z`OJ}3^Z0+6aOj^YsI0xsM=}1I4 z&*YF%?08WnRaqpt^RteR_$WnSF_C0d!A;7?!#!U2FzCwd%J%ntzle0NAF5a8&zq)8xofcbpDhRGngM0;CLtZH=g3B?5F)` zvWt6uG^zf0>F8&jtv+eo1{vkzvr-bn4v%54rk+V5@oyTHSQICE$Kw?|K*ODou%=k% z*MMPL&RlBqK5s6?>tD0@7|NF3QC$^99$U1p`D(N%W!lk~r;@y66|av|h#b3{&w{e_ zD~L$m8`eoC`NJ1xf1*il{i9`L#S1-AhUBr>QRv=DP(8%V(y42JE|ogR)q7nUCOw0! ztFCd`d8}vdVf>&^TgOkU_vRt4jq$g&*%@S%Wx$ZdV`nqlg_f04w+Ii*4w8l$3)pa?lYf6|-Qh_8t7D&D2IZtEo}az^+uUBr?evOgkww1JkWoDPp1Y!i zGQVHK5^zjy(wRC=-`h+?s_V;rBNK=Qe?b)@{N>9vHo9L_Rt_EhfK? z$e)4^$}D`AdtW~?lO&S9$ja)ocYf_J-erOv2r9s!hKEP7=u|H-kccq9@bHXvnYE;n zfOcT?)5hiZ&0`6_f~oS~KCMjd#l$=fHqP%e@L6(qS8%mtb1x`TT;ws&DKgdR*S>RR zy)$6LQ*0_20A^0o^5TvDC13G7Vq9eb7qSsb3JQV$b=Q-VlN3rFawhkoud%aEnI!NX z$|>iPJccx*krjQPP|wGnT2)s}=c+dh1lxlF2B-f|XSbA8OYxC))b(uq%X`tC#FSrwac6FTplPv$0AJu!|p&=U5HL8ukoO6kb+dvNKz=uN!l z{-3>#MPiLIKtf3O%5xg9D&RtcOB(~ErmqMjWozq z7066UNl&-5va*7~#zub{wgWx00uv)GWt4>Yw;^%h>yZ^hl^MNuq3O58sv@P)Hwp|x zvu}hJMI|gf-^` zX9Sc7m>g;K#8LOA=jD*AVqzHvdIsGx7cR)ilol5kmzFxitwwVcsl0yS(y6!R_(U)B zQjJ{VywwQv=F0MFr0IuS{RNIh!NNGA$aqaDsquQo%Yf5Vi42kPJ&)ix&m)6iDsWT} zf_yD8ROgla!u@NufI)_eDOP}wPe4#GRPBm_=bmLsdS>X_RK%0<=WoV`(_FmsF4UC0 z`xaz`x|6u)JBRbzVNfj{&J4-juTJl$!sLWi|5*dFkM|C#pI+pD^LUphGXBZ>mq&85 z4Vb_?BtCHoCh-ozYu?_cyB^>sS6{a`*ZXU7vNyiBthelupuIhpa$dfZZztZ_X?%BT zid7Vwn>)i)GGPTwAX!=%IVI+5=$Xl~8J*M4Iq&NLi=uhB)ltocU(L&wHvfczBlWS@>WT@n zNPzxv!}_#9OFDnpJ`z|Ps9GTpt-iRAN+x|31E%?fE=CHa6g#o6-|e1r2rAjKOs9vP z_+d~oU{cD1Hxo}L^Jfx8GFSq|rUV~zlA1@jq&iH#tQ%RoLNkUxeu#qmepHZ!KW7E= zkjgx*4kw&z`lW^Ld;+Ls;C}%4T-^CubAV?>B;Jqh9~&E+D$6;uOt$nNjz$@`z3iKt z?N|7CXGRTFf3Zu=A5$X8o9GwsEfNT4&tdda$gc1x|d?7D8*xw+N zednnD@k%%2Zxv38ee?N&D&K#nO)NS&I{tX8!D&!(xAX0WTfL)L&JJhkyBAJ7=u@>X zh(;MTW)(bZYK@_{c|2vY`BtK|$8L4bu+yo0{#l!^Si5`Sjl7VwgE?F`JRK&v(c?605}POxUJ<^f~c&Bw7g$YsUheW->e%JJ>+np>GqGT;$Ko5{TvrQ z)!zrcsVg=bc(2=J#iZJ})(1*z2tVA>;qtryonma<=aMjW(#a)r?7fzOkg5kXLoH}` zqfB)}l9&4A>T(qR&hlsD_dI?-Os*N4s^GhfzsQ|0H8S~POhAsIo@)n$@N~Zl@KCmv zoeB=1EIg1|g1=s*6@;E~n8~QEHp-VDVe9JS8WjN4IA2ARr>93^@!gTJK>kA?`CMLnth3h#b(i}e z9)Zn0m-;CY>s+hVGXMoFC`z=4 z1>rCX_mx01rBbZg{aZ#~yP>~|6+KQy7@z{uk-AnxVKcN2{t`7 z)wH~?2~$xmQQ`#vAs0q_T_%*$LD<{t#_eDA*~NwKb_nioFNa^*+nmVU-=@xakydSq zz3+vo$PV~+0eoOmBtvrA;nMkB74sG!P6Nwj0KU7gj@JR{cxXsq(TlC${dTuJ1(U(^ zDgg|ILj^CR-oOgtqrYD0s(Km3~h1AIwgxn%o> zh6-C>g{g`qhx~a1P6MvqGx2yJ8F^uT;Q`NDHGjVkC#gT)xt>gk=3R3$*3(eI>jkVY zgkiwQ|I7%2{7(18tX%SeWUf_RiYZmPzV77E-A(19pL-I8Gl58`-i@AOj6&Z9pTNL- zZ5|#W);i*PwE}W&T{a2xA{hYRFy`;UG$UtE26 zSd&Tjwz{Y&ixLr7MFc@XK|rZOXsaShRcT5IF4Ck+NkSKE1QDed11L%_Ymk}{R6u%B znjwTpD4``Wp&9Bo?C%xA_m7ts@H{im%qjP|&zUnF*WZ}c0V8T#m*1x!fh4x&3A(yM z2b;dqt%aFdAxK~rDyh;#6I2jVqL8nb5Bpx@aEE_Z=#;*)#I!iYWI0(j#u=z-W?smo zcN^(~6L=S|GTTqLD8)ldh~UuI^ee3LiPKoB=Ra^y&p@Z%$IvJR)h_ySGg^k2dpE)W zp4ZTX(m`MH`9Q%R&)mU5~WY%mQ; zuEDRdCg!FR&6vBEr#ePC059Ls?TORV_YGsGrBw*02JZBuvl6hnNlsMTTeaxVq^#uI z_}9FMJmM*GZhZ6XZ0k%@E|W?1AejNTUlzo2xFK=Cup(&oBFXGXdJAF?f3y2a(SzV@ z?e3*<&6VdePI`kQ-6JD$;%Tm^2qY*62IfuKynaRk*mbKMP>7^LNse=tNXtWl5d9Gq z?z82X>6sThn*T1`nS7}5iy3C7*0%JO=`jbwHo(rCnG2C4)o1ff;6#mXR?Pr zdK7C5>XQUPDrrG0C2CNR+4_7v$K_)-VIE>>2DGzd-u8}bWmc9HF3h(8wJ_QxY+0{p zq`ZbS5Gbb6f0}Tj%khxy!oe}@g2TrB4t@O|AZZ$pxdK;@VEgr_-oXzg(!?RAm0hpR zlckBL29o2GeSMv3(fI>tvNx4cW?D(RE;x#nGD(xZ1jB00GzVudbnCgOr;%P#c^ggb zgmg9H4+=255xR=3IMzXC9Ah4SSlzG=IvC_1_>;MkE5x(`3W-xa-Hn^Q#N2WWVD`BBzRWzwM)U5^0~d$p}So_3I~#Pv6?V!C#^Pl)k- zl9|~}Uo1^dmdKVbVRcOFo$~QOLh-wuE*%CVP`G=r5w*G3Z^yWD99^tDVrqxr2)X zuj`X191L3&N+rA8D~LBtE4q$w^+}u7LoLg?5>$og_d^s`FeKm-Y~?{cKh!lntS^sj z`;svW(SPaWcRvzYC=w8XujQH;mFNxoB*cxq3TclHF_=_9E> zZ=Y<7U!j7tlQW6S*YdRKzdmewQ`bx5W;p%4!6sonG zYhji_K&mh(#mC4}D$fIlxk6qrA>;896!rpYH;0uH>xAy`EVq@5HFH&Tgql{)SU5?O z19%i@GmC{z;yE5pTB(NFl*3*?ypz4NSKx5&&!0cvw|;TRC4R!F!grWvQ!&#ZI)L(S z2`)dY3iVwH%Jcg!J#yz#TDgSDen2|qJf3n&g5HyIZyNJ)9*8xoC1-D^oD*UBYl7D;d+`Q>aXG^DPx)3i;e=A0(zo(eG` z?vjr}E@657ZH`fFae5kCI?gP}W&E4v?YutnRP2PV8kW0Dvur1{M67FFX!lmesf@of z^`w#>$DpkfD*vs>aZuG_+Mo?SfH|~V$Ff^nPY4nIS?-osF$UCWOsm8BA-O#9#HobbyF+^~^6*3gO>=O@<~|D|nOQkv z^S_7=AT^s27cQ6_K+|fbG{}`5A*}9#oU z{L-ww0f!rl2J%qZNAjg%`3(I4ME2c^ns;$v<(^nd4^>v~@o;X}<}}RfNxZi)cTYg$ zhj5CjhTK_X@ndhD#|FyF}YAH8OS>| z#H^^w73dEsmt48O$4_If=R=FKvRFrZqwpc$M;gGD>ipf8AK`q4Qh9bAvg!#nEi<@SD%N!ZT7D92VE5Hg_DEdngC8;I&)@@A>SorI+3o0m zjR)W2oF&xFP-e0wEk+L@CNF#43U4;{<~i*OJVUwTw*$hE8VnrVQk5yU_axy?Ejk63 z!i0xoY_01QYkWe?Sa+(w%M(u#fFsOucWy|`PkLt|U6dL@@K&AlH@!xnw}+U?rIiJZ zS&l(N-T=7QT=K`kFYdA(1_80LrV+^e{QUPffXo&oq(ntTBBk`ORyh-Z7?5We?<+5^ z5>MNj%A`yFC~RuYGK-n1Mbk3u%lg?+Myq0>WU}Y--_3H3W))q%iseM(b$$JC9boJy zSAb8#C<@clqVlHa#=pj5(L-}#?}8VQE|*hRBOVEZ!>4;Ip~W44rag#67QLWW-Ah6B zS-sDVc_+S}M?B1wNLzGueLcn;GCo784)Omh*m{c#0*8A9uZju?(LbE-`txs4-9j^6 zzJOLV!q23gZBb}*hw{oHurwQjoc&VHFGp-8JD~IkQ*wY{AuUH(nJV9n(CV04>m0#0 z01)w}4dJWUSM!fljk$@DZQ@fT{LjV8I8}u#_bGFxd!3BXOdf>|pz{Pi4+%WtHFFJd zm{dP*7bmY;By=_1P!Wp*o^Q_J&LdDhI6d?kZJRLB>yX7?6dkeX;98DOy_a$Nb~Ait zMp2q*WK39bDT|Lldn}YJ=GgeF0UzC)!%Uq*Xv>o)8~_@yu6KKNZc&m5`(KNY~%03tC#dd;-L>CJehlWD9aDBiJeVqZyv%lX#_yIZ7J>wPO}C z0-)BZMPZ^swPN5AcFunk3MCrz^BEG1Lv%rKACG-`b}k{9F$l}K~TV~=*Zt-bmG@+LMCKR%-$AI>R^5TZ}_8<>x`Lbwru1wuJjvg|-y zZYnHr0$W;YUV8m&w~t7Q6+H$`^v=GQY2(|r$8W;2`US)9P9A{`G1=$((S9JAh zU}Fvle~!5o2r#8b?~5`)lEA!PQN(g}Ib(uqd!6FJX`R6tc9@I+t<01lm*~Tz&{hUj z%^G+NN(2Uq57H0*;gN1=T4tIKuut5yUk*6aoiKG3;0R*w)pu1r@^VCW`6V{}Yo_sH zzLLInX-!1fj@3WFcKrF-jCpjwrbpyD?y{{jl}WNup@|Q|OR}Va8C;!Nk$`k8jBHu? z4|`nv-}O2yu45aX1R87byiwTSS!fR`m|KM}k3wHxZ`|~3x)agJsAJrlpKss?YYC7y z`X2b8w*kI=3mpT5$v}J;JIR$ap0o#NlBRhy&_|H@*hqk}h*}uyd7V$mozO3VxniT2 zx0EmMx~apXu;PudD0AaMRK~I6c|#&X4?m>BiMb=$^$+&~ifGY9n7-`o{Dqhs-8^1l z{rp$Ux^~F~fwl$5pU?_?3tN@)l{^F(OWQS>{0KxKEHW|9ApwS!w!*VX-?nhFazXILL9!vGU5e7*Kp(Z%AnGrl}mH+h9tB z>0{~IUdl~JMAqikU1CV$2o_xkn)G+YUJ#LL*c}**{CCN15xM00tvmRrzp7} zvv0%Uz0t_}^JUj$rnoO@6n-;X*S4Q|`D0sj{4c)kHSrOc)a$8x5QPq)&WdoVtCH+G zk>zyaLo@trJgr-*>k$-tyvtCh^S)t?d-h`7d?G0bIKz0*qGQHaag_{beER;qf)J@% za1G*Yjw4E4Ze^`C|z?fnj0F@ zg*V#8;(ipeasT z18A_QM(;rHg9_8}7U$Sc-r4m@>MGMnkmqkJS8VchT`X{SmO^L;cUwC`*F2Mh7k<9% zjhnYxX-5ySQO;@tJ2)aWM!$-;c_)NE0W3hC350C6lY&oo7h3 zX>Eu%T{pPOg*q&lX{X4gy11`j&z2un;bTgN)&&LNz|p}JS69#T@?`GzEq!%Duj(|l zKZ33(4arUMLVvcv1NjW$$sgcBx&rhMVy5QcL+jN=4p(c|{L6Qmc;|U4$wPJaf%A8o zHaLgu5j4XHC9Gn9JlZV*)?1RIDbh>V=)2aXt3leQO)-~oDjXX$zQCgl*mj0C*-N$M z6Jl&jh0sGCoxeZI6CJyro^MYz^Nd+{oGRo>fGUlg`r~MCKq~-%_&o1kgMNgywy)Fd z`A>o8RL#PWIy+17SF3FCk)8tv_}G!UnG)$V_)vg3K$}*+{9|KdMNg3+)f>WIPo|;1 zB14!xBgZ+c>bT)YyI4Rvd1nJ`B_r@o;{;UoJ6H;=WY_Gqrx#Vg*EbovDF_J(#ZUXW z2qlTq7vH#3p>qcKu084I%rxHJ60m=Bvm%jJ>QnO+wz-A?%dFnCZfPbO;hM(=k-hv! z&VA(@x7*&9=Nk_#ZPu`kB}``8$Jn~TD?{^*0^|s}?n05CRo>JXbgx4ShBPw!tIpTD zOjy+sE46a1Y{n~{MSAdLzw(P}@0DOKaHc@Cx@Hj#9inzfRaYZJ>$*C*psJsgd%Ar< z2sk==LKhco?B>=LT4&lIAoL#*!?xSTnKtjt-Z6<8FKjZD0(Of40>8Et!=MTWD)8Y~ zoYd)wv=5S|OSE2#x%6ZYRaMpE+7rNu_PS$XWDf-M3y|^*FBZDJMw6mxE(;)Zac-7) z8f;h`CY`JH7?7(?L(fxOt56LtxJdHuG>)@D8S-4$3o&RxhcSh$czt4uAwS*lNo!m) zT!oNa2xorJ0t~Wp^8Z?_@sT71(5hQoT zwkR73bX?NFiWJ8JA@dSlTOOwA@^cQlEgUBJQ*|Jj1Xt@i-nAb=4^Q)Rgz9R?&tJb% zd?m{|w$f<|OhC33Kxh>wm4RIMg=vDzeq&k2GVD9})Y`e^ZxzL>(jJxvpCKdsLz}UG zF_kLBZ`8YWxAaE>&6=kqSMDKeDX6|~O9~x|sefJo#@dcLW1CCJq0!w%MCjT-g-;{ham2`MG$I`3-0PZBxu-BI<*?OjH9@fF_!)`87XGfgx|vMB z0Y>T828rI8I@T46sndH8t#?$OVu2v#)IhFNwga`J%oNk*2^H!0q<%)j!A~nOB$OFDONsQEWq?*$UQ}3qhd2f_?fWW+%aoioKtnT zQ2Dc1j*8e@+jcHnNE0jw?L44=%c&{wZo+PlA!BoC#j0RZL9IJ()~Zks$=cTs^n@kUTk&@k5+!srJ{%QWkp-1D&9B)47}^?A7P?jY+3t zJ^Aj<9snYmcdFwoq$O@2E``fmc31B=$1klc?9Q{CzrE7_9vGm-Oy>PZ8c@}tg4`@Y z*M3xXT8<>JbM-VQ^B`vH02g4gahlfv12ITTQ`y=pvi!hRK)|AJhE5bWx$A0_C@3ac z#2TJ}LRZBoDg(fqY9(ixkM-yAfNAja$7Y#~HQq>ShHKs7W}%Bl>m%#SfUQE@^#o)Y zXx?h3?*Uhkqj)IiMbeupH6fB|$R2!P<_wlaj|GU)(Q zT$hZks6gs;D;Jmc`p{+4(nJtyrrzVjW6)s_-0@4*#Zw5nmC{duQNp0Gpt=$w^B{9p zKi(zw>5XGyx^+wQ%&sNV^sVgI&&ZwK`t|Ze_60senfTt<7~3-grM(V;JPN9+)fjXP z>CH+<9PLXh*TX0KYfFf9iqRe;yl-OfmAWnqeUF@O!Iq2SV|mE<>wgoOpl}0}4>df2 z=21e{7FVOAi{*Tne{$x4{H%fNVr1F3!0(irFk``Kr{rtgi}BJ3g5mk$7TeMPh|z8% zM}PnNM_2+u?F9DaS7x?JZ5bFi3X}wY>sVs+%egu^Np{|K9Qh_a*x2ZDhBAtoC_^pK z+un;G?dl-9v!ytOv=!)-2659silI@38`0aj1)h}}kv^>;`De;C?)Trb%Iw)g#=`Wt zX-TQt5A1LpZnFb!mVHocr2rfpXs zUFc2?+ir+oqG3QO7&6cY=@Xn`H8}K%-VV>SX?0VZ3fAss4DJDrXNyA|*0C7c1@ROCVmy|6+c)Zuy9`o}!~(U+0sl#0LFSL0?}u za~3s$;vzXvhmoBw*G33-z7Eq$HKQnon8mFsfQ4{{!!T}u?LG}4a*yYEwNjj~wLICw z^B}9z^MDkDb4;H-brQ{)H^V1H!2+nRNuXZKz!{xm3s5=4jyft(la`yD8Sr`;=?_g6M{Aa(wh}r*tcG670)9 zqY17;(a8=V0=zQ^0EMwex*37~>4BbV$h6Kfj7_(zS;?9frZ1wgiLkn^^F~CoF6*K@ z*VCeqg)~s`GqEO|QLC%*4hK@B(dBkpHHT1)-9j8isvk`RyaAB`1vOYnhR)@riEK>T zzBU;XDWi%Kz1Db|+5N9WQrLQ3#X)0$(oCL&P41arNaZ!dcNJcrvrvSX<#qjYJ+mQkCmc1t^kR{WS7GO%%9VWGnbgmMNjTFLY0<)j80VXRZ$KBukI+RL( zV&#}pjReTR6edRD4Kh*|V4BUCH@CbsS7`qQ@j_sWY?13u^V{x)B-2fS*ZG0p>0U7- z=#a7=*ERd8^iE_)2Ej$LEX#a{jPuX>yBMZwuYLq(bbG4RAe$uoF<9zVqEt|`ryM1j zhJ+ns*w@Xd7mZK7MP*-r6knIii2ztIHStNS(fD%97mm{oyRPcok*koL0WzfwEp7Oq zjD0qdVgDJO4!*maYPV(@Z2Ev^VX+L5B8gY*_LIb5VsLq<_Dq}C!E-Vrw!+Ly4PS%= z1>bxHz2+Pgiq6BV>oOw{63X(MP4fOS1lsFYL4pI4)H>JYRF+llNdkLF?q4FHkHLVb zJqY-}Bo+&^y1Q~BQ$c-ooGG@B_*xVj*~a>yRD*b*y4F3w<@I_jNgTvZliKfaWvKG< zF60X9$5Ohey6V~*jdT+(Y+0q^!dqXB4w1O_=6J;9cYS*q{e!38dwu#6F#RD~ku=(b z4cohRaP?UCUz7N;YeN31bGlrAab0=Ab@?7@+fmum!d&5~>U7@XcYS0}T2XA-dVms?s2aG;$3iEG!}_9O=C<{`HoR zE88xfCb!l*i^TI}@I&PH1_a;@%B-)5!wiR?@mdZ;giGq?PhS($5@zBD$*ZFcHPDr1 zmi#Nk`e6T!I(zTqtQls)QC)H77uUlAccCUZ=#ZRB(=)v`3+X1pZi1Hd#8>zgOwjx^ zVP(l!){7!6LEhQ>^XJvDwUtZ}%NUd;$yhN8d8HXDMUlk?VKE>6iq4_v)Ndk%a7vrLq^D||Aj z?eahGF?}_KfsY6%<&_`nz)6)8n+u47KOE~VrjwF&iu2NZmcY$i?nr7$RstlYQms%lJW z9>n`-{nO75BbENjrv+XqQVxk{xQfi65keZH?5k!?0S@X)n6G9IC~|(NgS)>pj6>iBi};^&j>`dxFw!?&3z zZv}dGOkE26!=-A|=_q`Pc&_?hHwXr)DL30YLf+9_x-ap@CYz^>&EK$HPm3Ts_&lqBynhN-#m3 zGB-zR%R@R#z(PIGxAqw3Ath?hdYn57VUCg8t5d`Hp+y(#mcBku@eirK{98J%T7}0t zVvi3vvgKBj> z1n?MOpDv5ZKWt=5Y#PkutoSkyYb&H9kdbC_X5Y0uMp@tJ^+3? z#M8 zwRW_MLYPN24+qar-vnBpc~*SzGd2^o(6(Bvy;A)N8YujGueXJt-*eHSrPlU3&LGQP zvPf)d`1sH~P`M}^@Y}25eFvk)2AstyMLeM4I-$Utq*6x-w2q}JqDwyX9UaQSC7$MoXgy4X(P=apg@Wr0DVPFmv-=C0kl zXMj1qdjg%GY}Ablv1y!|stH>olw|ijO;Lu(w;TOhDApe71FfSrMt!-HrIvh?Dfi9h zD4lW{t1;lX6Ihrl1*yTx@sF{W;Wr7OBP;CX(sv_|C00wz6apN=0G)XHqB|MNv)3|+y?iC<6jRQ2nXJ#GHFPrB(O#~^fDYWZ7&@E z@_WqZ+)-7<8>NV+!K$IIDH%c2%WNujtBKjEEGM<)0$fL%7e%o&i4Fi{Exd0SNUn#wm2{+X*&( zVz{NK&$mYO&`~XZCaa5Sd=Uo?K@6X1P@{(!``{x~ zqEw>iAs{afE9h^L7;K$2b1#oE>Ru)eJc+`@5Kis_84r z1G@N@2n1w`0?DV@Ux@#%KRWa=b6(|ZkFeki#^J20k*I6+1_}M>@*|A#TeGJDBp{<~ zAK5#Y?=VF3YRpvcc+rB-iFYQsEQ3RG?tp7juMLAy1Nj)J;^&jKvWAa&SY zmhbWmX?&DTuMX~e0dK8#KSLqatcm3znNpER9>(Btz2SEdMqfJKYust@;%`@?^Fx2f zwWrW>cgxu6Z{_u#$xRYYQRh@&4+#fK{5CGz!X>%#d=>1R zr3QLVmm0*{x);UJGh?_uW)8RH1B@}~89cz;ZFGbD%UXgQ6@@M$i%c_)9yJ@m%0yp! zq4F2g9vhFmC?M}7Z(?NJTAdbkevtL;b9?WkHhzs5FZ|=drfyE|eKjCe;`E7>jIq@^ zrYMcLi<-%|lpl7-R`t!=-{k@nXfwSmxG!eAx&YH&qHS12IU2MBk%k>*+P`tSi0dnM zW}$?jMZq)Wqy(iex*J|G&_-;Z0;BV4omYhjEr&A+)Q2f`cOl!xfE_p!mHwt{p_h#AH~ z$eFk@T8t1&xU7T6hJT7^yPX-4coFArHTLylTW~}CxpRzmG&Wlt*8OSN563PqwoD-F z)hz+PF`#2gy1$`ksa!E?$%;*(re)e;{xS@ZM!ti1bE!*6@1dF-lb88qcZ@|UXRZq~FJ))a^*9{Cl~mpgi5 z^>HIYRRh_Pu4y3Ungx;1a?6UYT91hyJa`aLmztUy^+#u)rFQVzLanf82@&!;LWsL8 zHs)aL%tLpI-U}~|mKY4kr@?T4MPqEAR^{gU@B9|5>f;kSX0b8@>1IssRavuNe!_oB zo?tfPq6X7Y<7e6{!@^W7eUUCF^Vb6(X%LEd;fs{QtkZuF!8aZn{wwIVf>g;MVU!sN z_AMb6Nz17yBp|`#(WSzkWt(4e@FswIPyxD}jfapUwjnzGV5Mn)Z`?;AyWp?4 z@TnFxZu;{W)rM<`J9R-!*dvGowfd^G*Lzi2TvBmL-^y)eeB#FiXEQ zH@0&MH-pCaaUEK{CeQILWr#Aiz@7T*f!v{0MUsmo+31|;&@($X7z!n{TfF`xk5@vUrJWR-i-wa;4*%QO)*j^X|@gBasD{=^nmVv z&?;at`<)Tbt0qK#JZW*s`O;ZSyjy?y(Ehr8(s$Kie?W@06NUj`9D0pBf_|=AUWs1@ zeq1$J)oUY!J6Zmb`Kr~SywyS4X|++(!D&ctbzk~JY|~pGpmfb7=Rz+Xu_lB>>5?<- z6~n!->)wPpSwTU;Mv7u?0FG?pK13jj*I+<_+Aa{j?ol+I@uFHJ2-d6=SLY87P=8x1 zE`5m?Pp~MT()V)dvB~IrXEc?QPhj7_|C+>OkwU*SuFPdTf{lOI#>=K3PU%~9anC!H zTUd2O-U$AlOFpP>xpnsCMI7=(H1b-#u&6LvEdpsL>TZV>ko)ag#je_f^ZP19!>=~Q zlCBZtjNrwvFA-_fjwcbsL$YqAIw_3D;NpqkU;lz@1xr&FT>G#}6vwCXWe!jIXDMy( zbAcWIKBAIOsju8)i7htSP*4!qP^<+SH%t*T8-K#z<)GWY<4yC00#A{_sQ+7*x z2PN9v3Ux-XNrFiu*aeoY+nr+n(i|08G;|t1h-Ms zQhhB+aU3cF2O*g!t_UzrQb6QaQu?0af|IPMj{l#by?QJB=|@5!>^V|*%h`LpssC-cYE*F zB4SO}VQyD6g%y zf{U%C4*p(K86Jl_a`vQa6$VbXjZL!Od%BA6)4x1_?T|=yNCR`Xr3yW7ze*w_EjgX= z{;P@j;DaYkHf_F6cfL#k4~F4Jz||v>;QXeSh+CEL1{Srsa*IA^X!UPPGh8Z`RF|LI zWGQd=tRainvZ`#qf3{8xm@QYPU4f=pOV+TFzf zy(jH$zx|344}d4n^{gse+O?7lL8NFvgBckf-%YHa53E^Q5lzJx?e{DFNKFp|T~k~h zN>DWQ!3|6-IysE*l>9DLao7kJiL-k}CX!BGb5{Pn`JF90d`r3}Qm~V`@E(6SzkH^P zvuHeQ)!t@cL5a+pOSUaA%OQX1uadclJ3Sh5Spw$hTzFOU+g}^_(R7Dm7ypE0a+9ZY z(|xSplh*IIj>V8loFyI7zOjbi19>0%hfV+M?ZFQ50>?)_U(3& z6W|4T;5JX~>aB1M(V`85`VtZnH|tWvpyl|gS%zKMNvE0*5x-|MyhHv=!=A7_5bcsMC({a5*4Qoyn8U}@lqlfXC4D+NItq(r*SRp^ zLz1e;HY||$A3J!*upq$MwQD%99A%^c=5x9fTLHX<*R3Ddtm=iIuSvw|;=Y^Bh_2CG zaQWYsj{LUp+rq{7D8)0<^2q{srd^2#Qb(Lxm@y~>mVwIv_BFJX+A0An_!jj)_udU_ z^ZmU~;1$g$UyNX1^DJ~2Qk~^OE{{1kBX){XPE%}c8vg?X4yJ7{*PWL9B^7WKcF^fl zPpEjR)zEjJz z2Kr?@#`$GG=&coV5f{j>JcB~4eR_}sg6=0zo|H%rrdAT7O5d$524)+G`91i(hxc@% z_gusa9}d)7n>U(%QCWrgQ2E}9KvMrs*3`&3LTAv;%NAJdJ2k(+*fHMbk$QAnye6N3^e z1;lCeQC=q?n=e7Mbi;FEc80#FKF<65Nzib+5kb;yg)k|G4`<4{p7jA3;k$0D1)26$ zz+i{1EQ1hrT;%ry+rs7e&ov`_$DHAW#xYWp_+a(w>dctyrMjS>KmRdff_MOQuLeQX z@~>J|w!g-vl;~vq0CSwbS+!b}!cgg*DyRWS)}USQ-_@cYw*x|FSY z355aioB`w#`A8H3UqIf7y!lSX=nS(xFX3greN-kUppd}bxAwHocW6Lw1B3gL1t#FD zEHMhaSv-2q$&0$Oxp&+HIAEsI8dj4N`+$*36-DQ>+|{J$B#Q9jG>P@Ah6K` zToZsz-+l;luO zK)hTjE0ksOzH**^nKtna1?!yI!Ls!V-MLQFzZt9c-KWzb4m;f&*#O98iXWgV7iP3; zXhura8v(c2RqyTKa@{|=@ngXGvIYVm@+!9~gBC#K_NEc4u5duKX}!*R?#aAzYy59} z3|6WlR=XAY;6tCfolqD$dPRS?dBc`Z1>Cyz%sxIM%qmfW(qP_;T2s8yDB-wy^ZHMn@*@)0t(+2nJ~u> zToH)yX30fDOiF$KdVmV+FlNv^<4QaFjW%{M1IwjVtwHwi@&cW=`*PB|Qb8_d5)h3c z0d@Zuou{Uy4frjx)!xE3m(n|SM|$Yu&DOS{B{;oy=}}MoyQsOIW_s_ZRr=81quybv z>(RcdnwSW_Z=GYwBZRGmqNN8PLA*e-lv*Q1(B>y=%D))HW=D--sq>Z-t6qkNmCwK# zf(Yaaz+pa0FrUQ$P@h}7gdm3nb*|_HZt&PT896`%uIXjf(jriZVr_Iz09rwt!de6%MDNnS4W8G5wx+bM!+ zh6}FmOG-Am6BgIUVs*3vIN4N!^nVQvEkqaD?>OcO1id|p`Sy(2h^jdL@_C-2Nd7hGK*|0_4>l5&D(oSj4WXPmp&1dloK%V75S2Z zp;=(oiRbx-uwc{vqi*Lmb(yj^_`s60)|FneNDsqevX_ydeVm$_ntpR2eA=dk5($AY zfVnR*2LVa(dd$7fz@1b5G(klRpG9nJ6iAMlXx%wSZfiu?E-6wbPHUy zD8Np1Q$BSv)@@_#rAdTABoHatS5#*%45|;YFi1ELGhY1C!J){n73Erj5C*O?1xN(2zt*lT1fN>p!dUFXqoC9-A$qd$|F zY1t+|7yzi4^T5VnL@Ytzkq$IIlPpBqSOAygd%=AQ`a*e-Bs3bI5n(CJWUZURl_}@! z^ggjb{Y?S75^lgE4bHN(dlZV!4D<MVbJjkz&;Cw-`_y zc4s#I_X7Mlyn{tj{uw;$6Yky+UjiwfcfnCR()A7;iA1Tgr9n!T!NB8}s|Nqx813H2 zL*d8Cnp$Bi=ta_@v+_zZe2*$4ReJ!}#>_=gU2sk>t2f>cF53g#NR4eewk9H&YW;0* zIKY<^z}Kyex35kN9MR)0&bZo{5P(ES9F=rLCnplRu*5FQ;&=nMd>L(ySm|)Jlh}-dJ zisS}vh`XSJmuWcXZz%)LP_lghE&{HaAw&&ZrIwQ%!KDlv^S6?}3W|G<{>Q2A+Yetb zDXuZCaa-Y=9TRYN&I0BS1WQTjhvu-;FN^Afe*PE&<$wTSj~mHwxZloFqn_VnMB%X-Y;hh#d~Qri&MXSK6yH|l z*LiBwiu4`)^=mlVjYWDgS9)&E7>||Ai&mB8`$YS;p1O^sS%_0SisV&8_KR+iXJVbS z9m;GvX%ci@r48HuSk?6o`gI1_TwntFMJ!$WfCUg16%AtA2fMnSuao(C%k}VYmD6$N z`WC!!5}kgE?C-=qpe%%38k_69iUyBKz;MT+L83B}?X1ZO4pqp7Ib`C~XFhRlz7}I~*re!ghVhGEuXT0+*DyYQc{(S+)wB(Ode)C(?J&EHUbhXdYg>4# z06^BoWO+PPQM&|Fli1M_?6pE_d;Sb7!gH}Ma*YQP$zUA-xD5`hs|N;n}$Xl_92j^WCHIu`zs*%=C@@yMM@F%u`={Jwu+UVH8h^4o9_g@@KMlN6 zO?o_|U;79hXc`FIK=%`qbS;sG7deb7>4U27ps`ywa6XMl_+G8Ckd zrgPMklt3~b_ji~0?;*lf_BycXMrC1R;Ciw6cMFpUk0ZMh@sD-Pri^uQje&QME`I!& zc{u>Q3oF2{T)cfcb3^6dK|o6C0=r1*kF3{oT#~TrRzM>JrU|WwGcCZD1-io|e#5$P z6(EAdOCKzk_#q5%2h__6@JA-}IdVrHl3-(Gj)Seh$5sEQiW!z%huaV>XSIC;k>fXu zE5@Do?4-!3pF5Xy5tliNWWJT8oLKjHzAoqYG+4xLAi={2F0)9ryVg+(@7+LC>Q2f} z?8$XyLWY{v8;B2fk32;6vG0D{vHA7DUj&^bmu~Mp0X_Lb7q_~)M8Ky2ym20eUndz0 zqvH3Kbrx=n!2JQ3WVa`IZg87hJ{0r+LdVpiX`T z4k<@sNA_N@0dHOaBAY$q3}}$yhqKQ=G#hbFORNpCUru|isA`>ggYNpIOq4ql<5}fX zT%#>N0y2d^0s`gIP<`+a)eU=8aVq>Vi!}d5KY{Uh6q|bZuZ26MIq#Q5mOZ(hZ~}YZ@kDM*Pm_!xzaC{ zdjK)5J}Aw*F;_8fBd{7N_q1TH;dp$|*=vfcHz#2(8o!PAws1oo{LH4U1rO>V)@g#X z&jUHY#5RD5NZKJ<_gBn=6*s&m_|H|9@GKSyH3Ml@!S@^dR%h@M2DjM^X<(|p9wE~r z+S_LVN2u&?&jqnl^-O)I>2E;-)6kdVW6RB>!X(J?o+C<08zu+*M+%_6*rTDFu`zh> z&7JK{2R#UND-^==X1injkD|*(pvYVH0~9f_YPnZibxY%s!6o;XY^rz|>%p3xwl6Tt(uY zhWOM&heAW+gMR(V`5W#Jb{Q!QSce=;OIwjey1HaNvX5h}`NX^h!gtM(CVi#>Ua-~u z?#wAo-iiR{ww=TBaK5o$7KG7Q-^8|#f?md@)(-cDdlg!oe^7Lik4>lBvgr|lS{y9S zwr~o!QVPT3+Z}dL1}_HLSaoTQqCMgS6G|2W#pIZ()Mi; z9gKKLA#*Ox$=85w#%r;Q9!g|4asJ}mDKRp7_9s8*M>k80k>mYGKBR6{m^`+p%6!L% zRr>L$t=}dMzRj%m-TN)?wba2w6TirBSp;d|iAj|+{mZS_qf)+b=z`9V0x&;tjonS5 z;ti+`{*&Rpt|OJnUthk)%$Wpj8dp$_DzhVsidALV76+f2-K@dg7JhwiBjVi=m8gv{ z3aA_iSU{0L)>8gy`LG*y)&#=fcQR2;Bd2comKOkjBEcS2hY;#vBn-ADr{8>ax9b4s z=e!bZoB_vzm%)*gl!lHi&qje&u2~+HS5!1*+1~kLc!5&_u9{@z2CI$*KMZ`l32N4z z41{Y0EB@@h3g@(cEbizDRwZ>V8-goaA7D3wda#E5$HmB{dwLx?U+!JIo{K1r9|`7~ z!wMf2Dc^ui>mv;B;2p)HdD%sGuQNETE61ieKf;FGRK7SUS$|>m? z*MPQMJH^=YzV|y1w;)o1DLHznknA8tkU4C7R1}nRG8yan z>r{>G^%(QPL^bD1jc4c>;e)K5L&uteRXxMv_w9?f=6v+W`S32b=iCV3Qb~^jL$7SY zg>@&^-GZ2ESZBZM4@qxzVvlybWQ49QX&auHVtivKUjacE_C+fP#R~x1Wnfi}Kx_IV zB2im_)G%OFmOxQlMG|6*=qG_t=xl>-{uWs*0H~=TX@PUj8A&_z*!1`n^9VH^D_zbR z?*f2gg}(3}SVcF!RwCz%u3iP+1^h0SUuwqI@&A-%c!rTc#s_F>sa)^$bP?nf#XuN< z=Kxy;u10R-9N`;Kq<5m{MK*yN(0A!h5R7Nb#(C-$Puwl%8+4cj9yDn$0{D3S+>c0i|GKsyme#*H;{_*|Hs~&KSKF_ z|Kpa(R)j$+p@dP0tl1h_8Zl$$9&45s)MP1Jb|xcHLQJw7+sxc8N~tWNMQKVTQ&F;% zY-Nk=`dpLe>-p5T{)6xPr*zLf*L_{*I_GiDd7N|2o$<06svEx0^G0xmWmY+Ww{rGA zU}>$m7KR2c>;8d|>EO`8#g3tgA8+QO{*lEZI~^E#Svu!}iBt)^^q+c?Gz7qWoBX18 zk0Zgm*(5(#Yt3ItKN(Vyx#Aufb{^*k5{&Dq5jsY#rn{>CV;_O?;`rN|PKA5*dwEV( zkH5kN*&JR8rY)vyg=k{Txm>N>eIM-IFjXz?`U=&+qDjvuI(>tp5wq9RA6AUE{Snd32#WM$p0OH&hzvv{fM!&cM26@q= zMQ??m&^y33lzpzoB~zcQR6SYX!XkuM>Q&1o;5nuz%)ZTj>HihSpE_UZy27=zWKZihXPeXFExD^J(9=YeC?hnDg=jJ6C9534lDbFjG#_W3EbzUqlJxe_bq+fA--kGNYBbqdueyh1J_O7Va^&5o{4f7zTq%G~Mi z^qb+QamB`RyG2eBG(expZskvkDa1} zqxP_Am}_d}k1O}l2{^agrnH`wQ_%&bgWT>h?iK4_g;p8!IQ(6+tI0XqzGLT`6Dyt{ zW(v6cbG&cZ`P_I=%fIco;Opq^V|^JDE(!6N*DJPKHU*fhUfh3;@8ID|6`;s7)bl!I z#lU=@!A9Bi@c%ZC9c;_q=`@r_{4Z|>H&i)yKUb@Z*lD!nyY%f>7jfUUrYT@RJ$n>n zmd{q)s;s?}!_G8hn zWsn`1xXyVFsH~WthuB$QY%)Mj2krr@QF(ulsJ7zc`-&&Pi(pvq-4vdkQgfqsO?{j; zO)h6IqBi_+l;_=~`%5d;+l8&( zNwkkEuT^uoJzmN@40_t~+TA=(X}UzyKu+oQdrm3N{gwd^fdqF7s`(9UC&0D74VpVv#``9Q zB(>U^hYK&l)PD~RpRJN^JmtLMO&7%*()y2L1-~}|;`6YRZBxrLx$W5fCN8=oA|L}q z(k7ztu{N z$$yhyzB8N0H|b;5)K6EL59J@;Hi^uE`I9aHlFv8lpB8nXTou15mr7SqAo;^`43WO4 z`_0dQ&|0w(rus#YUz=0{CkUFw!Lnt{t}Tc9xe_44x%M;2mmhO)cv7U&n3Ky8nBCN4 z_2K0J>?p1N+Rw-x5ZWrw53x6%7#h)}c>-%$Z;YHjjKR^c`pY3!>SqAl`qzOR23kzsw8kKq?N&=&#nq?`nFn{cHU( zDWFb@W3vfUr>t0ugde9c-^vQ3-bR|1Su6`gfs6Gl)3MeH6h|`Y}psp-0 z+<&fZ&tPg|9d?CB3)E%$t3kCHxtbuFrPp){LL#rak}0WP7yibuNnRGBN>6*QP(a`zWb)KgYn z>~*P~QGM9?Od*8DpVhxGjMkZyV@vbi-tNHK_YUu`cyE5Qd-I;!YI1AYFPk>;6Z|lj z%%6FGaSd=Us|47gw7bZz7DQ2Nis--xq#ppUa(WNdsm#U@m${6Abnu~a=rkxq znyAWl^@->GW6LY@wWA5_&buq~Ue~XyGP)}EvX-0hO@u)L5VH65P(x?0JFj-ATVAL&FistXZ$@BYy7r(YVEWB0 zU%&j^KYbr#`MR4P%<|Q)1|JXHsQ2<3K2;sm4BWiF0nT?>1q8r^5fL%Fl7Wee%zVA2 z$u9A`N`*u&NAcIdF%qX8Lt$WmqfUSZ&U&$W8Hq_@0JaPfWnc%o&3P_-@0>4UV~ua% zst?O`j=%&U6a{X^1|Ts<(4cENxCBnVWInZhzbx&i0IDwtlX!usx^FcbrHw|c`Df%| z;BMaP1hT1u19(7}ZYxOs2joG$wm+Mlja?A@)u5G^Z!;-)&xZdif}=UnZ+%S5jKM;H&QyTOA2)PiAFQz#(M=t-yEy042bkRe zm)dHsYst%ld=v$cb-ZTk5;!LZ#*5o1@lO=qCkCiE9Zx5)XK#W0U37}|m&={{TV%U} zo^-l^6=JurTNE~Kq|ef6zn%$Zbr|qg?;dJ`bp=`ii8LqwXs+>I%#ChQV^S&e0^)yclbm!ps)RJ)K%NJU;pZBHefXb zPQ5*QVi)jhU+R;qEm2q)R*Y+VVRUkXA_TImydy%%tdi*kd|LMJgQpOWnFV|w90oTXt}ZWwhd6I z+!7VG3MB&a5YZFyPl;>=X{Ij=;z+NX(IBi|J=VG0k`kB(RLi=Ep$1e70vyG3$ccjD z&NlB~A~Y%J1e;qO=fbX#XMo5%{LKk=Zq@dB`7o$SGuz^JPwLymn4Dx+KW{%^AIUn& zYh(3G|9}~Ot}aYE`vV9!7K|jkwo3Jv`jLVGxBd+qWDOp(OF_0vtD&!Hd1vcG!R$jd zTmj0~C$SCE{G0i&PYUo{cYQmnNX}g+YR}oQzP$}C>xzkSW^3RlF!a-S6Yk|_R`aNy zHIQ6@+wD5RonKf!5uK9R-_EgRP# zj~_gBUAB7*xIA#LUJ;D@^q+C-llXF)jJ(_`ZA^WQy3CFrug1OZ0`kz2cbsc@po{DC*S%<@Qmqw)nCRD+Iw{5}xZn@L%pCc$TaVtBV7Wjps(iA-COus z)lpl6W1+MIZ1>p*jFYM5>a<+9kd~Y={@HJ5@Uphfnsq(6zxwC!n`;ZHr(o?56%4o8 z`|S2clW~AJy~(K(%O1@WymHn0qRW!*)VOwE!JRMQBu*b@q!=9MtZg$gW_cKc+X^h$ zB_Gh-FSFjKlMRTZ5y`Vh?%oQ>`8s4?1HSg7uiD@>%P2H0=+oz%7urGB=IeCAKm>7@ zU1I|T-t(hFtJ&UhvfSix)k5mis)c>m_GhD7*7R35hN)O2Zy0d-w&Ry~KFDL!R}I?L z-eLRP*#>$jn)2{M)|p>94++neoqcy{X?kc&b6^FA*yZ*lLelxjlcGCOAjKU_o2nl0 z%nq{`{8cXy0EUSOKDuk!ly)hItW&cJRXptSwG20JsoGw;s;zg9(23~$JRQ!mVY52(?o36x3}T&)b6egzjP5BLb|nX6m5OIDQx!px$A+p zwYw=_UZ(e}R*k$GC2sln>iE*HenCZGtzsLamf3_(`4q`frw*#Y0LzH+u}8P7LcXcu zcDpJ&9&}wdqx;e#Bw}{18Z>W-flj-Ll9pv6t|i?>Ygl1c)hgIJvV$!PlY$_w&Cv_b zJ~f{5`-Oilj{1Jll<9L5F2gM@2|)dRnIIdCeMA7cIuDZT&yTH!M?2KHRDVkZ-|$5& zj6Zb*0Cao}{mL)D^3RtG*g5-#^K9&iH?Q~k1-}0b+#(IUfYycUzY&l&g6#Hd-JjQA zf9hNM_wnElT@3Igv64;AAKrI%d~irw)I1D=yb%NQvVXkhubY1doc}!toS{1vJ9KIX zHSpgf$L#3^LV)>Ds>}Xu01vi)1cGqlO;^Q>j<{dI^}lg!Nahormlg>fdaJJg*TxB? zehFaaj)VW7(GP&pXGD(v^X26n-AR7zmBnUZqpBl|xwDx&sKLKY=r#f5tVP?qcBo#x zzTM|)nO*SRfBN%&p~gEmkK>1%X21As;*ngA*OvuUKgDA-H&6t;Q}@*9?*yo9%UU4h zP4M;Kwkul_l=n^imt0K0vxAwavmgF;8_3@GX?TPd36RIw=*CRh%|BaFj7TCKuVjUDsDUPz& z>56m!Z*-f5bFZE7S-BFCqon$h+3P&hC-{H6Jdje~vozxBQEjSoYB_pZ)};Sr@UJlb z?~mUkw{ma()6svG_5c3(KSlaKBl`cT737G_{N!{P*9{l&@I4X`=&} zowDk(>_2vCY3b?y@2c)U7Yz(#)%JV%dIcVp)dQDsvT9K12@hE{2h1U&$KgO(HGI&a zz+YGP`5g2DAJ`u|0`A?ZrKc{dX6bRv>u8{?-maapYWsWxJ^WAjc^?e)5D4@S0(YAF zdHea}PaHh#A*-`IH2WT3FecW+|FFl2z@UTPvTCSffdSzErhYyr{CwG;>dLB_AM*x- zfq&Vf?e#e9cf>=$$VlLyb%k(#y+2%q(796@s^H>c-!gUFm{2jS@gw;v28T;ZKjXQ;vCiM?B>97J3)6X8X&_kDRVr!7>5FGlwjtaRcJC^=?K?ia?ya=VP5M z+gh``q&n(C!lI8e?W4OaP9kO|iWb*BkHgO!rr#H&p`S}`9`Q(THvV9xwE1hKjQz{} z55veZoJDcYtnOFE;dBcUCqe>kA&4KjuejHhV&b0V^=K?;7o6*Wgu(l+i>5Z<4 zF)Rt2+RRjd+Hfd3?<4$?^28Guh7o=%B=!J*p7~$msO01w$yu`dUhx{s4w>Is|@is%3~`spQE&BG^Q9 z1qwm;*CD%=H((x^daQkNgXh0_aw?e!Y(EVKb)*yb+OSL?yD`#;b}4Y1c|&NrvzrFB zH38P8I;E=k@xs0aaUyjyWJqir`@lrYVFl>3{L^ZfnjmK@%QvQ226}8646VuWxbPu=^F=M?W2qIzD>p6-zO1!yG?`i?hxrC4N`BJE90p;cX+szLu0l z_)nJ5YG!8WcXNy;9^#kUIM7!eAoR4O*#ctk?2hgH1W#Uga4U6aHRgedLN~)_KZ-|~ z@Zz#q!oFO+}9rH{;ew z4)pKDrru;8FOc`6JT)=<)+vMZC~EbD*W_g-#KXcU%4L$km6=p~^!7*bGp`hxcS;^` zK>e#JBw2qI>sx^r?zM2Tt>u3*m%YltN4U#%4n-)s%#c{c*eKQ4t4!qYRj#jg+QgNP0E<7x5K8p~8mAF~YOq+Z8Som_YhK#)^9&SpqV*^J? zRb=S}S|bA}Rfxlx`^#ANYj+%OaLGal@poa6mO2fV9)H_I5xC6gZBHL@l*A<+EppmM zZS@u)13S8S1y+qr)O+8?&-&4;474^xDakqhUz329v83khANDo)MV|vUN_m1Mp?zpPyGT7|a^X*d=d&JH`y`zjF$#IO5#-Dm zp*X=-2G-?9%wFB*RiMB0GA&^%6<$?zU;{x23%~ao3L#!u1Ia=x-csFl|3dQ(cODaZ zn610BEz4Vvb;1U&N`ar7v-Z#*lA?ONA-xpzOH-|5D6?Q?9tITmo^JQ8l8ii0J34xU zjO4_~S%ew76EeVdtRWLWh&<#;RyaAlLQeD|6Sasl?-M0lyU>uB!zUdr%9)KN-+O=byD z69va(NkhPI-7m>I%tR4bgZO@a+6CGj!^gs8VtdiC4~G9f1ZzPe&AfP+3(fs_z?f)x z^EC&$NltXI`6d#hIw zx+y(su2B%f?}2{njW+vn%!;7SPv{~ORpp{EO7BBmm1QAU9jIQZ?>!IL@ho1I_cGv_ z6<=TN8j<-IMCe8Jx)J8#iP-kF5QUUIv9{gDQVULk{R`X*Ix**UypZB$f z8>Ju$Gd?jqr06E}q4VgI690mxdpm#}YkSgcAuKeIe$sM{jn-Zpm?}%CO+p&B_*wB$ z62E?`q;*tDVwRWOYdZTl&sn_7;stStOkB^46oEaGOHWS!tHmapcuJrD!v4%(V}>=h z%2LF;?mm?^O+l);h21x)``ov1W*mF$X?nSBMRWi^D?U10MwMUyvG`dDb+|Uyi1kK$ z^o5|pa3XIAaVPr`f067hTaFy`XM1NJ2Kw+Kiac~Ht&BSbE=@w)m;nO>cw7$oEQRqC z%H*P&jdj~L_1SO2lqgcObf~9ENVN>;hwT`4M|e&`^?&G6U{b?%t4H$$?ii0}JiNCY zx_MF}1-84oIbi?E>GbRIvMhOiR=)lT%vB{}iW%K5>5~YEDuO0jZVi!<4Tf6i(_k0f z3*_TlC#@D*1P%Y)J+_nD3#`!dYJClsV765u55A0_%1a}PSR&-1P;Dfpz>SE6ZyG>y zsFJa^C%YgP#BzCdBUFg<9e9_L0_q2iT4BFsGx*Ru$3~ zB*-n|o}^o$EFu49)Ou~CFf}Z4guEG7vTBYUA~+!XsK9ec?^BMa6cVmH*)B`~0QhYO zh7IADXANpkoykH>P6ydKmcl)GeLI%Q`~i<)I(StD;;vf);XHt{>1YIcukdsxTW--rl2Q?Mcz+Fpd6K$vJ>cT5*cNK6dWU za)>`t1js}5qeWrk96>UD zZY7Uy@noqah+@_nl$>l?rSfJ*Ap2jKVJ8+0f$dq%^*DfuvT$z%!>)4=M)mwe#pgY+ zNFMGs2%1^*iBZZ7`V)ERnjdjf?_K`6=jgPLr$k{}(*^%AagS1@EOd5MY+PLHG}c;V z|DY9mQw-JkHZF zwmnjFrvCv0hk!cJo&pm~(qI8{Bo@Xs_d&;cqU4kPH&g?-4NsRe#4e;ThpF=66k%M+ zJNiYOt@T-Kg(dtfy_QNCBqL*JN8iel!G3cdtS(XN*t;jl9Ai`?(2{ z)U1%RUFS8ioEVST(i(2bWSR-x|4D%^@4pT-hN~2KP^_#q>6IQi{3aJqGWTf(nOCP*0m>PgJH2Qmq(1Sd^#;mAxF<`i{QQz^oo# zOT}?UCR!(1(C@UE5Nzl( zFmf6@sCgulF=PslkReTZ=xKsQrAHze&8>n-?>Z_MwN9@!oN1zUm>V$$$#{VIhQPKl z!q>4Y+!Kd*BevkI&Gz=a$R2_7r{OOT8MQMf%5DXc z=hui1-<=|(dz2S-VzIAqktB^xDAwKZp_$!#Gs~^CxDmbcyxjPq*cjS=9*rmNx~o(y+Gi zGKUsjql0m(`itp=gfmbogU$=kMIHhUNg*4{(>s6Ee&5-yLmGgyP!L7lqsb?om>hgj{KIB{(E@63EN@m&;|RJ@B; zD3MG;rf)Mep`*vzKr)9Eh50woV`yIzX-fQ*%xL~>H0k_KskNkkQ!kJ-c7s@P59yV- z)OkE7F7r0}2gtV2cxBi2FjU1uyemqpX)DC$zV7T5gB8=i8B~Zrp60|Pgs|nEr8e3d ztJ3zHC(;m?O0uc9SjBUj>rnyxK#zs(iJB_6J*nO>Y?cDcA_!eF@S1GgY^(4&Z5a5o z7QmN;3=JmKZTrNy=33Vb-qPf|IxkBtuTZ7=?*hM^$aSk5N&r7DW?2#416AMER3rqW zkgp9(GG;flm{*jLi8Ug1LnF%FjHeb|<>;=hXanQ1wyWdfe2C4?g=_ya4w3;+DN6Bn z?vtxEl_6oJ9=#83<|gLM32~lqSPHBF?Y**%i*YXq{q~#z^i+8~oj^8#yn@d>H}z2K z=}(%t;#*KSIk-s%-U)WnkjDVQ^E4$Kwj$LWl)7+wrHoqy&YK}UnYpmr4~Mzt?tr^z z@$0uHI@7L(tt&=fm>Pa$P6*Yjb1hm>dWo+BG->N>xZS=3!>o!kyO7*$Po9yyU=++EKex*{k^fgs#?Qby=RscFE zF1X5~sLP+C=4+!kn2fiU!F>zxBeGgd>=>Si%vS9cc@-+49ek>a`?^nh$B;&O6H21_hN2v zG28|g=BCLoZx6(&NI>;Ya>^o3VFtr$lVC4Y5J(Majb!wWk2FIl>%cxTaX_R_)xc~4 znTVaLit2i~8{==4u7`YL$`Ymyy;thnZ9E251{~A(Qrei@b7G|(lQ;_a(nP-IrgD+| zLa$esK4HKX3n#nMorU+nx5<#dHqyEzL?IvBpkUSf1FIL37(?KqUL0%7-@NIED123< zE{<(wfHE=A+H?=`^=r;ot*t2?Vmo!g3fTbM4%@FA(W$U6ZQdzRGNhEFm=swnv#=2MH?+ zP~aU36zpJkZ50_lf~Z51k>G`rjp%Jq<%39ZghM=5?w;DVgHWeYLWFs2R)gIi>vBKN zA?RCN#r6HL-Nu~+M*m6pfh<7*RdH(R$o67?L#VCS1SZM=D@Rw-+C-zsH0^A4?ETlA zS7T@wY82)QCZxSYKCGUGwq%riBc`j z+C*)YffLC@BVKr|RM3G!LM3>$#RxF?<0x7P#A8t5u~wy_6mYLOXa2K969ms41g*Pv z&d!~;9*r-ZKLL;9r0Mh$e*1fqW7cR{K1sOKj0JEAKpE)XV&+z8P4wc!>4KYBL7`4hXA12 z_j{hMma!r+T3{p{sWqZ@8sDeK_)#}=B02HxK81FAqqBk@W0hq?8kSMDVL)dKs^lWp zXX(d=-n%B;taN;lqGKL1_)Iu+b%bY|Z>mz4=WL3Q*Z&GAAXlw_h>$u5bq7#6l+`tE z0GF6Xf>clx0R~9ny%gQvlAzsXFQxnXGB;JfdVj1iBkXk!U4HS)XSs@A!6ZF`pA9S{N7#f4 zia3HY^F~v&@m1Z_i{s)4uk1y!s!7B{Aw$nz?ndwtZnfmOo-9K*@K|u)ei3VZfBMo{ zj~2SP$WEx>W`yOL-^vL+0{h7}-5LcP_U@~k2#t)3FQ8W`#Gen9^+qsyrH||O-Hb}r z20Y1LgQHT;a9xf^5jpIF^_I)r~5uh>=-3}Zl1S8Ujp&7(=)d6km6L-wd6^|BrYSKGerc29C))PW&f3n zas+SYqXi#x9NDi$K!_bKdwYaHrw z5Q{96IZ!^vmb$L1|@?1VV-yov&{|R`854X6MTE2l4yk z|FR$t0n+hUu3Ul13vjs}p(Ya+!ug06SEm3t+&mH~!^80RhWc%4w5@cRe!76r0i}Us znk*$U82;URbJUd2Nleoj>(qYc_}U#c3cQA9KOFyDkUl?$z6q&Psb$NxEDoBeA(U+{ ziD5{r$MuQA%{H}naHXf(>A?9{}Ei3@sy={yr##2R6trf|7k6k1taQ%P^1u^ITRr@2hPhRMp$~RLw4MjCB(-Q z^~p$menNvt-5w#R9#1I1FYJq<#n5&=boz7VyhSOyvM}l=Pz?fD-p`lg`b_^T>%%{50Kh- zu0Ej7PJfJGW;c}T342>=?Z2AuQB-aK-EKcvq;aw2{jYpbrDZg&NX=2XDIHYC_(Kve zQ{u64{>75g^trR6+xLznzUk?vZJnBjWVz*iXhXQ;Z+bew^Y4JL4FZ9hmOv+<2)fm*AV3S zi(wtrW8+(WH?PR%`UE(vUtl<`FO?q1+))F^!bARWq79Jvx;vl*R^bC37C~+irhKCg zrD7>kbosHi*J9Duve4jzNU;NV%It*{@*-@!1wvoF4Sf~Ph0Uey_|unt|D<`#Z1YVV zCUZBd>W*GSLJ6H{lLE(LzvUVqGetf(r$`Lw$Wn2YG>wbc1i7fZjf3CS*<{7F4?2nl z4HDO~GrAbPtYB2J>+bCl1_|$12xuI3WwMbB*qo{ zi$!mh+TXNwBqOER1fJWT^!$yzG_m3<4#tZ7EG1s}Lbp-k(m8eP4yK_(Rd$$9j#&2T zprNt4>BKyFjO(9jVwAFT?^m#cZcT-&?Z3Ux(Al?fg(fcC^BqqhFI5Y z-(bQDi0CRFhrZPe+`p(a{<$8Hh_vR;L0*)d>h$^3Ih^I%F4oN*Q1!Bh^Cg$@$r>+> z%>=VKhJF*YWe*%iih3l9-0~RX(1;nsnu)=#z4Kp2^0M^uxU!`=ln4uFYpM9w+2`>` zbh%f!9Et1oIgQOBSoz{suECaFexdK49zJ5zM}o?eh8{BRzdK?4dLQLB-OU#XgW~3S zoFTJW7Fx#(rNA`2;w9>!dS9Q5BZYW!)Q=6+k8g1Bntf(>|7%$y-K%{=rF*Y9RL;d_baX@0J}T! zxQio&xfS|R7-d%*SeJw}p}XdOdugWUWF@h{gs?9SSP82C0WL&As360RmCo+sqmAjNQT-cS^3 zYVHHS7;YAC+YnB-*&KRMVmH3Zsi8RrGEdJ>A)$rF=et`1Xd!DL&Bx%;_gx^kmyxHQ zK6+d85&rodn>D;y<;L_sV~`gd5>rpazJ@1%-Y{^-T3~W4P$2-0dI9mIFwak&Q-qE% zdQ*lz@N?m-Cavk-1|?hOolqX#3}a*c?IQ3^4Qx_>9`X>Le8=+~t-cglsxmqcwKpE^ z=KjkxPW6;EGg`MS9g<_oYQz4hsoqaT=76yfzuX#aPuY&@ zyGLupXw{IA+PlLJop4(Rl&~Cs*;kbe)S5oU4o~s#L zv#l0ep$$m0H_8NaHY3U-Vb{~@P&82|j`*_TQCG~tXteWG$}v9yVMfSaM5U`}wR zfVgocOP5fYmgryXtf25lP1{X>3q(3Hct3=$OZ69mZtkP^nl4O;7OTBCq%>vWgjZz` z?Z!Zz-<$dNIc8M-3BulrRHtpm4_t&xP1eJSeb7NomPiUx|4s6H`XTPcGf5M}`%#FD zErwd$ghmrB-n=Z!UIz3yy>qiSth#$>-dkcUv-2-u`8y;^ORAuL^&ZX=6Ha(218?@F zxZE4MeQY%tFPhurbE(D5Uul{;~NLEQax^LWvF9M|e~HrK7c zJD{@u{>3=BP?sP(;3tqmbVngvLEizjHChw35T=D~YBbc+G2qc=osxC!{C@n-txc4_ zBx_M*V&JNqF9f9|O%PFYN^Xw&@X!~C)6%SZuT7sW=MD2u82094DWx1F zZFXur{UvCIqieK22bL%ncs!SDT=_InX9FR)pbIp?O-wv{m0=w^KK|+sv=v$xGBmq7 z9t6&On4psUF#m;9dU93QQ0SV5wURO5+y1n!XuarD;1>A|(Vg!Tll$QL( zh|{rCs|6&&zZ~Riz7&a`qIpQ!ump<_-Hdu+Y8C}c;Km^+!mRG%k-;QVVh(hT1fKZ< zP;#Fow?e@Yo6Qy+Wsr)s7;S8*XfZd&&}hz%c<6i0lGv1mBY3^}X=^P3?=|N|{f_+U z8!vC9!Y@}zgg@L7Ylgp;1F)s`SG@^SMl!npw|@PVC~c)Z~WoEI2RErth?y;l~EdVQo?@? zA@3$Khp21GW}|Vo_w~bb5Xz2K@!0je@QrvP2TEZ*y)=fVA%-D5#E06^i;FxTl}bNv zaUb*Q-F(|x3VA~9&ycZxh72?JN8eO*%BTv*mug1~68XljxEDwxr=hiZS^U{tm$P(Z1l(LX2EE(=mI!X6B6Hf* zevA!%%2IGU`0TJ_BcrzolC=4DtNc_?x-IHvRCy9or$z0pDMA)nRSLAs^{m@P5-ft5 z%94y+8$y)v7Pz2X$L0K_;Njg{e*)Hdz-E_@oihx6_QI=nI&bwT;$`XMBWN$%C|-7Sx~mxcNT;6(H(_L#|=i@iT_j!80>P!gN-<^CBkn`}ZM^sc#j-$i~sG^e=!JWo?^tUz7a<&1_$j3b(aNJ~P4xz;Lnf%t~) zRl-86CiWRG3@RE4HyQjSWh?_Nu$`>c*ZJj777mN1ANum@+&6rqQfc(ecFR}dsv7fG z&WD~t>ryCb$S3<)ymOKFrbD?IplkX#dc$yk2b~N-1b#~5#BjR_K@4MdwOuk>+%Uts zVZNX@{DM#^l6rZ^9pk=ECz;!hZMJ=;8aXQ)90l!V0XP04H=|u~gT;&9dS#A$M>o@t zcQ-~+=17n^3aR&|Ob#N$XXGFf=wB2?J~A}(gpGut&=H31IAq|99?}DfeSXM|WF}Yo zFx%zN&GF|Wgp}8Oz8^YvaL%GBi_dzt7hg9w_8ig7xO&#OE)B_vBPc@o8zbA(-))7` zgSg5yu06@^4XWXcg8GDmy(hRi{N+;FY0qIy5<^w6pv1Ki=~~#gBo7+g~_el ztdI~SvRp0B8Yo<2o(WFV4EKDMMQrEPpPM9NMSqyq+c09yCHQ)@Ci1ga@G0@1DXUzo zmShRKZ`3->S>4LL5QUG0oNntdshGf4kl{iSvel4v)7$M@W9?A`#J-$ERV1`^4tmX# zgJXM)c>atAOvI@IFXAMtRr0p(uj~J+ZZmM&IP&|qvA#4Nsui zhZjMMq%j%R!bV0+nx(}P5lu9~r}%L)vWA?0tN@Ooo$iIep z3+w+}S<4%>t)5)=dN!>gfkNK7?Iu}F#FaXy zFmL7Le`7cN;W9AE_o0%6iR1hPwoofVh;hXs$JRhcN;M3iO1UWRZbsF?$ejbv-mbP} zdZlOaaX;|b?@0QS)#z4$YV}4By+3U7U~=AJ@~}-dBk*X}qTpph|LeYRolQ0#v=RYb z#$L;k!;4NE0F@LOJW+8P`l&naL1bT=cgs6-AyzSHE~N_90p# zyq~kwb9E|jb@x#xM2K`l##=HpIkzE)DLIlMKI~OeII(IjXz#3o0u{%g+eLrkBgk5W zy)!`!<_YvNl!hT6?Fub-;&Cjm?-3P*(x29+f>L;SB%@vG@@Vs+w`~vF+{s?qMoJg# zX7e!PX4-lL(PB|==rgTjYq3VTZ5;QaG%9F;)lNxbzGQQQ=4aiWmllqT_gQ(7nU=<8 z?Q|(>xmfYjZic@$BGn((EK46!cSBZCzH;eQtm668t#NiUlDKO5mkx9&HkIBb?&axfYlN}3?IsM}>$pNd6gDHM&)a$84IlzHi-2Fk3GCSI(OhK)llNae{x z9wNvyG(N(5GU!P+n=O@p2d0$#03Ugi@$vM`rFzv9$!ECYmnPh^`uw7IUe`Q%>(4Ma z277^N5$R}cR!yGt3vL9cg&Q8l? zNJI_;g7Vd}ZP`Of7UTQz3cEO-{%IdJ-s+^XBOXy^E)D z@d8xu+y2puWIO<4BT{aT>Nla5mRy;*iVN ztx&c|odjmeryvp3y4s=rN8F_Iq+>0P8EDBli0@q^mbB-Q7RH(Mm#8cOG!k!RR@uZb zII1$m55XZjNzM|%p;*e4EW`R7{^o7yOd4p(2dhT#Q~WV&ju#|8zz4NMLV1NRAbv7& zD|m!@$ydT_-c8+yH3@%P*g0$heriz1=7KfPf&upk%y;^WKazy5JZ%wxG%hYwFmkr( zi-&@*<{v5QxH>??*@77Sj_tGKvw)i{B%#INWOj-#7quPq`4|BGO{`BxPJJ&FwxVxa zU3zuE_ykf3OZeN`l*z<7DRd3$hVsiJUmm9N-m_6XcUP5)oZk5;$cb;XGxn+=~M#95B3}uA7a9-}2h|24B5q=I|k_LMn%{ z`mARl^k>clcpi_`d`E8^KFpfSPUr_|oDZPrnxh{yPrZgMZ9ML8&%*OOT-3|nM7F>54OvsUL;Se; zJ>^fhKe!f$%^H8N$51N4gj#42xYY8Fp&uOz=Vix!?3kWC%Vcqs#IuRP9k<|xIT zp`nL}#(t6`*lQy}595_vPv0usyVRx6Y_?3RJ%k5LMGkZ)o+%Fny)MosBgHVsoXlQD z*T`%Vl8S{t7~LY<8_^Z+#CkM6J*y=-kRF)(7r3tBN90>K7uN3AW+^7O?()=?BBbu| z$U*WrA3OOKeHlM)|BM99OJe*Io6SM@qieQ?3)+meyWgdo3Y`F>DW|^;t>pA~5zAA#;0}eYT4g-iSeDtkZkXCh0Ag)cHBBYXbgMhRZ6{ z-n0S7wg;tiJ&Kl5Lr~4873@&Y?N=um^s_zSRsL7lqNiA2m z*T2#F84goGL^$fIOpQHUdP95LwVnHbPsm~8eui+%++GJU8fIt4-9JOB7ZHk) z<*dq+R_}t0)zOD9ePpz`M=<7A^N=VKE%a5ol&CY2DNMAbf+?Jo#9TXh9B-Rx8}-4| zW5;J&@B9nG!YW~K*d}c00o5y=jLvBDhK^kIUw{mq;O*{a*@in+hF=T?s6^Vy9nWg( zF)O~ZS&G0DOptY&60s9nm*tfIXTYhhi7KJJ2w=om6G{k%<&2>lM<>PRj#0n?qA282 zVP+2V?9>*>%<;7cYO3dB|8}=IH(z$LClCrB4iju0~V)k=i z4l~Z4Nz_t$=udqU=!BFjt5wep3=Nuf;OfrW`jWZYQEP_PMi;Nk`-@|A!>iHM^N87rxo zt2cvR8May|b}{y*o!M%ykWWG17rl4svbj;qyA7+YJRP+}-o%iW~hN~f;Za8-0g;!u$dv~wc}z%3x~V` zl*6(3%Fi&`D#t@5O@mPRaLMMP|LC*g<9lNrC61hpy&3wzsmY^4!jKyy4orpWvxbibAG zsyQtgwt6+0B0f=Z>dfi4LX)?|a0)17FXU^xR^{$}JFCVA1bz`#RhwM1n2MFaAoECM z<>plWH@#B!9KdJ1{ZQk395ogRA9RJq2M5Jo9W} zzZbgf^P$`vbaXZXz&kkyR)S=gCbqkzB|Od_1B%}W97FF_4fw%RznJB{=>8dq8Tiz( z_YRoheytCOA2gKr&HF;ps7rGVR6WFt#Q>NF z9rF%RlfvA>>^YQ(LsCUtTks9=bd@~sCMK(hXI5^gtu#PL%ur&MLuDdkFHGk=>(oL; zzL3<{-5RXZLRD>it2m%`9IzLWF_$gEOU{A~q zDwDxxm@>{*3@rwE!;nBrj7puh)w&aeM2@LR_w$x)DILTe&V9nK*f*KIC|Q!$=`~)B z7+?K4u>g@~r`+7sMVN}8uhv!b%`calSr#tan8=m~%hqiC%G7RHG&Yp(NxC)u->@$F zKnca$FeDe8{Pv-O72eYx`#KZck;_?(d1G* zcKAmBN#|IgYR8@8#ZK^qgEuPXWmU$SvNi1^VH+Fdvr)amy>(>!N-@bxU)%}A#Dg7& z7Yc)ZiS5t!!@W9meo&22D$m!`BH-eO$nO>$4a*#+;)6(QlQ*vGfxK_`d^I{vsP240 z8UG^*GJOHo3o5lTA<6~W=@Tqkm-gH1ljSxzX3%C}KBff9#V{CWmLWCgLSia2L2Je0 zc9+0I$n^eH*&fa%k#?owf!$+JTW8*M2!doqRNhkWkY;IstvDuW?R13Nqn+Gpsd4X|#?#oqh3$(L(Pb(usfA20Xw3)n&BiP*jr>abOFnU_ ztdOzZ{fV`JCeGV(P&w9fsG71P>P_jf#Kp#%P3v6@e{_U8i3vX+@)3ezX^sE2hj zTsaFeQlYTeYS4y^@7*T^kcNQ93BV9=w<6iU+ET2HC4WRFcJSEbM$sD zcX@2Dxu)V7seS5yUn4bv7H4RQ6%&&ld6GBixg>WuKlVYMiphP~nNBz;qJNW}%g6?f zU0VoQFU$ndLlHH{z?lB3Uez5shaygvRE2NVJg;yJAy-+SqBOWBR-tgdh4Pv2TZuHf zJJuXummir~mMz~B`jC@KUUz>Q9B%r?MCiZISxYpSbr`>IkLI!sOQ3(Z{n~g6$p#hz_1CzN(qEKBz<`4A^CauKy93-fziivIBB(r25nb>fsvGBfm#FUp)&)0)!ed)< zb*!Ctrl$pt=W^T=;Nr}$B0KKCj0<27+qqkucduwsJ`bbHX>s&WL$Cc5No@Y5xceF5 zZ>eG=k9B!Vx>vw(8c`!_AzfEp-J^fRbjFv!EP!fwwTWrzrJx?fvE)h9IT@SR~=>O)kHdQi#NkHMKAIJ0RrCEQ;n$qe;A z+`*Oh^(*m6;!9?me9iHd&v3Cx6_>`6SSjP4j0#iNMhfMzRKQ*YUE_+~La1F;_u44; z^Owzy?*&fcD_VA|MT)lM84a~=rJU}jf4}8wrFrGn3Vc=7E`uXXx;ZVfd8}lh?*96S zpq4a-J^`T>Why+p(QRT;@-M&Wq$J58r8>ccpEy3AXc>5vP|D+)(;u_s`swq=r1=7z zC%YdXrm2YD9>l5H^TMcYG-md{fV1&p0me(I(gQTmP_me=W`TZw10ISVi1Bn&;_&mX zG&{&l2A%Eraw`^+kvZ7lG3aR6D=TV?tL)Y1>*5u6lz{2Z=J#X44u;1bx=WlZ=yfYPJz!N#E(C~gvR&L(%kdhHo`2PQ%}DH_Eh)x% z5P0#{kSMl?3#_8mX<{L$bzb+6WFjAE8u?=w7HNm-I!l-dlHxE?_AnD`4C_6Mt6%xW zPc0Q04H^$TE^iZ4h4TE(v3o|(;k3XSH+W##$ma;#5&}2njmaYN@P;N1m*uRwKW+-N zEpK`~UyRg5j;*YaIZp5I_|&zCOPb8hs?D5tudWb;L1_Zys*UJ$akX!7D-yiok@D4* zlArZSjPBC2zxNYY9?8vfX|S*z7P=mTu{2C@a#@Fe=B;x%))yBc^y%1Cj7^Wq97+hh z8QE76{+N8Fj!ic+aM#gnqH;A)N~g2OD$jS$|K@M$td3t8VK1R&=YtWU7}wAG<%bTH z&1p3LYjyuR?fbyK108<*%FEJ?7l+(ke6h9;wP+h{SdRXuiGmj@+_yJdZ$uc1XFhH#JnVRDdZ2A? zc4vTc5WM~=^QT68v8=__M` z4nf<&>Ox}m?K*AiA=_h%H?7=T86tOi2Lg#sOBkL@KGlitq%DM2E`87i`0ft z`Zauy0{Uyo$uWzvW%d90BnC&sf#rX*@n~kFzPL7A1oY*Z-QjkSIM(Y5RmZ=`qU!G= zDwXP#wP%y37({KjQC%Mt$%*m4kL6j^Th%oZ5x*2)o08V4%GNw^d9F<}KOj4?Sqwdi zW)hm7;>*jF@{Le$T#Eth;BC3Uc(L&lQ_XPg+2Y6JX?gaIXx=3;U0&TA6!ds^qw{C zZ<1X;`DB#Ll5Tgp(`cBkN@mJt(XuYGI8&F`wfBiPFRsk4b9*d~dEgx{f*&uZFI5{u zE50s}@BgNsw>rOck@bG!RC>@G85bR+KjGhb_AssarZNNjoKQtVt&!G7HJ)Y`Lt=n) z#*$3Y%Wi~snW~+zB^A5s_#|`NY~Lhe3?11)+TxxheAClpJ1hRJc2$p{*@cc3_H_FO zuc_C4EgMfJ7fIUk|F(rbEkWhggwU~fe-KMeOFVRjFBq}=(68q>(LR-MESZ0x`&8P- zo#laoHEGUf_|$A0IWAGs3kJqnyYJ+9i^ zS}HJW$*bKbG*T0cF*jN;a#3}~nm8};XkHJ@uK*#aTd5=Hj7d~rWT^3C`}xjx;z2^u zIoT%trn6CYoY(q0*+Do%J2#+XzWpz*UJ*; ztIs(P=Vlu4N|1w9gG_weukQ{0&i!>>GNW?C$%u<^C#Tr?U6sj#?!$UZf!PrJ&FZ~# ziR_m;KA^MPPAjEP%BXatB(KF*lHwCJxgkbXyz-6**h~c^Pqt913pwPT!jnSMO6Q99 zBwtjIexOUyXz{_sOrQ7_fCQ9N0)$+4R3|pU9AZSf4c6_VN8p=AQrg znhEr2PexDBV;ePgdDl%$YrTS%mbI|+Z|c&*0yPCqjSSLQUa!Y}7tqrj@9e(E;8vh~ zhl}cBUoZ^c^LbKOb3c_+N#L$ZEN1e+^LM37OtN!`apOMFiJ7UkxkKNli3X~fi}Ewcl;#d;b1 zqtmDg5pXBHnxcw3%}SWfK7DMc?)-e~quX&z{*2ve_KQ!mB77^ZhljgYJWZ5IjsyCa ztQ*L~{3@v&E7R-t`jD$=PnyeAO4 zdboc|_}~7jB0|X_o|?CHYLG7{+@?3OV(nph3t7n{C13K#g2%Id zVyx{*ULU~qXN%mGptY=Y;Msuw%h}naBe!*$n|fB zv4jPChaV2Dn|BXCq-dQi&a~N3aS~6m^K@9XKS znsN?;BbCq2?|2NubzId}X51dVkSLXSmYJcHL7jDb*2G>d_82ya+Bkh^{FN>i*;P#sEbYD9n zFnhHI(USF2oxdou5PUvR=b>})Ja{c8`DGehw8F-Q`zEL6cRsw>_6JQr_@z7Kh*GyH z+|^R7IutTYW14^I_A!hqY0&QR`?YC=1cf0&?- zQcs^pawW^Cp416zSzG1~v)%W=csI5uWX(P^GoPCt2THpK(jYZ48Q(q;Maf0jwVtR{ceEgG{^~!J138$ANtT+1 zZf~kP9U8l{g@nTz%fL+Kg0nx}T?*-x3l9>Y=XLc))dA{pjzRm;b*oSI??~!JhcGq} z{XU*Nyv=k2BPPFYqF`Wt);*>4g`2TalrQ;nirXu$@FGF&gOzt$bp4g=^V+5G=DW|5 zpjYGJU!F%-EL*Sa*Ek<{iiyxjOr--!nH_oq=TJO=A#@P!E>Y#w>2M)j%g!B0ekh-CZ2x3 zCl%w8_u~j{reJggJD{|4FW(xztP`9wJ?Ji(4+PJ9^Jdit#pwwlIPZMBQI;kzHulZC zH0u5-KTJ@4FR^e&p?x>)i-&tqf6f;VX#Z7?Kv8-z>Ct=>hlXOyp>WWRQ4Sflk4$6x`1ar1dUjhXVAD_>tDqseN7z_?X z7!4}&0+$wujy#aN9-|w_|JVm9Q!YD6@vJ)(>V=v0lsLWFw$TrN#v)jw`J(2Fy?*bn zu33ixShtRR^)B{Q_LG?-S$~GIJEKJoabu5`By(M?cnMx4eczSm6205>PwfP~O zu9_xcB>TMrR)`Jzo`HpJITA9EUL|a7b-j|Ebl}I7k}LTRwjL$Fj(+zk$LZsIAumSy z0IjOmji+>=xk8uarr*;ErcmGeewUJ`r6qKA<7#_TiOvEZd%Uf8-cg#`rVzqb&SmLR z6m>jrLdeZ<*l-Un^yuEi%>gpzmEfLU+)iVrP>qT}l3TIQtiHav^Bj{#Mz|wF!CE>D~~F~=$K+I%?dxt5-`Otehye#5w_LGP8&3a^iDe_5#BKE zL|)f0R{Ja^xa98KNkE1{E}oUOL(pEz{M3yf^m!s&Zl)|8a{aLtt=>|K1AFV21Yprw z`#U^6dP<6#cQj(+)~4s#ue^`b+X}rA+wO-@f6dJ<+;?uvY z*k8u`IATnZVjC!SEz*GD#|($m3(w!ys+!@s;XaM!SYWJj$Y_*_p+CQD2;m#g{)YqN zFIXJy{X8Cj`m1vnF>o;T$q-Uqo0O+`x-BhN0^LEmG3@3jIII0}kPQ^>` z+WK*q>Roo{xsD%&h)E9*#)n9(iI z#yel0x5-yI7{3kHFZXis%1+a0U?z3=uaSJ>g(ojVE}eNU}> zZ$NH9)V*ucde#Xu>nyokCN0s)89dyg|v7RsI61N3h;`ea~)iRK4YlW^o*u8TGHg7d`o`$P>j2Vjg-~T9fhBTw--3;Mb zDXl1JMh)`hqIE%ip-Ic5Lv8#tW5<>h-_Gm-*Ub09?%@niEk-`?_XcB+Z*A1 zZM=Fq`26YIv)Ifd(69?ChQ>fJk7d=O@`NI$P;XTfDcqE--nd@S@W5rDC_}j`3__yZ zIQmmEjM`l9-jd}|I~GqiRlaczy{t=iUv#{iFS#q7wL;}<_XjXr%G1r|DhptGv+hg8 z%pbTfq2FUj@WjIK7MN;c5wqd33za|Cax)vLH73EM*-7tiXWekvuc8=P78R!PT$gq= za2__Kofu)v1OYwr1E+uV#95UjO}KhQ$oxTBwgbd^Ou0;>zIT5iyI`zgCmU~GL?6;8 zcyggObPjfIYo|&i4A4=2}ac{&l24Q zq}IJf(?2&A-b{~q%Q%4yH?4%l;&TK>|Ks85H82^1pXGMjA4H)y5TgT`Oz+GOj-UBb zVv1w;G0&iNL746_m|4!C!Z^>#JlkhEOGMSslxk9_T+hwJCZ|`HtccIsG5JCNjye+$ zNvwM169{#jY2^0@jF_1BKJWG7sD~@uc-0oi< zZgb4tI~Z%_{lC^khSm`ag>IVk*pMPW}*^PT0)LQtC-s zv2w6K_yBAY&#?(#+83*Mq+`d0{4r-LXh+4S=1g{LtQ#n5qNU8@?wS->9(8$|Fg=UYDk~CKc<+W&Gd+7vR((=sylPy-wXvOY(s>) zD!6Y6#n=C%cY~+Y!~e~Gv*-sp@XLNo`Bl#&Ua`KE$@{rM{W`&O*rc#hP%S_5uwEmj zmB|)n*lDVaqQxwJ<1fi2DKXC|GJOw6K4N1~-c_xDZf;FU2~jtT3+q`?AG&Rfm+s>q z!rK>hczg)eAcYx7;B%H(q1z>ImYXu0+2guLAjXD54$Cd}e zjFPeV=LB}J?rM8k?#x#y+n;)11gFDJWgq0TuJwDA6a#&_o@Yf)Xh|JD0BEBZR_qPv zFW8ZtH!70OMZu!|lIjq5CbnvI;KXN5Op29c`zedYGxNvg`J_pzX%zXBHD#l0>9fcK z#r2h!483o?R7{3)Xg{C|+*yM>3b^<_{1p5vJ|(tf==B-m^h{m9jzXTE(~g=vc_;lt ztBjZt!;;I*^r1%7G@`dRW)h#XVkc!ib@2m2%#y!cPd3{dP1{Ih-CqFZ0m%|G1rta zj;HCj=~hgEk=ULZpWwpiFk(CT9>;RVrX)T9MXBR29vauoGiyHi3W=8hEWA8epM`9h zxZCa^W@Y#-CDPPf08XS#Ool<}$@3NPzck*}zbis9jX1bpC_9BnF=LaT%JGe9*>xws z8*NU=N7J!&qPDO^JG!-MjdN9(2$(W!FBV5Q+dY#)csJgaxwYAldKmQIq2aj~E_HCQ z730oW;qI7zB7#FoQqef?XSVlL%8e4^{5Q|ERcp}%tT7d6ZjJuo?qD6zI?Z+KXSJ)} zJnSjq+0pmc>vWCWE9Twt*3i~%8jPy+{JfST)0~ZiOju6zIIBY!-`2P_W52b&FrtvS zku={4XWq2nf(*=sEC1cvo0moULG={&kwbaLoTs6M(&T ze`<$}|EiCJZapT_!`ADjo|M>5rjVAn^})GPy%9QD;*xBobWYHCw@g``JZ-|1K^liq zUTzWB?Da*g)(dal zjvwVDnZHM1VnvkLyddwfTUc}J=Ki9H!g&%p{p4$GynGpI8rSK|chfk^J|&@*u@RMj zc;gpDSbKCzyXbecP#26Q?iXn-e}`{B$<*d-#aG~^;OwI{ct>4Q1N@-Kbb@9T5~reh z16<29Mc5+-|B_Fn%)|whXBH;BaU+>U=8h?*ZdyMfDa*!c(1v@HSzuxfjF|cpf7+LT zGj`yK05>QM%bLFNlep2iE1!7~bDG1v)xG;1^RUU8X#C(jLIJTnxRpmE(k@UvBTwH* z`lB(*&*YaFWoUCkp^Ij*rTBJ|b$VEH_XJY<>{}XfqiGzg@;`dyH%0#cBedBWqXm}u zkiUG|poUt&45fPx61iUfsRRd(4Chyfr#m6DFGdQ^` zSh3Miw-FijrsTz>rP z7(e~*N>09AMBiUK;HjEPTTx}l(~F!O`#z3tpGtX>W$V`On4Z*`GEn3nH{Z*oD%T){F9}bdh4u1-_lyi-2g3B%iWqUc3X8!>7-3~E!fDntbfw~lh}^`&OH&m z0K@V>8>)4|^4d?|4pH~zgq2c+5GjG$rShuX15gzMw{kJ|IY_cipDEhLN&eF3?feh( zw-+D(khM8|uPxeGtLn_AN|!2yiJy@0R%>)F;_?~0>ScF$Sj0@d9JP+dUzp)Ox*xZ< z%ZCGNpOkx&GHw6LB_0~3iqz9$VRMLFk~A!%pl%d<)X0dj(H9O|ymjZfq)DeuN6g6lz_JA>IF+7M_Q&JWgOe+)hDGW0G_5&FNDrl)(=%o95u<@|loD(7x zIAY)Vh(sLi`A9uji>sI8yTqpV(tLS__*XeKm#t^9*QTUFGQYG!cCy@Ym_~PHLRpnL&QGexG|t~!@<|4}$p1L2kakTd*K}3ZXmjhqaIjQ%ozax* z9=OtIN}_Y@ae*AbZVX<@0zVN~Z)@?$E`syyi^jQVz*(v%KJwl5+@6n8XId|gGlw#3 zLL78ZhV*D2V~_aa@fE(FB0)whbD^;~pP!nxP#}R$>W#R?WIr0UCt->i5>0qTB-Sw; z4{Y-`{jAoNZa+ovq)tq1^Q2C)&^D6XGd!in<@I9E&PdxS%4m4^!<7CI`O!QeEVd&7 z&ahxI@AT*&GbG=rF`uFQ2p}mY?SXyBkiWg#X92aHTZX*n?k)jw=K|{%^w}F^o20eq z=!|xHZB#~yndz>M^$8}ujaL&f&s|6vL&ZIuG0|}mJ`#&F zY%EA0J?tkWj~lLbxpM%oWwTo-IU#9^r~Y2IP9M4im&1MHT=kDRMK_|<62;`o8+teO zoEeu5Rk(Us9>jTX0*eJ!i)d29pQ($eY#sbcSd<4wTFOCXU-A|DP&}9%IKTy0rPBrr z7rMT81h7{YF6rW#$Mn zsHb#_eIzFt_luR`IOBUN!(XR!+{@|Z9Jf{QgdJb6(F~K_RCLfUaSeU1#$*{D=K%_i zK9R*^p$Rjlrr8YsXeYCF9BC9RlI}jFXtsg>k5xqhpcDn6fKn7-RiL0Pk;#0uTb%s! zN#Ujb-z^;xc$>7Oo33_eeC-L5hmGUtwG8*EL7@%w{J5G^D`htl3Q<2K633?50qvDKZ4EBW7>TNny?km(iwCp& zO}-fU!?@g#g;sh&h3od0;>9>Ws=MY{bZEO&%I!UF1vl$?NR!lClK71tOU3*i&n`PP z$glgaH@%_Pw!2s@pZ>c@^5)%qSa9AhwCFfJ2*lZ>_Y-1x_a(#~LAnFS_=2?`H~<~Q zWSvIW{YtyD3T>E97P?nVwICQ%7A8M&@6fe=ZN5^+g`Y(`2Hvj*on`N#$@XCbxbb!= zg~d?4F=`9JbhurLI65Vwn2fq7SpUg=OKavYj_r$M#*%xdzPw>bLj2qE>kzOz%o|b%cVO5Vn~KoN!S~*ojiaN$&6y<)&d9yIcWy4J)<_{> zJx9B;Gewuz0dK3Z{MQtJ@kdz@XIFEgE_eo|B8p1F-h%@RmFA2nCb+dc@Wm8i;$&Q6 z`(8}={%enTV<+`_V&gr#sU~|`D>sd{f6=80_#N>;Nj&Vsy2zE*f*B5vTlAh|m9llT zRwGIua(UJe5z+4x;Gf~yq=z^Eqqfwf0ewdk<#eOuk7yk4hz1WZmm0MP)$+bM-GGEcCF0fTetvMwN76r>$l%^&9hJuPxm_8gACW9jrQ=%X| zF)m^$9?t|ld5LA#1KP|?sA8fhC+X(cK8P(2gC$d*23>;{miK;Nei|9Y_t$&KbSwRm zyH|mCOoBXJY^3plzFcR;9O7y&jqixA*s}dy>h%9z<-VgCetlGZ9oc_<7JB740$C&b z!>-Gy!vU6iI$^-Js(X6MkecL^;}rZNARWlw@R({BmUS>I4Fn_S?Q{BTbWLm!etZjK zJj?K853pG&T$}w8JC08E*qG2--L^Pi`B0tCc6qcEu@G{xl)g%hX?UCPE_J-yMl0KnrV)BZDfA+x%@z4-=wGd=e8HcC)yK zMakQvjE(unbNS2Fr+?JG1TGQoyHFjATy58X7B;jG=Q5H^Q{uO zma!O5pHL^I?2qZKLnzrVF!Vl0KoSu=xo69ZH$~JI(TSBX!HS`eu;83_y4*2m%db^Bcb_sJ|N&@(|JSQ9W4*F%e3iP(<#*g||V2I|x z=q|rQig@DK<7TC;@PBaedRi-0^rQxHz z#rpV34ZKW|L;>;#eP-wN0!w!!sXdJ`X}ey;H-uh=HG3pit8!Uuu_!Kv07ytiqnn9< z7*+f^>ia10CqUpt0?Z)sX=Pq7}>+Dj0m07k|@qp=8&cev_EN0HTzDCc#I9z|a#vmVX-B&$$aWQwAo!)VF zxG^yyVs&vklFra^f0W=r)6FGk-kbw1nYy=A*7~A=F{aKsWd%Z!~FJ zSh=ugMJhf(;SjAO#^%6*#(tgf@>*N3d1yuNpF*e>KpaN6(qwJ_%&o8OJA25Cm6Df7 zFtN}U&E^x$aF1Qq|Ho3|r2FRIzo!qVZ3rats!0DK_I0Yz0%VlGhb!BUiPk_$o67c2 zo8#r4t%Rj*zc*Lu^900+Y z8a({_1!w6i3R&QoRPImDg8(A0H7RWd{ol{1D@&RG$px-313u%;!(4IBb73}fkLTxs z7WG45*+wz_OwD1I%@kea)rNfKxTDCVI@7Si{j-Tt-h|wTh`o!0(a%7evGE6F948p~|6_{zipG%OW_mP`FAVbW zs_EV3CshNc3}RFQ8&z{& zo<48cQGrKfqB>^u|#CMAa z&TQliS}u?C-aXO(V`_?u;pkg`0*8hHvb0^n=e1_pTi<1Xc&z2&ep$o+j(>AZW_RrO z7Z2Gj{xpA33WJ5}5&C;O1Eo7n0o3)VE%fKN^F9i81@LlPPSN&l`HQV3bwhirWPC)9 z2iP74J+a(OwT1T&`naRg7F~Cm15kq1V+7igaPVC;d6ak#1i}dBgjnjO;1%6-rxrjP z^Otla+(o@T#%Fck3QZWP$61)0_0tNiYt56~P3tr!ZT(Aw^regDf-4&MI`mBee={nE z_t0Q^ngE*P`z>4@`^{hZ<@omx z$f&yRdr9@^z`lw(Oro-6S8v0Sg{Sv33Ii*gT?T;s+Tn5HqILf>wamAC*+Aa|^eX~+ z6TFLnQqgQLFu0Fwq32(J*{O)opt#m|O@7ua^!~bgb73B^UhA(>34htGPWV?{*Qe~h z!(5p9MG4sYGeijd?-vyDi4y;Rv{bkBa*{3d5M}T#B7)%9_Xk=^>VCn zz8CN3qhKfb6IH*xL4tryIlpfj{YK$6e;Kq8TE;wJlG?ZDn4@Xix&%F3zMQ)OK$!di zMAOC+`f?%EW$~OEQ_m0OzYJm1a9OzO*M34Yyj5P|FS0%SCM{#8{uA!p!uOjN z-}u{ccW8Iur~QZrTj+;I$40ToyQ$|-x6oDx{fOs5F1HsPn@ZW{$(u@PbG`4LGiFa0 zXPVaY&xiq;EM03~B9Nr}LeL79RuU3APtxY?{K3z(xu;RxMDkw<>E;i@(R?7R#8c+E zJ3lQu<8BPHib&GQ>|P0hHyVU`!b=!mHLUwQxwbVt-I#8#CKG+!rT$l<%a-;A1_>el zBOI7ff@4PwTtng4__Fx2fcm8ACj6=Af``tt1H~=$Q`w$TJ%CfDt8n;p_>xxu*C3lY z$7Na$U<0ylj)6*sY+;y!f-3i>=<#xH=TkYN(y-Kgp_Q`lz4j}cdKa<=r z5IUXdYf}!-1c@^L_2y?k*a_XKaL@dgmWL>CdURi2O+A`fG-=-M5AZ1Am&V2BH1m#X7)rjGyBu8fcxQc_rvuKcxM;D&YHrp9EJ>Qr}|Z>vQ2}jFOTvHw7q)y3ZPR z#ux|{EJVSLv#=1^KTzs%MefyHa4)R8M9SZVZeikQt|{U1rPq_~DvGVvtLfwrq{w{f z&X~-jGlY9SKk7E=K^G;9hp6nuSs1a+*3&VO*`)7?;ZSJjpF)pO#|d`nfC20MKhtkKcxxdwN>f?1YKQeq1 ziRj1CuU*qzW!tvZCjpQ{keg;HUHMY<{5pjd{i{YtaHhwTQF?#%HTdxR3vTJt<#Gd` z&QsP&^uk4e98Q&6_M@)Iv8D7A6bqn+jCO#QggmU}}naB+IcB zYp%p}T`XYeo}+FLIHp0Yk9ynqS5v-~)bZ+pQmt$*pi{)MIE!hdtZHFUPw>-;EwA*A)Hi*jLGKJX(s-0=BRfy>{i!QA=JORjbV+c1)1UTM45ge&7x~(7^#(eXh z^CE2-Z71LD3Wm*864PRw!7}|3Z@nWTk(lI!K;vQI~{@I#U7J&`k}Rm@&$Ov15e01!jnUgBhZjRwSu3O{D&0AgFxgPSU4H_#* zsj}-Vpjnc>hQVAL_3X#p;^^Vq!hp_HcqKe6Ia9P?qznn-hHB#(m`D#w(-q*9f=<)C z1Zgu;aB!(GmEACd`l7o)PWDRP*5yEc7DitH{s^-T&SRRLX!N(TJwvA)o(B_Px1h0=x8-)AM! z28UPjz>VK0B;~#QQr29`!?wWtGdF8>5fOd>>nI;v%f?$5Y}cz^NVm^F%V8-4bU3!# z&yQl39+v9noSh`=$v^N}S<)K{KG-eodlg#40{}HK#Jlz6aN*oKYP}}_0wx!bj4cn7 z?HC;=&1S`lCR&hFVLbChiY{JdBM=D9n)0J_$^PdKW2%- zVI4eK)6XD6w?!^G!By!N9GZUrASJb;?(ljyNKA+AD*b5rzk7J=uUEC;2-+1mh73Ug zU}6-BB8FD!5O-NNK@j*+sP!_NO9hYNA!lfw_Uci&!x@xxcL|qlqe(}?4y~2~UEFr7 zJC{bs^=A3pf@M{IB?FvomIoI*t=yx00bJW$*?Gi;li%w7%hm4M92)h6y!&-Ni=TFr zLm$>9>y$NxBbWFibogbLW7cDBVI{u(Jun+Khu?=k(67kgFG}I-U{zIr%nNqdA^^ z}5#duPt056Si}laFV8+xp00iidf0%pvZn@3D5olxWdvbHWgNIvrFY@a?DH1kH)Rdd z0RR!4uJD?~TrX14Ra8`xFPF2_kdh7LJE*Ne2e9C7A{qofOB;MF`J{=>bVJJgG$|$0 zbC$xV#F`VdHRCD~_iR+W6g@DENf74`}rfv{`c)PcU5rF#* zY2buYu6HCDHqNOh__51DG|Oy9iXCrZbS$4n{Sl=BpcgTv!5}4xDeL zsv+qLM`;)>bh_NZO+|9QVJRlLh2fG-t%FVPCxjkS-k{b0w^ziYYviI zg~Nh;+Nka}8zmGV`+*io04+*J$Db7;=-9KNzvY$iH4OF)7LEBt({SXd|G1z}ujZ-N zq&1JnQuhf{j%4e)i}UIxX`eh^M8^_Nbhv*ZH+`#@>OsLL(gKp^uh9E5k6xwa7@SA4 zmAnH7cy8UtsepybwWtFE42zD`ppUSG&x%-T4B>6k)8-e*)q+Jx$g}59CAt$F)%CdH z+#Df*LWy~F9?8LIsPA{n9&o`2=h?3EQOu)Vc%BsI!m~q|*Fd}&sfDx@sHpCiS#Bx) zUcl^nD|RRnC)VH&C7zeePrFC&+f?R%3H)UEKCTJ}kghI9pX0w91J{wj(0Y@IuCC}D zP*ea&J7XW~i_%N;I5p@r%iKr%5g7B3rQTyPB@|8Z_Vo`QjfAg?%cQ$A7TKkSY#`vE zjG4+zmHvi8S0!w*=JozyRe#FW-n;Yiz0J#XK>ivOP_}5adp8*?uCmT9n|(bhC535`X@$Syf4f z1~qV0#cnAiwaOSk?>y!ZXFlFhlHz8YC#~5CH(ch@-DZb2OMzUx-oWXS^iN->V1@sf zC!pWRM!Gaz(D|1CHR1Dn;@&Z@C!vL=^K=_uKHY^!p9q}xdkWGrYKNcwO+AqBq3*-6 z2d5w`!*+RY2r>y}##FXAs;9%%KGY36@3`(J!Zx-E<6_G#y!Ad4fEtktS^9I7+y#ry zBiUT=u3I1qbQ~NW9=!f49y6S}$&R7+=}jqZ64YyjZf=%a2>m z0U&udrLCnv(&IzVA>lfSFmfsHE&yo`7&j-~C)`JXe4navfg<;wZMS=XkrNf>dQ;(& z*FeVZ@&>xw<7T|RHI&4Sv>;383?13>HxM_Kw%0Ihvry|T_Z&|VU>bw^`xPAkvA$9% zrZQ%L=%2f%U%7bx=2nN9h@VGW{@(Zh!_$`sLiK;|hh!;PGPZ0f;aVzE$d)a}HfHV} zTM{J^DcQ@QNR5;*iEP6#GuOVgP^b(wg~(L2$V4I$k-dH|y+6P2zZr4e*Xx|;Jm)#* z`CTA7iHrX8YHi^s7OZL?rFy7QxryULI~`-xs6|0=QS!KSs56tBGNacC#~8M(--^i7 zu&E37T)2iOUg{adM^tvz`3U(Fn)UkpiLA|Kdtu6VT8=Ueva{9yA4cL)Z^e98zA~PB z(E1HuB6*6dlmm~tzKgaqwZPm!(tKys16C$NEAH{Y6xiz*7K!dYQYe)VCo7iX{Y zFLx=_E9_|MlLV`lQ>Tu7pKkz;Vc*_reR36W4)2%;NaxJ;FtxVsZE&~ZCj{7aE2)Y> zdZLuB%s)>GG-5H|4jsixJ2Ak^X)A?&QkMKA(37^5PNr`y9MFyA)L@U5VOy~`%f=HD z#uIfU(>+g5zWA|!L-71i>CA5?Pnny?$SB+#zIxnZ?$@8J>ly6SxpTa$>a$fAI#~^AvWB=f9 zyR`stD^DR02i8N)B+ZTe9_yF~On$v#=R&imnauZj_YLS^)nuLOiUTn5YMWA2gUt>v zEq$HSj66MfKX$o2q-C|%^$X?6Lx?QW6wDKqg`jzzn`(mmi10DX@RNh zXN$=w!Jb2Ncbhwwg_S^eRigBDAIROpJ;*H2bzJPiWxHbx%8O1SDyW13#gcKweNKR> zUe~yFI_r2T{#~H(C8NV@_8Xq%tu24v{w-hYK>ejdN&7vopn^yE1u35>kv9{m7qXOXLLjlfkXVNfS2>Xpb_pId@3RgHIJ76{tb7qb`zrV`+QSA5jyaW3~J~mFjm^-CHUHbC)*MX))dZQ2m zynDcgC^xhGG)VhHh?pK_^EwAzB8P`aKFnz+rl`7_et-rtbvdL4_x26D&Qk30B>JewTdR@#3vOeP{vXdu6aQM08;0(eLN`2v$MRkQIGF)FT=4FN{lBSGxQ%Q-Kh9v@07+V-kN#thj&SIL4M z#Pi_k6KJzQkinW?u|3iJiw1gT_sAQ2xL4U0F?yW&ew#UCp|UHb-ZnF&ZmYxUeB83q z-_^mW{YvQg!yRFO;yo(EKQ4xz-2?;TzRu1p{HogR@p5O~=BmA`nHkED);p_K4bD4m z&L@K=hfr_lg6UK9hDcZTP10Z2Qy83Xhi^C&UkGa_%A>Sg8*fmG)vf%-Akw~b{27V z`R1+OR%Ot0LU+MjPUep zSq3TKr{qECEXFM4%HXf$xV^v&cJCP7)Hr(bL-wxbg$XXJN{19X{Q}f|f4M1yxWBgr zIk9@8m}n5iRRxyZ)5e#)*jdfk?9*Tuc^+KfIv5jfc7W?#jPBH?_?3c(ly|~}FjZWU z!FK3$N2m{s-}sCZc7eEpO;3aGpW{D@aV)c71QK)E$>@bjbellPf)=!WlssazuoT$KyLcRLbfwp-aOq6kwQ%Gl8X^0Bk-sh@~{MJSao4fyqueeG3jXs2uaoI z{CjD_=G1jmZc}aeRvF|0c-KR_vE@yPY<)scLS+HusUj~3+CmR_f9-(lu1?(%$D(910V7PMn=Ltn3>v88UBC#%h&k&bkFc)9n*yjhOEnj# z0>Bx<$0@muGp*^){jzKk75H#&Ieimsb3w@u8&X?LDDk~GtImfhvAgm7=A`KK3sv}r zl1bFmqxtKKCci)R9810-Z*pPy-DGh`F7D&`g=?1R2}84Ouc}_#P=Lt;tt3=y%?C~t zE|I7>RofS-iosu9)yydSg!hV#JlEn|v%6>gem-O9gez~Ia4)nAO}F?P^PBKI7vdm( zJY}XE0u0nZWWt$ih<%|-@VLa|roH-&ZX}_5i8BaqB9u<>J9Uu{+)Z^CuoIrgc`o&T zO*|VG!L23a$Oh;@TS!JCIeDR^#4f}bwqhun#Mt`H4IU~>6*y?2T2d4k3?H<`e5Y{( zm>y0e=FomairD;U4Lm|cWkNWutysQ2H?92kzDag%SVXK(lsM@hgju^ZE<0Y0^-Z7@ z5Lv}2IhRaax57o;*4rbXE|9%8v{s%Jn!6?Z{bIIq$jeHC)Bh|QzOUFUF?a-AsZY@+ zr<1D-us@Iw&kvP^HMJ8^?f~OS8o8@@6>eU(J^-HBL}T}U3t$D^vxl`cE17O{Wh%uv z&GdQ#q;n|7|B8~cg&!T1ERXZRAP!xAOv`a8W?Rc#F1zN%3B2EToxloAF2lj$ehQX2c%GLX#VY6fc`pP(VaRt zTn~MXDL3VTL7gs6@5R}dt2<%hz5pk`wJVhkyx`Gh5jcBN!vZOmfHb8Wn`FDLH@B`I z0F)Cq^P!*Ia#m{9DfbD zjnnPWXmvppD|&a2|Mj18ESNCr((7)q%TzW!rGlb=hbdb*pP*p7qo@8%!HTTrD6h1L5uh$#ydj(gla?jGnF-0#!hGx^u& zYsH=U;pZ9Wzdkp9@#qG3E%dMLJBHq^n+ugiAIoEHfwtQ}%f6WFh~^T++1Qtkd`>h>nxo;6a0M8T3vmybtQ zGaFaj#HkY7I4iGgfJthf8%oY*KVe?Mo&^iz7Lg?F4$Rnd6y?qJ!bcJu>-{ER|IUz)_1@4*cU+18UW8)@v-*2};Cxgu%_ zU#Z8|?ub@2+J^Bw`e4HgPZgB?k?+}KNhPqjLDo%2F=P!b(s&;y25L?BC0+8=`8M2A zxPN)x%g|U*oiAO&kg~qG@9A(9n((K&Fn;!p1fzZfdg@N3mh4!wHi;qzO#MVWS5%r- zj$1Sw*|(G(1WV9VcB|eRn4~Ac7^m=2jebUyixy@Vn_8PSu<9SQZf`N<>5H*MNWaln zmFB10(gpD;$q^fnUmx29HE;eR%O4I{M4EoGd6^5I`#d;`sBRA=UEO1zcO^7<~xFVTQ-k2D8czIdSO;rv4GpXUh zJnMY31Rc*Wvg|P#X(QRVY3a!fSuh7&j(Z<(5?6otIdEW(@G^3rJ}vxJMgb7oKP1n$}K`? zS~59n9h27F;*x1($c)k$#-^a$lN9M{_RDgahk@cqc5~xSTI~g6)fTKkRqssM*C7lY zUz%`}xL6F8EKg0mEDa%I!ug3?*DX@tc(T+wwG)ch{cg|y@YDL=<#*<{@)#MTrQgy& zQJ&uXb`%#hyQM?kVLBm^I+2_|;42HFShl3#cKBF8Ar|xrP*>@@LJLNh$cdDk1N+s#uf*5V-8#Kxu8nh#HZzj!F9imFY}AsjVM;h-5(BT$ zp+s`y%7?_j-($Kz20H?`uKnxKG}|J9&K5&+5(Dq&4Mw;%u45|dxc=(3-pc76SF@Hw z`0+JI%(Q7UV+&=snW$r2j1zzpl~XsGD(dUU<)Rr54fpL}HlFao&QJEkr{RjYe7;Gl zu)^)1F4AAMH$h7kT~EpqS5Vm~KQ0_(dW9Gux9(ICq*qbt7BIzI8Hh z^es&PK#(&=K0fKbOivFUI#iFnLC0F?H&{<<^qYqV*R>Jam|BYHL}K8vW3hRELXI5^ zZW46v7o_Aql{=R5AI>#AYi1e_Sd(kq(4+&Wsif*q| zQUVRh!e(BcL{xzf3Hb^00t;Sn3w)S23B3+8f0}Esg(_;u{RFlXgZ;Nh_1 z{`B;VA!;LOZsN&A-$&M+lzXQ?<+S*y!lA|97<}xLAox!j_PNupZIruX&R=2bE$9s& zWAD23d+bD1z8=!9_We_KrVI&th)H&J3hc|{_t=Cn$-eEaYV9^Rgm{Gd@e*S^O1|^- z-A65Om}$*U(|GRJc;Zpj27xzm|KDcSga6M+%L;;qTv#>i=CJ-S4ZgPao&fQQ(~7orD|vnJH$0h@lVE0Bz)zH5mNDhLj_Zrc&QDC%IdZ3&G}m_Z zm@dsDuDTXbphU`EG$;+7C5Wf@5@n0Jdi%;;#sje&L1d4U>hE>q2AGW%&p1 z%#`poA7YK;#W@kz57C@MiK;#fqvSDhB6;PvU=)(!uJ2H$)k@YEGP*!a8ihJ6<+=bu zStt293Tw|WK#LAS6#$7#Y%9oiXoq?b*7vAk$~$82I(H??Omo0`@4O_fKph3h|673W2zd%+9+Md+RHEWtjWv z;_SA;#|xop*j5lx0j46~1f;tQavDP?+vi@qep_|;PGi_KckyYmC^He;Y43gHye(++ zLfdprdhPu76S8yu$UGpMBO|}#P8hQ?IC=H#kDFu!L1>@ptdsai%-iM~yWTxKp0d>6 zCRnD}BCO)t^Ac-cHX9sYcV~3v0FOv#yzz7F)}yM9*kSf!TN3|TP)`u#UlGF45%EFa zC0j=iiac^w(K?ZQgOxB$<;t)P&xAr5R=0skt#SqLX|Rruveh|!kMhT-CWw-A_zvYq zWg8$7s_$y7A1}p6xl5_*)>%*U z%jiPcz31eul{p>6=fSQL57RfBG%b3#m-;et^a9k0S`TO1h-X_-(+ZWuk{gx2zZ%QK zyUKHkW%W1w4c1i1xOhpiX~|UUzY?P^zYjvPAPF?i?5M{kx(uA%OZ64p2&xvPOFHEZ5txzudhx$oO_%QX=Xh8m})5?s<`qwFY@=JKkaw;sp*lknlY<3 ziRAYTNn6#D(o@Qmh)ZS{VHJ9gSLqS6BhFWFHNE>*r|tUjBdI799KQ(xk*kSUgk%t-iy)7kUKA-iy9^a- z=u)ZHMlA-m5t0YrkVfPY03|1zRXZ*L&CYuj8-z7%(k4YHsy@=J)3}VP2vXuw3ewCG zA*!%bVXq9s*mH%^(tVE=a(=s+Mj}=^L(zc|@#Dg3#l48B{zvD!^S#bTObtBp@9y#f z8L`IWJwpt7(BoX=5^#Q1%L%aYFmN_=vTkJyAP-WJ4Up>GI&!kpQR|Ht9ElhFz~-Dy z!{qH+0coN>J=rD+c+D49AZ1jtsvbT^WU6xp!)D5Md-$E)Fw09U;6+d$ zp4Wj#$wHM^v#WUG(vBH2gWS&bi@I(SfNAm&vI!71q!uOcn@2YTykOV&bS?M4f{tzn zBK-%`FmRVGI8RRRHSt)fzxu8B_)L7*0L$4I_uEp0N^V`t5V9UCz~QY!vu|*J(6pz! zy2r{zAOygj$8@+qeo6j}7~Dnu?sF4d?ebhD?)EBvJ?dUjtE;Ui(&7GW zN(S!g#)|t~L z*JC%9wmq*;BfCi%An7e)x$A|apjRdqNqsGHu|6^^je4H zB0JV41%dF&GYbX5^;5P3q_ZlOBB zh?1l9eINZoOZR0Ocf#QYluvj+b7Y?fE9cLG<`fT&N6FJ&>JZ-aQhPNb7s?X9wf7|X zr0RP2e03(pPu`Lxa&d@)@pO-;2o_&x-+9z;LSQ)d;@5Wb>lJN0+qAkzb+j(6J*$=a z&&9ae8`06cN@r!0UAhjoHP|VMyCB446x))v8e7J@cdz%194;+_#y*{0V~S$=udS7} zA2y&mzvmrqCty2m3$}G+!Yc-Y}p$weV4CRW&xXA*M7&> z`lsgp2Z8I|#2?n`Y5uM>jm_gL^A%fKcX{q#Zdwv{*j%AYMS;7e7?MEX{Qb_7EsQ57 z=!m1AX6JjH;skA#Y?%bE&n^juoF1-IS`l5`c&U~w)skc{N!H;=B^B9QcgB`WU3ILH zJ3V}FZ-ah$r)sFP9boV8L|Pcbpf$5pn}9Riy1F+2COsl)Y@@U>CGC+1BL&V_OdTxi zLV4`w7r-}sSrcPKxvY7a%6ssZC_Vj+m2X+!Fx#r0wm1>LQS$pOZSzk`M>syj(n|9l z6U^SjlYb0 zY|ioGLyoTW`Hc_!+O-2`JwKl$#}GuU#UUYQZEV!|z*mI_tQ*Rl*G-uwEc^E(`{##0 z-A#Z#ScZ@GEP0{HiS)2UwxqT73CQP=nSLrZq}cZniDM3JrQr|!$vpu{)6+fwULl^9 z@l*P?bzLWeyjC8nD1ySC^h_Y>JoeJvmmzkx>|eX{4|Cpm;U8gvr}JsvJbe`)#V?N~z;CVoN}OMCPpVP{_q?3x{GGqo_4ex$nTg}Bq>+vA2b~eU zp8=C~RXp_ZXG&%|$2LiR+e95tO+YKp2c|DCKlAi^VY`2Je&pSgT?GkbxmCGS)4!Bq z-aEcPz{JS^a7W=*9`56xu({uAP?-1~PM)oaX z0$|PWiS)Zdln8G#HCkvp{%TsF&j`T+KcFH?ajOI36dE}U>A!{$kFtW{TL-g!RDCsX zT4jG_>0ho^S;@N*2F{oBaQ!Sz| zec2PWvrQX3`fif&EU*`9hk~0MZ2_iM6$gfFZLUfdls9;NQk?bu?Q0Z=E=YfYL7QM6 zPy()}MQSIISKzPLX5DoiuVOOIF{cWl$mtiLE||t?8y|5m6hl>#As!&Bfa|LYs*9Dn z?ccs<)ITC^OAC~=2Pn|p07)!i4Q#gC}bX(P>8{ng@lHWE^*#U*2;%dT_nO!mr?iad; z9xhKl?HCr_O5cEIg$%ugQ@rgMmxbV@1ajyae?gIIX%&N%)>sTXS~7Nv^@vX~I=iG@ zWwK)*Daz9(-m+Tr<{V$2l+9q6o4T;;?9lK6n zFdv2`D0tCW1LOwj&|yeY#*82OSFJi3hYuB+#m>09XW_g`^A@QxXN3d#_nWh?hSvlK|S)Xbs;2B5!zp-a+@RQxd&!_rhq2WL*J=T2FCQK6~0sJ z6z_%91JB4dZp_b!ah=Dz9cGkA26tv;uMKWjnG^&_{kppOUXAaRpRXXfpI7LGJYH1) z#Sd2!X?>P}Q;FXKQ4YDE$Yroc@il82#bM!0@OZ{^kEIUME?~GfLM70~C}APET@1Y- z1S{;rxwysTd4ZxV@VvBH%k407k=zK*@j@2p-SmGSl^&%}YIov3dgWxdMEeOc z-}Kp-Wuyj%uO2+e7&eDQZIS0r^U3fZ62!q%Fvx=d%KmEM8TZtj_13#ti#uk`}DM*}pai zmXKgL^mvRhjjIrsZ9v(NVqfz;3oUyXj|kSGNfk18xRp>lv+b=_E7rbd+@X}8c&o1D zxVxQ()F~H-r?r8~<;tMCJj`Jcttt=y#4cwh+5PJTDDcZr@!KfR%ExmD|McHINogzY zv%HGyp_(MHxioHwJC5R|`Vg>4<{tbu08Kzy?@<#A%)7zJ?81yV1=+*XjIu+)(}YUk*v8A1w*x~^ljydHvuID;w z<_PKg3$+{a_b>cuo2As%z0P8sKHRiBd}QM4vE&_FF=}wcR%D2VPJCAbs)5I2+tnxv z_<${a&mAzs^xjbDQW^FJXi=_K;1kkm;)(snH8U9+v(ebe4DS7ve1RKo~naJwri?0y0!34o+yh z$p9~E3CZDqp*wZZ(a+GLwmmo7}#8zd9xR zysKKG7@tcBaL*7de;4D?uC{2tT0Wv3ewLso-pZc6*`}~`!*B>0+6n<*CED-D5xv}@=7V#o{0TUmGE2<#Gkd$7pBhafU#~% z9}j&mj=A5w@_TasV4VNd(4{HG11pcGw=01T-RD-o=zf}OPs5G<>fLA?9vA%O&p1P| ze8cah>}`mb9%Yz5GXy6v*eA3vT;yPVc^U$c?mu@&vISXWhcp*o`d;C;tO) zIl^ZwtfR22O2>#!wk+wshcd4_?obg4I$j9VN%JN2M(=?AdU<|<57Y4L*4Ci~bc9d$ zMG4Rjc&-Gk#(tGDo3Y|Y_#J?YQ=1M6;p4o_=2C+($fp4=I?||^-sUa&pSUq@uBW~$ED@AQaAUR-qd|)(c5lu zTg*l#R*zCL<~#z2<0uaVb|0t^o)j52&=m7z%?TNObbsGZxF&v;cEv~acc72e1zDwP zR@gJ_YWe;2RL4_&(bL1Fkxxgz#8XBH&)tY7WX!c{<7Y_5JMwfHEPBE~^dEho@!67L z6~*$&>{d>Gws?|a#rTHX$b3gjyqzvj&V`c0{xv%fC)^T5y8blNc*few$0gAAP4M&O zW%Z)KTnR?wN3N@8BADe%!ZlbjCa)+$1200RD);}Mh&k8YwLc={?H$p5#49*V8rGSi zwGVppU0RqqS$;Ddi#n@kkTLx9y2eM?DDqpn6~nDY%IvjfjYf@IT){62BlGTwtgG1U zaiM;O1IwN85R!;>gNUwA8`4&P8S^bOurgq4?G`q+*^%f-oGbNUG7H4 zv{vEMG%Y+o?7{5)>`asaz+fGJx_YZ108R|u=X z@<&twPi|*`rcX+*9T6J-=q4dbnV<8iOkKw}EW&PFzcJh)AemfQ5wQtYI5mAP2`8k8 zuHQ3O1A44f5AU6}b3F{AsfsZIAcc)tupFiAZTDNdl1p&T^_KB{VB`TkX^-J^_kjKM ziTw`|c^_3Pgv-2GgXyn)BH}uJs8N(@QB}?D(>(}Xu4{7@a;v#VdmfW~wiUa~{Hk$l z*F&sTazGhQS{8@B~{dp7kE{1UZK|m4~#cTLCD5P!XL%32cv)kZ2RhXX!34&^{f9tA6 zFg*W8NvF=^{KdvWn{SQPd`1QJ#s^E5!1`j^ zo~J~W3SnO2^Qu9ovZ!NU&UvrSbM@~CV$_@>ELejh-w7guh-#J~$iQ1FTknfQGK>$8 zNQX99737XgOufi7x4wlc$}mA{v&?_ooQ4+Rj^5}fAhcDjfhFw8yXm@rd>HBNW`+{l@PdL37_}X2>-OLXBMn&H- zpj1-+KFG65=`5r`t8K?qPCz#aLJD!^b5#?|b%)>@l6lSCjnuq~I4*BS4f_%?nn&|Q z1NVZ)pz`Iz9NVVAjn1stDmB`SJ24d6eA9sDtJmxEO}E+fg4pA7+Ko2l@>`z)^?zi` zALFa<0gqXT;Wwx#;;}R`O(a**SlR<+J3Ls^k|I}dSJT))g?5&^n{B%AQm^0~QPWJl zS#m8=2_Yey;9~=Wk?%T7K_@K*$3LXuk*l@cgu&{*fulqL19-5g;Af_{AR?YosS5jn zM$LA!B4kX6({alF#v6MJ>jbzyPiaU)lR9vEwpeA~8u+*@u=jvgXEP~W84=M#N~U&Q zCy0Yh6PexbEXr2mk$bl>#Xb$sFo)c{w$i@&_dU^3vK^_j`Eps}IVM#*xvjJM7L1jCMsD3eRG~<8T*KA4 z#u>8=F(MO*{e^a6B`N-eykJ5zV_Zt?~Paky-(aD zJVr#yd2b`fPHRqnk#mmnO9&Xde@m1m>`|9W+YzMds}2Y#*?nT(EYbGsm#Q(|@~u@5 zhdBB+CFNBEbS;N}yyF1gyabWBp#rIPzS^d_q5K<1$&K}~^gn`ThZFcu3ThM(me;Y(i!O~4@y?u@fYyz#CsOFjc%y3?i8nRN1hOj_>jXX1?G&sTNi^rWxq+p zxfBo1bo%g*;;y>D$Md+LVy+W|f+Z;*zNwYEL|dTezt=OB%98y88)fm+Zjh3#>Se;% z3cTkQI?N!4Z!}UMZriEZULIeOQ+($6E22>v%VYDUAlELIum9lh+uJqveNG}1X7C)kCc%LLHmU&kM+*_uER!tdE<4IbOzuJ5I#-_TX8U9toX za1%S1B==TXBMCtP@N4F{e3Yw96(KS`-#zSgP6PmyO#TaK}_fmIcm2<_GK z%F0soD;|h4PbFbN)Ii}h)VCB!A~z#QQJ;x6QtCE$SESW@h0$= z;KG@0aONJrstpp1*$rq$?RmCl0%~Ie+VWUF%Au5kE=!D*MM*oY?%HhVE>Mr-{N`}( zf}B~_mU}03bUKe5$$fNqxMb_r)wYLW-dmAi+Yz5q;Sr!1gM?7>X}-*AidkJ?`eCYP z_2z2b*nO(ce76Cm!7Vd1v{GKS#^A2R?X5D5F&;U{Ft%i< zYkZVki*AYZ3xXU5>xSHFVEAITAScycE$j4=#>nNRf!L ze^41~zin{WkrpE-NF1Mi=a0l0R2c@OnuB$j!9!sdvA$WhoAM^lk5~84uYuQJ@65JT z-zAp%yUSj=wFSSZl_pQP`&3e^%=<>%eGhP+8mn5XNFy)g=jy{7JUl>OU#*UN@3Z`w zeXI=-)mJZ9OI7I%%(*qNur|PDn_we|{HyQ-FQR&Ue4N&NOTS2G!@EDX+xjWP*}A=t zjA4rv$rn_KEsT?g?Fx&Ysw6;33D`ld|2BBshBQotrooOKl7GwG}(e2{kNF7acKU zo~}wy#zGI4cS$1s0Z8c45v72Vq6+m;%$9J9sCxMD%itcUV9L?CKE1K-0*(@pn(uzr zgC(F-hB+Xb5B-ZFLKtOZ7ItHV1j*$U)9NTo2=mMFY!FKzh{ue^(|Ix^*)awN#kM&lxU z@AToECeqN?hF@7-3Mo6`4O=l(R4a`gSem{HD~co6+*QpHCl88{8)wg9R!rp%I`PZ| zMd?&}v+AHv>Gu$wXCDQQFi-VDr{F{nmX-<2_ zuIl#c$ub6B+E(>&v$`!=LL4rq!o@MzCCWtSuz+z57mA5r z9uBjsD{DpsHlvI>l>dN~u;T;SuM4#)3gPEUFIm0VT&^|cH1l-Fqym5k^}=V2tuOf( z0OrCfG&eb*s$(=Lm)H}(P2)E^O_Gk!1p=?%QVP9}R};~&y|HtH=LR#+wVKTVj8T`> z?dT%{azm%)tB|$GCr!sD(izKDQdHg9`6RAJ93N7wO}e=a-YklwBnJ8oO^;VN9|~Xo zADEIn2WIwK4ut%O`f({TLdop@-`O6~F8KptOWz)EIkZ{+UCY~KoI5Y`&Axq?!wckA zhmW){B3ecok`rn5)=}iF2V*z%`EJF=mGe|@M#1ahd6n+ zvl1+U+`~QB3^ceJa_8Q(2{;+Er1!?P{QEdwBP|=eS$!KYLPxC)9`bi8WFKOj&Xu#( zx4f>w)J?>7<|)1OR{sxYQgn7c;!?qUW62AuoCFkS+wiL)q@`}OGcuxO`jh8@!Sm<$ zbKW-%eyIDhtU{F=DS2D%!np{47Zq}@>6L&0p)pR!d;XQVi^ro;Cn==@)jKPM{fG|^ ztlyGeHvF0KMa`k3Aw5CslU0E4p}ah2z6N7AA}XMlE3g*&&4u3yA&w_F)lYz6;y2)T zFA4$$N8p0ubojptrm$nJ6J#pO0D_jW3_iy^IlzMgvc89Ujc(M>^}lN8+O#qZ=K2x? z|LhrJnp@1BjD2s@5b}0w$kc_r@rt~ViI3AuPgBpsDzq5$DD0uN5{~(H*Lr-c6?3fo z7I+8`I)-P9-Z@I%Q0X(4|a=(CmZ@D`c@pC9wfmzs~ z$uhIARD^oz!X^R#Tavc?4e1xP_T1fw`+n87Uc&Uw5d5$7a^bN+%8jQp8(-QnX#CuJ zbh&f8RX5AfB>E+{9(bJDXl~DVcO3O>UDIWpG*4(=`>iG980v@ej20#k%>*bffo+xu zJu%lmcjC;ippp~ao1yU2=40Q=zp6)J%YX3&P98(I=y8azTgOZ>!~4mGl$VwqO}>_T{GwVX~P-Ai*Q;gSfD-G9p7$F+<%Au9kd<|o}PL?M4@4LXi zMrD{I@qC(cj7g1d*#p${Pe|2c!|iyDvsx06+@Y-u2SNKHr0aVdF9-)7u7z1^jOH#r z&Ja&_@dfr|zVFn43B1pkb2)*1O1i~Co8;@z_?g-(%XqkdM$;I!CuH8NylS`01O|O! zlpYxZpZYrXF`NEke@aelqw(^vV%Y<=`L9d8wya~j`!9|~rL-muK3-2Y?+59CN!X}`W-;rZ+D zk*fz)&0dN&zr%Tj#q6=pp{yx=sgb^E*i9X$sNe3vDCX02?Jp!%k<6Yq?_OkuF2 z8{B}F$~;9F(2%=9EK_Yn<>qlrZBowdS-GZ#=Za`iOI2-3K|Fm$1U|TD?ENE>WU5ZY zB1;10#RD>wUUtvS=RZwng2s`|Ow;lo>JSA7*r`iF@Wl*h9XqRG(7sYXj}V&~_;Y4^?EB5MplwfZZg zYKfbfdx=7b!lsd5?$=Q*@{so0>wyd7)?SYc13JH`;km$)Wf)0VV6Y59XMHQiY4LnO z)wD4kQb`&?aPbi{pHpUcGEiZ_l_4HZl=T3)P|9S}deGe`SPK;Ft(@#J!M{C6Y>52z zgKlxPcYd--h?E3q9@?e3rgVoc1cIMf7~jGR8Ub%G>Mk17I8`{PJz1aQ{biRN5tMeX zZu82n9q;H(a2E4acT3Lr)VUqFxx1{Y3NcjB0ksF7HiT&%5=^ zg$wdmW4_iE6k|0dyEcFi@d?jfTZ1MWndS^9k+vf(ve>+IbYNt(C8gj4H*4=s6HO{q z%xIH`^r#;0%Elvhj35_yrj(SkcP+My&_MALMF!Eg`2-5lL%$N3YtSmG7&>;6QYV{s z5>xiRtSE!+KS2pBN!QGg<@>64>)ufxf_TWBq+3a2koJvUr+q(PUakVya-HyApcy|3 zUY`N#`%35=GoghCT-cK?JYwkM63glE{?|GsItPrEonhQ!t;SS*n6S%Ktj*GMp1D~& z)r%UYcfT+TrOdK%LfhcZQ5@p2!uZlXPQ^Mh`qa^+@BXE`6!!NsOb70}W~OB|*I0ms zXgHw+_)SEMxvlE{)ueMMjln)xc0rz~UyV4F6U^+R^$I^!Emh*UH4m`Tvdq zD9a71$&92sKTv;Pl>2$zT6$D z7C135zqg0gXi#`9%+jHew7tbZ6k}gJKytKZd{qMS1TMAc;cTGW(gzM9@~ck8r{=qj zQL!U$`esYEbUh5yNQLxiy>0lb3UN|;h=h}$1(M*7JQR85ShnIwl=tjW{%}T>wByqS z&Y{1Qwn4nYZ~o}TIwq`nzOD3KNyHF!^ILE-)>6z`OgO)e;|C@ZDZ4HtP}HctFXZk! z{)>+l>gz1@BQ`()9K;ozkTwgPFT1 z&`YPhM`vbmB3n6vc#JY?MHpd3Re?gWslfDr*SCeb9OgwsiW$m2S}weS_%aaFx9wRr zMyc+=QVe5T!OI!Bg16tz=f<}97q^u~Pp_gT)d2C+j6on`(EVwQAimy+4plW|G7=h0&~0T{p=DpPuAN4YT83K65%7NT;& z@!-dPaW+Vw0izF?{kD&*WPUxj59#&tSFpgW_GfbIFWzbYVsD*G`Pu((PtehH%+aX8 z<+=WnZt`713SHFOD0bmPKY@Nj z(V#jc>u%4KkN&QYxi)?ibLS4Cy$%hH2UAH870c68$w*B{!SPb;6Q+d=C68FLfq3mO z>!{|2``p`o&P;K_-kheVXus}%VIwx@!9NUWgw#NwSvdA5OD_Eu54zV=IQ%I2aO+M zuT%?8?G-#@dbXE#TE|w~#W&3_&{+OhJ7vsJgq{R?dAt~zp*;VVA_*w`a)$cfgQxAR zjjg{(=P&DDgdw_c3BGhrqJkY8`ERh+9b;<+Aaw6QN#FDG4d~Ut>DS^=;5Wjl%b`6b zXv89T8hslETMS~`?^i4F-vPJ(Sb;6(rU!cec!5^l==@;+-0Ho^*to&Usg{Oc`Wvab z1B`t{km(v*4o0zU7%O=&#|_$M`Z3o5sD0=K*luPo6)Hj$))7@6Vq2@O_=acvzBZ4P zoN#Xwz4O#vo8-#qhQ7a+bK1PNZB?V%F>2*!WgbFVh34=hGoF&09OXAL@%?Xog@{X{9ZZ~;$x-6b&x z(MKT<8|UX-=O0dwPwqbwTTeQ)19sYq9Ih&m!nUuibok7fd3`y@p&PF0RwO z>vHsm7q9B>k!ZKKaV&+y!P6=vo<}k}Ts8Qf)t(<}7dfZDvU0f!$ooJGc41=Fw41%Y z*m%_N>WosG#>5Wzr2`^h8BN+ZxiqZ-!rK6{E-~=T7|u=qZj!efFJ(W~B1NfT?y4%# zLDXHs=50+2A!qHPhJMyqwINlALjyfkAG)gEz39G#6LJ9)hEXEZnU`>YOt_c_BeqC8 zK01fV80#*ca()VK4dUnls5TE4QRO4{a&^qXG^6mF&(BKbRi7>5%!LHapWQt8-#bZL z?+GSxntL^BrJQ?c->AOFoY}(-3X2 zF-U;6^h`3la%}E}023ua+YWlYV1`x1ZDX)s@!2wfF51^rb3^gPBc8g4uMT77B6*J6 zW%czxZSxpe=bk?*&-aOwLN`6U1Kjj4sJX-m>j7S&fQv3Iy)&?ioQ+BFI0l(vXDQ8pnZMF{m#f=4CC zgv4=o>zm$a|FZVJ<;yMRj!$a$kce#+YZGUOfLIL-M*Lxrt6)RSsLRvG>IRRD7Qe?z z%D&wMVrnRV;1&>5>mxM6Lqi1-BV**XImI{;@^Xl=%_vC3sFQ$%Hnx+PRQ5@2s-~zTG;@OH@a-9+ZY}QhU+mp*a%IpQ`PPCBYMtOCF zm4Hz?c@zG&L+s5vjkFZMvy2h5lPRYby{Y$g7q`ec0f{LXEvhts`VwRji5t2KJ6rs6 zK^jXSX}k(pBZ)%rOE-B&3YPn5$v6!!5?&CaK(qjjWkD)lh_kZz_^`{b%m~^4#A{b=y9M2M9#O8Gc@-J zS|g=%#{|w8O;Q3!W{lQ1SRL>CdH?@Yu!ZXg%0hLz4FWb|kWJ;!?;wTlt`Y9r4x%^n zh{lhX!!ity!09`t`pTd?D83D*CW0MSa+y)=M>oBFMUnoIQ5D!vk`u9+l7d5?^!{*x zd-g#*_~89Z*=`;lQHAus+GxwKN5cn+cc)KVzoz?yS*gErYDBrjLXJ=Y08ClAjFiOZ$ z*+;g?GR%Ejv$Uv4l!z=NnJgn&$G#1QnXwlYDq2)VC2B;GB3UZ?zW%Q9{eC{ra~!|t z-#U)E=f1D&yw2-9-|yGC4-JE2yw=R6WNfk@Mh5yc0h|ZXl60V~lr)joSYh6`<;#M^ zq~W7wGY_CFTT(4g(nT2ML8{mOz*$i@+t#+jTC}o-Q?@wTulHY@#Rf{Ct>WpLJgZQa z;#Loh-yU(qz*#WUz4OX2*dHfY`J?pQPh9wG+$WBsKuYYzOQN)PfT$WJiRvEAxQTUo zI2-Rhw_BPdli(emMX}}6qT8Np)JmdfXS+>I1Qi_pc)c&})J$#7Eq!dIx{>Qh*^Kx4 z5hr>Dm9AAe^BZxlh1l$EYuA+8`H9lX|A6Yq5!A2xRV=YOKA8K38CY{S+1KHgcqb=5 zl2pw~;N1HBVj`!*E-qPN>Q>OXJc?839Mpbm&F^nh+Zwn7l7?Q?1U$2lzd`l2Z(8#f zq)Ut>0?eXs;6~SzhW2>v_qF@hInl_o#Ta(lW1S7r8h?M3J4A|NiEYp!9LMetMv2f) zrc`$qqfKx2Ai>?(mFV$v$UUX{P{eWCuy;`zhAeNP*&hk6J882|hGf>=pN zowW}UzLS8`F0p&CT>gv}&>sPec~r)5rGHPkXwA$x;^$k&;V$Aw)L)MshC6+q;UbS$ zoL4s}4`)1QMMbPMI`VM%*ml7J?{&E|<7r11e%LN(!p`%TDhHHQfW9Cy4Dpgxw}PtE zt{)Jv5qvLx5>0w*Xi^Jd*kK*DF%h)9&rj`$WOOI9Ye?z2edTU?=rtSr2fwEgwMzEj zhuAqDmxCOvB{Q4C!lqYxhkN7O?`LeR#T4i-2Ls!010U(Z=flX7dzrMbqa^aY%>|k) zM7nLi%wFyR?gs!ucPNFJImapOsPzpIfUwh)3w&y(nJWgKEY9xclrXdXuwHeg%1Iee z>hUSF5u7ZVtZt9sex#*{#YL(J(W}I$Ny*l1V-;1M_TlN`*JqPmF_q^C41ODsvfaM? z^Yc!0s}S`JP=UJQYrih{%j&lBGJE+48t@BKeWcWLc_AxpE5$tR@!LOl?EU86VG48G zX>!nXfrK3LT(rN@Q_kzirCR=dmk|){8yzRe+f|?cVB|6&`^{_aQDyw=#b^|E_Qnn= zu=lqiRJr~T=$Cqku7^UyrLR47Z(z(un1wN@o1oe-P}Av`)gxTq>n+Ue+pUg8N`g~Ja}F!^yo=9n zUwF{s?czySz4ae+%f++zKVK-V&OLth=Zp0wc3zUc`V#`gf6>gqZP7tVJr52HG6=eU zydCp!KULx=GH??RcY1z|bKjtT5)YwfreebOU0n8G!8-DYQN zDzBXd0DNdVb%!n7FX#y0vz3kJ*+~7Bfg{~#(qxO2rW#QHGQ zuM466-XbtEc}Z_*2j?upw(m#%n7oBEigZ){a170?7ikXWK(dwl3ed~Vc-{|&howhW zHYYl7B19>>Qb3`RkGbP^QF-8bRoo%gmHYrCq6=T1mQw)6d07S0cQV6@3hIlpkS2ZX zoz7Rve##yKF&7HqC&gj2o_Cog;7?G$_0Nlk_DlW=xjb-pQj8b=m^8j|eW4-2r1zTy zK1IK}`~;OD?u_KDD5^o;KYLrOYJYGm|25l#$rrs|(^NASehz78VN`O>pu#1cvH6eE zDlF^xgyMG_s^t`L)#Rp<5y0`cODr?R&18qkkRN{N_J_mILqLLh026tIb@Gpsy50wH z*l2?87C#^9O=-`gW&-^sF8v9(JZKV&Li`iKq6H=E34Bn3mZf0HygPPyM-=Z|2{_pH(gaxuJZC+<>ZaXkOCaBF4uAW6CHN=wQ%x=8b0kZqZVJ#T#c?)`3 zad70B3)qc@Y_^fUf~*MfN?PuT4BAr*n@mAv#n8*u#{PnAG#C}ldb3uxkazKbLis~8 zRz0+4zd68ol_y|$OX$9TN0<|30c(^ID0-s#C^XDg!RzA0QL)sNYqrcko~$f*&XepY z^r=hom4^twDS5rBHtX&FFOTxIMuYZ9RjGoy(l*3T`@%pUpqb6AMLj&QwHeM9ZsR2# zQrZU`iDT7fhwxWfO49M_7{&wR;%mNp}@Ll|Mv`Gu*CKS}BEl<))V(hW& zJwrn!F?#3B(oq)%q}&C@>GuxUFL%-f3Sh!lOo_|b66wu7y9FdSnd6`})$p(f^n7*R zfGMi`pUDcNP3)J&s*YBsIImg8gnt(M%n#n8J{LP55;((lhL7)eUPCy*>KvpXUS^3P zY6dGW2PFd|Kyksj;uKv7MpJ5SvqIJfrAhsk!!KyJurProh#Ed)uh|BW5*KrKpF3vr z?M_hp4Y4OKAMW_BucT`jocV7&2XtjzWM6bS7R_}MekUaiLgv{D!x&!he^>35TJ0h1Sa-}%UOW<-LrgtzS3k#TctETvV3rv~SdbHTsALfyR;c01AAyfo9&<_Ae zZ^bb7nE>a*`22k|s@J&nAWXJK-H2+YXVGt1dz!$X_^2HY7iNF;p;%^2%~!;%iluV* z7->J`PYym~%5fj$1&WctBQB%JDmCgKgW6dG!av!%YC2-S#wh@&@b9!@<#CSQ@j0wI zfpet5fA)g$FV8MkC&uE@Lt(c%6MI$E)HL(H!XFN)6yi(sJ}Y+K@Tn( z_?LjvErGsp9j}6xKVi$Iu>$8o;^wdr-CLS8Sfc*gjth;lF@UKQVjz3=*KPaiP;&PX zle>TRV8oAZ*5~_0ZnL;&%s19F(+{1!kUnuyo&N}J-@o3-;}k>Ah7?{>T||M1rA2C< z-L|blO+4ZzR_q#e(3r|T{mJuvo-PkQ7zLXi7b`E)g9H!Z=aRkdoupCZAP_xctXL33 zS83>}EB@KnWiKD#x8k({e&EY<<(G;Pk&xy)Xd@T33vPG}dqu+Lq0&Jv(?%74F@p|W zrw>Tq{CNFDq`j)cL}L-jL5QBcVsedT>2K)t4FvP4&)`Z8&cvd_{U~)6b8~9_wdY`96BXF z>ixUhGra%ly;kq(aeF76OZ*Gx>@O(qYjJ(Jis)ldvLvd$({F-LjEdkVMPn-uev)C` z>gAJ&(l7}ZUS~9+RBIn=H63EejiLenU$s>As)TT^O1F5e5-rwf*`dYmM~S^3>9UJq zz0HRvZB@EO(phD%q?j|y0^6KZb53&R4a{ci)E^w>etrJxN`c`@;+f!{bu;}_GFy2U ziCva7cy@Q9|NCp`R&JV#&{jPo5fQu_RkxHSzEZN>7fcMZ$4jCLIO*T&mOOWn$92f` z?@C0<%p@@Gk^F?=x&%7lWdyAqdj~aMLEUI>mOhD8u(?{tc;SY81!N7k&nj;uCnYKO zH-B)TwAnk^hbTsVoyJP<{>0e0go$XhjR_CqeW|(i0S1M?LzulsEz&mG(eTwh(Kf8> zXb{(NBWj8`^?{0{y4Hm23|{%0F)0VT{DY=aw=}PKz}1)q$|%<~8yh{db9Hqla5*`Z zF<@*$Kq)G%PrSuVg7n+8ekyYZbUOyKAJRU&x8d6Q4w8*q2njp3IDcP<7LY_wu_O_3 ztz^_0`%YlTbL2W(9`X|<@fpz+?*D>r_Ow+WUx zyOb!RfSgyM1Tg}6z6Q;^)SQjJW8)P(Sl{)tc{lr1kQ!9u@}3KNjqJe6{LDU*_UA!F zzQYq2+FwT{FOI58L9Udfsz1$5n+0`vN>8Xxx=q|8R%Hjc1=*}AfYp*`>F3pPhvm&U zaEi?UeOttUM(PO2{A$R`9KhNHO*%g9nQI}`gTW}AUC1Fce800pn+Pt?q}`L9oBetE z_q8I%_84q-c5DvvL>vzuHKy7bq4Ek)nK&`$O^yDDKrC$KM>^5SUW)=h*72E*xlEjS7V>7bh;T%b(;8eDuT=4uaFy zzj$Ez#p?O@Qf`m@2j9VpMYahc0Q`%Mw;(>>A${G zYH+ssMrYF_J;`RX6MceUS-fKvdSB7%s&~4JHUU1#;Pz%ClRYh3RDeR))F6r>-JEsAG+cz8V@RA$XWHNp{O}_G=BcAa zMkk_NMhWcs5q`fs)uZlhmT8>thkO(-x4mbpO5&3IND zU5s)tra=!fGu;;^e8jUl|G^S7(L%vPeu(x+#9$9O+rXgkW`Ns|(B+*XDu5GIp@c9W zsSge;ub>_J^2Vk)W1!wj1U>wljPWTB@f!&m=${^M(s|kxv9$7DqFRW|*h%xgf@#Dl7yXZZibd%Amk~SoHjnUytUPDQ=L&C@v3Gp6=h{=$||Tk~atl01awZN(W)w!*&~}Oh5MSG7RiBkj|?Nh*Y{;8G@mfwkcB% zcK^Oh-h{p8|ja+Pxxrb{+lKuba78FCMU8Q$4UUX{ zGp>})`E2WpH@cs1W#5r|5gI$HkJ1NAmD;6WuMg&erDA!D{jv}^|G54Pjyy>&;Lm6D z4+5G%gE6&^fH_;p7$T3evC6O9X!*I7%5So06U}qDKY?EjTT#@{Hax7CHxNrV1gJOr zW7%x?*_EwpEjORO(iQ%Wn2SF#-R|q(vKciPWf6Swr5>xbznx38f$`%p&`q$HetH-} z7F7YVba3O@hGu5Rpm_3SCEz{0FlW9x_|7}XpsVrHw3#4@@?M|)J#*~_b$mCyS79;Q z7Mk<6C`R#;MC?ceOpPtjvyB^~!Ux>-tWBy|%p;R>-9NBf3th~ob%WIZ(_m`a6f}skaJuUK5zM*+Z zHOT|}1%PaZxu4u+W{Y&iKedHgujA)~<|KYmLVKy+Mkx0qB!e>bx{a|zurFj%huT?# z@UZvd=&9cvv{wj?5x(*aTX>g!Jc2!4>|Zw&Ug`TEv7fGZ+5E1%FuL{piac)>aDGMF z3tvnCA@Oib42l%#O8mlN^0K67^=kP~^1aXNI|ps`>tFdm z`PJzWM%v5v`wrghKu10hrp^wSE8ARMvSTfBLwhb!67X6UV0&xf?(MJI!1)g@ET93K z;hw5Cc5DhVb6)#`Aa}hkx$t}DQj4((71Q5tV?(XFYC(uBDtPw{%5Rs9Q(_&Aruhxc~QSY1qx$b1R7b z=Cow;zj^0?KcJjcUX`4<;cBy4bu>wZOC_#k9G&8jB5e z2q>@kf$mmg3jes>pGOuPOwTWwhpBgWypbBl>AT`TJsYXG`*6uid*-ACl~b$rD3ELA zNyMs+5$Ni}*alsQ_M*!VWcxrDEt7zkFQK0(jWI?kmoYqPXWre6o-nADuX*qU=~5R~Cqhq=&$X;{}H|cFYx621)+CBER*h1O!2dPH<0P zDer-c`3@TyK-gk0XAWY)t~cK+Z8HQlU9CyG_<|3^BVy^2A4eU8P`#$`ZRouvYN8B8A;2FPcH(c-qa1R@ zAUi5&3Sp%`@Q)T0(W&*Ua&k~$4F7jbq2VkdcJt6ptkrip4PP;YWh}ca*={GaTbA9I zHB#`Eu&MwEMoz%d@bJT+gB4~n*z&mMy2T-Uz(v1lISJBF@{9tMmLZv!<_2U#auE8p zdu{Q6dPA8b4FrkBYZ@zuT=inXm#eq8H^l08xZ*3{JFwR1WK zBTgct9G1P1^_-0y6)!bq^vfN6TE)5L^c=bjdaPpJrE-SJfqu))m686QREej&thzHW z?#q(BXF@?F0b#S0{SfO(Z{MJB&>UVH`buAsmZ9YZc~!VC^-)@2tu|`(&Uqj*aq4 zdS)2~x3OvpaF(%279=788&UV#LfNJU=ZlX&-F!#eJ^3!*V6E*1>D}u^1ANWnr~bd! zvd*5MX2(Ex>?wl~pBGZFazC5>+taP?FTQY`twkQWczaTT+C`7Pa6s^`m9&!gaJp46 z@z*r8MF6AHwiO%8=Ff(8a~ZPE@_Ri#>LI`o1{z zjU&^HpR^YZO7vq3Gx5^ULlr+;c4WB;v0xD1Px;CR_IfWLDJerz)CAPJpY;#ug~Jm`fcX%G;H@TU*q^(B@gv6nfN_mDBkY1Vw>E}X@6t$eWjL2$vmXx4n@u)&v4 zHhry$iH9Un60Bnn2Ib!7>AxIJPeTX$^UC=D^fzzjg|B|Y|E>S*w(-kP4ebetOVXsO zq3RqeL(m!7!!OESk-6uR$q76CA<>6$@M99OQuo4vIA67cS`Y5T3s_CYrfzb5?G+By zo>1FS0O~l~5LZAqR#2{s4YiodXS4kF{&p5?>ln$7XYH2Smb7iZgP{xv`}gPOEc}MG zu=`Zlgt^FH%eTuwsUTH3NLB|2bT94%&rW{VWAKu9m0vl}O#4c#M|58joqK8j?(lDZMG0l#iiveT zHTI&^keXtUH%Qoe%={a_u0g&hhMj*z(R;+B>5wXLdd0tF)i@QCFsvowiU*yRc+A!F z!%<~nJD^GeR=)R5;)8{cK0ik?(j+^FKkp(JU2lGFTCV{ZkM>A@QWloE{iL?3EkG_P zC@^)ZaZk|m!Jem^KJ=!+E%WWNqSTLD(#G*_HWfU z>P)iu&|>wZufA0rg7?3(UlyAksv zn20W~;$)r^VCmM+=80of8X>SOxX^&sHD7;35*w}!)&zi zpv^1}W^eS(WGA?&7PY%lHU>^>Lq$8)iadXFzzFHc%;g)%6ELlivEgVS$~YK#5Dz~v z@crSsm1DRd2(kxFsZW<$4||;iKIn5UK>NcI*W?P19%h|YD*MK3B2j_y1&J~AW*Ja^ zXJ$RSW2fD*t7N=5h9Q)$vYWnC6HuT?XSV^c;obC1HvmAZh)y2s)AJOc3Yd#EI!i_E zaJ*f|seT@LyYiM?Wl2wYRZBT`fyw=6JagH*q6W!x0!W9}d<3Jeh8%tQ1bjkOTZB1p zyEV10hiG*RXZ5LIr>_X&oLwO+EhK$3MxHMOa!6`ahts+|l+TS~w-?GUdZ8u<)nx#{ zvj1($eMOW)i4aicHMvthcl1o`c|-Ho+SZ7LZ#_b_ogV(W<4y7Bm>oqED$btD>3DM4HcXFwhT$KzlQVMdFb>-ggiNTe5~)&5J{#J!3+US)~<K$}RcDK#zCW_=4> zwrz4JBoKpuO%CwC9yUCQmpc5dPhl5YV*NZ|Qh|QW%Btf#J#xaDW93`HoHKCUQmxfG z!PJ0Z?f#^-{i7+;r&K75#8XK$$9=|^xQ3EMy_k2H#8x*GE*Gz3@Os-Xa|d;QE)P!) zr??hk;;LEItM6F?5C5AYY`vT7$cwR9`ODK^8-o>%GTh7fkZ7tQwaVwJIedMYPZFg= zR@Yboc5P#aBQ~_w>aO7oSt1=n4bVb`SGzwhVC2|)k#Te9cqj-CXa-r{KMIS={?>JN(su|KlroC0o&(wX?VpbIDlw7TnHE351e*KJqaPb1K?-&5)X2`V**=SRVEMtm9Ad zvu_R71{F5f{UX-14OX8C*l`J>ViEw5_3BjIC~0P|i!F&un;BMqsg8KmaYqf2;gP{h z8aW;1R?*l(S1DrvHgTW!^W9VB+`!2vWb!?8s9f86v)_HQcVL6b zAF+{P(6bisS50#u%)vk@B|j^XRA10~tH60h@E_xY<_+0qa%7}fMZaWgwp zfDTD4Cs1ODZ{WS;FLy2X9O+u_=^AzTiG_=(eW%A9?oNR8cXax-vcbx;*PvwjXg)YR z-1GFnVl&d3It~Qj6=8p26^N8$FW5eQpoXaJboG2IPxx(zE(r4*>wddluOm?&-yZa<%1wXOY+xly5lz}*r{+9-o348l zI3BIL=)WxOm9hX;*e7ZCY04EBu3~zX5lUlS^Fyzh>@4wLy-X4NiG=*{1*hF)MD`w= z@_m4+fF;?huq^Aq*I*2ykPNi*bqUX-vdj+pHf-*REN*?4$SCn5l9&0X*T@NYx0%_+ z7XxTr`zib)Dy>1wPQ1uo>Ny2ct1$>8NG-Z2!+ZoNOl>CKAv6~WXe!7Lq$ZXp8lpn) zO0G|>HGG81tR+KN|31-qIxlsIz(~rl2C$FIzOfi}^LYBUir}Kq-cg0CWl)U8GQ87+ zDO@IG$fF=h%VT z@6+$)NtxKH0o^?WhzP4XZpUhdNH0R&SG%RcSHBK`n(YP{tGfC8Gb)(KPNN@#Bnhb6 zEaKU!y;QoG2a+k&Lv16TEx!}3yz8lVYPq5_@)b??9dt|v$#ZxaE3`?B+ZQma#_zy- z&}t-$-7s4Qzb9QKfTYQ-JvN?2eK13uQvgeM{AmomG!hkV8KQ-juT{F9c^m60`qsVT z({uS-wqIsuSaP(o2XFLR>44^}z&fG23{9+2F)`z9jJ-zm#cyj1p?>(0hLPrt=kWtQ ztEl>=cMj4pC|+^VV(o8SMLl@i#FKOtwc*`y(q_gtI2yjxLVQs^mtQVUMeVgq;3wbv zE_cfzJ!m=|7b&T?`ooTOfSlywy>MIT&@b{z%8!T|C}DVj4=6kWPDSDcQ3PzD8aPJ1 zC)PajlhUAiJ~*!?z_)nNWwk#J=(;aX7hi8KYWM3IHB0gySlpPZoLv9$bzt>{OpdJX zurvfLYTxEY40tc`?=XZpD~?;1pV?<`yl5PuvL7adKzoL#`fv6aI4b3IUzCSZI9?Dh*k(b9Wc+DyMQv<#(_wpf)P?1*fbXryW zVF_}IBa2r)1ohq0^lhPgI+IGZRdaD%X!KQ0JFEcB0=;p9 zD_&m`j1Cx+U|kpTuwEcAxZ=TJDGU{exdx%r;F^nzi@I{2RMOvZBZZ1@(dQ^Pv_`Vi z)OXX>jE%kg6o`9}u< zu~*N+I9390=rPP`MH3-#l&5>amPb5zq)B;aM+dCp144oxTyV3vLm3gWI?XHs7t9_|>OW)s@%G;|iNutL8>{ix_ z0Y%g>A84UwPFNB}wA>@UPTWf;htg*yQP$Mw2jSB?+lc2;fx7y2#KCSC4*O?RMhO+*Inmw z;}|p#bg?F~wxt-PiTrmkiR7~x`~#9aJ+|A3Dtidd#aTp|`yek?pK(Eaal)kpHSt#f z2AZD)Yz-73C98#PBZwnO1rK6zql*iRwgNyCxs?ZQrB`b1G>@8%&(i{m9XvVTmLO6`b9 zzN`EBhx)(I0uCK_t`#)(%Pz940}`;5G$SDqZqJDFkKpvXX^FFIb7gT1Dmy0^NQd0w z9Ud~Wzp(0mUlhUOxQP8i)zyW9F65)M=;mn3kh$#=^$%y=O{Mut>LezP4!}1%9Oc1G zFY7K%hzVR&d!hr_45u%>L0n(6et!kG{`sW`@g%fkWmPd&c}tJ?pA}qo}r&ag`BtZg41II51TWiW9Ta6GkvAsC9MKBmy?TL z63SL6^K5AyV&mU#&6|z=AFJgSFGzz+T-TiMSSa{&p-D+BEmGTY_!;h8>Aheo;4k+r z8!LY-!%xpjZ6r3Yjty+SD_DP6;G2h!xDZzsi&G+??h4aJ;_~B~wtX&>z3iY?M|9@p zSY@-yr>@M}R?*X_-f#JkJV)(OLT{^=yuOMq8J6^2l9eI-c6iiW`(?n)=+rR~Wm5}V z3|7lF)5a;);ekTFB8x1-a0K#=3AlV}0#jb6#Bwh$leX(8)+BH_@T^WVMi|r%1nHo& z4vqshN%}RZKiPUgQ`5zv2J4+e%`4RrmemFusW$c#eRTq;JtKm8CyTFY#QEb@2hX7O zh2B<#Sd~Awh1IQxqoMVA>@mKSHk3_w%en7RgygBjKBYzNR z4;X==0l?&J%>{_L2FE7^5pyhm;VDcV&jzOB^INd1f&c()D6Q7*E#&VeV90`wOgn2ebUHC{5toH{45oG1A+teub!FG)wjXmX|2Q_mp8SOOz7^}lCx|ELgi>JQ_`6DlrN5}nG#Ffe0*UHXc zs5`c8*)-r zEN8-m@>JFZ{ga-zAi-IoN>JG>q)%+#{*EBG^eC$;5fEx)-j*TjB>|yQ1;hP+)W$9c zvou-1_$(}#?Bp)(70Sd+=sooykJrkOd&F4Iz*^-1er$Mi_L6(VjgFuVj}uhk_c-|@ zeb{pnM=z!TX5BB+N&j4f>)|i+b{TXbohhDHfd?eML%Ym}XRx*sg+awqm8as$olE48 zG!UDLEenW(3``N#$;Rv5&=GM_6A`6dc?YA2;ogsY{}hN`jRKK8z@F_nHvd#SFEium zoaY5LIB?612Ra z$tTl)*Q+B|wVPK4{ley3pHy#LNR1>qVih0O{*c=pHItiYV)Njndcl#oSMl?wTTm^I z!y|NhRLQ4~5JS4NHHwEk6Ij1T}u=$E*p-%}DGE7fnKP>mdl8Z(p5_vQ9t6O?q>KT@r1ciUibz{1g2Feg`EE*4L{DJ zx0g^!m$tva*=u=DVcJZUl69P33EfQD)pilCTz!HUf7uEIPGG_IOn>Sb(D!96ho?YS zh6cl@FtY%X?(sd8Qoe*ZlqdkdH{Q2+)i`EbhxttB>(?)qKcI>zSJ-1*K7ing!KUFj>z;W1? zP&N@?-^hk$W+=FyQV`C>veG6p>iYxM_IV7pj|xBXOxHVWRH!modun4dI9}2#Q}`Wu zd^@>OXEuP7cD_Kx?{jMC<6rrG65TcJ)mLoP02`HTmt>uE^-XL*mw#E<1)T3du-S8l zbX;_NcmnKJMK3+dN}PkM3o_lftdSLlR$8Q&D)MTIV;^pn#G1jspN+qYdT%iOgB?7^ zKh=;Afm{b}VKw)r;+LnSE86{@Yt6{{GtJPNCv`EE^cajWRagQJ+|<8%*g$;McO+<) z(LKm4DrH?q0CEjYW%cMJknQG+<1aE5uKC3;JvogrpfW`{6%r$ zJ*CS&8xJ{mcs|xSZFK-B9jrB;;T|ME{4+ZlAR zvyW>_@0W*DRGLeRfQYWzXKqMmMa_V@P~K+B+>S_M_>vE6_svp5pe18 zcha7mdzW981ydZ23+`IMEl`~;irXUVke#(;EA`XD?=RHzhE9jq+{&!acB3acoUKse=o(iB4 zkY8Opza)ywZaH8XRKa_$L)<&f^ z7CJT;sy6~=KQb>{!^5b0UJ_5fU2BYx7`C%GjUSZ>bh8FyWP}V-n3l-5 zG||fOL-$iM9fd3J38Lik5$A9sO=)S~Dw5fc?Z^=0XUdG3U9MHF(PycpE8+k92KSgf zjt{9d(+)-u4ANF4mdWkaCGZFjXryH;fc3{T_53@tU7E#M1+Ti&6ezD6!+utN%}Cr> zvN70b?TDCLjF=s2UN4to{Q=FGdelp7=c!;u%!&GY2lhr#PQbm#;G8xnNc19obDU%c zYV3c59}O40ycKeFbZ5n#BoONQd>9W&HU!(S+#HN;5yWMQObG1*=1j%Er$-8wu0(?8 zwM=K<{8_MO104?kTMnfLjy!S!TYja&FoO^Nsx~IIOC@FmYsE`0T3;%bL_)n?_> z!f9YG$CucD!1ZN-y7DAu$JWXNrjq)#-;95vvbxVL^U1=G zXF>AaKO-@~xOk^*Z)R+j70UG}X=s11{vbeKU`gqJ_)=A-FDH!ynAk3BO_B2`LAdjg zR2_!hJ#vb{RjSyAIghhOQNHF>bK=OAVUiF-*_rX_r2W|O`U`8hg9ec20Z2WwYx1MR-(UBSmRfpX{4J)9`BjG>oYb_T9L+B>sxIKZI?YN7 zjo5BM^Cvk^J#J5oQVRTVTjDi~7qN}&5&KzdYE5!MW4wD4kS^?J1(G^j5(L`Kc`*zg zJ7!!F{o^Q*K$}W1shxfg8d)`u`ENN90Ujek_(_BHXXVxS#reJJ#CCH=8VrzNI zWFaPd<-MB~qYs4yRF%urzbo-;4euSIm2NyzM!0VHGTy3yhY44T}r#I?bY>R&v2}VtrrrdI2Z{pO-sP%K3xG&kaLb=EJ@#*OqDH#i$~eZ*|_5H<5C# zr+XNd)E&VX-{033=HPJLgs=Xg9HACrnM2B%U_P948h_?J&iwe%HVu0<;T%DWG%ufj zrH{Xm92aUsW5kCcH|d#slsO%( zQaS)M4g9w2Hf_O}8f*C3C)5o}Fzjk8CyV4N)d&x3prwgeWQnGQe;XlhzqIvj5|j!7 z82qWYJ0~mYiM21hPe4d4?|h@(+MbHF*v|-XOi{dBQevb`VB9R@b;;s|v6d@G1?k5V z@JMvvlLKU-E11)hw83QdkkOCS6aM$~7Sym_-&1&tZ@to2WsDH?M`%?RQFO#R&8dN?2R6myWIx-Ct)E6QjeDCt_slygVjOBO|#+~g)iXYlhle}F!K&05Mre@ zJe;Y1lNOV9?LEEJfp~*j7mUfS!zpd3grin0c1UfhfPZ3d^1^pNZmCfXBP&?W7+q+n zDOu{YvH^5zRansZfpG$kv0_yp&BZ*n-{y3VcTf$hWi)PK<_;0e!3iIZsAodM-%32%AzqHJ1 z5e8(0E>qh;*%-ht6yE|Os7P$#9HMnrKrgq#`ScjOs$fqnpDAq?`OwC~nGrBY45hP& zp=l7uZ{wDXc>9J^@U0n&@AHzWYtRX|57*E?%4o7mhaP}fSN&uYOz*r=o?YjVbrc>A z6aI`ag@J2}h0KMq*W4RV%&nG7m?(zS+7$Hky>47%cV62;0G{ol*?3Jp{)9(n|33RR z#5sWaKsjZ&i{>N1(A_e2a<(~I)A3QA$$o|%XKC;uw|>+m?@P5*3a#=qk}&=y*2-2I z@DrB*j6S?vEHrfz^wOjS2lsO!1+T;;$4s>r8^t;01~Xc-FK#~T6d_cRKdCl>oJ84hcAL=f8%KPGD=LVi`{2z<9 zFozWuVDW8w)53?2T>hr;zNu;L-fgU{Utw)4u*1Hhw%bgSF~GCeOU3Ad&)kNi(Df!HPnOMwS_C4og8a2zi7B2pe$Z0JN3lXfwno)r&(bCk?Y|$MQC6nkbEXpt z3;}&(z{CVzaQ9xSlB%5HvS-@`%tc_np4P=ZmR`;MCgqQhf;J00E!+u;8(pTwW({Ss z(-8Bxy!K-252c;<;@q&;$i7sr#FSe#qtE}3b$=5(-(t*#rf6b2&vi7eo#BPqS%N@b z81{jX=1AtKgK8>DQqWT8z#JK!LK1YSZ7LI9+I@m@Pi2>(o4t9fqy0%LqYW7^^$A#? zRLeacvYNW8J{)OD&^zNpIEIFoDeP+wYQcMh0XGqj#3o#y_|2BD9<+SyN^19Y&-2)W z?By$%9hV`eg6=DKgS0-)R3}-H29%hl=rLV$63?)`Lc^+RGl_;N}p#sk6q6RhP^673r7WOnmB0qPl3V3!VY(METX1x16 z0#E(Rb}sdo)ZI--A)h))Zgu5XkNVjDy!EC$^_}F;d_4Z6;^IS?vt&jNI<8w^D?}{g zHEZBS+8#PoqVA6pF_&kTa&>Hs7T%d`+g8C@aV}dUuSC7tjW0(q>b~h&$>pbPXwv*u zq{9DnEe@a~YvrK~gHL3Ij~tQNPXDgB{L0%ipBgIi9wIzNs#(ak+Y(MLZ`yw-5Y5BHXvTRUtq?A}RuM8NW*C zhA5eXdfmn*fAP;;@h7S{72q}+-D2#Zy6c;h7n01(twyBZoFLZCzWrVj-hLq^f~G4V z3N>(@7F*K?>blU}*fP^T7MNn6{r3#~SjN-o`4Pv!CH1RbTi3%Jb}wFLtFeoPvXNcL zXFg^!M&vk<71L^Epa+?A`THrU3H0{$)1t@6EFA35#s_b{=hre=8G6TKqwnVG zmV4t;M-JC?jojT7tIm~_qMoU=@0b*$)YwnCLo(M=JCZJR#XB9lNP1=iXZLb8JJr+@ z(+=aS8HbB<>NX3RK}gl%*mqJ@)oj(liKicPoh)+vqnhH`Py?vDc1K}Jb4rjMDGBrS z_XTw@3JsJ&#BRd%V%SpCH2{acpoVI;C*vX@%tW8`FKZ-%Q^CFYW`4phi%sKlMFv6QPczM%m{c#ud z1jylCE>9{q2l;PGjCADZW<9+Zb|HVfyKfFO1n{eyD~I;=se*86mHgs0k4@XTwzgvb zgR!knz8+w*P@MSqt6K^5qQ|OIGqW&Fc#>0NCjbPPxhO3md7L!NTkeG|lf)ds5LGU_ z{u_0^KcQ)B0K@T`?XpT@Jf{gm@KsptjogfsXT?&5k6~LxEw|ouwa5ot!=BSj(FX}7 zb>VmW!`{AtLEY)Y9O5Us}NKbqLeFJf<;u)VFh(%=J;tk%Je>@%(1#%oUQjU1XTXmVpS z!5{?m6u$K?E+orINg7=L*%G0+Yvi zcot_LXD@w!@L;**<3V9%-5S?(_Ft}wzVSbz%uzXG1S874g;-NRIC6TqwVW@$P=Mc@ z^)S*3dwI<6Wy@S(Yna#V!3@UXZ|VYE&u}aUDho>%i?gu&-R_R>hIYD3Jl)0m#sX!) z*MHYDFb;b|oO&_Kb5nmKT_=X|w$xD{*2pj7{{p&b&+5pA)M(rByN~CNYk|OEQvJ2w z3QW_5r85K_dZQs8x6R`JN7r{pHT7*3TEiF8oCF-^7<-ta@b%}z`=_~#fbsvon@Pd22Gzav5n}#pOxdT1Z6gv4* zB7pEPaE7010t7n*9dO_?@wbv17j|7ivc$@nPM}zvi3}d8Uqltk37)&cTh%z z9yuoZo&E67gN>iF-Wx~d$g^$(v(vSgW=!*3I-|N4NN5Ih95k3pvz~M#M%sDKVOyB} zMr&n#kwZ~)t)=XPQcHTcWl*Tn=gg|6Pk0=(VW^^kmXEi&{L9CZKsY8I>Gna>W*L=% z4M(y?MXpgFN(PZ}ZE*B|eZ;H0?u2?L(>NdT*NGYf8finV{}xO$1G2=7w2Jsgi2X~_ zD8PDiVl&5vFC3=8b!@dxQMPWl5IP@_gfDyCb}^kBaJen$R>S32YwSzFXyO$)Ajj}O z@q8e{Q{3(e48d{!?lE5XG82f+JW0%C*4*+?z#eO2fr)*mcfW?EMJB0J;KIpTpbIfX zA!Oc>;~?L(NwNs&H1hV~iqxv27iw}Z(&?!75QiejekG~CgNw-g^b&q%BPy5g6tH{c zhFj8G8|45#XHQ_#0}zJt&>LB}7?IWO-u8;sv1Aka;13{J2LAZGFGdKSu529&>rAFe z`_P`gyBp>NE6`cr_oB-anhUQ~c#^sM+~S{szzD$l0lB!S*KkNODijD`7OtsY*P~@A zGFM!x(xr%9y$Q^iD$neca;;G8x(^dWQ~)XgO42sANU1L$7OEE>t7e-teI51XO;_cm zsAfDf3>>~qp-)CAH~ORbqh8wo#ZDEEC#Uz0eGs2>@KUF~zVXtVqM|f{Q$dc$-80n4 zb0}rev0538;Z46v5#CT&5_8VvsQae`*t?uDjagpSwL#iTJbPrMkGU;)l(Da*e-sN+ z`!!s&>i!Q3bJY(Z30_;sF3rQ316{dBIG;OTH8!&6uJT7==c1te3{{XjsJqgfOz%K%tyK`G zD&HL``&k+CKfDnjFEH%4;Pr53qiqf>ENXlEgMZ1O>@;iCqt>4~Abw9?AB5j#GqAO_ zDbTxzU5l^92iE|K=ilCt;6Bi->q(jG-7~uPG?(;&3MER^a!^=gaHx67e{vAU>}p9@ za)Wzd0i{_l({%}D!v-^md~lNY=ITFFF&7sEHU|`6K6<4WXbdtbx-Y5!6%1sV5*#V6db&Sv(N*1UiIarJA*Am@B>}mbZ&OV%U3LD4<)J|B$K+$$s z^Kjkra5oqc^5H9zI~<+)zwSl*)KiB(naf~8DFb3LyC3v+Hs@!-g`H%h<3E0O*!k{8Mwvou{Lx;Xv$PsRXfyBy-OU$!_Ee2&3IK= zcZJ0PX01A9^&mRjvtHitL&~8?WhE^0kXUvuQ`q;ROz(bVsu9BnR>&=u@jvI)9<%<4 z+a7-o&m(^8WcJnlzAZ2zHMM>8GV}dQ3DsW0caH40MCz|e$VuL&b#V#vrH*q7*iGCX zza7fC%mE*WD_wczGb5|x1L|YVW0qnoB9{oSOF_2zUy3ri?}nOl8kv1-eTwPTl%E*VQ!&rC;$4@c?5y&N z{q4BP1UbI0FCOyUT=I&_ir~uL5!-JF zl)|m-z_ATC?Ty8|6V(XsZF_8F2mu>OxPdEa^otY4IppLhLmimQ&;jCgT_6cC4b!U- z8hJR%@1e)SOK|^#fpik4N(o+X&&qD8Q+94XcS@m+ndu3bP)iI8G>zcidwZ(k@r%T3 z&6OD61ne^$#`UtGrwy9{pqYKGgsQga{nk@M^L!y*ThRq{sbo|3Yh**z`{8(WH<-x9o3@TD;l)CNDBf{ zVmq~?uL&OX72K%B>B((@+@QyYfB53n*!H3Ig-~_Xb-i#DAA*JNcW{UPv3;=+sILQA z*H`2>N{X}QbgxT1)aColX=v-RWUFsnfq1IdWr59esRPED2ZwA1ABc`G_`swR`(^3x zaN4;q4eJdY2~BIHK53 z#7pVdom>1QxA)T{oLk*D_V>P?ebajULdi%R>}ys`gDZe`sJes&RzG)qy2^i~O(nM3 zsUK!lhWoI*F!UtgW%hy}elt9Js_d=pWLB(cW%1nJBA<;Tgrm{g;D z%93GQ(yJyAWzw#Qyy#Vxse@9LP{I41oIb(x3P?Vgkp=Swi87zQ1VKO7wEwv{7x%~7 zftUl;2v-VWfPLl8hV}8u=>X;up=1L^DKcOT@+`$Hxnuhyo^0?N&rEuLw>Im`f7wE( z?UByBE-{GMnY(neg&y0{dG6w$n;#;jZoF@@Sr?a)5(4he$4Zjct#{6v^y0!j+Tq%7 z{$8jAd3ZLopOw5;nXnyHr&*pY{5ZHMhsUzvIz}ab6Ul)}=0tJc+~l!)U`lpuJs!F7 z^GOt{T`-|+d^33UO}-w}W3N`9vreTe&{U@AeOEEJTJah&=Bc*Ab?SpZGZ2(}v?bIM z2by&RJzh{oo)YDxlU$M1RL5T1IS?XQ@4RC7rGB9{y}%*n%EG7uigS-wc7<4fCFf!N zC-yeLp|e+k`G#23%4!_kc=k)QH8h*?T9s)PiyOwa?s=2ZJIvoyH3#muzGF^d`SI|rlY@EfjWTpu zNj9Y__S66ohDWIx+(;Vt{6L&PBEs$bXn(ul9jOiH1M2nS={64!Wuq5=LTk_e{5}_m zzZM{CNzIV@&|^g^^>Y=ZP$8h%%W)t*Df;j`AIO1t+B%5Gy~S+)ON}r8VR$FUr{TWPH1Fi#n}T=)23`YslSy2lla0Y`y_#Trqe|sE=E{-!KFeWtin}Kt(j1ES_{$x3JW}k--^qWOO~Mn9okm140>248Ach*ggFgBR_gcpJ zP7RB12faG&1B}1<_qRAGE9$?#T+MhC0{NJJZf@1+O~PQ zJm9;w`oxvcK_5J}V<=>kn?y2a2qk^(u(pEJ zmes?wAo!1DhHy8poFD1<(z}W{c|A|aAx9;cZ-m9EAEPhbCO;D2adbuoJDu3NbmC&>>)zE(%wE1DYipo({=W*x*^`BaQzKjc{KwoqPWRTjv@*`;zrkFiD z+!g45pLY&n*NlIIJDODat@uyqa-CaVF(kN12(i(^>72kyF*4(L)6f|5^b= zqRwqOT#Qn}7mA76P8E*%ry|D|_N{e;@Bae?fp_Ynh=Iq#lPO0s_+!}|e~-ScvYBc* zeO;8X}yuDNvngS-Cu zPD3kc6c1D*%Z!`GDeWsuyaJnpewI9E1w>Nx8Q2ZZY6IcP(o`jeif*^0sZd#%d-uOf zmw$ifsmb?$eJB?#EW+omToO2G-^i~hq%io!fg3iiQB&$mLR_JInHm=4KtrV-Cxi`v;mdbC7-qRbn7T{>J% z9FoFI9Z&MC2rV80Y7fs&cv81rC-eYivX#(UReV2Ne|wW#i5T0>YpAkMZR6R`h6L6FLC3ZNJ>|NPFg`mj18-kgwq9qdcRQ~&%C=w2iwl5}qJU?(Y4^MaM@5j(Z- zW@==I(YJq&5?ph!RKv}ACT98QdQ=`cAr`{@iE-xjlNhX(KQHd zNY-ulZ*i>=51Q z2TnX`Q8sMm4gjnjUKIIG-6^W`fAw&t3g|w6dy`7wA)D|N)AIHCC5JR>eL6nri80qL z&E+HHFCX~&^MEjqb?;mQ2(!%A34fEjwTG4KhLJ1OPFKIdGatiS&C6N9Y<C==KHM|$SposShk2c3Id@jg|FCpgFG-1dwbn3%DAy=QU{Y62vbS%U_ zyRf1KIKlsroczBwqvX{Q=gWN8l%-{aOFXFL`L^=gyCb9#0}r*E-5oc-i3_y2ot%~y z2ff)(R6Y=l1Enz{a8Iv~d#&H#=!`9vHDbD5A$3K@jcOALYV4#?JDxZ5b&B+pg5*LM zJE3(I7?0AbR17kW1W-;5rdudXJ5eX7k$Ym;#qwn%g;3BHphcg9)ON%q^J(MmQp~{r z+UXh&c|}oBCS{`4V2pnOR7Xcmt?l?OQH3=iDH&V@dM9l+4T)xrWLzZ@9gtE zljXp02b$Y(#6>Hq1zz^^^rNhFKbX`D)fbbBI)EhlUyF z7eLK2gXOhJ&B538lKU@_6j}B=VBF?g1N?rLw3n19LSi^qM9da~%9zhtY+4LlsRJCK zK^D*!s0|E(a79q-AB;xuC$`=mYW!a&`hw?TL&I&4l+l{=An>z?INCKD#z$w7#vF!^ z-U%j>#}}?I$&glal^V6=*n9MDSzR$njS?SW#Yr}`dG`ExdsCAEi{=g!o=xgP*W{kk zS6r?WXpsQl6DvEF7D`9@Lw&yHmq$NjD{^szj<-K8g+`;6Dw}~>yGGI>oWR9rLGLTg z;iju`pknj`C0r@wp4R6{l{{{4m9V?lMp~|o*d5(cb%p_MS~9-`8E?4gp^SID!*>p_(IJ`E#6B7??Uho>VHjFx>@OV1Rm{JD&`j@ z4Rxa53*&BeCq@+;^esDcC_`nFZk297Nix#Z({BWHml1Bw!$?vvlnkkvLoXw#M`+Yy z%iI2pWY8C1(#Vgz73Xq=$3mT_FD31m1X}^+fX|Wil3blu>LA9W*AR#l>1|gL-ub%$tWY_YOV5f= zeNmt#_v9Za6+DXJ4yuY6S_o5DCGJ3F+4-*4L98N$iLsZ<>U*u2o_-6nLf?~5ZltZp zWrQjn|2TdZA@=XU$G;z603-yMw++T3$Jmy&I%kuIK#lT8MaP>-%+Jl#Zz!o_sZdaM zRON(^Rky5^%WlJ<6<6eK(d)+OLK-1bUu&d<<6}JNH@0lieJS6-m&4rj2zO&f`HVdv zw^NmOcS}9YcYgO5b>la6DOoHaPQk+Y^*m4REV9jE0avsVhs@Gx<_piJWx44<>D+$o z_s7=r8;a{P`o&G)y;r}fpRLblkePh-|CaOQp9U?9#Pn}ig8<7OQV3>bC2^diR<@t3 zu~a4dBuMk*xycK1FdHY9`yN*8imhsExHbCgL2yg*4%#XoXLh<>@1DA_ikFhMHb@$3 zK(-gUX5Nb7-MhlYV4Q#Yy?t3#K`)G2Jtwq3<%Qk(IC-MpiI9=BO%tP@EeLMmWC`Vr zB$vi75u#yR%7bT{sBvYaEt!q+C9u;?bh1M7CG=z>id0w3m4*s-P_gy)r?|l6|F^_{ zzq))T5d|3dVM-@^3iOneu$rE*548380trn8ZUuQo_V^|k45?q}MYvJrYMws|^-)or z-B0e2FFZW`7z<2#{~?B9A3@qJK^n?450tS!T3b7xkt$+f7L|}bIK+&K(4N&yg!b^Z zmmXToUu|<5to|pJfD@Pfg=;otaJzPPQ|nDA6oL%7oLB6f7o750qQ-c_5v0%GQge%w*iyd0FrFws0=P zwn`S0&d6cXrb5c%fv@N+@7b5mA=*6kc836P`sZw2SL+oh+aa@ zN$Y-}8bseIC!+96e>16RWiPgv^kY%s?SGl7+iJtUdjrbMReOh}SA3 zkU!p&PL2dQp5>Y8rl|*wmnJahPIE$QM0=HrgM=^hT=o^FD;!Tyeb1zo`se2@8I6DN z2qMn86nSk5J+A<~maNo_^Y<$Ue>6^7P8Dg3`eUJvS38lL#+*6<(w=WfZ;-`;_{hSd z`aA=!Sz!;8!)kr|9 z#GiQjf|R%wa^|ujD#1=hVuM^Jakzm$<+uFg}c5JCi3+5JwD-jouR zEPgh|@15`u$ae|WE_z|;i^io;#uv)DeCq|qc93h-M+A#QebLFSuSrQRQlOLEE5N# z&_gsxgeQYpboU=|ZRBI}Tv@m7$PFQkC8j8RV9-ibcc=;S z)dgo=jP@SQ=tIkJs@uuH9^J~v@YLI5zu!X-WKCZp$Y*|P?CnW7E;rfb`zPy0zkUV; z3ogP1;Mmm5d_)3PZ|)ClYvjNuu43gi6mi+G1h|c$PQKGTF2;h8o)?)YPhDvmjstN) zR^L{^!b@fHk+}8{1baMsGWXORt)Jr~j5dLwh=N=$^RO0tKaPv~vH0Jz7g39`V7*udGi~QvCS_$vbk6 z5LWL6$Z1ErZ||EAx|ZC@qlu1Cuzo4pC>wnRvk-#N%p5O~k)SYill|!#)weJD(WyKezo4egVOdDW>8?^^rYM8nHH}H5NQeP zE%lC(L{o29t)mdJ)&`4FSco#B`(SP-7jZjFNYkQd2&~0vMU$BWhu)7vXin^?Ai@`T zlx@(Axrzxq@i6XHF)}i6t8A_K*nhu((4uTc#p+Xu(6`LjZ7QQ`LJ4(HI=&(Bv)k^w zq9`%Aa0kz_m~ciXJ^q9S6UQGs5S`}1!NF+~@##r6C>Dj8;AkBWTyBt{+zq>m`C`zC z;=-Z}p%7}0e4g0tIb91&bPg8`rpXnAv*3B@YVV8_cm6M5>*6RYDPtdEI&A^jkZz=q z`n3%ix@X$iRSt!?jrP@mgkm~x!OWks?$|rTDj!G?W(^L0igBbauxuX%SRprw5CR=86L7pb&I9Ckl$zbpva;~)~?uQ z!Rb~ggrO=J*^>=E_69x(?GlhUR4ediryJV3nZsc<8>9Ain}5@S++!=A5~C+i+Q>X^ zUB$Th#itq+q4r!-f@D9A)i8n4hmrqMnPwAZEdi z$xPV!<-ut@(D%lfnpYtqX+gOInn4U1Bxu-Vz)1Pf|5|Uabqm@HB`ib;$)2Vn+(@@f z6-|43&;Gw|7)oiWF%+t+(Pa_tVU6yHfe|w%g<3asV1hg%8@t-z9WPw;BHRyg7UdCl zN6rqunY{GW$*VtF3;FXv{PRq+%Qhk8Pj}NAJy=+%W(=u52wbZ|wJYlCN4mt(hoBN! z*^Y;^FPN7Sb=*fH%VWjkq!6-M2uLCnayd@;@%Z#BUl2+?n+C$hbqZh6APP@Z+lq?I zJC0V(+$Kf#7GvUYs2D|@ImgI1PgEHqJ3$R6L(s87YvQ{{Z z_uU=)OQY2Q8U+tXd%jBZV4Ogb9ezh|FVsuxfqosP#Br*&z-ebl&9&PMge%bWD`<8# zv2t|t*V##qPmi5R$cPFJIwAaMJqrY#*L75R}h0fs_P)E#rgTAD(tLM+;w&Pqm zmVW3$+IhO+hk|8coxXSDT#`GM4f6N*MhNDx#>vJbs@6{kh@|=@yMZDLWopqp+vE zrJ(xjTDfXm#FavJBhjciwQl-5kSxn`uzQl{N9wM%&91VU+E@5b-M@HW7dE*syXk#* zLp#r@iCT0XUi&$=E-aH7Et_XwW)v(xv>e^mSdN3;KK@1XjYx&tFav?oN4Qh=cE`pJ1lHxG-64O@3 z0yfgVIx2|Aba9k@xjyFTIxZMQcb*aCUNoAZlKp=|+(Wveq0<1kNgkivQ(nP}hF;Y| zAl_T42U2OS%~1<^G1YRnpm4Wy;C?iDL2 z*7|?rbu&q<1(iDqnoyUPT0dH>!`NupzMlK`@-u73tBoTYjYOvzRE_Ucf)>-&2+ExT ztyEhI%#O?RI2YLvl{5~{HqEH39PE&n(SanvnwHe@3W$v5pZOX&CF)*=X($@b$W%*E zYU{GFhhRIEEEa=6Yd|ar&8BPS&MmrlRLsZ#SR*|`h_f6xxad|cn5P&hZhKAFJ`w=~ znLr62b3ak$5ap7*cJW>LzX_gAc7kdK@xXRBvZCdlPDcWlH0e~sHptru2cbP&rCx>yLqS+p1GwIZYx<`sZzl@j8yy9zGoO8E%|=S|9=|3+lyG|i`z=4X#bXCL&~1z+IE0QS_s?5cmeFU1Wz zY;L&%-Reh4+*Q+#^iGg@P+;8~@oKEqh39-E<()>9qbaemoB7%4yXwsOYBtsAbRn1B z!>3H58?p1bInw!d7jam;G30@|x>L>aCXa-}{KLHEXSWJ)4{-_i4l2#j9mCRAVVykI zi9AkPrpXfOTZQJqa!gn&6e~CmhU?2m3%L=|6D9)NQO-)WB~J+}wmwzikjy27qA2=D zwqm|CpTkBitf(bqHGa*R2;*`W@5O_>4?Lk91 zevu7@bmCz#>Uw+o~} zTFC+;7|kR~xB%ERUn=Dpk_;(Oi!i=;U61Has{GYAd-%wGrGLC;dkhd0xj=$2V!jt* zFF>0WoL`kiI)3KgmAhGxsxCnq5o0;TP(+rcv{}c5l~t#N^+Curkqo{hQOJ3I zq4?+YD!YO2okpL(x9x(a=cp;bKX>-tyUU(^&-HzD?V@DCce(RHxtY(|kK~R&`nhR% z2i*+I*ZUu+I@OI8(B82;ZVKp2@|F1BUsU+PFb~6g+7l*WnIjKw2Y3Uk2@Pd6VzYJK z&j&7$Uz`*-g^J067~zMrSqy)fK8>32k>xG8EtHRo?$m*x)+7w$3k!mAKcsk~;>3QT zWNq;1>jlG5aB$vzAmTdw-*<_jm!dU26Uzg+3B4Tfq8`#p%cNjXGJEJF`fy&_-pz`dr~@&8Rym?K zmX=>sx*9`#pIMhzJ4USQ0p<>fcxTSiXs=|QbWmJ%EgqGP`y{+rEAOr`Pi&OFC^PQ(igypL(OJgD(6gEx#z!XzAO;N1VhpJ(#!Tq&c!?cf+>p^c%%P0nS#Y zS<)W%lXi#a^D(-3^!qUP$Xoq<#8qSguNG(NQ|OK(L3I#aWl7-H>@EDw5FTIHKkkB3 z+E3+3mjGO(r`8;|$Lux7!@JZKKlYYtWd6EMNgx#t9)aiAhQch6pGr{Dq>Dz}sKGTh zO@tzAKxAi>^sp*Uy{C@0he_1I?3;d5Yjst{OAo(SUNeI^_&Tcu3GiWDdXXjd`J&vP z*)_esK3E;AWKDhTk*CSd*72m$$Q7tr#$HaXFIB+@`H~x;p7I?Yh*GZsgnBT`l2`bJ z2aQw#(Na%30+E+znS+XY4-91iLwGu=JRzfN7W_AZ!S;baOAZyKbYD3-hVBPl1Um%*ud%V1z1P0;4H<4Z9g@=ty6T+!W=y91IX}_K|>V zR~g+)ocJHjR=y`U5OvrlPuRm=de}W?okv%e42i3S-S zni28sf+Q`kC5U^P|B1(J^Ut#P2=`CBDt{wkdH)kk251-1Dc6CVlT7AE6=(W8d`>X{ zoPu$iuiH+UTR;9MqemI;TT`>=;Qg(S%BgXg+bj1LxuuT}ze7H^oNlKXRok{5E_@oa z>dt;-BxZv}q~$$~tkOWs1zB!pCWMd^5IL!HUKjlWEU`F@y1yT^>XonWa zS36%nFBn3K6pxBpgUG0FJ*gfqFlNl*)LXOj-9%3*u2ckE$5HX-Qi9U`YvLZ3nB0}5p-I&9j5sj-C}o;^9`Z(uG-Kk4u@w06HKsYECrWtN?Sk-j2ks)5PJN*iQxyND4P)cyT+9YEw92!q=$eDgix<;y!WSiCny*4 zz*D44mVBhX?TlFw+STw>1h86vi}^0H<8gOTNri!9@Q`9e=ZvLVt=-0O)lzlw=%)uU z^-s@34GzlE%_?062sm2HlDrB?VrRulvENzhD?k6wXD?E#X6hTA&ch0nzWoxtqsa_m zH5Xe#K_c>Q)7xZ5ywS)uR6zeKr^!+rDr`6HQs}O+S0j^{f1o$FBP_|`w^6{%ta(i< z17^93ddWPE(HR-Os$;{0XdD78EC*_0`%z+4Jk7^o5_%o=*fplv%?d_6uC%Mnm;c_r zUX6cwO(;YW|D@|)kxNI~?g;#zs1zzi{3T+3y*Jg&%WpY{&Vw(l(q`uB<`@0F?=F;q zmJ^>pR^jkhm($jOsyE#EuLsMs&2IbKM>7(@xCwx{e#~{){Scn@od~R%`RRE#NY6S8 zJzp-`!5Qz^Dc%2C3}Z8b^x4R0rA;f8O38K8Con?!5tkm@rNfNWmk^qm8W>b5Xvl#J z(2<36{!WGdN~ZbvjwDIzY=2CyM~zfWSsKGMmN*ayAh1r@#S)-OA%xHGPKSB(S;rZ4 zYl9vr-GXL&hwEal{vMalOa!geE&gMi&aO-lMdYW#B6fBzMR~k0BW6$G>nEt zN}Hr*HA%ONDT-BsS@Ols+MG$fV6)#2pX+fGW3C%=FbDFC#*C@}UW#_>YbH^j;2_+{ zI(`;H@yys;cnRbIwZKa=?2BK`<`c8|%+WpLO~m6HUmCGt@e7C6-uPM!^3!KW%{Wb| zs^zmo#tJ)+Emck~N}#4Sh|I(J)kyu5;rCMSWDr`OX+3!e0GmsH6ApK>DUGn6d!P;L zBsep~*r(xnW&eBNfUPz5=(lYiuF+-0OrVuA)8e{SZ)jF}1Q_F|1y;~?u^MqryYveBb)HS(hT3;k~{JH(G7+g>DMWfJi6sHiYo7yQ-;NU5Knem)Q1LjMZ&_N{%zA6aFf5=PHC z#w}7SWX{Q8Dgn8B?e2{Hr)V>U(Bx10wu$4fZ-EmHZIM++zVdq4vjbzD)T@D;U2!MR zB@lBR*I?FY2Y#(5{0V0E60`5@>PiHd^q3hEln`b;w+V1w^X><$r(ch9lX*KdIixNOel$jZko0|FFZLa%X2Y#kX~L=#)n(*#9Xi5 z)_25zhuX|eue`fBZn-q@j^S^k{#|cm*c{n2@Uy;)Cf`x)Kh)pn0GICm-%@fQ-{6`Z zSo>8ZE7X3q+Uinn(bZe5Q_VSkJ&aFlr}Tl-=z3E8mBh%!EEv`Y6emj|Sbq16DbC8+ zPUkLiYX-Mj^~i|X?;Zk$dk?*!lO(C(S_>Lz4P^_;#^7}3;g4BvWZVM1-!JL>fVs_j z1vlM9c5a6n+z{24jX2(?4qGc3Va<502*yT2-^WlUt$Ux`Z?7txbpcJ1T}m3LpgzA7Aymj)5^M-KeW1rv7f`#}vSYr} zm&+lmpTd{o?>AZ+a9r*u9AmL4%IMta_#5bjuXy4_-|pL)ce;e3JES=2(v-5&yzQ4k za_*^eiE+>ZJ&Qn$(>Lg2YjBg1S2Fv@iK2VIW>;2-{-t>8y*5ANL{{khzqR%17_Gj(f#$4HE6asV&rm~qfa zSY}ylwf6eOd4Z&^V?&o+Br<(ofa*C(E*zCYsdM2Xtmyy4l!#mS;m>GUVcL( z@wWX78WhL&2*v{m3hiN-{q(Wi^gHYe{Wqm`N!b&eF5l1Gg;lnA21d}j!Y^lVvc6LR>>g&!_!^t-rK9UZ+D&zDbVT~;NO>DH`0%kF}H@;=9 zkX%Q7^kgn^aMG?!|{(p|1JaW|Xsd(RV)F;>`;Q_q^hAx{o*e+!cQ|f?S_rdX3L{3jw zm|1|e=CJ|Jqa8VWcHus{xk;mL9f{C>Wx_7k}`G#od z?A1><(=@tQ{?^R97GpmjD0!{+$`$XF^2aM}UT&L{_<*ZVnwXwZ6N3yNng_h*BodB} zJ6#ix} zbr^n5CMoFE_eEmv`nT#59I?hCW78=<4!Ai;(!vw1jbdD&+n~pO?UegCtho|UrQbgobj?jQie<**`RqpRGyT)uLOC0`ok8l;m1ytYa?icr z9x}Z1v#XGmpVZy^CA;^(O;BD|%ZaXiIMkyjPiTFJz5kjPR4%~~!eii*+0EQfv9A^s zw*?}Jl5KAgya~*r_g?JIuRf&pv#28p;c-|zH#r`hJvXJs>fI|Jz^V&+GiW|S zvY~zT4Y>AKg+j!lx{sMg;K?9;$W?4s9ZXlAbg_sSN^furuHc9%c}+={Pl^(vx4njW zguR~qrpd@JUw}9Nl^MPLat?#4IDheMWmB!Il8G1azrL2aUD=`YcIU32+TUV^c~aVA zzfhtok9=R<()M*l4jwCAajzF0OIv@&v@SO|H8GCzfBOC7pvaQ}<2r{`pfD^|9K5t# zYS!k|Ppcyx;5RvCLD9sNF0O-6b@YESg!pbrcEdm z^^DQItaPfi$#y6FTk((Q@FBOuYb0JhuRn4qhIkU1{AV*b1*KazM~+Oy=zs|z#l?~+ z6Qpm0w~h_IOg%m$V{>J3v0HBcQyv6aAT75#0Rdo|_xWXNyx;KM)T$3$pirRLue&PJDHd9vUR68lE!lTcVVuH~5@+ym{t9ntgoOMNL#b-V^Fe z{(HKK41+46o|e(iF4a?CsTF!|chcG#G8l1jIj+)}f89MKEO(-0B`yh|zF4R& zou2eN`|*kv9)HdJL(+Cru;5N%XC?ds!V8Q21x+bSh1fh;KVRGCGwf);XO+)V8h{0F zLruLs7pv9+@h9TV#?9Y3IW=EI#<@>lB;JdO$39lPGdkqFE)qr{Bg}v9gH8ZJ|yNJUW_^Bj|Ew?TAZ>B=mOthvKBc@0HXOa^Y*JJQ|A~>; z18W`xeKs`E_;s#$gjB8G-3isBJg~5m=T8y?K-|uYB%Fs+MdGiH&CJIhCYPrNsco4;?x%Ht(-mA5%~80B^1LGS^G5;Bo-luE%r=uwbKs|kpQE(E$PiC@`nEUL;pn+FjwVXK}r<3#B6jF^=-^(Y|tCE z^?rP}(1z^v{;hPv5mRP*?va_p&9K%drIu=)U5OqvLNl}*olLhrRWz_0I43O4PG(;xa} z6=bvcT?vkA&rSgt}enOwtoWD|Q6GDREB_rLp$ z+G-7C?v(@=l7tRP-=~B2@SiRqPjg67gN#M3lfK2aIw4Tp&D?GoX@}v8`P^3)zW{m% z))~27ChcFeIIxHOt>S#@aqD>EwN0&8kQ*s1A?YXU#qDAKFunnn}E1 zcX31p5L@Kt!K>L5RW8(YfpE4rjC}cb>y}mr&fLgtG?;&t{V#p61A3x>#F#zSS`;F$1lgA;u=2E2(!XeD;GKx`x7N+${%Qlk>$e}6f=|ctZ8Nmn3j~f746bUlX8fTPf%S= z>N@*<7>H_zKS#?c)+<2_-{FmJDVPDf=?^Wo*ODSh7Y^C>65r+m~b?lC8lsW9)0lE`%avmo59g zZ)5r2dY<3&;(s^}Z_JyyeeUaXUgve5=au2#Xf8`;^@`cJJ9FO5vcYvdCe!EI4&Bjz zLwdJR;PYgVPtX6!!gF;LiH2mz{H2+sR>&{c(^!6c%?^mU=WhLe&)*WCSr6VIxoT0`ugC|Inx*8%-O{IcrH0a^I5g3@@)qzVtuC!_JOYil*lS zjJxSdW3C%P#_fCBj6NNo{FMFj1Lj-|9v-^7QD^I|wey;=?X~8$yB_%bc_ZS)S6Zuy zYUAos&LN5YUmKDmbm`J(DJ`XNj>}&lmMWN1TiR{)@!TrJ4MWO~1j`Fy>;E)!01tx$ zWDhMtZ8H@>m+?Q~xnkoUVWf7PDtGr5&dVqem4(={>vM#rBToQ1m<}NeR+Acix)}~L zuYKmHwiIm}e(<(@-~gB}K9im>aevlcnFS~%(iuNXf$dQ3jTN;BP--Y|5a|5Ri@v5O z-1`;Ql*SrssBXL}w$w!Z_JNRbfbx70(|XdQ7#sd98Qq8LKj60?AJ0yUWDK$9Z=6u= zRSpC{OJ9|q_K8&YApbv3FpQUrz?Ax}{Y9r|?Co5!S5G-%qmyUz$-johOhvz2)1*bZ z)t|0y1OQ)ptBPb$b`ndi76mYO4|P2S3-}T`~UT6 zMaBC}ewr(Y>H-zqEACjrWzV9)mu4fijuvK~erBeY+DlhFs%(2*ISg}mJAB4p%dIP; z6HG!n@1ZIoe$*L})S#2aRH>~kv|zIHAMK=1C__x4v!R=!rz2S}E%^s^Y3tmH5AX(fe5#fcM)B z{%T^Y*Xl%bMy_9?u8H~RsPxYvD>C7<$xL-ZW=!d8-_o$VW}^%pz(H}$ zF{2yA#tSK9u0vOhH@_R$X80_pn3mZWncO*b?#&7nX^^`ZH>rhoDk*jZ@R1bQ^~$H_ z!zFdH7g3{F~PzdCA-Xe6F~&puA= zuospBrkE_y!H(Hrylpn{f$@K31seYJXzf2TbuBX!Wn66>=lGNe?qJ(Y!A^NAJ_YSK z&+)^`=gHqvl~8SLnf=-crbix{i|u=dJQ<1q&iy}6d52T>tmGN{!Qx`cP4yU7k9Q6I!W&VdHH^L#TYr0#|r7gj$p*kn9Yi0zg>RBC)qX;_j zn(?z5O?wUMYoQcm>BDjgKRcQws-!)aQzwtTpM8{n(v9@r`7(K(5Xmuie)O(^9N(Gt zH|OpJp5g{9?*FU``B88K70i8Q%4--HX{4Y?Z?eMGsFhfa>$191JSw;0xgiHeLmvMM zM6qEb@1k9A5D#Tg_mtgkeQNALZuU!6K6$;?(xNWEyZJqwll7=ExJ7D7${LE@C_JgYO7-=<2y84itXLRAhk)%)n-gA$tA|KV+cK-B+Zn1!%1 zPtfQN$Ak~$(wpt38&4LvULt@i*mQF{@x-);`A0^Y{wRL+aou`wd?B z&M&{TeHFOQ?&XX(Gy|{I=+G)|`YqT+uOTtu9%;=Bn{m{~+GWd(MbqtzTS!m(zAUb* ze_G^AlOfAfQSp#B+f(`)hsj86WU{ezdE|oaV4NemaT^-N-j}(ytrTcJe#a}fdRtMw zW9$XhEl?P4Dlb9X_b411^(|;s8e=uFSa;E6V5nbVY$QTMfigCRlGtX7jvGQMg?F&~ zCkdC(`}-e^olgh<2L5lrM_K<@CImJnxXMxTJW1vpQ29#rIPB5+O#g}v9RuGnkwd** z{0`2GhC^5;2iS=MX;&VwLV{kr!7?Um#hhn-Va7HCW<#3sFw7nC-*=?`!HoWmI?tto zu?1&K>1wxruV2_FpO6Bihp~dvCai`a)hA)7RfT}gQK*p%=$@SisbfPO?RBJ;AvG<( z64SIh(wN4$Zr3?o=SiZtQgyH6FkYPmq?G^+Iu|guj;h>F5C}e$+w*jHTq@}2z7VELiO`v}5}rFo5WZV5i>H5u)D+6Ckb#&|yg?|SxjZMk~q6lFCjQA|M{eXpN zywLNq5a#OeX{~K8p=eT$G+Kcix<_9w&Pf*QOM_ve}yc*1couNeK%6(m^%e3g9^LE1El|X#WKjw-Y&GFrPVBX-Z zQ0cYKEZzvC=d5s(ZHqT2gBiUfcqp`<9^*-eUe(|vDG_tA9}hb7Prc!0Y%u^SBI{0c zEN&<$$}1^+dVcdJKgBj~u&we}s;Ox*b3X4QFeLvC0@EH3H8R7cUHR^iH{~2(r8xZJ zzh~Dc(Tc9|uR|JwnYte)-)TNQ8$KY^@AEBrroVUf-)-`?0w}0tE1$C_?~SzejVGzO zZPO!VaTz@@Qa?+k|J(H^MXs3{SHzvaG1NEI^-f|!jp=?C#kme9DpvAOp&*vvR+;Xb z-!w664@ie2r_26+3U3ZoPPjL$iOm4P+(NqYHg zv|=4GZPTC}I?1+2iFu>I)Wh?3Sd%d2F{9b)NQhoCh95|EiBvM*1jHn^ZRKlbl6QuU zd&ggu*A?738yvhXG*NOi9ezg?MEnKr?5D4A!u^8w=IX?D8p~rKXt1rqC;k_kKdH35 zu=wDf>G#uukto8wwB_^Tm7*d`x&F!CYwYHAujVf}cYmUlcsCC@;61|no{iXFQt5BF zF(xhRF_{_rsv)Cy;^Ou7q$ayR4Z?jYGRVywKee4uzvg}Y(Kfx1h4+<=petSamkdkV zVkq>tf)&R9GO!6|^W@Ax3@$=glz|SI1_J0kZPGBjSn}^Y0BbDF^Mdq6V^;X8{SoMg z*VFT3N)3s7d6V@uj~7O3*76)H^9hf3A`J;leRd!tZp_T$?5@BP)uh72jW__Ye7$NO zvTR-Ci*rpj_0uHWVU@5sJMm;6ED|26uyyy;+UkBGTM5i|I?bi^JxlMdwG{}zKc26q z(AGtZ;Thv-YVUREwU&1RaXA)+CUGe?VOg?udc+jwCKZ* zOvLHU05-32!b|VreyN_LMQq+>XV<;v=e1V@ih#dU#Waq+w(OSz`BATjAO4AYs|FxA zKs13?Ttd?{$Syz@MX~W`ts)&Y3V$K>hBEHZMeB?Dd@hFXtVzIKz8KeC13WxH1NQXD zZd<5fKtxB#LdLOY^k{%mo1R5j)}+|uJS_BUQg`CTJd1po=}KM*GB-3b*rQxq?e@64-lNA;X-n^!b$l=NnyFXVE?@{d`Y)}&s-y%!Gl;!hYF{tDF z#o?k}Lby~Y&EnG^!_>CzFo~zD*}v4^v%-McZPm_UDMWv9*4fsbxIKm9G3v1CF%>^Uivk0fOK+sm^j z;-_LMUPmg-^7E_>_jEtY%B-MAyW(6^5Cg^s4{t9&mm2T)$dMhDqXOlL)EqD{D1Tj; z7~V$KJJC#i&y+gy#=!7!_50{yFq%h$>p!X|M%TbPuefr@Ua?bGWK#>j%M5b93&k?F zO>>i$c{svjezlh270xz;1J`f<`s8wS^8D87hQsBUWrf~=qSiTDJk00(&mkU%t1QDY z&(gf5=NO!VtTfJWY92PmB1%q{M1YD+Mg1zCagaE(hcd^RXn1%=%Rj_JD?flpskYp| zmM(M|P~bL$zn}x<=fA8p^db%c`D3Hci*h18nUIhZ<94aHEz=aU1_XK_6~VCl`y&Zx zG-~tJ+AjalPY*W0SA5N!_Ql`W`+iPa(TO=Z!6hzo-_A<^jCK-MwGGg1$yxA^h>`hr zQ{{m^gfFpSZnU)?@c&#TnVB1W&lIQh#B_0kvp>Ks^fAgrn`K6FlgA&wfAC{YWt{nT zy_>wgk!t4KKEvO>N00%j+U0j53Y@DePeeFZH-e~re>HgQ=j_V%0X#BwPe$~vX6D+4 z!~43p7lHZpx8kN_t~=e7^~lULTr%tD0-nSZKXPdNG2Z{!e*6Q14wBJ4q^E{I6rojZRFip<#$W9gu=M)D|1~rE!#^Yb%w_o z;x4I?L*>Z}?(6p!3EzvxYRDl8YUoRz@N!5oU#@EF6^xzj6=gfKNSYzUns&Yls4A?J z4@D+h@E$BHNx%Qavf<(8`U=ZrwafHgs(nwI)6hG_bw`@RM}Go4(mIPjz@?W&g41ZU z|I?>yERGFPP-w(OSX0WFCbmc~H^nsd>qKYWYTertUS`aJHNWSTWap zVq@GhpM_YsRScHlYaV6ieRlsMp0T_U)SA1w-=`q>t64vHg39@_vyw6;_b>lM#cqCU zO~XdybxM(R#t`TN(lDLNl0Z|026O}=k+EhL@ap$4>oeSzb%=c zW3sf?Zm1?YGN`b#85ngIfL9I*Qu&pj43wz-Wr#{fv$$=oh;q^;!)Y9WvFyaU&ecRn z9yn{hZYOX3Mos-TN%zkjSpvZIdQw8S?l|AdRgYowE3YXn%A1}U$rvh3ukro6`(BV= zUt`p`$ULX?Q@}T-&MtI&m_FUXQFXT7FHCL~|CH4V>n{e%qQ+!vn98G+=yU(c{h{OW zv%i_QCjyIZ1NHeZo1w^3rbjZk8$)XkJ372OAmv16XTVRY8LqheA*jRm*VVG)nVp{Q zGzu-adB3Dp1Km61^bI`1mr*{z#e@AVnFj^E0v{?u{;$0S>HpanbM9Z#=WUJIxllUl zLQy`c*zq_+kPCoPLr^M5f0Y*Ws1N^_=;~Bxh|xXJ-V`f_ULS!Nh(e1x6iyL)9VsAdz`+LD49y=gC-STI8>ZW_<5!pax<>dUIUhgCn zn#&E1_0oj6EuFA>Pzma$!(0qy=$*Y*+R&SMXN5p*+8KTCxT@Km&UU!{PUN1I6fG$b zKT)+aYVUt+dqDl6DLEF5M>J)vY^ocJWCVAFZ3^W(P@>VV$PUr3HhEF?4f=hwkU$;n zfR6a$B&Ljt_G4npQ#mjfNN0=v{)y5As^}+f%j#^V0sEe9OZ4HACw1Am2No`gi5i2y^dh5fLv!8mWyx{Bh zoWWf;e6(Ncp2^H;PkZ$?3?*+LE=2w1 zD4;9)Q+s7BSmTf1n!1ML-58tV22$|BL?};Q5A6I}2$7_E(?8Np#*DrD+CFWtqS;16 z7yVRMjDpAcc&^{{Ofxnfkz0SSPYN9CMlFgJUm4#eXwd7G0^K)UFRaQOG}SYo{iGD52pq+1*pQ$z&N4xd#H?-~CJn z2y{*cwTvUsuSRK(DLoE!JrlJPM=5IcvgK6tXAD<7c{)clrk@ukc3ai@x8!*bc2CN= zJ4h*myEh)>X3Q8Uw#NZv=Bg&8;}ed1?`Q|&wlB>YqC~qk$TAo0-^juaL9FMv=PE>s zUeUVhg$dHrA0JA5j!J)~Ms~v8*P#>jzGL%yD}&?i=a=EgWxq8wFeM?tTvlda4N zidi&I<-a~(cadeOL)CiB?;GQtQw~l(K93AnDim@AeXEqXXtc%-GLUqYc{vs0bvm6Ow)~%I`6t}GMS`3rUU&7+)noX7JKHJ2D#DU7Rsbp&)#0MRLOa+6elnD(eWHR|?;sw66OBDth}+GY zp?D)8kIV5QR)#%Mv%2!(AmY-CCBEaiHX)d^a)tZac+HEh)VGDi$x3r;!hnce$+4$D z4hdvNS?w_m@&9g0-~qdE1Jqa?^sIiL4XV%^Bdi80z>WroLM3`dN|-=qLUmv7*R!GR zk#rAzSS0SDHjzxHFLnQ;E6S-^U|={~KR9TbT>P&UQJ8M6H`k5$cq$kp{70EGg+Vt* zY=9bK!&OT4UN>m1?1=MBT2tkGd=n;*%{)vdD5CV)sbmj!ME9oI{Wh|GUbMCr)KxZ2 z!%QBDWzR#P77Ovz8!K?M6Frv#svDWV6YlN*F7tnpQ|$lbYtB-G6q%_pt`Oqtqwr1x z^$O=dg1W7aGSKZBD6Ne9g5<^{K`wMaI2%?ufuxwkxI>DC-;ZdP2qk49w>U-@jyw1O z`4MVQ!;#>@3VIYt#E!m#KtIJ3*iB#qy+!liM69Aw@p_K72N8emc?u-&?ODn7kC?kF zE-SNXz$cJ>cO&TevZCPVKj(xTn9Qa&=HkoRfPt7hv;3qEH=t&0s zkr>l)mH${M8*cdKT~J$5@WwA1_pvk3R@thTG{>xNrO#ov@J7=_s5+Wlze(jfRGCWpXuq60Hzr+FK3s4#|havK=FVdaqn z%e$WkS3^*h{#Lm`5TIhtgq#&|rR&>`vdGEYfm<)~T8o+Lqd8mUXzbk%V*Ht$-OoSl zFu7JC-rqjsn#eeoy2Oue(oxJu59fYB#3852axd-!UesG`ke2@h|FLK4+*Ks`&!RNukJA4o-ECOzVI>0!jav*uyC@{0pKo@#9qJL?k%Ck{Ola}fG-=6 z+*M6n6xiK?HljAFlN)7_L%eN$^E4_cOC~F2kwql?O1Btfn^DydU`WAuyQ5& zEjuZ-pb>dR3x2Ui&;S6^tqr+ECfFajs2(edv zntbUISTSjKQn~XavfdDQ&lMjrTK_j|F4rk-+7n^WcX^NsG@Mwjb&#+V+;Dj0|Ge8k zA3dH+mHUvj51H8b>wnY<4g@DR)nQ9U(kEGpv=7`dWhv+g-&$U5N zyM(Z;VR??zQGTN`ZW@A8w3EH-w#W1ZGJYcs3hV`j=7k8=aA7XzMz5(WbpI44$OI6Yo2KakqK{M!B3LcPpMk{#k&1f71YD#hcsn? zvb+XhfbBJd?!Wp}An4~Ha%iru*41>*@e_uHF`XL`soHtd;E+Al5u)moO*-lU%44d~`uC6e1Gs zw%Qgdh6OknNKzItSwwAM!1Y=|a)u&N3SxqRMsvo`6b*g#-%hA@dAc!Nxzt!6`8h0m z?Zw_tI*k;PnOpCpn%ok5ysya*q`jfY15jam28H2ta(loo5r${^0`D9#sH{V-dW-ZG zv)Q&QI)sb7GHYzJ@AN}fEr39gYjw$nL%HvHX;NRC`-dfku%k?mS9EjF`eaZDG2TJl z=^NQ>(5gR{P5D~CBpSBI2aiOYKFU@s&UHBAkwZp(pbFmADZ z+`O&HB^gQ-nw-`vZcKd4Ub+HUm9eEf?DHnb6JIF@ViC(MaJsu34 z@V3Qk=~Ntj+S}TPU0cfoVDMEBRx~he$_Q&QqQg{K)=(QZ{gzn4KiuH;JBenMeY|?u z-WKJ}G)lPtR|6O!ZZm!67D3s;^$SVgu3B#h`ep3&M*%hgtHx$xY#hzJ-sjudIUBd) z5l!tvTMUuM-4t);Q@PWrz_E4Ihe-nS2Hg#X%9uLSP`_D)a(Dpb7Q~JRWo*E>SuE|nd3(O{VL9@ z%$D@uWUFSV_FnLUr7!|0P?wd%c>T8O(lOBCcmJW}0C@r?#7!`tZyK(!dN&BQ|V^>w4hF29H^Qg2PlvhkPwXlI9dd-W9;X3c)D?m*sk z@^Z{LDg5e4kv50n{kw1MaK#eE2}}y23k=i4|9wZknlVg&g-#A2CTNSe|Ad~h6ADY; zriH+_Vgv-Lrv351dKx!8Ts0FF3;D)W;C%DeG`?$G!U;RtHvfxmOO-okK z`}7+iO1J7a>kYBwIXrmApsesj#dYw%NQGIz|E7Z-ZFp(9mNX~a>Nwi9qnG&NnXrYw zPuF%l_yLn9C=78V@ClB{NY4ql^g4mb$aLM_P@VG2&O4E$?oNUU9lACO-oOO160tB= zx6^~{`>N$U$f6JvzC?J&IIeY!fa`ZF zEsX>sq~qXIxp6I=ZzPr`o?U0$#G>^wX6yj!VHcZ4@#exe8;)qIg#lca77~|xG;>z@z!LTJJ5tWaY*m>Rw3-IOM}}jt~%;XYIk#7+9EH(1Znu!5q$;lZuD`ZLJL zZ0#b9^BqfvbXsR+a^%|FJauw8B?CJdS)YflAHM$S!M~;Av9^rke-xe0zUr}docraa zl?M=#0I1s~hB(EJbw5&ku-V8vqZXNlNNIRp!Z4dCH>KU4h*(p>>58d*QO%^8lp9#s z&pZzPc*vhLJ$CC zFnz;^<CKAUwb>6-WwQ*{=4F1W_iJ7DT-gRIEwQ6x|R}aU@uiTfgky4z_EdeX2{2 zhkiJ9n)qSAZLj-C(!xryb-cq(3CgNpT@?3{J6-@axQz@_(h{MWXwzp!+qsswI%Zj| zzV(~oIGtU=jdc-#RV$-#Xd~+`ZTen1tla-Fn^V~0#KE*=3mu<9@JSN^DXHUP;oemR-u;VcVZ%qnq3oLBA zHXjHAUd3m+l}^R;7H{i`Ij zRySnQ&K-WXwQA5Bs8ndQILu45V~`G6SsFxk7IDY*&g)SlP@Go?#n!=g>cq1_do5h#7R zquEYO*O!+gRnGcqdrk7*&@O0aq_I$VuD{J|O-BEHnTf8gb?g??Y&Q0m7d#E`brPPtC%{N#^3lM3`9z_^c$n;eWSkHr08(j^T2&gY zLOc$O-@EIups_Fy@8WlVO_O#E0(z4LAD;VyOWX7$&eUvQCfZrB|IW4|=dsFri ze=pTF`8n~xRnfep<3uWSWEynb-*;w0E#$1*WvV!-Q&iXwi1ou@a6rKb(HX4oYl!g&6az_wH4Tpv&^}3hvtn# za4wKVW#1K5I(%N3{Ozl|{sEGi$-@Z6lRd zQJOS(f#C^+U0-WRQ&RBLn`uZPItd95p%G5G^AjnI%8vqgz&VB94Ftm@5eu0i{R%G7 z0#zLS6E}@jmV@FOwx8t1oPMjsDDD9ft39wh94zan9Na_1=T>FC$-~edZ41R#TdbZ5 zb>r1*Z^3>)ekXHTm|dBMcodvkg{);ilLz~_s(1*Tx-&I@a*uxlPjukrZvgjc82|#z zMl=D?d$SH@e(yOa!Ax32TS-73ySt&AlsYxX>HTY=_9~YIfw9^UEl7F*acJHvJ#PZg z2PyYZAhoz3DT~Q7Y($|OL|ji)zPU6Ban=kxgrOG}o<2LJ*=pL*q#ha})D<~OJscyn zNDwg+66u{-{#O;67X>66PoW|P2v?#LHB!e^8vup%jP5BLHXyQM*Z~zS2JO+DGt##^ zovA#%RwVz(GiwR4S8q}OsiVEfZR{&;_-qXR11<#opgc1_077r0#SG=ld^M-7EGl5n zkzE4MUDUci@q5(9QF{M07Fdy^X-l3K_Hc&Rw{!19wW{tdNyE`YvmN^RT+Xx2$xqUc z;jsb>D)tuF*6qzV^pC2Dxm8h+8UaOUNv>cIhkNg?!(SfYuaL+K*-74$sF@d0h z@Tn^ma<(q=lD=SyCFubE4+E?C4_w=m>vIP&o;K%AI~pSwMex`NgEU{ z`(-|J)v^9f{lU+n?umK{k0W#a_&B&d@|B!SMv(mBmy^eIV=S&Q&T=8nSi42tf2plwKn90h<)y@>`)0_(>Jc z)DpdtJGXfS8w{8fn*Cj*+qYHnKc&#LsOk2)=?9+nsY2O{Gukm0oiUk>BV8AKe(Ju*Q!0#a zq!mw!$xFE&kL{DlZ!*nb<|6A=wi0>O7WX6rumgc7ybHj+(Kv!o&gi7EJC}h9*i^)# znhgZa-VQ=V+CbG6qlkAhrRuAve~l!p6g)ju5+8H_OafP0E`kmEs)c%9E(b z48E?KC2Dxu)o_+q4=jRLiML7hJ@`6lEBvnc;57kuKH^{cbo-INb*MJ6Sa++w!>nK8 zqA_i|fS(V$7}igXpNxvx1JU#tWdd35w!K0E5I2=yka-sJ9zV15=f~5v6c*D6O4PF( z(8rOSI`y`+uUbPpZRF>*sc)$&gEyJ{pSeIaSV6VgHd&cEgooM&t?P@)io~$xjIcvP zRG}S;Pm_`-?r<&|u*Wpaq#u@9Ppp2t>+L18ERwcV|N3ZluPaV)fdq^YS?XkxJ>&L< z7MxvHhU(&Uo4loCen|xB!+Q@p#Z=yUA8Dw?Iqqc7sl0ePXKGUy|ssdE{n(#p{?QqplHK6bGReSdCslZO-gw<3(@iMq+% zbor<^k;JAGDbu`r3iX~^JKbo0_z)25C|&vb#wIHN()H)5((n_5f+E949byIBo!@f8CXTeD zWF(^EISRIa$L0}iScCrZy|$Z_=wndVK27mH6Vz16-2WsoXNv1nGK2=a;m{vqk@m8> zSn;I!RdwrfBalptb~)Y^Z3TCZOpD?+o{&Q40pcMLpTi)&kk<f4nT7F!ZaTjZz0tVR2IWN`|mSpHctQU`Nk zT9NlODcQ0UuaX!}_%l4@{98u1`_eTSHXQR|kK9jw#i@7;cD~iS1*1QGIs^m%Os zx{&K~lp4{z@B#h^LvX^MzxzD}JN=9y_^FCPyv3m$yS$F17OU=v3y!~quJ6zydg3GF z_X&zyXH(SfmLwvPf9Q3zL7zJlDiW5so%s868spsU-h{;EkqzGs&a$mY7q+182ETJs zzSax4%%YrKw88ECL#h=j_tW6;0MwzV$N3q_Z(|(x{zB>U=pSSMMkupT4N7Oam>@?Mer z`c5dcBBlQ}?_Cu$LL$p=t|TX4;p2R`0>k1+qcTuW2J;8Pt{FpAUcUMBqmlycv{LT# zE*mg?mdanc2Q%br4lbO@84b{8a^0l2Ae{`q(zs6aCw=(}VE9Y$2U&gmOH#2+&ZfSt z)l{#sZ{Fs}fjO9f8-H;Ya%=kP)GC=_9MWzN|BhY(D9xq>WeXvBa>>866P;MLPAkEv z#&7caKgWa`R?Q=6*hBGtRmzlZvX=bEuL(C~ET0|;`@K1w5O;}Y76ztPS+Conhh|^x zmNEuJ>;n*{$P-3D=<)Rs9NB5}4pGvK|5o04i~YFz)1Yd@At>VK=O}e(_x4Tx;{nwE zQ1RFiFbiAiB(TLO(_s+mc2==a0mDC}aMDFiR~7Y5yuv|q6pPhIvArW8wUVCmzKoE& z*hq}!9Y!GPQU~Z;?eh3iEV#1ERCW^&$(~(J5JqKa5pmd`PREvx+Sy7jB8hM2_)f3r zMa4(Y{*Y9Wx$#ekeKKvC6T~<4TFNQfz{goh26%wsw4h-oN4Btd1+cil<5+K|b*izc z@Z8!bmnK(4&bEuvp*YsK(L~qlw3tM^4j_YpPVM26k>pJ`zdymU34pPsM#!GD);@Xe zu;LPi9Gh64(^PsaxyML_$AvhE;h$jY5OJ1wRZ=J*4n>OrdiP!?SRPTg%Ce9ln*}9| zx|K_x9HH!%|0aMNU_PN8UQ5ejK$H`NB}Xhj$7`xd1KhN`=Ud>(Cykow^~H@fF_I%HF0#%e03*@THDd zqKC#}qnE*=6gQ_1|I#3QE+-jQ-J*=$D~dipEZL&}3mJ|DMnE~&z#QK`^X`_YN|Tz~ z!WhbC{!&e z8occ0duh!KF=nV=X^Iy5WRq}HSCK^h8}<(N=rJ{V8`XL1b0QR{#Qzf+wmVy6iqxhp zPdiD{pvYzS;Q*5Uofuny3dpImHmvhGTrVs>TFQ#RdNcuR zJJ;SvYcHSG1%ZBBX=xMFf`_wnfc~#G;r9bv`h_g&A+Q`uG_>=9p()r9^fLWNE|xfY z`!zgtT2qf|09$)R`5?0+^T@TlZkOrdJ3QGFLpKrF*88-J>4_o~k6_i?>bH9B%ZlE; z7ygxJaP7o|6}?rO;+sxqEV6r%nweUZ{?+BLEAmg%*f2^YMKQ z{IblW=xczDLGI6MhfkELijDQlYvyfrvLI1Sw%o{D@OVW{Xeca@<<6O1>^$A)C`a56 z6f{^f@_yoc(XJUY9WWRR@Fc&T{jh3w33AuN(D~aWt+9?YsqYO$;k%L+4dSEHnX+%Y za_-`J5aK0b5V`Tv0&A6R@8I#|#DN5}OWJm6$g# z=T!)b206%+nY=r#Nhn4<2}?QvGh0O##PH@Tw%(~JP;vA5JM(!>@S}UaoKe-UN0zxB zf6CjlUmXAa4?i9PeJKvUUqZb<#D~($C^h;dmN~OfYvM%V5h=MOQ5zL$@p-Z0m1!iA zXrp0e{C94r4%i-gCuF(85l{M>ny4JQv1p&UI7A0*xacs-E=@K7Q|3PH@xiXBuHnl5 zIFHMa*4dM%%nL2p8ilSGZv+`Y+c!f|<67}V^od3Mm;w0aj7M?oO+05CcZ$!Ci{bI0 z1wqUNXWo^GVt>XmRQ;76-PU~-J1jA|e`-(c4)w|T zYTd$@+e2>qM=>5x6=a0F;!hv1x}Vg?3wJyya~etfmZlhBnxz$y!b5%KK9cM|oggx* zfJU`wmg#wlDRM~(r67YGUc)Rq(~)>Ju=i8~EtvzXRdj78;X*Y;7LYo-H??9{MpY4ua67~}fK*)cY8Ik{5Nw?1-?c(6E zJv+7dtK>4t>*d$IE(n%QN=nv4AOPWsGw>WCoNy1|74|ybi{!7%R{C#0IX^PyoAmTO z-g8M%93!g-KlxOyxOYPFnGDm{k2SI^ez0Y5#@TgTJME9s6%D;BiDl&fdvo5d<H70cgF$t4eIQ($aH2xsQ3fmVmuTfO72tw( zLujT<%6tufl|77H9vLh83PiId348D3eu}LB=`ZtM=n`=rs|DiWdVJS2qu%?qXgm#z z(P7ZILu^!U5c57I>%JbgDe1o>*(2=#_Mp4Kx1BysTKu7`_**XBz zoXG>@-0{jg60YNQc_ZY!rO+z1hh9!d++)&q2dvQJ? zaB`m;lIhuh*&zjVYDfqkJi8eZ$&Jx^m0?f$MzApi5ZQMd+Eo~6MK$}E^-~QDYHSRD z@mcDvh}m=YAZ~=>$@JH(N_Im@4ZkG-de8csB4xhN`gRv1)Zr6(OafI@q-`HvNF)!W zBFS%SzK5+iZSo_@+2YL_omJgwx5gdM-7^wr6`;o}ta@|9v|FEATR)p{`@NsNhCW$* zeB11;D*WOrp*8zmdONM}_6no}_etNO&V?lBk&~I}VDIQV(#8JHJ%#CG8J@=-=1xsY zgsG2ey}Al-QR}9ynOW>bh*gF*O`Jdu@jt{7ckT^QRnxG6#hm-<&p-c27DYl*wL6XGVH5WP0P`x zEi?2?{19iISZ=xldqDH<_hfUpu4#0jJ$^`XKq-XgUQleLH2UXx&EdX`_9Z@)k#g(f zB^ea>QsgJyyE&29HKKG&-AM6$L*p*}Nx&oB`!N)NT(j7pTDRZuUy2*MX@y{>!|4(8 zpTq6oYEG!-fxZnjIlK2-JyVchBjE@oGs3pLqW|upq^{VS_GvJ@_*SH ziO=*}-fHLkIvd~h?$Xt(L}+KOz%(RTp=n^TRWMHwGvv8-yJxZX>ER_y6b%*V?Lys` zMb5};Y!U;^P)aJ|HBq}9!w}hy_ujqtQdD!D;6GdkS2!ny1%EM9QjFbi#Q!LVC%ySW z_;lBGe$=s0l+J@0qZ`2*p_-e@7}fWZ_!%OlV~1o6>w8%__l5q{Fh^afAubdy?LI9T z$-|_t1)NFrqDXgp895&%K-%3-s;3=2kkhythC|BSc*IVPo@p`QMw6&OjRdy?U(Ypp zNoSAE!G(smUB{%CroKbEFYcn)AxrnaGhj*c3aSrd71QNSfjPfv=L2{- z+#`>F(|WhDXc<65J!m3%JZQRwL*aA(CDD*0v2P)Qm~BNvTYini$6mcNo<;#6MauFJ z=vA-23`SLn@~f%ViEk%D@VD&`O``J@8A37snnI@|r3iBUJ8ybiU=9?cY5z^ej& zPVJ&@6|fRF?UqTy@$;?;xVx6*NYYO@XR+D6^{#BynnWPydPl3-GdF~IilRBhz&>=U z;LJ50JXRCm3dJ6%`{@`pA}>)$scAB$@TXd~BIx`J4f;NT_$EXI@S=jV6=lD=G z(I#Xe4wI#%a7lTWH>Ai1UyT49;pWip;wvJT8;&Y4$hf^;bE{SN@52+HO zu0SoQFuQ_|XL_1NR@EWI=h@2=%6oln13So;jWihP?CZ`({e5{4AFF~_a7a1vn4d;P z^5LD@TABZkrRxra`v3n%!l}$N8b;=w5E*4V`;5DDcZrCMjFhtHStp?~FJzv1cNHa) zh85vtlgQqC@A-TCe1HG@!@b_m@pwL-kLUCGg|l1G=-4Ttle0NB(N`1`^GqKMaLg!j zj=DO1YS-U_aB?!((B*!zPboph{m}ZI<`G!)@dSbt^d)|Sm(#2Cw@L|_KNL~KoeU%{ zLIg5xHp#QqrBOvMZtBaoWhActsDupOBGn()320guu#8%u z+mL;^;Hll8C&E|>2}oTj+^T0sHfzYp7vz%9WL#L*ok4A|!akoGX3hhrUlbK*8mFoE zm3PS)u3wkez>ZM=>@~kxqf&whK8ffHIdoq+91V2GtqxZXN2m=%@EkheywLp5D1B;8 zgAg`Dlq!SwW0=CizW6_nnUM^0)xALhV?O0wU|};I_WaAt@XjkGk%z##L<^AMS6Oxn z@^KEodzfjV^}OzStJSyNQ_En($CN@)=n<}^^`Bp#yMvmr78+J+CEB;zd(H2`qT0{% zC|L=8PISX0BehIc(C^o5vjeB??}RbD)x_c{kMGZ^JybK`s*zZ_GxC@3W{`cC?wbHc zJrqir9n+VJT=E+))|M2Q4?K>peTmp{_gk;uKrG(fuK606=e*fN( zDT>7a^cfGD=s8%)Iyh!@58Am~f?HVHTT94mUTg3-u=thr$Es*|!)F6b=a;OBRnAM+ zDX`__Y#XUw+t7VxkWA(AmKJ(P^Q^#qO7d(W@N(h$sFtmd z(M!IDt#t|8ysy`0sE3d`+YL!_G*U4V`bnun+M-86e5_bCW^BojHWs)bJVwSVxG=S! z9Hv)Wd~@yZ{P_*>ia*5rxCf}v)s%ca9=m#xPCCpVA9xtKX}tMXI{4(H^?Q5$S`mFG zHP`54JrfW0aDl{J3}}suOLvtkLlRZk(JBbVej&*Gl`UB6OA^EK7GzqCt|T4qz6;H# znNlQrHMM1y1!`B9ii`HgN+n6FwM;-h;e(lO^s>SqMh&@`w`o#R==GG$jZY zmCuQ*Ty7v(WOmnkN;;RBY*8-NvlWyB#MN_E5Z6MGJThzy`db@7IJpzoVg|Uw{&f|7 zZjiaBSiEY9qw&m@*4VZ39Z6ACU6n}}IG&GX9R|_=Sz!^!*gm2bnz|?*F%z~or$yF~ z1$e0cYYG$gk6vVG%NTKho4xYNhxqKTuWd4ti=}6Zc90EtsLN*3w?hnU$~|Yj5p9~a z(ToV5pDW@Ysd|K7A*ykX&M7OXs(aXxP7K;x(q+DkW)Bz{xb809BEEd3?%iGxBLs;l z8qg(CY0&Y{rPB+~@u8<8AW{)>h%Ek#Dlgq{TYaEou?lO)?I&H2N4nghr4|h9Tf&3 zc|Hv%MH<-LfiFm^C%z~bOVbDN%H#(W){qonuIA;}Ylg=>T&{9yRa1IjbpRyfp`1o^ zXoSR-t{#3oh%HGx9||K~4>daD!^~&D&x6vMt7tjwuw=#FByxBt2mq-HKED!Sf`Ap& zqMx;?^JKZcaZ=w%tFE4#PS3{8H_!By4E=a`5ElH+XZi2``kz*W##a5v@zO|dJUceP zXh{1d)X{F(fa;K(NaFfDt<@>Vij^S9-7J*11tGBzH@KX>Vfq7_-WO@qS7HDlhXwdg zIyo{pFtD{DzlaEeIrzUyl72~YT{Aux)5fz0;?j~5fic9-b7t?}Jcpjha=iB%ci#=& zv#}NzQm5__0cq!C#}af&sc5Me)pj_z4FgmJ;~ksZQr_8yJY<}3oIjLb;IqWUDpkiEdP;DTr=nHFtOtek}OAA_(E!)=~;3M+no?FNeK154sBKq0RIAa^ltHY z%;{QxN#b6_#3aVpSOvEKF^p6%;6wLY@9XYBMKQNX7`9Z9J^EQbBwEKX-C|QDL1Hl3 zKN(;2S9|JUxVh1rOxNTP-jNjWgk4joy`ZDntQ#HEClPK5Si&e73F|EgQMnff)*%fv zmCOdeaqZRHN<*By_wh6Q$@r1Zx=6E#4f-nAvIB(?gMl~LR`fI$gH_7Bw=(TCH3J~NX$aRGf`qYbjDv(-y=4Yu?)KU>3?u&`%NYd;3?LAipEjnDa!KB>k~P z21sFjcj?GJYToT1%WW8;4DqgZ|JFODMnbm^eAI(|xy{(SlXc#PGhs_=v5xMWH^w1o zCafSa5vOqIm>x-PK>QXDIp-I-tE3P}f-kJAxFX<6oKSaqLUCpLVpi8DhzN?u+M}T% z#p>x;LrTb4Y|1sAb6DOUE`7BtPZ`|#r(*L(3NdF8wUy(pm1K-WDy2t$ineg@9t2*X zqjuBh;zha^ ze06qs`z~Y1YBi4oTD^!d45Ipl3&ubK34%Q-;UVHd0Ywr3lH`f1b4 zRUj;s_%66!%X}=lNNM%-Uz2biPvT7uzM({X<9(DDX?_+eiX=QU;j7`&$y>NR`<6Bx zCL#)ESz<`cP66kDkTAj}ZlT8>+?CZZwaz2!&HmpCj_BOiPm=IOi)Wz}sXld(t@dRu zbL*$kyz1inUy5QbqZx>H8iaP4mPW5)x+^-Qn=zD035pLpwC19o0T}hl?_;Igdj%wT zc0IzU+It5#7kS|B4^RzC8k+9 zLHBE5fM@-o8gW3W?>EsELZn6(ZMs2ejM)!bKmPo7?_tJao6;qX!@i39K_?MP!|EDX zZgH0u@AHQiCZN3aZnd8cPos^cwlB9<5JK z&pd!O`L=;3k)xlok43H|50bbHR3>z^{X(}lgOdDA&|z7mj$B}S*hIxBS|TeK4?+_dWdyc# zhOq!wb>7{C=0oFrsxG%4l2BW2sm>Evq9(cp|6SruUUJ^ z`7jaREd0AP27#Y~+a`VrsX=CbePaWe@WRW4j&KDrr+gsqMm=B16qgv^30$`94{`$n$$v$4LusK)-4zq;p3|=b9^1nX>nrl*g>_ayOsa5NxG@c7ZU7fMYHP%&>yo%W) zVR%#NE)i19D&j zt4L_qCQO)*qVaSb?H^Z3gWt-`RQ3q0SsWyIz?mhna0t0$_!6R&F7qvbO9t4WD-x6; z8Tp{IJ{uM>;ffUG^~lDGXyp0ttM$!~TEu4{5x$VHJtwmg$$!-IQUG!=g z1Jd`^7qq(}C;UK*c!pKKas~g(Gi{Q5C2T)y$ z?nf0k7vFXx?W3r|_H)@9zSCQtP8V-X6g3_wKE884syrsGY&SNX{biY;^;^XV2LPAH z&`2y*_DpO>1eQSMW(%w^ROb}A2#B_ljs8c77$)=J;&0z91Z_PUX~4zgoG5QU^4lc4 zhjYp1OkjBs#EXOLh7d$qrhKHZ7Qy4 zR95tQWIBcJ=FbqIk0cIdV+Rs4U2L)^=0`@h5^-Qlm6LMTk|NJHheF?-7X(<%xOYL$ z4&673Dl~k3X5KVsVZ|%n-~7DY$z|s9H@W6Eb7Eo_i7JYza)Zu;@@+CJ-{L=&|I!xS z_~k5A{bi*~IBLFrd5;sAWk~vZXh#odbS5JYjb-P!>9J=Kj-H)hRq%NFIz8GT`}MVZ zhjshCfxhknH=piq){l~-!xC!q^y3zTo#*!h zJLPB~p&Sa}^8hB_SLMs6>EgB2T)Fpj5Hkc8G0jl(~6||Xp*Q_`A@lZu%0Y4N@k~<4^ z5dvlzn~#EZSCgxX+8GLszs%LK$lTi>jc9*=XS-{fXJ=`s(y4DdrQ#9p>CgR!Se|rK zNMMyuN8y1pR%_fr!`cqH-AZL5s9S?b$zbC&6Z8Ycg5p+vr-80+9!|=06WT00Snn@$ zi{tq}l7h9|Qo>MJc8_Pdjh6VSId!28ISIKNP-5Z()#_N*4U{HKKD6ji-gQ3rhHTkd+A&X->c``?A;d^uBp%L78ol9@;H^$9 zm6=ous0%IH7jKlqQ-PfDhkV(V$|xFq%)%pm&*P}o=Ihk(LDlvo0Cd-z@^%2A+iJ7# z;q{pDlduYA?1wJbhZ_K2h2fN=%F?7RJ<&K`@HobzN3P7-f+ICogAB zhyF6BPrCR0W|>~t zwfz0q~RMw`_}zc*k&N15uZfX+;Ml{8ci$(z zCL_z$t_>;0P|xy z{TMBpx}rXK7;=0v>=K6yj;jpnW%ehK}{o{xQ3J6}U z?ir0D7___A>)ut29h&2%l0}%ZM8{KrofIOxt!Djp5_It>!y4zki6j`4UcIvluv^O0 zH&;6|>CkGeR9v<3OaVy9)5Ynxhn@zXMR=bjQpX`o)o@SJAv2*SG=1_ys~}8wjvJ;6 zC%tLjcwY4R9}^Z|G`+u5goj!-AUKoMJ=`oU8`}Slr^q5BzZN;D7VH+jv!#aRmx)ke zMz^Ix+-5#+y{7jwcY=(vroiILCeu!4i4SAX#aTggun$BW+fqF~uQP;`uPcI|6?y%E zY$JQe9=%>6GJu%4l5+DALBO_ZMS3uQiIhi<_!1?3&`3TeWPDINu3G7?~kSQ<^QqEk-!o?%EXMCOX25vVX z^#)=PG85&cHO`TPGRBjwT>hvb?TVy$g@#h;+}zDK%s~6VtHuLo0V9keKI$`s8mO6J(1%jf9s}cmXH^vhqxQ@qp!nDd9O# z`}Pi3SR8M2ON45kwMc@Ko}_&4s4KXfWXT(u6tev>uGYCgkaUjQfMogP(jizKgsh|A z!kSxMmZxz&+RJ9lFG&ffVeEJ>J_nRt!u;id;+#5InRP zv)d(rCKl)GVd+a)KuP;~StMc9@EUf75~UBY+51y7ZQJkO3|4vAwaBF!26kW!BIEU? zN!aL~_5EOrpviybJY~Z++mhGt&{u|0z2}52cw~c1lI-Y`3iKeKK`=xXqf_-; z7_1-?6CFhnBvLt(idl$M4ruzR;rMTD&h;m2tUcl11CCIzZePjB=0BQFzafB|IRtji zgq-~Fbk9)vya;4mg*}Ts#jgOd4JX-Z)$GG4W{)se_;j&t9ypck?*~oP zsDtbfyC*-b~zicrv-oZEMA-uMA*X6`E6)kVsBm+BhMDYFvP z#eTGRPVxAYUcu;qkXJA8v^3)O;26YPaTHtC_jouvaG_e*>?b^eFcgqnt+LfCNsF_R!7n{S2RGsJptilL{S58LLj#_--a@8VW@8`{hy9n zhQ2qBBe$WiN0vv!4LAOmcI_vcOSzgj{+D*Az(=kFvnjOf#WYt5_69jWLq65(Rp)<_ zdF&diX!HG~MGZ0dBcwlq(fr!b$xB8b4eyb!-`q=eQO&KvhNb9V6rHb!Km%n}#a}s3 zm9^y}NltbSeu415g_R~poS17$!6OZ;-8amhqPDv0uXA4d}GCswaw5XLR;1u$4_tr@Ie)xjz*4LrweWM^e!Km zjQo?%s2jPf6ZWS@!dm6tji28gU{hiF&_c6YwHV&4(r39WBBH^sx9ooP-Dj95)70e- z0yn0SU4`8D$5LF$$*J#(tb)w9P?`nu*Sq1*d-hkl)a6XCrshVT$tz1wMt;nusE3RV z`HH_6#$48&B4}fMQfzLaFwB|AHK3zUikx`>6fjFeO2yx1reCrSg6w}DRn$y-+F08O zW4vwJN`#pRotnKj2l6&f>9v5OsC0fnTW}?tP8G}!m7&LWjm*RqWmJ)a2ASK}^DhHf zV=gaFy)+;*{0#{&Lk5*RV-c$SNm8Rb zR8G&zWhOVGBmjzKGR8V(!c2REOP(LufNErLY4DCoRsx`$NP$4(H(}p`auwvCZZ`vhut_gN5B0{ z=Hc|j^7qrOx-LzDREEoppQi0%B~vO#b}jpCopfY&gnbdc-j~3bZ-?+8nJJ^*+qC(5 zT%z}-XeC@YS-ZLCg(rN|mi3=8aGRn-h&-=V4AjXiYe6Y3!NH_cd>Bc>;=BX}O!sFNa4@8jNTj`I4Q6`^~ z9w!@-;&1M8`I9jy5r7T=8X-G(C9?lQKtbEx*?8JP=6H6b7_+8fy5+gZq^vk&A@CN` zKdUY3BOQhoe9)A8oa4@3Cj=jc9`l)c!|g!_L6`{!Hp6th|OF!Q7cWF~fnFzu$)b7hu z{;3Vx*t5j&?4Lai(Hj@(u`trO#C4wkDiuFxpVjLxB%K2zu zOcZ0`fC_L#HcslA>8k9q8Qy2NeZz6#?e{;B<#oy3tJI=C3)&hTj$kt-b~TsSK|~P; zWiVx&(}EV{WEq`0ux{N{K8rR|FoRecT&I?~L}5OpoDAOy3kP{g6QRV;lB$+H{~{D^ z@H$@^u^po#h#k+>x}(LyY_;otkr|s;1ugQ(;l#y#Q`? zMjOBJn$nVT0+R4=w(l{l;P_o`11s)|JTm$MmBX%!9pMNgWk}(k9am9SF}k+!A8veB z1q+!*S*&-S%LqApaQho#aOVg_v;ONFgLv0JTdbkv?*)P#1Yindx}c22aD`)ND5ijevJ^M;)VU#|u}|&K$>Bs} zAMS^5@6UhLxNlj&X}nxzGR%{7nV%A=MLHwJC4}K1&JPXG4$<<>JxksE;dvCFTxC-c zFTg>05NjibhkuI69@Z4y+9_BjuZ<-|hfyc9JS>Ya&y(E?1p|~n_&&4`n9S^JuiE+Z z`)-K|FopZ|FT-6O_YA)x;R{VIId~1q^=PV`#3LA&>GUb0+SHHEeQW^LNcFHNT2uw? zY{zA>3(qdavOZu?hSBC|b7>lS>#Nd@h)9m+g~r$!+friuqrHL`+sCpqw3hvH0ixPO z5HpWFeFP?OIyvZgb(i-&oiYsTm^bpOd^8yPP@YB>e0i%JMHraXH%ulk2f@mhvo2Mr z1sn`JE&tnDJo=Vh<=Z&nTm1EC;5v-qH=LFHSwZgOq{AoO`*Sg2pem&wq8|TVUxsQL ze!O)4nrr$+ia3-B_RC9F4oQrHaw7+qTF&1%B@$KoWBK_qux0B0zI3M!9hPZ^3oBq4{*!{^T__gcdQlW!&&~P98W1PstO&yJvwvNaRdi z$HtSmt%@H|m{WZuFmQP{L9LfB9!^vO58Z?8yxzIWa2;cK4n$6#^yNrDZG10ik)SiENLwy5 za-uOh^u0tXhxZ5*C$u|Vto;++I~qykLk45ELIzE8md$;R`dcNU7`xIxA+$lB3h10X zW-K!bW8E=3lXO~VTo{H%y`+RoYlQL>@$h_pGEj4@eLqu0##Y!=%)eT=s@nSlIB@+N zzK*nDBH)X<1THXROAT_R@zAC9JeEBdCTwDYdh*{3_Q6h^*^2uCd}L z=)>u+9=%-yv!0KRv-C9Qwz&4~8b0P0;lMp1&VcJW8}#w!-M%MEG{x?V=Pp;Bg&M$j zE*On$1--57QW1;+*dLn0+2^CoIwGAyU&ne7!GJzWn<2mHe%`tjr5%^LE(ORuka^iU zqz?`4GGc0Cn9q@i7uxh#_L|@Bp0`gKS$klt%uEC+BB$!mS#DH%WAHeN<92u}i}V-U zp@Et0rT*cN!;b#$pEsNuO<(TBo#P)`TNnG=GT5A>$@hi1G6|C$M$C8z8KI42#-jMK zw?ezjAgN`a*CR_I%*M51r2tpeY$SRT0?6uY8I+A_S=?RDvruL#?l^p0@qj^Z=KMU? z+4Z?wta*tEthB%90WiAM?VScbxZ!GoYaSH|;UUg{_^^4K9U83@ZQ^{CG@XEqw$buJ zg9eK>kgWp$`Y&IEO}#SYIZFY;E|AksChsf~<;r&(&Qe@g0sauIYj*Y*M|V-k@l3nM zVMiBm8}iY=uXC%!AB_R5izENKKiMyQYFBm9kach;sEYIEVFPaP^T^O^YRTMFub)(H z8Ghb(5!S1CPIL^y3Z1G}6|gMI@B;~ATSi8ASuAM(`(ZIq+cBy5JNF!VIMwz>2)cYN z(gLuCc*?BJql)a2IXva(#iOA9tw<3@@~?754kue_bsBwPz&vy&DEZt!)J&eq2v z_a|rU8Sc;m3NG;VwbxhuC^4Q#V`dQjHx3`$1392i@Aw|8t)aoUYm7->I^!-K^*B%h z^ihOyBJ6jr7FI+sQ?dWn*Tb&_r0xYJ+lY^g2Bb5_pV%p@k%vI_&_6ySk97G|wCG2z zDIBz=vR-Z$p?dsrG`IROIdG}?p4ZZr(%`uXpeG(`@zP6D9~4krO62SkM>)Hg&E{*^ zK!YadP9f-{8!y&3bWmpt-mCd@@lUfB?(4P1pmtxrkg55fw{@IlC~GPJ)nh6i4rsl; z&7IvWXwZP8C>}QS9ZUYx2LAQ-KI4X$xB~h8NIz04((o0;<%Ys{6buZxY~&<<>Oj}= zt`BybHlM7N3FD!^H4CJN%{j8%&t|l&$^Nrc$gw&aO*xTYJnA0D2Rf=0~w> z5|+*0cY78t*1Z<_u?tcy=_jfK@DHDgLpE0_B8B-3Cd4Fz3{{p>xA8V~T;MgP%~EE6 zIZ(Z}b{-f%ppmQr&4Q7&MnleK3oH7)^`2s79@?(OcL2ol_gR$fTXGV$*gzn|i9og_!(9Ej)U50-nHe{}kDpT(8>n z(dJuyF2bnPyf__SC6mi$UX3{Vk}8HKmhv*U%eq<$A9InkDLa>-lcTq?t+(>(S0_L3 ze&pf45M;<#sCpWT!y{c_q+d~{ajZZFEW>Bxi^P7>-fXr&ulso5>k3C5_z)KT7=MEp zP4SS=p0@3O%xA=g10PN^js$Z4iW>2MwEa7N!%HBvyR$JFo?Ua?<4RMYq+nymc(b#_CS+l#ZzO;fBzx&OBmtRaK)BV^e7V0&2*GdSD#cPl6_?-2&FAO96N zcR0~CEZ?eD+263vUv#*eHHSRcF)-kkI#~2VAGH zp{^DqP2=cfvNPlvc(QghGc8uNwLQoR0O;zF-R&I>zoT^bwqoloH~kIKgVq$2Z0KAy zi>@(4+{qM+jij6i4MVyQ_vR4m$^(jju+Ov8%^;c!AmVq*j8NQukx^bLkxCgYhONR|KNHcOD__%FT`d_Yln*l{u$t9c6dXDPCA_*_qx-)gZdsaZGlhrJLR=2+ z)?sz-W^AT?G(}+u>BunF`Kj;1gWA1xFhD?G%|^*@DXEON0q#jXC_}t>j%<*f1NeMD zlChubnRjSA2M8v~)P)&nzo!MG`Q0dVyalU;WxCvI)(+ASxYUFKS&zj1ag5UrH4%R4_KWepEa)g9XN8lEOWA9ezFJn?#aQ)elsEj=d+Cs z;O$x621F&6P(UFRWP%PixpFCsBQI~{?B4YMr*>nIfo;s=KWTE{%8ILa_%7Ll6S|E~ zJHEiv7Nl|-m!9Scyz$Jr4x`k66uw37;1U4`uwonVlmWf!05-}dBZ!r#{Mqv!8>LF^ zHq2YZx&dL))NV?$lEMKk(jspvwGjAPS!d>6%Kak*9rI52&=rSQPCN-oeNz{AgN z_wU9+)+Z~X9XB3Ha@2L%Wd6Db7dFUBp@xg~woKmYhQqd&E7W(7S#c6Xk-?y;@{0Nc z@NQoHWc$fPN@5gfw>RW)JmtgANXRaype5R~By0(Ek)C+q?lBGi&c*cvLO`aG0G(8B zA!Ix?yovl*HqsW(r5{z<;y(6WWg`hlJ~ee_p;sYfX;|2NP%)gOp2uw3UUtlUT{Kv( z$nwq!8Zzhd?HTfEUbcJQNY?rDGo-#49F_z60b{rf`N%gs^$NFtuU|6mtX!PeP?mqP`8VO{V0+QedG5#>Pn{=M8n75kJN&eX1|EF=(9};Rm-_!3eaW62he^BXUKE3*2Xobd% z_8Hv?Hc98`c*nhJL+UTXCi6aRL***-;=)MCCg&iYZaCtXX}e{7vH)TIsd2&kAdb{< z6I=B4fT%a`V-Hz@JPiaX%^ip!3i7qz>P5*aNt|LPMDWzBLw~WrqrFG6IW-c{w5+Gq ztN?%q%TYiD7oQ}^3g(2?W|GoO?%q9zfoW@z##M`xk#qK42hJC;e_=RzJoQ@x0+7@? zFMEzd=+i;8=;M0GW)sjX+O9{(EH?SLfG(p5rasQ4s;Vw@ysJp1u;3y6t0$3(Xd@f1Knx;1P&4h46LLZbFe9h z8DrVw((+PJMWa!A~cL)+r5{ zEjiRP$bx}v%g|I1uA$_!>iFePmB+;I&fA0O)%&x3^!843BJV>E{*BN&a@=rwU=wNb z)i=oF!v4W9Zb!w=W3uPmnS4Y>TBH5&(Y9~M>d)*Nu{sIAgo|nlvFX!Sx8R*#FzNSfg>KqZyy`JtaR?sMgi`ss4<;u?$XgCO>tAe4qy6s_WoFbqg^L= z+{V9gUc9bw(F2YBE%$mcL9yBCOW7Gwv<=@zj`{h|Hn4^qb_<+L&Twh|*vVYcY823X zKNg*~fil}Clg(!#t1*sZ7(FN!l*&=~pU>&q7ao@c1x5W=BYdFS<3ciHpJtmqD#`H> zKjC8`nECeK!dBVDw9nHqe0_l=#HS3)v4XuA_Djh=^83B9NLmBtFpL&IbP=un8GZkb za%f@7Ss!DaGgnBy~yToxQh$Bba!>f)}RrR`1KT!i6d)StGeB?Yg1$88_1WSl z4tJD3f?GIZt$h^9SiSx0TYQSTPrwByowaGD>W#NHM;E_iX-dS3YzW(R1ZE;t5YjAJ zfP_TZQ@iCwYkJ0N)3oVZI~i8+hfM$fT$Ny&agl_K0KFWZYRNg-0uzExzZ1rka3DU) z`AwVF9R?JG1G^BH#5@v*J)s9OT}dWhbzWx{!f2v4<3W#f`(bwIFMLWR>`@$_KRME% z>SD(;o?Jn~eS5Qzd?Asu;_*ya_(nZiAK1v+zZS(y5P3F~nX}X^z`>mXLTbVEUh$fn)*B(8M3eCqr z3qr~Aw(x({nKS5UYmhPe229oq^LTOSRp>5%=feg{`P7{?lIUssd zp6>=d?vp^WoIXd@1Av!8-z3n8%@<`My`8xT7yKRB`0hJD@9UA)=r|Ke_3L7zw~W#8 zCm@B&ADZ3tW$I0;82Rw9aXPxwzN9Vt@Xx=E>%+<#-qVvco-NsL_|!Q9NgS#Q3{trK z762TXzG79L|4{eP`p!TOnir)E=1=A+C0qI_c?R! zlzcs2`sV)q;LqYGgxa`j-$Lm69nNc(MOThRimdgOnaz3`{{obp`$2p%zcw@PR8+ps zu|KG=Cln%^XPu64nR;jj5LQ<%r$+0CbW8m@`LE7Eaxxt6mz;opfm5uRCJ@Jyh=(5L zL&2AlyKJrR)?-$Gtkpf4ge@B-M98LcfPWZPE$!e)EjYS7B~&;N3}gf(p_ zD%;?=Huk5;AFDD=TB)}XCct98Zr^{}Wth9jST@=?UPAgrCxoX^^{N>j=B;}p%7tS< zY_El1Lg(hX3kw5%whg2B?*2}^od04kYBN(Pu$JzlabeT;j?hn{E#t#_b&rIyt>)Aw z%_IjmtP+etF5pX%roS*T=FHj#QZ2Zz)kq-7_UNlZppUx-Zqs&UEcjq&d2qFEK(hGD zpbiOU-zD{S*Wx@zbONHGNZ>S_3PsI9>R))xT&Y;T_3zVx6;5< z@(BSNYktCOmS#g*HC?pCjFm4qBs&fHc#_jG_HzYWPG*P&8 zBqxQdA!Aqx3V0wAL;sC9c_L6HT<_KXVy>sc_sssBnMxJE4mZjuu0B?-i2(GgD;iH{ z0sZP^GqH2bzAuGmH$k(66{$$E&RBe6uFn;l(*X<1WDyhi8FIY|{foqZ zJ2Zw($aH(&jg z-los5{LgL zq=RVC7dG>!Fw*>yLCmqINIOBF|6aLA!|N2q<&lbonks9xe-)31H|ri%3|ZnC$``C+ z;$nK1V20pe;LIBK>f=Od#{$IP68%`?l`IBBi|=Nd1#HIsN$qO2J;PNNvaZKfjTMdm zqb8ALI*wfSbOs1A6VazGV`?_Yg)!g1wAP>k3%kfpVfZ)8bC!Hq*VPh}J3p(ZA%CGc zvQ1Ak3^M3;gGe=lxOPzWNt&Sam!N+~T&ki#Kz+xvAiRv`C4K&X`C+QY=TEmvS@xJ= z3Mx-V>tdz9&5lb}`E@#eia0I2E`Rjh1IHPrSROKE$uZ<}!U(NdxvwCoyZy;LsUSVG zF;!4aa{Vjm@2iQxtWx!q&EtcCzU7eVG^ebf_2wx4fZ1i>etgLBNJ#vvcg+vjmqps% zKc_1{DE%z`{l7LT;-+2hmu9mT5$fZF#I82o#Y#ccCg%$?yGdF!N+5f7n)4Nz*Elov z-=&vo;?v6G@8jGP|KDV;0>f+_xoywMO+PxFFbjerk&Nb>-&P$}Ov4_FVlq;e!LRRm z=Vi~wt*6Nbkf^1oIVJ+rk>2%4T`V3H{|ZrJV}S?p^ZmB(e8L93k}fv}L6XS`O(t*v zDHN$YF}gTPOhq;WeGzM%YwXC}8nH=RAqf6%oJVRh1&^#e&A}dgr1c31V>&3$EX;tK z1hIZPb+xR_y4<u$q+20qL;L)38@X|nCnJHz?+o{vH8W~U<+*Ip1e zzZhzYcNc}4wjrz{SV5q?4|-7D{oTS|(Y>7XIOW0*=_S$miK!5?8^S!Q^%m7a#M4`3?#OHw!-!i#=FhP7hj;2)GeirWMj&iyH%O!Mfj%bvIO^~3}drgjF8koR?K?A>2*`V=sTVb&7g(BnewT~~N z!$8bfx8-#vA{>yr!y^5t4msfxlupj85NlD)-*G^F9i5QGDJ%waR7ASacg21ya&x2d z7)J_{uYQ>IJlTwlm8o1$Y$^V_n%fd<)#(3NYae6IiAghVX3or~&#$_*^x!^>z$ly6 z!P%xVmlQxVg%Zn4wnZ})ihKjQV!^+-*r26Q0W-+&RKV^)g+2n=oc4XP+eq*IOR^&x z|5etyV77N>h3glL(_#kGWAbNTh!Z%Xz}SrT6+MPjWIxAS4?WcThnf@jW=V8rdy@s) z0@0e-{JTS^bDP5H9uef*LJ)EIx<(GytcbP9Q%>-XFt`#nRGGxBSDWwZ zzwbPJF2+yu5oZsGCa%$MCJ;GTprp@Y-+Fn zpX+}J<;ux{_%0zx-0`J{Bq7k`RSb53L}f9OA$GEQ^mxK30GU+UMY@cqy5_CBETH2c zZ#!k|Gp~x}_E;oup=rBN`mS#hGcZsw_ycF#H}1*i{*3Uh8HU_jM*peAA`&*7NMF_17lfA+%S=A&d%q_%kCqIbX)7$f&>m zpWB9lNttw&WUj2)=pxsh$slcSvmBq(^6dL>49hJU>p3mXU{?;)S`)Q=YB=P~ZD>|_ zS^x*MUytwu5yTc$_CSmG%6vp*&vMkp9V9CjPP!@~u8R4A()-GllqG~&gW-T#yIW#I zl6YvnX2Hse=NK7KusNkb>)u?O@qzfl8Zpc?l&e+w_x?1b$Y)7Raq08iyTnY0RPVGl z$jD&$yb>KQzvhnuATg+`;E=8ma~+s-3nym{-;$l*^l03v``_oO0ZpQ4EYMYThNSgD z&g@S$TunwK?iVkiMNyQzi%0M#qZz&GdbP+_-wO*|Tl#5km`z^mmm^@FGiFnQ7|mQZ zfd8q30TV2j)_&D#lg=6#e{In&c!q42o%4s0dP2RFvewH?`-9NZijG1?w|u~1D23}P zLSBh6hv(pqIt)%+_a=WPAI3fH5YKM=#=#73fNPa=s-<0sk5B#_(LPH^>?&vq2-*&X zXcdfds_f?E_(1Z_R03vf-88x`vn(DZ2&DXfAY}nJF&5Ta_^9?q+N}v=^E9t8ga46S zo%5hwvy7;DSHN8grC#EgeDZTGFM&1r!Dd2xvOMZQ@DwRWS*T%{@_Mc+*ckH78IU~i z$XZKWBop{ozN8Rl9g6cmhj})w&VX=vht^YcWI&&)Ba;RBvA|G;DpWiI`aHdUj-XYf z`lUHaEA8TJeUKK+@hVEJ5aTdR%`;0$j>+$8*yVr{1`3!`OG_G^N{yn$)TIat+otS-DLQo2{n-Fq>qq z@&^o@Q1iTOYN73~S4DQLgb*gM{66^>=6`FSc1&3XGWl;Q_FithpRonV;+P2trrz0I zKe^v$Dc}8|jOkrwg*k=@5v&m}A?p9w`p&SXwykT5v`8l)ARwJ27K(_{JA_cuHY#`o zEJzU)L69z0q_;$xl#m3H96&^DNEbw6p(~)$k!GQH@Y{IKz4yG&cYfu0_{G|5t-0nL zbBr;KMfYJQNu}LqMK~}4orI8|mT{*KNSNQvT>V4Tbkyd_)s9HY5dfl5l4~2bV7aSg50#IT*p{ zUr+T)X%986L;qS2*vh&FA(+r+S23Z6(i9`xztQn()?=NZuNF6G^>Fzr_wZQM@+NC^ z_hyO42e{sl8ErzW;Z;|`#wFc61(8e{5e7)WYKv2gf$#w;Di-nr#PU{EaJU57Q_osOduK6CPHM1}T!w~ONP_ClH~P&4Dv*Xrvo-p~FNa`9TKc-xeX3+l1;g&Km74G9a* zJLDk_2D|fHa@B1ul>gm*-D4;E3WAGZX={yJrJ^*2#W6gjCdp>1Hs6-%yq=yADW#Fnb_Dd?Xb-bOXmYyqFv%q2F*C#DpZ=2+>6G@ydvl zbivQ_q2j+^Qn1*^_;EzZijLEBf8|Qw3RzJCyvVZ}2Z_fe&xb^GS(u9zycC@-N>kf^ zjaeI8T`rg192Et3bZdlq&`lMoV#Xl)?6NU8eN;#Q)P+>lg=c7(sC(dW${*xR{N9Dw zonDyx!ukXLA`*4L#1&L>A0OmmKew&i#+iFQeB2ak6MQzYupyEuf^PR>TvW4{Au>}* zz9EGz@vTxA?HLh@9ub-B>x_DnrKfUqy4~-Lu?dxolUz2tK#(@F3c-sj(ST;M+N>TG z*K#-(Kvh}OQ{Y>{p`M4FIc;+2z4xO1PC4nQagoP|ST^qb-Of47n#fjgA0>!*;~#k7 zupp(8O%7PnEq?2l9$N4-(;H~M+(!zU(eP~#sE~^k;-KQHD|AVVNyQ1DF&4%ci6bow z=f<8GOQ3~JL`UHY;J-`j&Rzzc%8x0Zhme?kV=5e!Pn%mdKj12P5MLXIZ@5@Gz>3bA{wx2Amd)rBoI{S9H28Cf2dT^Ajpr-Vc5HzX05 z?7fVzO^YGy4W`BwZW=t{3z0y+Ic?+`+$mEA^MDfvKXTV#%u|E3$WQ7PL|EF?s9~@I zL^Y861{#e#YE_MkOcbiA4DPsvg$t?Ke?BI9Yu=R(@RH@p&_x(b z%gvH+cwznC-<^WrKhsAz#P~_GP6zvzKsn7zE}VAH9*L1JxlUCw?n!EgwnL#sgH#N{ z&J$vlwfJ)d^cbm<0ZEZ;%Q50i;M4+C60CG6AfZ`V-xQSo1|OMl^InLyXc$!{q0THU zwIiQ$P!8s9;q-_X@Rv%t9tAQpZHbT)FC_Djg(xRxV+NmiZa#D*VH0^y+AVjE;8?r$(}InH}aM+Mx{FP+SFJ z9z_KZH>|AmJbUW3J^r>?`QN)SKun>fm>S)ey3O+Q*2QMfI}^i2@_^Kn`VaQR|uODTjYI78Vc~oVI6TO*Uk0d zso>x#FqK_Eg<@-Ob9*z9+Ph-t3pT-Bf{dY=Q7`_! zX`Xh|$>A}#W;}UZL}B6XSm`Uf6f^cOct<_rLpx$iiHYMzR64*7j!7xP&D_U5MnP|4BY6NK_i4=|u2@PTIQ0CTENwCgg)+p{xvyYiLNHpL{m6xtwId{FT?4topf>eSW2N$1Wm;V3HV zs89mxI)@Joj@@zzF#5jOGY$vg8c+|{HRdJ{Na&ro)`Y({M?j+sXY&?0@sbGF8&*NG zbTwh(L3vT_F8*Ab5L0bj{kUytyT;Gtg4)lR3>8pranJU`ZKf^l%K2ZkW%#=cCTCt^ z%u-zhY5J5pmmVsSQcEMS+DL4z7vF@xIG=!_L#^m)C|&%^TYB|M|5@U1)}D1FzwBO# z9n093+;O~21{vt{8tFoV^;5U?cJ4iUBFvCQnlC_mk+iW-3KBCHLp3=Y9)OV=L|VCl-{ZLJf+bH}A!2c-)F5t32gN(3*De z$#l*7d{;%DltEnFd&Do67z@07`-tP%!#MLhWF?!Ksp*vVy#F}urw0h$yRT#DU1fyHvS6F!YpA+ePy zMk?P%nxoD1IEHD$2+PFbq31B=umF~R!Uv2ThhSTerj@vC)vQBJ* z93QO&&>%HbmdJ^YOh(9Gw>637WK_34xKZsUb8p_SY-~yvH2z8{v=yfD9u0q)oh~E9 zcq<%!x3uUk_^3&L$<`M=xfVM{_ffNtK}nzVd>80XVA&5Z!N6|AyMMi8pz_1Q)e3dsMZbk;`eEK|2qG!X(@(+!sF77hdALg- zOsHJo+uy2V&Vx(SW-hq|?^M6qvVsIJo$aZG(_dXGLLL%ZfGPn@M7VK`CrI6^d=NRi ze5wWQAxs0-z*#FSIIIcP%2K6k8d8AL*|MppBN_=!hpDAF146rRQoe@A+Sf))>iuF@ z+md!cPEpPxm@$I-OFOkEhyeQoT@*5?$^NZN#|ho_oU-jEH+!XdAr6+C24F6K(;^V zrFZ5nz^|qhLOt@?>I>CG#X}i-XwqP)IqUulHdcToI-?)!kavxfc)*l3!-P5E;GzXR zTBQ2`Mw0&uyNo#-A;8p#FdLm_6<4zODK!rh$!LD-H$DDI+2Ys>f*}!ip?68w%{S>^ zw?`P<9x%2)>q39u?K${V(J$+m>X-L)K##+jqKwf#voJS&@}pFIr02*;**B7oj=rxK zLp!BMknt7~{xA~Zz3?*WCOfJ7f_K{GWl#t4XNT%&MUBAgKhjcn&K9JSj!`2%w5H#I`QOoi zm3_Bq_j{0kWMJ*wnAVkGDkv_AL@m^DJng-jh1me=>8TW=M#;_cY&3ww;HsaC1; zz^{pZmZY9b(Kw5m>X<_n!*M%d3gaSONOISbL+N(#rk5A0Jsa#6+$B}cE85Lo2w+lv z9Bs^J^DXR6qg54U-poI(L9@A9;DSLGSEk9o12a#vrleL0YAhB>%{A}N{~a%dlQcHS z_w^v@0Qk7tQXADDYfA>a`0b|HL=cE@96p|T{chr|zifN|Z$2pr=97pgSo zmG3O#N_Q?3qKNBH#$=t~)8k9m#|~f2s!F5z>-Usg(B2==H!q!f zJ^nxNAecu*zQ+|Uaf5dXe99n{?vtB!1cxF1teVU~{%f;M{6;d(0lkhOH`1;50n!b2 zgZW_$9x5YOSC@6LE-gidgQCL80P%xU%KA>t9kmJ0pc=qy!TK|vlbv`tocXmNVS%9S z4_P3{T}Qa$Z(cA+Jdg4oARl*67mm$09(5Ac?~=IAD{4~+X!ce~sB+q$5{3*Al1PfC zz{SuEfj953dSiFhAb;Q_(1d=Q`&dVDrA9(;R#qM+UW5wxc{da^g6d}=3o1(|pv;kA z04xJMul3YBh#Sw~9A6OjW!dmDUWdBXfd(P}#S!)@Z&MD00$6VUjwZbK5gZ2gCpVk; zF4KX=E51uJU#^_nPFZEiLoGm0VDkHq4?q3gz$$rzeur!mGjy{ERu1>PD7Cqf`;}f6 z2^lX1I}>OvS5AC=09^`5V1t$EBMAqhJtbTbPt zm7ote>iN59oxohMsRVtd_=e*ysRkhZ1V~Be;Yl;x)u-qX{*!MK-0lBus~C#E zx5^&OA1fcB5lI!4eTx*z-M5s9QVuP|`j9M=TGw%egyIG0ao|}SG6K0+k!u3-b zY$ruIY=wgt$L(-PLaf1P1+PO!AoN;I8gxtCCO9{`_z6VK2CVV2Ju(M{(Ah+%3ZR@y7b; zCt8&Ys^};WT3SwG#)6%Qw%8oa8CB?cnQi3n<*CR=V!9T|FW`9!Bqeo4`9MPO2N2DX zFQKcc*+-z-kqCn21{*EICsP0v3n;S}?Ym_%wvXcj)Jnp$#kNHLaHBAAR3`XT z7viVSxX=CT#Zvq4#qw2@c4hX{DD0i~O7AT5W?U84py0GFc6%3#&4-VSXtj>p7SxDk zT0;jr+WhJ&-8)RXANu_Z`GmhsP!zrF3_>NNDxGGuIboV+lIkI>vflwBXD1mb`VcM> z(Yzs+2^+yOjx$9p=z5TO!V_2Y8!$8|x#k^E1e&Fk&QYY0h-<@3rQkiHxYLV)*-82d z?K^Q(s94}%(~JU)y$6{gN*SD~w$9=IZDd^A-@9qCR5=ya23lahf9PiV(qOgt66#!S zfB#jPEiEk*OF`1$q2B3_!UshKDFhDD3U57B9Lc7w^r_+~{X3sX0XY5lmso?4589O% zz;gFBPV_g=^e<;&qK^J+iY95Sh}DAHn3v5g{#4B0cuy~w@2JAwLM7+s-1_^fpG zheH}+mdJ=fO^#sSMY{){AW0ebYl3o{NikPhB02_!)vI-$;nB^IzTb8}DLXQdk-@&g}dW-(poTCY*D&y)s@aP-`mNCeAc&_V)JO3itSA+q&$uyE% z1doO+rQm{4U(13>)$$=NQJv4%4zn|apMLzeg8QD}9xTrGiYS8P2&Ogq ziL%i9EzI4CVz?O|d#*tmi+av|?E9dj1-`3mbcvarEzkkyU6b3d-2v9&q?>p)(en-0 zy+Z%sy-*}6(P2h*iz=@KwAGl|m1qqbOFoAvo0ffOJ{Q&6Ohyjf_ zJ{+DjvN>0JdP^Ys6SEK#S-xM^UZsBDqW*8K?cdoW<}gQ1B&H9sR|5QSYH&1RT&u$J ze4fy>9c9%h82m8(cxCNG%Ie!_e-!VDNX9<)zWH`gBQB!Ah(wGRNE&Ku1o)nHe4;v6 zP&E#JaUE3&*Uj!8r21mue5q_KN;a5vj}@~Zd4=G!;h~CMlup|NVZ}&>fg*Dsd2xZp zNGA}yozgHtt3QHpblz+fjZmJN8UezTiz?U>g&a)ZY%AgVo&RNvVwG%1_ugU+CF*#n z%L8X4@^G^aS^iy^W+n=x$6O}sR6iz3$K8n3d+f6^OwXnfBw8?@tRLg7HqK?-yh(59 zAQ*w_`RWGrwS_#HANeu{I>{03Sjj^}7E$LE11U&9M zVw}j71Uvb}67!sQSb{3uKYR=tl>{?DPy^Ip=~BeQDyW;^Ssj?_5xO36wa*I9UVCth z|KrD(Ca1{rc*j4`UwFMgXa0c`&d8{G2l^tU!#G$_()U*NFXVTZwH$EI0$~w$cgM&6 zObw}f2x-bi0Z=oi`&%>jH`o}t3hPwbE1R9FnW||F(exQFGA@E>lK=z&E_cS@pALw= z!b`CCMGiEX-Z0wiOb6eyD2$c$I-Cax=S2J&f_iAjQ3>zUbY;a~dqK$A3l@+fmsjtK zn3rswMqWep3a$?&kdC~WvNtYXeh&j}bgPk*UZ3Br{+OWyRi9Oh-{h!Ry-u5Dh>AL*g*=yhBo3bxFp#&%=~A4c>vz&xL25fF(2{-d$d;*k(^Iw z$*8&j>v6T$Q))xcY;Gah?0fWMSwRO|gggLhoGot`@}ozq!a(ahi|M=LowoJxOb-Oq zCg&Tj_i!HtcSlYRuAj8Xg7KEM4v?7~vzuKEiaM2J;3r<(0(V3cvU_#OH%GC}^0Dt> zM*uWI$Mif7^XK6o@qvEpEip^7WT-6Il10{TeD0XyOyD)c4PxMj9uNeGAX#|C+yUV_ zYPb7>a`nod|Id5UZ1I^(;s5P$Mu@uSv3)V6)wEb}On62bffd)|4;HSMPRH09`xW*M z->T+nB#7s%!=E=?zaGHT0KNdc(gkvypa<#C-@I|Mm|Fjk#rUWm4d`7Qb)0z;*%Uj&7`!1ct)N&NyWeZrZ|YO$*D2h4k9 ztSk`MooFoxk1%Vb7Y8F=EeY z<=SBP^^#DfZ@@-ZA7>8c@ptok4cY&@VKvCedm;>kH*lVf&c*`{>Ubb#c;oE;gF6Xk zC8}@DcLuMJBxu<;tRmeJEi|=Al#^x3$zo+B2TBPU1dQO*tcofF<-aMYI z`}oXsi$18Ge*6es_8~4X;j66&zLO&lcf6$cw87Erj5?e#5;cmo5T3Lw1P1XPIiGnE z4M!1z7D0Bg0d%_q`_8Lx_r}ch9HbQsGBhJmmnm2IfKpI2*|Zt9ARNv@&HW131g-cE zlDlF-V@ZW&H^+dsDX9D0-;`wH9qv|1 zGJRm5tmuH4m7KE14aM)<%%g6$rXjTf!VNk{k=xL^piRv3g~u+ayX^H<|GLxhe_>b$ zB||P$CZpWw-JKNqWAK$fnoBgA@UO%S!`SRABT-pKeK*nOoQUq>xF2+Jbn?mZ(mSv0 z%oQ^Ash|n@xkK;ry0w@aKeI+m&iG{1lE`cJr1$DtI%edx#l!xo&;NZ^= z*S_?YcyJ)>*k)~jTI{>j??K7q*Z)sLDG}-}42F~(?=!JA+h%bt(x5$B_uR)WErw}l zr<qOZoukONKantsj;XlKnI%$7Qc6sBqJggsfOD@uNeDE<6_uIPojl&cX1KO3zY zgK|y6?F0Le2yQ94x|xz@i{iK5!D4OzrnErKmc9$qPi4N!n>&viSk*sB1P6~vuKA=@ z``y(~W$&P_>VIxAFo?n8Ig1T}c^1{)oCMGpTvsMu(D z;5=`hiK;_~CJqi$v#L)V;@iOfuTutw%~Uq94nx{YQw4vs@)P{mP@%VzVN=M$UX%U#M>2`?Fe98R2848iJhKp>FJ86_ zmVlWA$9m~zXgz+`?uV-ZScp+>>SfHVht|fI$Zyn@Cd_5Hy($kn3vcB7pB<&M!S`@g ze=SBzip}-dWTqst4|IQor!np(LpFDrycE!x+vfIg3g_9E9c+{p^<0Qa`^olg;%3r01)!*1^iJiiuOH{o&e!Gd|k0q`1O=iH!*C^{uNHJEAx zpiFR*;*-s%5Y=?|5}OKY2yDvx+_OxNGis@e)ySDNLT~-l3=u~I9=kvU6WlEhCt`xY zJH3AQS}+@IMJ-qe`w9F&$2ej@|DDiAXq5qqO1XootbV-wJ-H$2f3G0uRR9!y*-N;* z$c)Hj#*?~msxhPaH*mGJ)oBU>Ai+mDK|1UZXw11g^z?n$ywiBzbsOoS25CNEVAlYz zsWS$z^G~Q=aSh&FE`fKyQ_(GfVBiUq%Q94-gDTaL>^43nBefl8&fK!8&wFss626CQ zZ{X?OP0-DNqO_6t{uYAbg?$J+S}2H8rTbVY*{w?GrHg4~Fu$VWb>C_(tl7<+Z?A<~O}K%B6#v(urb0l$$tT*ZI~gKC8RRgY-W}g~bu6_DqCyNh-;e@k zFV8=AG?r-mfO8|C)|BomXclXz*Y^tx$=d@%05%L1cITak?=0*H zI2GnevYHUZX}O7Oe3pr84!K+MYXna8#v}N-!-ZVgxH?<`5@j8-7@7N_5VXd5a~Xci zeGIGC@J^HeUA&s#%%cHvX-c$TV-dwTYe;0pT2N6bdB-me7R%1wVSWLU%_t@c(4o+3 zQ$9Tt4j#~JdnTgzb@=?p+bg%7ZVZ@*w=H6S|E=1YH3y?kVJJ`>ha;fNMP05jo^qBYQ%|u$RdD?R zu#a*6_AqGpjWg1br18Jy2RU{7wE9}`{bMIj_#VkK>JzYD*Z1l8uKV=5j&{Iy==k#1 z&-%rtkg1`ttJl7MdtGzljYXSEE+^P@11Cet^p<^Ac~M&QNC02zer}i)DWMJw6PP7q zr@`@B&C2yG2=hO1&=IJdmKf&Jfc?b5PrenC4$M)kP9h=88Z`os0@FNCg>1HpC@%yk zg|y&lCKNA_&!7)TsFQI0P^#5gg+o>t}=I@*2+?Ac6)zj(C2I@tGgi zRizi#2>fWccbFo#^Z?;Wo~o@uDjRq=!4Ak77AuEr-Y>2b$6GATQUw_21jzTFx`hli zi^0K8^74;K(EK_Ao_Ps!mh0J#mNeSk{+4S7?L!J$LN@WuF1Cf{|u6c=bb?m<7h+*g?g*wGQq@I>SBAp@hz8%`UkIHaY%5y2^Fyh$Ij(2PtOT^dvAym5%800p z5n>k|0kdPKBrW#`{k4(kDE%(R+HepFl?}H>TGEGJZawiH z2>jyzF(v8b))wXF%|m+Tx?8|pZ{)6nxNsh*%}1-n+J+*Ci#M%2a*~o?3NH8R*)(f( z56#EV$JpqqDEk4A0QJPy5^M( z)JaH$UK4a)B%U^+EPsHn09A%>HsUDv-g9tC*HF?86AqbKc;d)KX0h^+T!Us2&ZeS8 z0t@`DB2Uq>VZL(kbz3|cx;=fDV)jO57u)v_anEmVOk@hi2o2h6t5dp77^}jFA1nJu z0M5O7kK^(BcdX;~Y6rj6U5i&nqL0@HKnMC02A~Q@>DExt+VKv(o#v&v4`mLIFK$$Q zy511IyhfdwE(n~RA6Xu4>eY$$4y*S{I8{P1sFw#4gvDtqg36IcHNqIzhHk3V1kDJc z272d=8oq3QGe$zXB7xTqI88^$20Og-Xta4VISmsV2^LNPJ%m_WRu6Ed*u{L42)sP0 zN=RkdxT`sWH1^(DBo$ntmrG0Afn1~>MC*+iZeB%bhdxq>7YVU21GZD2DhzF|EB`YE z2bFIA^1$c0w!I7Vw47BxtOR=>V!3T7H1}%>G4xNyo*(D3)OC2)M zRSU|(b}S=)r=`9{IZ10YArGbpSI&J@?HOLfDSYWYv1vS4_@wKBKj^!n2S}I@m)9J)Mazcctk>HmX6)FB z${;smT~HisOxq@<+9ahqg|>@k{SnXynoff4zRX<%ZRsxu(AYWPQK@P(I2|?t*J-ci z%8s|HhH5R)T@r9`k&Nz4G4?C*zf7MI>W2RK(>DfWFs%0l6I&F-dyP&eIucB%Ea*v2 zyyg|=`x2H??mtu4fn=kLcN|NLEVeL@WCJ1e6j;OtbOj^9O=Q=R3(J78Cq-?w=&ns* zl@p=U@H9dT+2#15jD%li3Xaz4(Ctq~+j%6F%>(9^wJQs@|EJUE#^JR$8r46|v$W@! ztB$M>*6=KA+Q*gs$u`3c&q=nnXgbJE!OY2mHlC0BrVC8Y5FaF?ENL2nOmYKS9rNz5 znWx7w(i!*W^X_HMCkoSEadsJT1bT*sdhzaFmqOHp7lO8RZFu+msIT=mo9bcLAqpU- zkPro@#d;w4vq5pie&V7zPN%WhgowMs#*)R=U=j)hUl_;wT+(TE>6XXxD^gcb5;Vet zODK$x=J&fMRm+{W%#xzjCcK1}>nr@UdsIGrC3`Vo*{CvO ziJ=VYVP)Dy1%#$V`wOkGbj|BghRY3|$5StHIEeX9-WGau)as5UeJb{4>7AV6yPGRn#~8uRpF<)cw}+PnBKBF0 z9;$62H!3N~!7rqn$i#x*B5&Vrd6kN!^umX>lkNY6%JM})Wg6JPcO%a_e0n`YfhYp@ z{j|{Fo%?A_V;ai^B80wr-E+F_D`$2|Z&y9ho;L_A0K=~b#^0&?dj&G@ltSkSDtQ_ACPaR4ZyqYeToQ5i%mVGLRTDBg zGnO0j6W<16j?7d{mv9J<-fra@Q9j(|8-Acp-TS;eku3@eUk>F zffZjL`kHzbNs6$}yxXmh z?6MNiPDu%baNGav)Z|SLK{Vsv_0rv2KERXi>lmnPlmI=Tz!67>s-v)J@=GGpw@j{D zHp%a(-uUuVb1k=Bw9f5ufGY zRB$a4TsYmdCu@1`d*zI;wWg}|r|P@O$+$;Ov3dv-94>~yB(peJBT*e>VMV3Qy9>?+ z|9TQc7_0p>Mhq}1gphUgmIpc)4op*K4UinkA=-C_EI3vfV_FO`PMkJ4zeX0&RH(b2 zsuan5)GELWyh~b+zhb1by4DqOvk@Pivuhw^2;v?=WANwYst%W6_9JSo`A+mkBLG!xyn#^bb#8Y;i z8m>ix59=*)w(h=%@6vOxMFSAhq8bKlN?g_hKsfHj)D0d(Q;T3TTFP6+qkAMP&xJgx zM+a$DtTU2&{-;OaUBhm-&?J9I)@<~zZq0`v3a<2Y5%l$oMY*o?Y&^IUpEg03cmL8Q z8tkZ4kK7FSZ1am;@Y&N37i)O=m0cQY_-cd1xI%U^ZhrmBPV2E8ORK0nBq5+4^tEs` zP>aXBE){GW`3 zSdo?oSZCrojYNeQ7B*xs8rj}|n4&E+lVe!S8egs;2t zn%6d$nO!2UM&vx^&PL|6P#%W<7#U zwHUS)WpI<@=GJl&jF5d{b>X~pO&YVq)W4c56o2Y6yZtwk=js|L!@bFgNKe0JSCqg9 zM3mkk>>4B$Hs4%+UEKMN9NDF*W_FKr{Q(lhnyc&v1_-_H4m_eC$woP#*lb|J4}Ao_ z-zH_9vf9057=60xDPi;Ow0Do=q+w1DXqcu0=w#l#|2*z;#*kLIZK_vx)s@`Kol0YjYT~~SbXE#jzHsI$pF1Fq^hbIxkdJ>2FyzY{{NQc}4q>n} zy6ucf9RAfYlxO(q#vdE`>$eBT@2(0wQTQwru)cQVX3~rAH{Oh&R+WiUc_l5aZy4zD z_=WA!UX%2r*NUF0vYZs$XPhP*Fml0p=%s?O&+vg8nXq_ycm@mnUAtb63c7;$_{+Jq z`smm7`A?m`)YuQ7vuAA2htvca^%CfeY>*ROsuC71pB0lnq=t+QistTTtXQY+?@mO+};+*a{AU0HAP%qnXE?gQP< zix~k=v~@3f*BK{w@HuNpilZXdVyC(JqtdUIXT}j1r7Vh~i(gJiw~3WW#w&^Go+>)y z1QzaFBE!kPh5V!n5oCH`9`sRdA)Br9f14a%FQC-hby^bJl{GR zA}@BBmOi;Hj69)1VTv%cKWyrUZf)|b*|r`vr$sm@@$@xnG1y3hHT7?vkWkzFdcmtB z6_2Mo^aYa_μ5d|9Ei$ZuqUeKAx>O0wxQ&yZ2Km2&q;E zmL6i0dFXc(0NmV1BU+Jg<%3Lw09~fWzs~ei_^05SFZK2MeG!(eM$sRCW@mP_$e%1-UlF=(bQ3Dr!4L zYMcj{LgH4a9`TV~)AZRB-lLccc=f!CE(r_C!r5c}B=(cj8$!F^ zd#@`ZPTWT{3Q5_z46{S^v+ZjqPh0nQ0H!n(8Byyln$s`Q=`5!IV1a1+_m-`VP3w*| zkJ$rH6(KrGZUCMt<8w*#GY}D(x7Wl#5ynR&FAE;Zcld+wAVdk#I&!Dledt z`c1b9wSD?@ic$10T`46@dSn7y_l@8qD9bkYo0S&N+?NRA1)U5aX(&W&G+vh`%gv~=kKlDzsew=g-4ie|cxjyakjhFnyL;QrbOsrA}@St=X zYmjQ9NDU+y;~0R%k1KI~`nJPgPMu2k7l{_EiUK0l2nu+DT04~1!3zG2L`7X!I_ zI+4C}&9R}O;+?uiSi<9Qc9Y*L4xU>2VCl zN|;tS>dcSoW_(4Nz^ksirEJ5%kftb^C5rR@evYt|?7#;5iW9$FK!;HEKxlq5u6T31yS4c zjvfT}?tHt`TXJA~!Ga~|IWGq{|K$JZ*RR)I#Fw37{}v}OzvBcC#k0hoU5J6bx&y|? zNj5qv2UtmC{29j-LWpHn%x-a`^=oTVx$W)aoeAkbY)9MnIurby2-sUzcF|U}=x4l| z;42~Z!b*X8!kG_l0|Zc)Qwe_wW1|?+R9uYLwPcayNMMKA^tAEQ#QRQ@LATj`T%rx- zF*2;%JmRn44spIvFMayG=yaL(v36L;Ntt35y`i(;W8#wgCjFIxb>mzvk$h}2G5Cw} z$MFp;d*2*22-F~-GC>?0=-H)drn0F~)1hy7eYjEC_Hs*1%Y%BYWq9#C(?E#j z+C49rq#(<_i@Gskw3k6xeb=ZHCx`Rg%bzqh)THB^_J?J z^qArbgLyV%`shim2^KR%EF6~ua+1JinIW=haq6ev%=CLB zVjF&9K~^s|Qd`X=j->MtEecai@tt}Kss1>Kx2{C#$U12aPju!+eea?g*y`;3&%6UEI&4x^IZ7a`M$#N*PB#> zjm1A77;G#*nsN$XihrrxEv38@^Tc;?n`)i)u^^b=1$a%~=7vwDLabN+h=Iy37hUdH zCs&)JUefm7-)_Ey+_j6lPN5N1X8(A7S+PY#wlE%|5ul!APC!Zu@By-W&$_Gj=J@`}q)05VNO-k+8C-!>`zZwDH$L*u`zuV7uqKZ85 z0Ml$M(I9ex*0|m>tn;Jg0`wB5ecBgxqg6^Pu=UUJ$umwfJtH-ETZOTHso0>eFH-+_ zwmo@9;OF^2mo24r{71Vd-=L+Olw>%PBnzDQrF0v%1k-58RnDk}Z%m#+>u)VKk^fZb z(BJ85E3DlfJeTdpuQ%JsoJkE|S@2V>XY2)8re$ua^{Sc)CHD{|*T^&Y(&bH-NZ{lH zQ(NZ>e;=Id)XE#1?9Jdqe1Mw4V;G=hPdq;%+5%i3p?$kz>7*B8vy}F$Jkl2Yh zBSy&evkd}zSm{B|NFd1MgpaJfHIi7da?sDSK@g`zrX_&(uImruw{hw-G9;W*cmjs> zfW@1WE^K&0Ti2$SKN{sUw$>si3plY6-HN*9w4jEueHMD*kXPeYdag#1$L82AlS>X4 z_%j+yp4szk?Mo2`5M1QhtkO!+Fa`gyx?&~b{e-fM{cc`#Hj) zmF>fZ8+|GbyAwSfP3y~#3V+Q`54f?M^1BUfgn9YY9XjV4Z<;S#Hc5}azA;&;O`-<+9zlV!NQ(a}*}F$1L= zqgGie^D^rCBc9I`g*d;j{GBah=2(mR^ufJBkf}x!}5Xi^HAaP zdufayorZUF*Yf#JJst*E4Mm>NHR0eyEMf)(5w^4hIiOv*0W33KHIH;QZW@@=$|4bs zcqEN&4H(c7eFT@+YYCNX1nwAoshsq(eWO$6@<^y$-Xu2PMPTEc4rF>?g<9|%IeTH7 zu4X8SIY`qnVl=4%13maH`*)>^hDOO&WwR_8xE!U6{T4AYU(RbApb4 zP`k*?at;sr@mbp@y*NYvL~FqzxxTYiAKlZVim%+E^m_aF8$Pi-y=KUkdH+@F+5bPX zM(@2;2rJv`%cprLvji*R(X|(0(ul3G564b~!Bp%eaLH37jTne2Ekk`qO`I3C-8hk! z+u9+BK$>&Dh|Oyj5TRv9&PIN@dTRN!U&6z6xcGaO1*ozRtG02s$q0ua->BrYY~Sd8 zu1zUO(CgP+_!DXj-~4@#5XB6axS6BIi14J^4jxf(cJgHv4my|#TOj-Rt@xPvr%3YC zExHaYCnUoVF0dc*Y>KXW*bicT+~g6I`a|pyZ3bv3wKUgsB*g8IevxD@`Sl)0@pbCp z(<%$45Y_t44_k&i+7`KF!-PPn88U34mD=;?0ovu%K&W1wlx~pN{dt#SS z0Xk2(f`_1mLX1zDKD*<>KPvrAuz>lHu6VO1{7uf2qtB(!igzRKFx-cW{vTU!9uH+3 zwvP`&O}3apvSl}jh>%?vOPHB^EGdzFBwJ+9PWEkV*=Lx=nvw{Sq$Z@0NF}l_*+bFq z?s?ze_j#Vr`~1Tn{&8LRd7aB~9_Mj#Evs}?#zeCTcnp5cNP7M%VDU6ov8XM|Wc!6> zk)ra>5HF&;tZk4KwtjWs5MZ)&PBRIrKpE^}W>_zvSWl@dDGlGrBJKaYj2IHT<#lJR4HExYbRmqgmjj%^NTwND`HPEWXI} z!|>D24ZDvI!EA0eoxsb3j~Xm^J&>2 z-Whxf>vu*wPha^+xjNMLdBTcpgiM;HfEL}1#<*3c^!jVwKY8b)prjZ+F*Ukxrw^w; zz?3e5`;z3+5%oehCSm}uqj3HcpnSu0#I4AaAM}K;EQJg87710((@di zh+9YXgX77tyU|Mg#oh;4ApoU0TYYBy9!YIv)xzP7tywp?Qfp`a&@v>*otFMnq2C%C)1v}0Gc8QJBf_et8yYI1=Q`eP7m3N20z@jxuD zhV2_8#-7|-IIe@95ZN9^3?GEob>$>y;A|Uv<6=oMn{37_zDTG-2d;CoG;+Cv z`LbsCE84#=?>;>P7a|HEFrnpc;r0*C*S@(P_%zIC|D7J<>3eS}a3L)4F-5;@z8osK zff1y}C{#GdQmM~DE+TuLu5bHOq4yI$DEdS> zXl#C?ZXfH*(3JL*NqCYG_g%ThT}-uKbIef8l}^x zKXd*4G=w=_iew?6-FjVwSQ0w>YzDM0jTTz)aDsOD@0IiR`hs!Xl;&%9_PW_W$Fy7= zNqyPZ$dj`yoeWFPn9_ho6FHHzb*Tmn)JV+vdT*I#iXP%6)x=`$_S}9N5c;id`|+Rj{w+cnYdJqUU%p}T zYYL&Q9D}DO-<8;iLEP)R7}4wS7#gL-p~YZ-oOkY71CQIfY0j>}F@UB6mVXq=U|?xp+;2JbsGd4gt}hu)AUUF zwH&zk$~{-pEHh*!wOQ+MH~WF7g`j4{;vUa6`stwp|LRDhd6CBU-dric04hBE=FZ_J z7<7(NfFc~5g}j@EfWF}Nls`|`nE=NXmilo9x8eN-LZ1A!kj)XEfl`gOz+aQ6v_TQzeva_g^+k;P_*+>J(R% zrfX09o}SdBGU+k?!hOzwRtz)0GEYASmn{%4*ZZv_l0dykc8CPUO?k7QO%CIC1yJJP zFl2yvFxe37bWBk`s2ik7q+c>{KpZ1v9skIQ_z*RaLB*#gSqgst_5t8e5PZMo(h1Wg zIg?5*(%m!ZB&&16ZAzftEvKMA&(sxR=iqv;DQ5MS1nWrDD-+E~RGN{20<=zmrj#z) zf9fO<%-Bs}3l$IL5Sy_hrgdy>$UHqJfF9sjS*ii-fpxsU-7ORP(l^`oSI7PK5r7_6tBj9zNF z#&1yB{cb_~Ks!(#PbMe9-4T`slGReD@MpX!qJVl{kWdiF9l$;(COp`U6OXX`@*~z{ zGO9~U-10PbQanOOgT_R?tl?6NNxgwMR)*t#1Wv3S!#eT7v3p?4>wv!mTJzVR2tJPV z#sN(R0kZu=jz0yEfFgn#Cr8U&$W)@mpj7mrjzE-=EpO#7)Y)|CM&IcVZ7gMczo}Qz zNk%8dDlz@=KzlVlVj)9T1rdU+-+ zS~~PW`;-3)#|qr#h3Tm{M`5hIMx48;@JMVC&|Dkiff#e0BU0tJUR%uN2?Gkc_`2X@ z{^UXZZQlBgYGD9$f4_LuX%d&n4!})4@-2F}B+$vlU#?fCD;`nP!45h8EcbCox)H(2 zx762SF9@-4kLqZdx+Ery?HH_okeZ|cT$~FcX_qX%sM15sh*J36K=mf5mee7MiF4!& zH@@cW5)&b*C&XBg(V!75hBudr$7-qW7EZB%Xbhr$l2pimS3H3(GU`%HB?^ZR5Rr6M z?~zb`ylZZ|LxrZ)7-5!#)VwJ%{yJ}YjH)TGhx01+H8zk&<0{&3CBY`PZj9K|L>OPzw(R{VOB$~5%=?&MQmT6t+dDZ* zMqP~byh)ck37sNvVTxvg`BK%p&kdTJ?=1Eoie=$EGRG4rvx!7l`n#@K%SO_@w2UMS zk?8@Fa(5@iXm~>klqWU@V+`?!Tt*J1<iTcvv|mz1R)?wC z;sBRFy2bcFwmiBK#z0Ami_koV2Umtw|7wh-y&x`eP{ZdEEl2vMc)m*K-xxSaRxO!| zMFd)$D2Yz%O%6lir_F0~C57=8WC!NmLsewJciUTGsE0q@gJ}I@z3V`idQTSs$8Tg4 z)Yr(ohH+w4))c-rGxi`Dxaxs52$m_e{9Gdm2@B*4hCL?Ii@`~SKe{k$w%j)a?TFOs zor#N~??qfPhU>zTa@;Z%Gs3=f4~V#k5*xWGV(EU;=spp~ABNVCjj->WGo#sFLmncN zF8TQ~o5h~czW$2y-*|!*G{u~J1Px-jClEGT$C1jf&8RK<2(6OqF|vHY{gIZH{^YFK zMV1fR8hVuv${cU83sUnfTR5K}JRW@`5us6WzjawW%uWPpDkAuM0j5AocdQ@ok5`3nZ3@UGo2ujSJ2I@^R`FM>f3%0h> zx2s9=wzmHQnuM(!xMOj9!q^k)x*Q?ZDo@R*xlIu(RXZPxn#>tHak{7BAL<%iskt)| z3Y}4o<`th_9Wu194BdG`V*4%slln#&3rha!kO4FGhtBvfb&LGe49lo>29s=XR|Yr_ zR&Ek+`H6Msl%QVa($CIChM~R@UNQvRBZz?LPCWW{1L#P=fx6`%5V1g?e$QNo^0mV1<=2d*~KCET|b1Q-OYj zs|SPojY{sx%~KMeOcz$6#R5B@Uwgm3Sb61F8TByjzr2O(Me-~IrB3^)%ft7a`uGAc zsJJTqNs999K#9JuGKY#8(0HYD509yb?M`odggIXb+lme6vnfc61I|G)0#}#Zj>3=B z2E|3>z;DcL3=Qq!{m6kO7j~tFXIU)BI|$V>J@T)+zalR~x*#;&SOj9-ZYCDw=zz~E z64T#fi0{U@s4zY;S(V?2K{1D4-!-X{UVIo}fpWRlSw%~eX095?P?*HFKa97xo=7Ro zR7>h2FJ5mC)Ifl5-*o4CGEA%mR5qAIB@)>L)T#=LJuNIAlA`-Ba3Ow8z7j{WbDSb+{P(*X<-Li))RI|MsIbooFs`3R!W_ zN&&VJRD-`x*NK#xv(oL8U=5D@QMhRdzy1y*h&XC0&jE^4G47d%oYB61aX_DOwJPcc z@HLPx9MfQmT7&6;wA|s-8V1Ou+t46rWQkW*Bl{Qtsag%P>3QqqKN6<0)5cQuk{fc=-_(M-kynh)s}p!e>1 zvXef7uWfR1XKp+uXj9>1n`l;}E_&haPN5vS2A7U2z>?fE>9Z`FEn6v6b5AkxSVROh z=U-La7Rn*;50Li9m-=6G%JzF|_rA+exh)&lXM^B#MD_ar2@4wR@IH?jT`HemfKDj+ zTzT}^V+Y9b?hk4l2q{e`uD$+FL%dmD5>Gr5YHZD9M#t~39G-FsUyFfITE9vkuZpyk zRvCGA4$q89H3+jsz)wrtS0x-Mru*STEF0aDx5;RBb=?BNwo2a35B%`Hn)52@v_JXi zGnjNE5;am1XnZ2;vhhF@^ZIN^t0vy-a5(w<506(1JM?0Vlb4$%@?aL3Q`pcr7=K%R@@9>T( zEZl6oS}{);lF}b1Kq~^?sR0EDZJ+Tn_5_~&s7hvjt@*uU6=cIEROJHZ+aq-KSuulf zMNdak<|Xl3jLV;Ps;$b%+jApbXAK-^!Ik5}6z1FY1+Lu$ng*Dc~m zU+(E@YboRRwVy={20u@uQn@K-kcdg^4M6(er4=U1_D@ktPl+aOO|A%cE%-+P0*ym< zz38TB;JqOus?!5GGe&kNlPk#4dQVx(>AB+gS_Pw9rZx2fuFpU?5xj~#$3_+uq{F|c zMIM8kjBfcQeEaAwQ$w0?5=d6dF`SvHY$k6H#YI4pj|!czT>Mh*h3+MwcSjyorT?tr z8-oRrgDweeWnQ8yo9>UMpv*A3j6!YwC~0UG;xW+#iP!*JfKYQmZV)4#8+KA!Vmy?x ztC@>43aA^ES(AFHk}ze3W9^!yP}_;7h;-s4y#^$&90WOH9^40!Dqr;atdCL#DwlrpPAfx zrAsYG9IES5&z0l)Oy68Ytt99P&Xk*+KqO*5=Sc#+KZHF$pCIqVAM zhQH2}VKPX{vn7^AVSHzV2OTC+bXn1_Ezfg#f6lgy@>0C;sf0C)o{&TP1Nbx{=^)-Q zL|)*w{|Y{MSXLH&HVc~jQnd14Pe#XraTXL~26K)-cM%B9z~$Zt)Rf@jKSGM>Kp@@_ zn^>`N6mCA(e5(81cI-95^2WFb%Z=MC-G5x`2uE&*8@y_hAuKB5l=3~h&{J5aTA^W@ zuhhk_->6PkvAQI)ifH_hcfnNz6UJBtTS7`t1)w@)zMGXAAWZ#|Vk4AY>n14l@!Ln`Y%pz;T6IrTaXu9i2dGy^rB&Ns ziQvsMP5PU9Ghype^S2Dqs{T<)=Mw_mZ(q}E`tEps`g0@_msi{o#nC#Aa-fqFrGTE7 zUJ(9tWluvwi05Aoi2PF^5-y&BC_{IBJgJK~TFZAjmkO+(Pb)|oZP6)Zx*hi1Ej}s) zu+aonx--_PzserE9g~rIM^wsIbu51jHEDvD9 znDM=+2@h#ujoj@4-_mq2u#wiULpZ{`ly=XIGcOKCNUWfJET0p|PF;Y$^0n(B9TG#s z3IJjtYl8yVH1&$~7aN#_uBZ<$jjTz|d8LPwCY7pM0DS5B+=-q`UQ+8FZ^JKhH=?f!aHV6sLkn;2Bv>>^zB<44&6U z*FocE_q%(?4dFWPBVy$a+hmOu9@H8FduOSPT()Ygb{mEwC>e z5dA&6IhF`wsgi9y2lCMrre1*FY{dqXV{tw^y2F2Ewb;`=FNp$EtxCCSLMoP&+10BD zbSlHdW+cXCfE5oh{C%W!!?7T)Q)TA32XiRb3e9*TTRkKN>?IGcW|}6+q9s1IF@tXc zHt;wB34Qlf;WIziz>{gpNc)R*QNzkhXW_~!h)Kl#Y$$F_mW1wF*d|k1 zY7(VSxKNh|nPbe|#27o}z@*~^aD`?K!JGv*^1)-I%`3|$IJ;o-Q=SHu8ibrPU%Fd% z=<{Gk=ts^L>r#5?BZP(+WD?JkZs{n9OQa_S=M=lkUqnAAl<6Z8&@A*BX_`vCuQ5Io zb|s(Jn{DVO)%eGLFxj1tG2Q6vawr|%Z+-S^=5Tj&J%-`B_c)l9RduW}qsIg(Ecs^p^p?bfuJBF}nQTu~^1sQZ+B1X8-W zXqpk-o-K>mj6-1+?mx^STNpHlBj^(;v;dqiyk^L~YMhCeI`QIeC7(h8&Gb_5<@~w~ z8V5p?QW^(*%Tr~~KzI_+aS_`}`=^N}@cm*axc%pt!W)NjAqQ3`LSs{eL`D++r?@KI zhgZ7@Du-nR@YQr;InVbvcQP?OuRV^1tBiVlLm7(&eAK52#`pJ>=pRw%Q2X?3ZIcB* zWhgx#8Z{>;vwImO?UchuZ)|%9##=e1;qRTKS#*uvJ}Mba(AX>w0tg04Plz{?a?VfN zXNco{jYm#X!ZUbCh32Yv$fN|^CrjzasCjPQ%9jU*;hE_CHPvZ4xtf3LM|iy<9x z3P0c+f3|7IvWx%6gdr9?-|GeNqopPB#iQ&>6u%;9o6dj*+y~)Bp&DTm)BSuXerj%( z!_2EWo;5yiE*3MSPk~=8hk)ib&a{R;F2eB}YgRBC&zQi;F!?VrT2^aa#H6Z9ze-R_ zuDu$3;HF|D?wN?3Wqi=^S1zYDsS=Tq_acm=$NL|TG8nHkSi4+**ACKXmQBfE+S&7r z4v!F~TzvI;SQh>157-s*UtxmduP{M9fn{Z+6gp81t9O@PP~3BRFO(Nh`Oq^WLqEsJ zThATwaSK@QBPL3XMrF&d6j#X7ZIyYnX! zD8oo5Dff6uB2Emq$Png!b`8Z(N6;=e0O}z7c+BK;n~x7Ju}1y4c|M*MGe0+1c~1)A zMYycy6E;&;nrH3-fKx_a)MA0QDfT{%`vuTY5aM0|XNlHq{eQSe5g~_LWoVcA;oZ??Yf=U*j)DFQ!%o4k+w+JafZU1f+&5qtxZ_069$1bk(?)SHmY z{#+}%8L*H0xW9ZP02@}2|ql22j#Ahv#8|r z#mqo!$*`3>gC6O`l+3=*t}~hcB>jT4BNBbKDBwWgl*Dp1ESi!deFMaR&Zb;8v>d5` zx=f_$Qq@nvVO;nd01mCq->`WO@x>U+Na+lU$$&ahUYf-s#$&yzAt2KcElzj%@c{2Ln;yA@o^rAkrz@Ur;MfbW|k>a<%=K> z;9sfcWHXmI7(gUgDcq?TR?PaSb5)`5TcOmG6t1*K=nPPc@Ema}3UDSwpRQ#i`nj_3 z9yL-y9H+RWwV%G17bu80IthvY#cxkZ0NgT@BCkp^Q-VGTao3*&Dm~yKNj|OWH`PUM zxP)0D>ux!gQOX}ozC_7hjut-t5{vr3_Ay61b{yozQs#%_=q3XS%VQ1fzv zkI2HKim6>&r%!<=(7vziQw?aq%8VT7f?TRTG8k2q_JeA7${IDWVxEx8c_7{WYo_4;SkKU(+jE6b zo}0lttGy!2X)Cz_!l=0SxQFoiBEdV3D`vD)IzdV5f+T7J@S{`VJ(~w>c{H83DRNut z$O2hJ0{%chbD^s(f(cD$0crDbpZOry{CVd&;m2y|uc#|6rGe;^N^l*jfO^`;;o=3w za|V|oEoGIoR;m;^DH5Az3$6yxvwH2yS}9~qZHD;DHB4Fb$6jv98YXEm{?>qY>bgjPdj@yQP7dT{7qyq&|i%Q>?(An{zn!-pVj zV3RbgYnC~si%#!!rmObZsLrL1d&*9T<^ey)HCOPBv9Y4k5ZOdRtumRtB>GKAEaF%W zlWl$#`lO=J#5(7Xb`89Ul|}K9ti~TNM6%w2L~+X|?^Nw8#@GJXT9mOgBo;b8dN|L1 z|6t(zuNdQ%lI4`YE)?8X!$GZ-{lTC#;$uz?)~6aISAt`L$9pMLr|->)G!!AuN_jF+ zK#lk+PCwvs8Wq(D;@OKwDM0O)Ggp^*s;c~v0YAOY3u!ehQAP;$Pq)6=)oUIs9-k|{ zd?E0MzLhn~aCHOcV64^I1Z<)0!ZV%gR#79+E>x+t zq85s|L0`J;G!HhB6yxyA!fOCM58tLq+@N zTr#26J3G7F6k$`GgBT-E{aKSefVOcm+-}~K%tUATD%C96#K2H`HvPK2bOP~;Ze?9P zQBr2%uZa$Y+l+@ZPj}t!>~GgQ{`~aiz-Tbik}e-qwf|9S82D%UhX&;Zw=IHHZfFv; z$Cz=8(wM5*`z5Czz-(X`i>N%HRNac(F*wT$0V37pk|c7Q;Mwui>1Vr4LZEg_;IC)< zcSnX2*oA_YL#^$7bv9WY1o|u(>kvfoGl}=y;peSU%yC^EW#KK#$BSpd^maf#2?1LzV@(AbNUXn4AaYoy{%5O%_ zSQ6`ojH4_Zlf)x_Txk5gON;t__~r29?5X;XJDs@)2FjL`Q9V*(aJMhSfH#1Tt8-1c?CpezCnzZa}*n|f!*{kbVejWr`mlYNK6&wnZ@IfHS#w`3}t z?X!BCLJssUzBc|Vi_~$c?w)oz_37=eT0^JT*tG43n%`U6y>Y+kd5lC3ETnwAnu?-w z8++)*JuM3VGX&iW@*mt3iX{NtvCM_#&8bzdLMUR@vkY#bouL$X?_+7rXb@sp-R zFU*I=T)0qkiU%EB0IV-ZeEB&5zq6NjCtwEurDbpS-p%o_?(~RT{pUN@Q-2>^J2-UI z>@A%EdawX@W#p==tm-CuebJ#HUAv&!fVJRP>qP4Qm{H(;i?52)TCfK!jLG>C( zfeGfrq@YVr5$AycE(0+{GT4&>E46Xdip9O9z^->cuhvJWoQ0NOu1UByX7_h$olmAe z_CIxqyyOVWb&8<^hLztOi~2D-gvJXV82DfHH6Niv7rZSH%=8#d*o^HADq==6767uU z0&YKs?gLLOgvL{=cvhmuen{Tgx$}E{^!Kv%Z|&dTOAp8HL=OmsuV_a$F-i40jyNFB zD?hlmgNe&U+^bqu9FeX|YQq-UGJb$|njfjpphr1l=ATaOlKo44C4W_9XgT(XtP0+V zJLolJjw=?sOD_%ivJk(YKl*5Zte6u0#a%^%mQP^Qrjukpr&HXj$+l_m%(!w~R~Ypn zko9XiZVI)H4fT1oEK*p0yz5p;VED7(MB*gpto6BV43K1ZhW*NJjfI_sAyS;D>bq&d zL;nw6>PJ4WuL8Vem-77&_LL*((L!kv7oWx$s_v-2ozobT`}^8B7`ct2&Vkjcawt-K zYyqQykrO9P>1)qFd0Q&5g)at95b5m_zXD8X#;yhSG2{NM`v8PHkioy92=_(k@MHbK z$2&jn94u+?-bT>goznP;;XW zo?Uk1bn{2Hq+gXuH5WNb)$7QgtSySJRj8|cE4m$B&HGseC2d3&Y;F1zpj0@hviQYgRm-eN&&$W# z*K%EYZf$H7x?K2FzJIJ@qy1bK%~G0)pm)3IaA-|FQ?gNj;6JOkV zPFd!a^Qd~q^=o~3E5RCH0G-?IcBb}%1xXRKAILDP3*Lm$j`b-*F8vr?*t8uo|Os&@}~p-?eh zkxy45_lg_!RSfQIegj1F4qHx$*zhzM==W@O4$c8B%eSHdg}?`d zM>Pc|{p-z|o>gFvHOF0A3BQfmD_Ruxr4p!<7VvCG-GbUf25Y>M)tI6V_LzGxwJnoX6W|UKAKHVY8}Y zjyyrXX8ZbiKFI+9YQP`&ZR*czq?;Vjz)6(;Q<<(71&sXBYo0`3sA9b_G?sJjQJF|wjTl{+O@ArPUD>Bj^ z!~FC8NKkbc$_rJAt#jj>9*IZBW(kiB3Makum$&R)sVAS4(wQjn^*^hpfnp4mlfhWU zAvQ`Zm8*Q36|PL8p2ygl&oH^`D#G`%VdjaNH8F zY~^?b&uFFI3?)?aKH7MNj{|K*Pm@l;@B4oAX!Sj6J-?rMJAxN)rYN6J2(+0!_PH&AE^0Bp zq5xB@1vqN8IGB__VekvvQBRYU_r%fXhnVo>+` zP35wf%BkVgpBkoBTeeHoibJi|D%;Rr{9)_|9j4|QDncY{g;WsChd!xB?@m``;=I18Bi zDcw~MLDF^NV|3^PE`Y!kq(OHC!dZ0#jnX4Ny*rRyu;v$6|Ps z3VR7_#Au(0Pi2pQCdr_f8|OYv-XL~|oAN~bhWl_1DD&xy`@eT+vPFf^y&P#?O{?V%Kya*?YfH#**k7jkMS~MrC_pgsu zPI=QuAo?1pNo1-aRzMY7q0%elu%QbssSxW26a*#BXY{FtN?$ahBG5BERiUBr0;1pbF;owY?f%(ekxip-`XA?fvy0Oln@#v!h#7%H#!+s`x}FutgmQ$|yBm|h5z2Cn z4cMIA#pV~7NRnfwdwyWnIRcz0B7lns^+U~_c&qaE-dwuq6(ehUoI@OjPOqu(CN)To zNtNH;v2-_mHRx92gvlp$E%#?~7bbE(sNK1JaND(4E;5?X-TkmKm|MS66BYc2H#l;H zAS`*U+0ZTL?%8^z;+z81{J~3pMpMo;N0=a^YV)`_BM;wsftC)rvFTBdgx4CsGqr-C zT1$cVzR0L!qr%Q)p23V82?0Qd1TW} zNP{-(2PUZ>OK{V;faoEaeNT8rnm_$}e}s*{jVU&v454+X9IoO#>tvxczmt48@wkzd zw1L7SUZb-qzJNjY!CoC=<;~kO0zBlB9jk>2#6S)IqsDKDcx&Sb14}6;+fTWJOveS7 ziWN9%Zzc0sdm!M{l4WtP$);>PUyY8uTeAAmc&Qt^*-@vVcBgn5=OS?+4cCrfjiThm zqdLV+G{7;|>Sm-%2JDLBFK9(ax8?F>(<^sD)cXWRn?Ky{nw~*IO!1MN2S1=xAL5kJ z;=?L5cg&N86W?t~ks+gZ{VEs9FiBJWZOQ#2$tU9fH2*27!8A)cBB!~syt%Rzk*{j1 zUY@jggwi^E@aZAj76q#h!S0PGVVd-@qK~PZ1Sgfis&ewF*zx;rs_#-%;Vfb!4JdZr z72&t62RJ#bj@r2&5Ej2RlxFQIIHdJ4V#A8=!MjaJYlse)gUfxms5Q;UfK@bqSf*3x z{mXmbZYK)hFT5E2cIW*^t>0&w*~gC={;awH)r^B6UY9j+b6#BYtI*-+g2TDzDT{4D zR7olK3=(KDtj|9gr_;z}h;jg4aAWBRlM~6J{h=FV5H`JXUH?>N)~P;O{z%J~Q}n?v zmWv&oKr2Z8&p5;LSAsj@0KbD_CFvDmjmhp!Ed;973xv1AYhn0fEoc$ckdR0%5{)Jx zyh0UngyX0zAd;Fg(DZq;Eby(5DLmfE-wCgWEwUY|4%)KFx4WBsq)8q+Xz*?dn6Ta87rAR8K{7QiR#R_2& zS*K(i9lP}hsN1w;O3K_dgN1FUr{d4 zl5a~LFgT2GV_9$3P~~}`Mvqyr>zP4*iG>%j91?^IC&as9)><^z{Q{i4naKE)VppG` zf<+qEB?YTqM|+FNtFK$eelS5OJkN1or-su1&T?#vjdFx>qDia z_%((ssW&Hk5ZhU^WRL$+*|yFf`3q37B0SE+~C~? z_A^kd!YR)1+Qt|w^J*B?1P-~r!cu{_R4og?>j^36_3NNhrG53w#psan`t;B0ZBkX!I*B%G{ANC!yr>pyZnFo|V+=vZN9z!-{v0q&U8) z5*h?C?N(i6oCWNG0k(^rqXsosdPcPGl^^tH(|MwymF;n?c*Rk2+7ofbb~6&(HDBp; zzxa=DzjxN;{&9`Aceb_Sw~d3}o803yJb#4e=F_HI+_ukCm(FpK_%4rd8?JAU?eNUK zwb%jvfyhSPMGWRyUJ^oo@?Y8GG@^ex6y)VBIpQpHxL-(V(C|7S8sBdx;!2$kegQb%z|~S0-yYoj6_ZAQdB( zu$ZAl;umzeiwR=de=SG8`!Fb+i(nMu)*q(R)8@krDn9bNv%zWkzhk?>*`K{ZS(VqXRMwmdcJWACYis5t1 z)JRWfbLCq-UmRSitj{Q|F4Ws>){?Et(%x{E(wMW20(=*elZ~n${)|q+-rQPj<2s^m zwst(E`pU^kmG~>LhK&L^nlH6B@hiuOuYj}GEW97NgN>18=Ql8w9o^V0t{6#qnru_> zqf*ef;wtNf)3>gxU1hg}#EDo25LcdO&#Q5|c%jPV*xnuJ-WC;K^RJ*9=U7+eMWIU6 zXuX$Khm&%dB^`e~dLF!?BfXGCrN6Z2)tXL9#CT{EJX3{S4U0a<(xzOVfh>+G4cw7> zSW)U~$z&GhLL@+79G-u^#ok4^{h?O=~Zr?OCT$IO&@w6T(=SPMW|G;~C6N#V=2 zI&q_^mbjaVm%4rK)D-io+Ihpd8T`EAZxOs75e_q!`16W!Z!6aSBm(uk9MM@fqR*?v zook`3$vo52dP%STjU$(h{rl!4R!^Eg2^K!Z?5SU&p$|k|j7mAwd2)n6Pe|^*`~Kui z`7u|bbcWRKLZ;1>XEnWMq{6RZ+V<-VN#C9EA=Th#Jny~NC4bXs%XM^a3GXJAf7|6eaqhFq-v#X+__T?c zS9E`-^ z_v~9b5=t^I+Cq9x0#N-*V<1}BfEOpl$*3(dCsss;9X0DO1xH~@jJksJHLiZzv;B3$ zL;3gfy74z>wnO$q?(-x|Hrl&q!tP5iZ-Gtmu|x|_%|}}50bYy8v!6bCg@?+2vvQY` zFxAX^xF7gvV_0Z6_xkU`5>m(IBtlNi|C6{XbAWW(IgmUy%`lP?3q>4O zUD-OXql(owA9;;dK0>9xVQ?CVxg}LV#gYtCM*7F7omZNKWi9+5m*-Qrwg*e*V+kkU z)1eVeeWMKT8Zuu{2XH->7W79LUl37WHZ<>tk2@|8MqMm^csfaxzI#j6aPVM|W8?)F z7BR?xe0Br1b?^OcL|2+!?J=ph(mc1?lo~ul7x2sm=qt?)UkZ(+5iWInLnq@c#m!0L z6=22##xcHwU*Zz^UcFX*kdeS2DwM=;r5$>sYjpdN+lSIG9 zyk85#@gtR;-+qCqj=(HOcqOW}tf~V)Kwn~8T=;G2WICJK=s!ehUuRXi+lMs5Q(dYq(dAEMAyl9e?`5=xZ*F7ogWfUE;=i+-GCFb}!9Bg?;c?%`?muet8|l~%l?EqPp){VZ(sfo9f5FsvI>b>opz`DL$t zo{KM99-M1sS+MvV=W4M_joY@ityZ>MVX!MmOH}XHu6V`WM8B(p}$h#%46mMpOXta zZttiJE7uKiSUKXE1P&0y(lae!kN9s)yYO9ov;w43#)7!t*B?N~y+$0_$VVctKbAh> z>;;KC0gjHAUX02jB5rAL&U~z(=N&n59`0_Td|}GXv`z?JwU}DX&K;=uo5Y{RmuuAJ zJseAnzSgEx{*3($mQkon=J$9_TajtrT3zkXoo{x7n$MZ3&jyAVu#N(I*?(uDva$5j zoYXk-?x|k0ICkLPp#m#q-UD|67o5cK(ou+S0kljuLFzTv;|FU| zNh6TOHK`*eqU~uJWm?AO;1lC}fi-xD3v*Cb3WBdm9kvVXhj~7)VX39+VAB|EfSE`v z?%Qhm*ulap)#DY7kI6AtUXMNGy@C*y*K>AExZ^>0e&#O5tl~Noqp2PX_Mt%()#GP| zMQX_Xvc4+lJY|iv8k%+C-LH)?Val#sfT`k~@y>+G+!}-AogosQ<5Fy`#sqLT#xNQc z_5dGx-P%+28;i4jP482KF}p+XTyA0Dxs3mLu4mE;qIyjn88}rXd}tZSoihkpR8OV8 zNB}xJVli~#xRKSlGLH|3mzD&`1H3}IXxI(476qH$(2u(ORXS$Xs?@2sOKC{=tjNJm zEI0yblHxgmEPaxqNQhW9eZ>hWRTQ_L{^%Rt!GO~Kyg89|BwU0s=waq+Z=`rE>SW-z zbKmdlMJYBNV0sT;5lEKIPh4wkf;tRD<{~mDu z#j{md8luZDlsek{oZ>3^I^k72y7djD2_OEo1j2JYVUGdZ)*Vf{e(CQy!G=L-Uz(*? ze$vxRzdg9_ltG~fib2rR@HQx^)ltB2IN>guS$jk$7ZH6~lwQU>h_`iJYH%X2+x(f< z+EtfuG^JzOizX=W7IDr>c@#pgVtkr0p%x;_(Y(%TO?UofV>G>?`#xq3uI#<{Id}i8 zU;*=8-0Qs7+Anb?V-KRu(_etIBs~MwlXo8xLoCEmqgAoD`DmaIv+TEpfhHWlnLsMnUc*i#)V@M zmx>m3GWKuiWV{HnYgS?fpo`q?A|20eFuvFG_;mC2x{WG@kSIiU|1lqxl#4X_JEhOn ziBjXBx+DOgq}oyVIC|339kVMh=X)z(PgXBUK4tGKJr|93HizYmuz5H@c($k$+z(A&XEGWjZ7DZ*V z=+DKZa+xdpq^WPDa=3r%Lar3D+&!n0Z|AO>!%!f(iGpTt|%3w1YH(oteCNt0@`)Q0TX9Qdh-*MHb`>pD>r4DgzGcA#s2!|GpmAIwR0 zIft1MBzGDzvIBDKIX={sQs|^%q9VGJxUHU>0Guv7Z524_BJm5FcD&>M^jjBLnhsY2 zN?`x=Q$_8H&t9U|oaj$&Y#xgrRQJm|jMV6v^ae$3KJUnRk=!IV+i%Ifek*+-awSUT z`u~~^OFF&z$hi0jw{a!9-}F!_aaIKzdN(bdNUs<0=Ixg)kEErt{QEHRXa^8FSoq6xv$6tDCmtSS0mk*= z-zsnGVU=Ey`1&oBlPYnt0OPqTrB}99?5<>(C4o<2L~iFxNz|&$WgV)7xw7m>ii_+^ zyU2$=YgymfpJZo`U#_HA(+AqZUS$GCg7EBufuKM5#L@bAddxJMa^)dFiIz92yu!G? z^D!YrA$z5aK8_iYiTwK?%f&_+gBE@k6a2f~JNvhH@`mNiA(o*Ue7tY_y?ugvwm|2b8WatpL|+y5)+9G`|<|$>i1dA()Rjn0KlnUuf2+RX2N zhQF8uA!n~?KL5~>U+Rqt>X#C`)u3f$T32l9H6>^OHYm`vY0{UuZ9QV#)#q(l)naF>i%>?%6#LyO{s0ulnRQ$Y$@2)WjTZ~5Ws zPn3Q=22;+azTMe@xP!5EDZ6Uii_QAg?4o4M$PdZ9*&aFjmH!_gbV27&gN5b|1W5?T zj&Y>TM@8)UUgPeH3ACP9F}t6v%3go=i$#Mjdi%u5X|+FhD$?qPqz);ho4qQaDCDq& z*{E(_Oh^#DEGW;Z=(U2^JhE>2x|tkzgeNn0d6Csgpo4NUNYP(1@!r>+fi4JgZ~+pr z$w=xK{dM6*KTdJ0tZH8Yx_R5QTr! z&FD&hNL8WQ9ZX+Ss)4)U+HDu}w+Hx(E(f%E(myJ8oJI<;gNw+WHTb5(F=vlr?_M_9 zJ}o`RYMT!peEb|0t*Ss@->HzpuHxfctZ7ZxgJ9DYx)_}ums7J_{1j1szJ^`w{&tPA4qfz?W*G--Xnv|Dd?liD#AJoM zS?5#H2ilmO5q^B|sR)_LjZnw?KQf?RR0yEy?kR_iyx|)JZc_9THq?O82+Ke_Aea4T z?9@Y)G7?&a(lfd6_wDV1X;>^90V{>*jD(7Fmr(FdKh@w-Tc|iyOU1e>T8TfV(7gr% z)YbBff}P{eiMk<3$#nL@@pJn#kHOu#=nbeln~YXSuMNj?hkGQ)27!YE!Iym^u;Kh-M{E6~KHJOtM zon7ePCzVShY=Mo?CWq)uhIVEn$X}PArf(=b=t0QDY{-r$9Oxe)R=mEQCeligA`Cd+ zF1aQH z7x0%y`)&Tpf{m!+9vflz%hVgMpEMi?=2v1pDf2#Y&J%3v-X)u|uihrOn5;B(Mkt}% zwNP|47zmM{{_jl@HjA)cjC2h9j)e72e5WOOcz^|kd7+L;Rv!ZciDYrRZ(=yi1T~l6 zp$yzbIo1T?!F8MHcUFK;MKkxYTVHlnq znE2VI-0|P8cA4UR7nR>~pgwp}(90^^YNa8>T8+e}+bls!U*oKUCqmxc{QeTMQE7J_ z2^ot*BJ5^5_MXe<2(YQijT{sT$mG7h7>ilpq*RQjCrnN5+H%Z|yUF3F6=I=bS( z`KpP@@p+Fp1HBq+I&}a&+f0bf&;u_6t1w7g2;Ez=fP;B9wUheHm$$z>+3udfvtbs= z@B}=E+M9(+yp3PKQVKF!+b*K$rUd@ICOFS!yhRAzq`l%`LAf{mLE zn0yI_0u5$Y%U*+4ls+JN(tc(H_5z!NV?1+xRbjDjm}=q!3xP41;@i}V|G+YxuTWk9 zk}nrZeiSa(vJr&lkWyEkek#CQytMW_>mc~-T{@TdP(x$|iG`_Aw zh(rya^*o?$O(X_<4ediuQMQ%$qMz3MJ`>>QMIGS zs9ysOc0H5gSk|RyBc)x@lp;(fQ7Caf6mc@!cusDMh~x-ox)D>}!j<+_MC`-W@F@ko z$f99e+zlGe0`Wvlcrbk-QX6cS!jaAU?Dq%H_^ywN_xyW zyX~j)83^RAgKL+=?^IDqa<|x!?p}~BuTX*REB@~O@hj>=`E~!S^N0`0KWQZ%`M?H) zDut8CpItGcqy_kmpzWn6U#iPi%v>mV%OWVjkPdj0;cZwb96F_S}q zjvL|#lp3tKeYWEF#E6;CsQFvUz}_q)(mG+Ca17TBY?ks)bW{8xtjO!8S&(ejCgcBJ z&?!-^5u(Qn2+cSPlH#;ihKHHTrGhy_GrisH0RToe;ZN_-=agy|Mh@>zIB=8*9eb1C z-JAOSvGZb4iI}oo@Z><*UHDVd(h=DKnANVN9u5M}u4c2MD{4MfeF`ob&Iw_5fgAbg zRZFYk(wC{xE&re^J?O+_F`2R@z>F;87yC%e&G*em-Y+Od)%W$&?``(b*KUu0dt}pZ zU4cA#-L@5JXg)rr6L;ucp8j?rqVY#&U5ngOmwpi2@WjB0{-|n{=cm#E{h+*$(u&YkYin%FncLm&X)HYAl+UGGJR*Z*B*UHAx)j<5ky0;tj$An77d5g+ zuZ{&PwdbJd^`yX7uc?*d<`JXqn}EMzL{@3H3M@Y@V_K3PKuDW!n7Z1(n0A=+tkR)W zBGy+0$kSmwfaY(|ept3C*sMXW5$8#U$c7AYf2!ro$||ZCogSlI^F2I$91s5q7|8y` z71J#55oUlp?{?P*PD2VmeOfW{_c>IxpiGa1PNfR+Z5ifU@gqM3xLUjN#n08Yeh$0U z!*y16t{DrP?0&TOW-Q5Asna7vpGp7Sl*La4&2{iNO;CF}8u4ep4P*}Vhf(I$O2B6Wn$qbpaI#VZNC;`<~g48SS>1GKB4CY zgN>F`B6H#8+BiE7ZhARmUavy`DLMmT<5fuPJ2oq|ZG3Ty3fKLT)z{U+xj(PDzQ0EPEt4tjL>#8~a`!FFkRG=I$_5E1|pt%hiSuZK;rEi}aV2(F@k zVBlz^qsw zf_DUWqoIlhiY%a3LkTu+&Tk@zU)9^lgFJ5^*1P<3LA&6xHL}67>|9c&O&rHdygb%n zKyotQBm`1Xd>A#m1{uPlVuq-Vn(d9>BT@UXg^by+Awri8I+!|yqZ z8Rsnu%e;l3vKn1l;)vIJ^@m=6e<-6BVJ2m)ojv+w*h=M#LAwxRU@YS}yOV6MFg1Bx z80?81XsDoP?{kh+unJ&LCpZQj;GLD4X6%XP@ZGZsO zAK*;LeG71vc=Nx=$$ql%6lgi0p;N&z+vHh&?O`lPA$w`b4vE z5WOg#w@&;_#eL2UjF{53j3~L4Md#7W{RVOE<>mn#r6|OT==^;CJ~+Qbb`;MU!Ee$- zRv38r>y^!R9?-d>S-@gcH4AIP|3>kX*mcpYh?+(w#^MjGV_lQ-?e3Ms5^;feI5IzOEK@H9J%)m&dy5u?)!X3Y4yN-O5r4}|%GybgXyPWa7C&+KJ6^)$*#hMZmsY4yL{gKNmPQt?{fO4_lX2ws`)3Mda; z!=6hDJU$&+PtnT@I_y<+t1I{69_P2b^M0u>ul|gbk)d)nf6=Xs$127`d2D{&qy>*G zf#Q=P7#PtXD~1BLx6pfOxtCv<4GvqtS0f$oDcd>yW1t>!4ys1d@!eklG)lY3BICS0 zyyx+kgFZZ{h{Q;Gy;|{(o;IyiTufJC%u%XkD$#OR`I@=k!~EOQNG8dk`7m(iz4Y(n zcPbxGZ}+eFJu-4v!qReHIJ%k@Zn~Pg8Pl}HoBPlipgEiO2|v@SvVo#oW6OS$<%r#Q zS}J3MgFohI%bK&{cuIJ!;^?nLNYW%ki|v@%p9iDQA>yD5j>LvYx^DfXPv#+4Eloz; zLR=?WG8*@nqgs+IeYbP->JP7w33&-Ul-9yqNZhIB+$W{3UyyuMhg)l0s2yV_i}trU z+od0II~wZf4%|*17+4!QCiae%Z)VvuTaCKU^^L6g&TL~k^3D!tTRvG1R<4wGWLT-Z zTfT%RS%W;>+ib@raKcW<{S9 zJNCo*^s4yoY-Zi*^rw(P7tj+WCjwTsoA+`<*i!l{19;DWc>lI3Evo&pZoR*A_t&*E zjR#%xaknn+{~kzO3s`%#rBjke8RxaY*5vq97hn|l#EK8pyDwf{$K};O+c65y-(v{jQtX?n-V}#(I zMs|Je5ZI0pM!rv#<~Ll~cs_E2p6|JuPKimFVMSjpY@VZu;}|cO<#-qO-LJq1^+s;F zZu3mh|LNRu9s<60qj>krrg>Z`!>*J0MZw4g{kWtGK{9F4ImNLp?XXNq8Vq>JW6Nj=K2bCAPZ{B7r@;aOv_=v6 zqSqJe8tl0Bn@!@@2s|wy6+qw%<-ME=|e*amV-yhJNh4STXJ1jsAMUv7fbc5 zl(y#6x1N?Y1q_c3-1+25AINeAA-Ou{I-2EkdXl>58a?+`xMp<_lwP2GT(t@x55xs?FGl<4mlVo=;6z)B1sI~8ls)!d3`xKZ3m+4 zyX92E6nHpw)OgV8W;u9PE(5vyJiDO)IFKDRR!7Sjd=0qLgK;I#{SIK&n8U4`chZ-v z6sz}A^BSo0jOo{EFYr3&j(cg(^k6ij7;$U=`8QzhW9G zZpzW874BT0Mn%`Bwp35dSir-iOYe%`iV2O@-+X6w*tnaT61@Gz@F24@0`x)r7a4NK z!$%LZLLC{m-k-iCch=UZ;$c1DX_V(bmtY^fyZU0SerL2)GJB#nsFe3d#j|aST*t?V zJ1>dX@ZO`b#EoJ3eDiZSg}+wSVY^jd=5Z9OO@GCHVW_svIayMFbTQmP&`upIWllVL zGj_YFN60v6weFK7X4;y_g}s8Fwgl1K4mtQX!&kSyeK9Zicy#rM(?xbgt6c9v;C>=K z^O$3D|4;65zs*}xqO+)Q@9ruix5krMz@4m*rdkDVmfG{xQuBsMDEYqlI5oIgPro<8 zKwoRR7&SH`0dQLFeMWf@AekNBYQB)OEAMwP@MKZV*#PS_4@*!)Q3I_`+;DqoS*UE* z*Xo1=aW$Om?==Z+RY*r*ZXZ}39S|1hZ7JnHbT`NVmFNer8;rsH2VuIo6}hw{1t#4qlvY-K$(DUu%^ ztnWJ8W@n;aYM}DOw&b_}`7pU7v%^F*NEsZ+ivw zl3E}+sQS*Yw$sRaKQd)x4szn9!K(1}>Wv8IY{_Ne6MVu=LFd7#MxGpA-naSzSb4O0 zNovT~oO)VP=cov$b`IcY2Ldjd8vF@EyH~>^Aq_2Dq=O^EGUWMFDd3{;n5U z2u95!JF5tL5@V}BR>HNB{SLiM=taH;J@ncTUBe6JF>)Qq2F{|)-=TX~Qsr#9O}N@m z3$zJwIpr0E>@c8j>OkIs)Ukl!v=m1x_>m@T6gMIovnHj-e=MVbIoJcxtm@-@)zG5H z>j|5jf5krxxKO!t2CcGN??=mXw5~(%+jK?7?RMS>!%VebsaE3gkSTt-J!0&AxvXdM zN8-3gL;q+@*rOCXKOfFvIi(ApUGo#}ON;}jb7xxwzQDEIPi`U88``@oLsd?5)hi>b zCwU=Tj4>q)m~a$-`im~nBekWp9fRKW(HR&tCqoUMdJamOk1dQ3Ho=jh7|sn31W|P&pRk*}dPQEMBKsWextnrxfvlYv`7wyZ03C zm5 zdxJk~<5WhNPV{$jGWBly!78Kde*QY)NW*EuhHpR0Tt`~xKq^6e`sifjjS~mcZPSVm zNG}D9a4R%|LSz~iks?xbi!#3DtUvK42_sl#P+(MRI99y>_V*zP8CS%lm@ToHTEdMU zwiyz8z(nJ=vmB7%OQ@sJ%-Mnh*Qm9KIY}~9c=A>W@BW6UHt#vl{tjxssJR$==Fz}~ zzN8dLeZbUmnaVNQYlM+&J?lI>S3$1dz62R!P36<+Lic#YGJfY%*}22>y>Q8uv5n1B z?S_xf7Itg{@`n9qQujvJ7cpO(jdzG)+E&Uq+0*3~pVB9wZjqe_l5@w=qTQ3{0~3(M ztN1k2xOjMvjU`A8F5GZdGng21=7tepikRj|)T1GB1XB)C|C6_+qPxWozT);XJ}M(P z$NyRWK=u{P^wHYAX6M`Sfo}O^XE5*)`l7jNTtN-F38ZmW2|SP_kM=Qbu5VM9{_4tr zl>c16A$i&|aP~_j_{8Y+IH?iX;8RIw+fHYvNkM<&drFzFs~~CKnikJiM3-C}AQB4E z{Lmh8Zl`(Xk-r0T{+B63a)wJ>>f%)K{5n-vka3?6)~06zhD9ia8+Rcoc~AsM`iS@b zP3AFkDriE8%xu5{6tvZNb;+VE#Quasl~5)TM7~>+vAfn}LC3MtoElG0ZSt?G?|GqaL+ z4!GzJtxqoUg|OiI=lD+egKsH>e66yl0i^DyweU`jE3?_Q1!?VQa1?|U70x6F0i+Gy z;nz-#oHr8NQ5X&uHJLQjUmonQM4k0Cov&^C69(?nDvu|1+ohzGNL_YtFb%nMN{y{( zQ(M{EfR%~CMUTr`?mcM{u-e(<%I2CD*S;HH03uf%!R7SiY-ZxPbmA=H*)hiyXkJ8( zl6_*LAu+-|5kTMr!Tzp{{`?(}y`dg3fXl;5-em^B=!hq&BQ~)aPchB%lsFJU%aK_BLP>+a-!W>aZJ5T4BkJ1bnR zM^2cwBEr0gwm{$mNyRx*$*|9`@7+zH&ws9QH%7fgEyNsPyd!x~;Uqe0&5-HvUq{E( zn}-o;Yt8NYJtX8hFz$a9^nssj1YDRl@O?P|dW~M9HLK$f-CtoP8wUC)urTsM8_S|Q zM7!_XRjUcW{x^|ybbIBD@P;`LtYcx9Z5dJk4fkDy^eyt$KkBRoY?ou{%h!^Bw_u3j zD8`@u;QKCn9GeTnrcyJ#pu;N_U9}6%;rN!v*@Zw_mYfnDKYDznK>SJzO^ia02c2VX zR?MkmQ&Gp!7)@~m2cF)!>@y=(H<^3W7Yvl_q|o_rKS3E$DjCIXj^qmkHxhFE_xt<} zDwMpI`eFDl=UO=_f^NDgv$YwaZ16}HFlYLjF$|RYi^{a`oQmt8&)F|dUuKtBG>Q7E zNG1&ldjQN*-a=Jaf^5@19#C6$`Q1j+v12cH?7=w$yF`td(BVyN0qJU*-8YjgwZB%{yA-XY!tU ztX4E5#$u*5LOZ6AHcGuok&&r1yiwyhOodRe**Rl@+)a21g{;?}LKMW$8G!I+OEV1T zaR>2#gwxtTsrvaGpU8^u^tOd=lq@!+B;rP|VK#HbP~iwW7O=4_fKp$3<#+x)49ME` zgy4XJs^__1r6Zgcl6wy8Dks0G)M{w7uu6h5N1MusPjen!MnD7~4jIbcdUU{B4w^$l z&}#r5a20H(Yz_lBlN8m%aCCi9s-jh|cOX~O#dV%6f z!u!-Pj+2S%kGH@QKg3XR)LFL{m;2sjdC5^L@N;ONumBxIkYgkb`a05IBmuGiYHC-! z*fDk#@g%=s8P8=@TXDxJ$HO@;3_s50csft}9P+9@?d&6&U|c1>9g4q#3h#@5id!V( zsd6cyEFswTb#)*K_Zz4OeHY5xU@IfQALF|n1B)|WcQ50(2I@Q5wc;bW(B{&X1k$MCijSAR{i|E54w{Tk z<+L4-Mmwm2c}km5>;$fk_{fOg4MY1n)MgL6*%5aUTh-GFIWk#lZ|!I~13%RQ(pYIU z=*xGw)uMcfY5QhMlr!#{IOk)ebnfM7gU-aeXc&C1QGzRCT8ZvR8Vi?}gUmjjaC*>? zkq^JDi|?RQj@uh2yFC{~OIk5aGH%djUq{HypB03M581=B8dsTpD7*hmULfhE4QC7q((|4^YrVOny zN_oMo&tTqDI>ET{>tiMt;6gO$-n=NNpHOgE7~OP^I0jHpO;ZFI^J%!6#;uk8{fHoEw-UF9rkOlz`X*9$b4tj)8!#!Si7K?PG z;_op13pMgbwa3%c+E-0eeSxWE9eea#0Qu}mrOnkB`{HO8{D>ohC9*5bgy&;^T#ow? zM;K`F*>$9ao3&7ILl_{RW~QV`1=f!|urp zpJ4Lm&y3Lg7xBmox}@t6j<1~#|$2lVnUFjN&!T`-256cX(Tu16+FrMa(>;>0Nvrg-j znS}i(MV#R+?R7%N+=^qkel;#^=+GtV*%Cw{pm1{PX ze1&j{x#LAqLzF2|E5}E2!s!y&SQkrUbXS{KOxswMhJ@QBe)%U;5-ZXa^HE^eBB3+m z$t;zcrnbUm!GnZT`|!@8nqTQ(orow2x*o}qYU!&lDJ(hEivX^rAm{4~ZV+~`4|lU| z5)EhiRfn}0gZxbz<6hO-AH7~=UIibFX7Jw>NZ*Su>wddO<|xQ=E46bKf1J(`O(*Db zO#3v-Rfk}mwwUf|>5xW2gdpG#gZppC*@$wtE-x=P{&w3^a?5@{R15q zM_sga*dUk-u_%E!gJU%)oZ&~+DAKkC<8v0b$_>PZTWj#v9#dS=q&*RVUmRAJR|d0T zL;XGu?K%H6li#sy%=Ua43g|Rk!#9a|HA)2Scy=YgfC3DEA;+laHe>53-TLPu(Zk)+ zqe;-dSpVvd_=G2C;B}be;cNhu_;mqM9ny9t|IlKFJ>zwcc33StcqS+r^P zPgE-)+5;5IlJG5V3$l@Uq!Nbu*anH3Iw@9*i$KLw?y~{Ue$tRjHQrY@rjw|hMsfUg z@u!<7tB?+o0Z-wW7O1B_keg#YlMqRy$Aly8moOf*NV%g+3pJ%=d~`ZgqA^>^iXG%B>kc}XIA(- z$I$rc8s!w^`iAvUHnbQ2Vov-w)Gv~lq)V+w>#O&KP9-;mm#Qc=EUtUBMrQqo;2=`^ zuvC@NkcFYW?f!tM zY)|TzouC$V_*2GdWBfn0UsKFj+zKH#a#6n`P_pZ`j~0+sEYJYWw_@Nf_7hny2bN&~ z^?>t_6i48%=U(5$lLm@}5Lc1q(t+K6dAkUOzweo$BES|Q7eREq^Pc8*kWzfbbjR!I zZx+d^kj|YLL1dV`co^rZNh)8@3>kAtI9ui&MjX?+*YKazM>i(3|!XeX;PTVUsx*BrgS( zJr>~cY`z+R- zerO_)>&qCgr_@Cm$_bKO#_I{g^~K3s3tZSqB7ngDSOoBrfSL<(anxV}VGxt;^92F) zS{bSpAaDO^im*lior1Xj;{^B#4wya56gCPxZj$k9{9XCJ>lqE_GJLKuza=H{-|s8P z`R!)GuE5fioQ#<0lSY|9isk_m>o}8KZcH50PsMb|v&z6y&59mLnWrUvv(kcD1ye4G zV!fMOTAb-UB{+m04$vpjG(H$&Q!$yHd-%i6EM^}s6-IYo!sjiwn%AEH{R!$@EwW`F zlFD@fHM=l;*CU5@W~OKYp!G+q3rzMnV)_ywD?iG6>n=p|%<*?SU&wKsR9w5bq42qbXc>yv0P+-+oPp60Aby=IzXA5z{jxUfZTBbo z(AUTrhyrTyZ6001um-s+Xf`!8FpqI@GbVYzOh&I*9e2p5*SSIb=U6v=L0bF1?ssq= zFXxs%N8fvKrx`(}{MZQRI{H5LGVJ2%El%FvO&bxVg833b8Lj1K$_E!i4TfNq8(u7c z9^YN?Du(}LYOd+!c48!C29yNFG9p*jkrFvLNG}pKU=WDsZ)XLSRZ# zqNbGbRoHe3c``Cd9)z2uXUAqb?mc!+3)dr)qz(#MPv%H@6chwpv!AV44*e;{T+k)Y zdRV#k;4CLM5^SI5NP~W;g%>IYob)1J?#4!8@QHQj5IfjEGn{Ef|5#Ns1oi*E^0sL{ zIinYkds3CzoKvLPMUx;M^-zbX9I!<}{%8=N`!T_4m9=BS$}KVy$E6%Tn4 z9kEhb^)>^bIa032s6sI<&9Jvdukl7PZrQuS*O9I00O~M+do`w_crEaFj%(+*LS3O7jF%xGg&bO)tibrZWYj{te+6y6zFBXB=O{7e zKE~hNQ`M{xQ@|9IfaaUdk)XhH|9{&TO3|T;3%~m=N-tquaPJoObR=&~#|R}2#vF<( zUA4P>QlsLVczD6-EGr7Bob+OQNQ6h>>qqb5Fc8;@$1-Bx6P~uTHwSAM?-|$_>zjGz zWqK(YdbcOpv98s~^uSCFkdlXXJ*MRpU8UdPuof~*53jkR%XxafbRz+0v{MB$h=jmc zf(mBZvP|uD{h|VVmiXklP!*}GLigb-DFDJ=5iFxz$f1#A@6q*O#j;nVEhX(CVj!@O zh2Zpd{*OFNoPoGJdish(-KkbEK}-pnB9?j``KkouO9U%Hr!YH85_6%(>_lQFB+qhT06u> z$s=8Ja)q2juk>VtYvq|B3`Jryt?~89xMkJrVFXsAA^4rd-0(ZB;QPD}MLtnBT;3V+ zBmkvbTGaBRcsMPaolSo1nTK_p!AI(G*|MoMJFBTVPsWr&EL_U8&|!tWtJ&uw7nWER z0JXRbL^j7Lsg5E?mfvNWiK*cO>PHwjkLu6pAcFIbD#=X9H{WsJIrpZF3PLlhcur(-otp5(%k0lJ`M}(jka@%Pp%55~cRXxoc1_}uQv1gHxvGFSY}mj;r1~FIHx~XwW<3xxsk*$(3iqw16uU-Ri~FP zwy$XN1m<6UG*iL)Z{+?BRDK*8ryl+M_)#9dKxPD%co3A$i!E2T3wlv;<~e8-9L><{ zqi&wyL>OnA0{O^u5O-2J{a!`s@^VTptKn32KhT*AVdp%6_=S&^z-2@p9Q$WqpJPE1 z>hz|sQy8@7JdrV1Te7Ck=yP<$XxhB)%Z1DePwE{4%9K>P_p#M} z7eG(-S!Mfq>{BYD0@ho|<39s>16K#HjCcd`wCU}rxCijaBAmCR@*3|THdC#u#5QfS zV~;KtUL43Qx*u4WMvh2_b98oV#0eRbb2rl6OuD!?V;s#f+q{ z*^(Z!3BJkDTgDH&Q3)0R9XcgyQ+7xTf>rfzL^$4Ob8fD~x|N&=GLx2R(J>`IXpxM` z5LUqlRoa1|Cg}SsCNn|DX%_M~Q53275+N=uf}E|o#-!DuO=ZhZ)O+`WRfKpzlB{ASVJSvh>&>iTZ!)ZA<#N^$6<>wlXARop~B{^xw~k- zNbGX59Abm)9stfyka8&{iyf(nM zFy#;?)p|2`*&AXN^y^Ix(>4>}Qsh?nz@&mMaTJiz0xBMfci}4girN0mmJYl1XC6D+ zLFV-^plOY}SrlDpylG8KcRm?%3+S~DJ8P`>JgS=cu(`!|%kPzvAUP`LZgPyD)MoP4 z=U>yO=-Kowe+#Kj#tXtZB>997PV49gMO>ioZ>jcQ53WQ*7!JKY>b$;AN1}4z6fo@AU^|n}~-< z5DJ1e9J3~ULEy`Xwa=grgaKW%NE90{+{w-L!YU&Seyu8C+lzC;(pVS0B*Mv+Hmp&k zai7pPH;QPOdk0@!3{cuH<29;cSm_>LdpL6sa~V_ zJux=;<61e_gGv;)!wzgt{rkro5A^MP5Zl7up}7wm)9eZw1@s6T44hS(s7qkS!Xh6? z#tpD0+=2LQB9(Y8|JIG!ZP>Qu$Jl9cV{DO9LJq`R)i^RglRUn~08x-MOVt}-9k<@yQb+Dp{DGFILRww>jx8!3XemQ6GNYRX#< zJWlN$}cNNmV#iGU8{40+NP?}3Jp z#F|4(>x1zx1}n>^)E1!Iw?9f|VAM>Ag(dUY9VLZn!@FeXRsZwLX9*i`B)(H;4y*l^ zO?h9qG|63<^*ZsE>9Pxjuo&>b3)^YyNH~1MYm;%aBy|7^<16Z%c7KC`KSbVCZ;K{g zF1+b@qOUvK2hINM@w-q&gp)6&K+kI%^}}??DMND9dF}NFIep#Q^pUIxRKeM8xih7M zCEk*7t}Q~#9beWGRmIWE^rZw&HNps<0_O17>|pGLb~8jFE?L_z^XF(v{OnTFnG@M z{<&(lGDe8do@^di2uuvIPD{(uaF%FVpI4Nn_QKyy2C@_q0@&VA|Qa57_UUz=9_!`ossUqnb2*%@q@eY zp)N`Hmb)-6GIm5GwkH2dnv?t{j9+dR3A_M@SF|Y{&Lh;OU!9tWV(Y0^S<=-#xH#6A z#&MG8coaf)um-qUSwPqDytALQ{J z9VFYdLn$rr_RQl-h_SS%Ls7YXPt94#$p8Dh#~k*naoXLQmxA-Kz#{|sDi*GC_rO$Y zfKf=l)v9Mo<-{GdL#pcqmBwy5zt;up#Y3c#{92kh;U73j0`|iUq#^Dkmrph-!4r&* zDJQ1Pqxq!KCqZ)WdPdlpT@-j;MT4(tkwAM(>;^oAb|XVrOsjWUJS1KxB`X{?9YO$K8tzvrle*J)`mpV8s(H71Y;p>EG} z3v9X7Ic>2fLdAo2Z{~Vgedzu*08uo!kRn@4o-mIJT66 z_be`u+X z6n;2|l!Y;bh$+gh3g}0IZME@DoAoBTXc`EmImnB=;gNdPz#iW#5ts6}W>ZD~W0EEh zJ9tLy^{w-RGBHo$PRc7{@#p00?0Gu(Elmk%Na}>DrEXz5Rmc+x}I? z70=ub$R%L3CHm&vs0tw)b5p!CvxdXpu*KnD!)vX4{>_- ztPXe#+AIDZML78UBr5nbl(M=2euUN2ZDYi@LcEbz23GWiUbB*Z+VS!7&Ef|F7Av!& zXl9`%Lx?RH=1yD%To;5N0)f8%S;YEZ`DqWa5(pA6vr*obBXLi|6@rHSJow6de3Fbw z->Ln@P|Y6pKNh`d`TaQwuJcOgH!VQDQrh=2BJ*-zr|tfD){DR1THqjZR>rGKx(q%P zlg&%B!QpPbe$d-}zpJ~tfKPIDZsFQja2ahUO%@Qi(yS=;MK8@n$;2VsoYfgR++ zJ`9uU;P0vekj*}aGzp?fm{HX}F`u7MY1*LjkJB?;kJxQEfi!$h*VZIU+U!{U0q)k2qC^(%`NpVn}D=W+kW4X~Z2ijy2TqX?yp2jo%>;3@Qu`mm9Cd^@7*Qpupzj((cF zcw>jRnj0apIJNc@*3Xhp^C85-se9RF91OCpRTdCJKhUkZi+4g+2veb#WA7e_+*lpE z#s{qW_hDtDR8LsL#ZegXa@t3Y%MfnGBYb_Wg2a`PlB9jtx!(l=zc1)rUrZKI#XkDW zZrb3iadgV+)9?Qq(gOi#az>L_(Rm4v+4FH0c$di%hYj(#{)ZulFZREi8kf%GTEy*h zNcPt`eiRtEQ0h-N@g%ppp34EJ5fACCXng=)7o;_rU)qz0_ z^mJjN2JsIeke{nNqIg??F8xKKN^Xv6?hR_OY)pW?%?!U00T;ykzd=4ifMk(=Z5(=p zzdYH5{BL`SHPqe)gZ;U`BL%WBPPTishfOP{de(xXGE%oR!C&4Ror=5ikv5dx9519G zi)AWYX$PRE%AKh-10YGu(FS9p0|M0$faZT}?Hl??W+$Wvd(%m8yfAz?XV$?L#Tvu8erf3l2qL@t$0vYP=P+?yO zb(M-uus7&`2ha=;4;-i1rtGanhw-`?oxC<2W_R}1GZ00rcDb#Touu(}#ebCc(8WXx` z$3PqO|E@WPs#)ArQ}vWm{B^Iq%0b!AuULn?V+&;1Opcyy{x`lLfsXTM8U!j^K$2Dx zzgBwRUI2fduG#x245BNf5m)uI%*=PSA)%i2ruH)f(^RBjNM=E!i7~BHYjvD3+~U%> zZcyyrz;%;LcH%z^^-wp7=}DVMB0d*ELxcCVisH54tq7dTo0{7;b8FT6^8ZKLdw|2$ zb$#QABubEo5<-X;Ga`Bk2GNZ&#>_|%1QCqry_YBrSi8?W_&fgjW0Iyzt= zt^vJo_DVOQQp(a$tn{6kx)_(da$9t<*NdZQKA+GQ{#XA%W@8dW2gTDaFqx(~dZ2Oi zFlIkEd|FB0#C9$~lWDY4%{5b!?W+m{WqP;^b(|Bz}HCpQ}D|p_@WQGr|~+FWrl^P*0<;4p@|2)&F>0w4{lCqhVlY(++wz%W=ezW zeEY>R#Z$?CKho&L{O_#x*k zNF3-y$^+AV-wqap&fnEL{xxkS0@eM=TWp{S&-eYMfv4N*lBVG3)v3q}N^E`6?_S_V zwKnKx1}6;@4E=(wtnhofeouz}@fX`I`1syZ9)`n)D>U-4t5JfbG@DJ@lh4p0zxiL^ zf6;nRG3c%-cst$z#Kh0qKRb5qZxl@HDLKvTNz267$2Nnwxh;4BMU#||bt_RQnELKz zw1VDrPU6AN;J$)E+O#8I;;Qwl9G$xfxLIBNyV-}r@SkdUdRfKUxBoyNc7Z@AT@p)U zk-()ylmjf!0zBSK%kI;^OxR<%UmT3?^}6$w0dcivo|Un0AxT`isv+CoOghz#Y5Yx6 z70(m$9|Y|NP>0!^N~-TJCf|N;FRr+gI~Ix?kV(9MYJ*4=RMV@Wt0*A^qk=&Q6~d} z`(Xs9;f{(-!3?j>IX2w~RrdyUk3)Iq-ScC9WP>=(q~|07`>`eRa}NS>uibRDo-VU1 z=eAU9a(l}VRIg#3B{_Js0L9Iln371_hl|ZbjbOBexUVJl%KmZG)DgLhcJmkfW}>aS z_76RtmP!dQRM;blIVVfxwq4;(1o)LSlp++kk;8ehvO~y3{RN$< zsCn3bu(O{>>z(HnS$6wRS|$g#^Ezkf0d|%FODrep5mCXG92Oxn(K|^7sW;+MOYfL{ zjPvqbW37pY>#6S!^qu>hc0M*fJVHM<{^&E44|!8sJ#^VtV<9E+Y^+}{E1rPRAyU*4 z%qjp-PK#kX7*rSOv=dW0m*bHIQdaNqS3Oal6VN?AjWeOS!Y9|cchfp?pyH}_`yU5~ z*+iAIR;0H(HV&>MfNMaZ>fMU1bdacm0g~kdFMhq!tg)42dzNjHBzM5h`_S+ISpA>8 z$lB$S38{%iDStXKgV%jfTHog+PM9e*S)4rUXSGLkTo8&qC z9t-_O&Z7T^6Z*Mgz2gc~v(oovP+f{W7w)-rhbc?+a{=5JrEp{2uxba0!1PMtrbw?JM^Co;_M^V2n9N+jiqEb9B@0X%FrR4ofH3Jx7i8PrQxE zKEK=U&v{bus~C0+ay;e@!ug1b@d6lNsdfuERx}--Yn&N$eq1oTKfzW5RgAyk3 z$@(+(xxR}PEUo?rmhV3(zD_IeHhn3f{E%CJZ!VdyRuRFLyf8`mLoksC_d4+tpKSHo z`SV4S={TCRCC&`c{_5j&znP=MMsJG^!|9KE{nN&N^L&tv>3tK4Z@5anQ!$Mnp#J+2 z!+m-$lSfQ88ODPl-1nR;K-^5q!ku$DC*0mH?kD`n#ygL|_+9AU)I7Y-l5U;8VA4i! z+L;$nk%KBdn&K9Q%AELi+s=8E!p2&Ukx|+u_#+Ab&9%GcEcImp?)rz@ zTy|`v@|kx?6x8DqkABLXwe3EoFCzVecofK<4^Z>LLA%pVUwYhUVHP{kW!w{<7HxyW z>$7?D&{51S+IX(FGusABgjUR>nebiizL(*#dLnXue6&97Cg7jQ6C-z&4Dp#YzpYx% zWC%f@iNEU=5p5J8&Ah;% zaHsYI%|EtSKtP!Mf_+iLBD}eKSDN4nHEmuH#wb3y{44Fl6Sa5c53=<@gHqQsV7hxy zc(}4=a+I6f81=I;eYfM;WiZ#N%2{Zx2^yuwT`NQ(1KKaNNqLuTvhX9XMY&n0Nyjt& z(kAUcR1GM~pV8-?DT{ad5F@R+4B!1uNSQB0@W;9rfkQ_;31HNI(=Kj3o8Qyf&a`GG zS#2Y$n%y@iJN-S-x(>ppIr6?mYxUma2L<(UE21S}ydGk5dx7ob;NIEK2H)ctR%y2% zp8^f-YIb{MUB1t=C8b!Ur^?SvrxVo+8llGfp4orEIM@h)V~PHIQuj9lrb2S{PWt^$?j&JcQE{jUY1chl`aqU zOhe%tfLe^dP7~)8$GG~n;$|1$QS}tx2c6sm@uHt(&ZCDCJ_tH$X?_)Tcyk(s;)B~4 zDrXsFetYWkU_Na9K#unOHq8+@6@zHJ(it{>I56<_?TKMGg{Zd@xNvL*ru(?(&Lr9g zbt@f3*NPrPp_J8aYt{6})S))Gukg|~#Wh~^&cotn@a6KiW+1V^cPXY`z@)68T#6FQ zyEH~4SO2kXP>93w z0@UHkL_e%q=XB+KXDjxuHiuv6>y*LupPoa_8voeHL?m}fg>PLs;JdEI9{ci6GmR*# z@+!k;Yqg|V4;&|`_Ku3bI)bC92F{Ha@0*WME|JXM8`S&o!5SdhCy?XawEWHOhW_vQ zgLbcWcXmSuR}?BADWIjk>nd4w6|JO)2h66HB}S-gYTeI!k($nIh21+kGc1fOo$_c` zWZb*Jx7UAP56B`3gpvmzqwjiuK~k-pQD3zv;T;FLQuVtE9OdKDj^Cu`bNM`fX%s^H z(6ObU4lUR6Yuq7`eFD|@lX53QJcq9cF(O^-sP#bMhYazl)$woRgRssRd<+F4EVddY z!EJ%iovHAi%!I$)0$J)IM}&R$hIA*a@$zO75oZy>d6Ft(Jv#&Pirn#!31b@zddg*6 zQR$ZaA4&fKd+gU0p24N#V#}NEeq|R_l4!kSGpGf<%{fU&elz2qkcrs0@ET=zK*V^Q zKt)jNY|vN|-G2WHO3LYrj&Ay6U&~4p!+p1|aYjQ;mobLnK-wFPP|DyURnzQg6h4=i z0Zo1EA$+oQ`V-V+;fui0_lDNVn@fKY*50GX%D6ay~7d5R;aXtdk;a4f^f92-JLZ8za zg?r(K;Y{4~)NHP6Q>^GXl%hH`!8zx%XK*}{;7&ezUss6Qfi`Omnxi}6+a=Aw+i41+ zoi^CukNryDkp8+r35BLOZj%+{JO8E z$)tx&;gBtwf8z*y`97P6a|xI1jdx-KMn5hb0^=m^Z1slt{%gSRuVFtK(q~wC_IrW6 zWhjdU(wi1{bjP#^8>lf{bvj+{x{NFO@>`^T`K3we67zRPS5j>~35)bmA9vq3o|Iz@ zM}v+g^W(d}a+LHs^(&H8)%B74zp}l5<$MH#DZx-cM!rw6HXp)Rv!s=IT<2Ta>;^>c zs5!QYxl;~m^i68vKRJvYlcq*F{sVjYdi!jO8N@6iubjUZ2K9>gtOiweb=Nbxc}SQ? z)iYt1-C}(h-(?0;RDmjWs;PHO%?~X2BrWfHILxHS$1e}8he$k>csup|mF}y;fgMM{ zjWmk&pzgN-PvOAy6w7zWKf^btW?)~}G_!~essEj2qynE{P&VhHgh~+$O2rF+=5}O^ z!nxePpFj?Zi*EARS2a|O$pG6`39pbAzifMN5TW}vb0DwEb6gu(Iq2!52aHLSs*HI% zRTjOCtT*0}>C)mp=H31Tpc*V_hUYK=OA!S&dXk&}$rwv+X2czA6AH|MPqP6tG6cJL zN;oLpDRC=#ybZXXFok=3Q{PqROOy+7iKU1Ioh>wC_vIn)r0Nm?fKU&)jP}t34{TZ# z{BWk*Bp|~JuOn-)^IVf)%a1YBHI}k zzbqP00a5pq0*}7ZO-UR(0VcxXCOBTcIZe&c0y-Sab`&Q%Ndj4nxDEk;W&jFz)YUrb1ZNVe!i^et*BC+ z*uVEQHFxVjDQ1u^2^gWVyBj6%){62`$TtH|y<5)9&VlXH@6Q#lQub-3`+npB_Nqd` z;K=BAy2F!{>%7YP0F9>+Hv75h%g@o-v$}67WJ`6?t?(ySNKy$zH(|$y96Umost@K; zFrSv~XOx&r;kno>d$C`xX_r~ z`(Ut*lWZ?ooe5pgl2r8?@)}T;TI+El{`EC*?xqpuNJ`7m!o*77#6iGCOak3~)lF%i z#TY69%)%U4YOxO76NTrN4RPXRdJH_sFCYr`V4{;QFLKmx4aM#yUCoYhJ{K5#ov`h* ziH;XOIGv(QcgYMW$Y%lntzWA965SH)$E@rFbp+slI=|g&jR2G)#3d{?gwU0WG~Z!4 zHMndhp!j2gN=0%FmWLui|6Ai04EN*?Hu3+!-lfI$mUK{eI-5U9d^T?ulGyPxQ5EJ07$vKXHd!-Y`Qyd0WG=wasbyl7$3$cFwbfSp_-6r!w( zak9j=yWmVQ{oBl-!CVk7o@&r|+P@?nIZDt0i5Hpr68Zh!p4`@`c|SOVJN$^NV-L6g zNo)~!6%rq?6_e!^u?;Qi_&7nQ4-l%&!ubh_RiskzuYVnD?P0u+yCNGi<8Yx%C%%REyve(Ua!PA_EX2Jb*roN22PF0svRkR*t`C@6 zAA+r?Gz2g#8ay(oqV#gHi?|6(?S*67;QnG6R$+E4L3dJ9Yt{HR^}}*T=@#-hB95DP z;7TSg2u+-`8eZ`*;_5xHZj?E8>hQ3qMPzWUF1l7}NTPA)Kw9p2X=Cbm?c95gd+b{| z!oK0ROj>Z&w8z0jo&D)aRinqTz1;qFd(HHTgRV>Vz8lgT=kvoGr^`ul$9wt1Y%-kM zb7OaoRXlP@FPJ8`)SgZGy;vu(%1Vz#)R%{lQZI^!4)4+_Udo^i@7tsTR=zx~$1oIN z+EuO1)fxf)uy2di0FbCf(YJdOC{8KYr5562NxyM!^O07%aXgVCJ$!<(0D}~P^X@z2 zQnSa~gy6Fbi^(k(*rN2)fj=u5ZPQG8&y1|uKb<~Z$``PqSX_zmn?H5;Q?#_Inm$<{ zx3AwCxLGW7%AF$PeEe-~uTk@z&uK}R|NfMBvFs_A(G*&GBlCMaKHJ^J7UJ}M_)>6NEIf&-aS`0cA)eEzfCIAVw%9j-yb@>OMuDg&3lnt8a1ar8x(w`t>+VTVKs6Qjmi*4}e;m!ayba{m5W};w!()LXd?!^O~-jrlLP;s~aX3XhqSn>G` zP2;q*JB>{S+GZ5zh)!?_qgwKSa7`PU4oy|uk^h3b7Cu8k+9m7wF|UMtNspqwSyXR#g8+dc225F zea^v%X913NeU*1m<62RLm^@+lHbl2jUl(D4O+OweDVEz>Vp}&pTN}5BS_0$c2Hr+^ zWx?clQ}SPg2kF{3p7~P9Le&W|twgbI9_s^+%LwH#?9k#|eOat?*%_(B&-pK2NmSrMz!$18JYxMjLiJd_DbO)>F8R;PRYP;&L^9QW>|PpfrWcED7} zTqCSgL#;?(`!WMMu~4wO&9EO{+n9c5sfIbXEIma~C4`IqEBa{ylnX%>8Zn0PKR z-Qv2fWLQyEKiy!xd@nloYG}g#&hFa@2s@50teCt^|=Dl^%tmijxQHEGM5g{QY;kjC{!G zH&2&U?LU@O+4%ZoR}UO-eB=~?FRW+H%8ngWa2{j1et-GA0C!XZ+(&Ao?Su%Mc{gU~ ztt`t91f!BBV# z33wf0Ywpk?RwH!?G#-C5Gh2J9o)xQr4F?g_Z>3y6uxF>8@A@XG|#8 zMRWvl(Sxk9p%L@t%D3>vtW*1w#b<1tT5-%AKX;lJ*o&GOZXsN71wqvfwI3P^+9q5VdU#t7D@ z;}xI1{VQZGOgS$qD9OMRKc2f*<&lai4oa|kWd=eY5wB?ntlu0cU%~|tA)1b4RUN0{ zUY)d=v)2$Q>Df+=6QTIVmSV7C2p7Ut2nakfjLijCCmA1#ykTu-tN(ECLjD1XMArt{ zNnn7Sz9|VMzPYihUY)nomLU)-YdNv#^yQ&_<*V4>tn7@`8*G_Qw}B=%f%cdkcE!u; z6;!I>ui@=IH%Q>K{CG8pqayGYemwQ5((%ae1=A>Ir0&)?YOQ0Hnvbw{ zPox9v@^{z(8mM@T3tGZC*5{ok(*ZjQGE`4(k7iU(HT z9(-5fr>2WY$~7p-Ev3j9wY}!Q)13Z~!XYBjBOuZ&(!5<|^9JwNu+D0l9k{%siGRTI z+0S8_S1c$?rK{LzV^BU#{XVMFBg0Br?Bk_DO)5m+E&9U!r1GK+$>onv((Qlrw4>l4 zb$qQEe5GhNH7!P1VB`oD@;}5$;Z*ZwuNBjA%u)!_qd1b#eZUVV1~R|E5-=E&YltQy zM0vW@i)FxAzdbf+7j-9d%q4B?!PGq-m2i{MYl&5z5Yqf0Gk66UFB2L;`q)lA#Gotf{*byDEc>H%BUysm;p#u%Ow+#We=$Un!bP%)+ z!f8DpD}&{{Od%ICCFTpW=vx>EtIbJ*J3-}fG@l3#F;{M8&o=Rg}OT^5ye(5EK&@fC4_(XcBu>nuQAMn(d;>L z(VM|vLqjwK&lBj4FJHjoYMdW56~ziK$fO9(9iYwEXkTtdAojgG5@BJSh1T(rV+rCh%1Oo!Y;_zL06G51+6UwHBB+RyHW z;{Z6oc8x;8v9c8oy9b;!hN7=>f zOwr0&h9ap$DTIK4Y9|d~3l>Qx8RbAV1IX*!yXK$y-zDu5dDn;zV%8to5J}q)IC;Oj zgj*>o?E85QA-@5L%UTwJ5A(9kvAGWI6Z#EWDtg2ojx(1Ap&N?ykN~Oy)$mzMfNqmQ zVHL3y_pQdhPxts(s4vhFtMcqcDEdr}ucJN>))hBv@Gt<+&9}1DB+~ppHMulO!_ZkCb&n9^aaa1Ft^)q*cfd zs;DJGY$y-{aXWSf#8t#5bm*g@SwqD)p4LzeE}Ovx;TA_|8Xt$|nTuL5glxbJ3#5}3 zsm-OW1?;`=g{3dTpB&?GJMfpUT)YDa2G6o>!W}bgaQZA!BJV!I)qrk+(4Dq29z`+d zG}rpYF;EKOZ;T~Eju~Eb0lvOfAk@Z%Sr-BFDkLywJQE-@ML${PbkHhUxc`HItM{S?m_e9y1I2(&GpsgiLqBV` z_L4z-XS_14e-Z9Su5)+b z(!C<+jSNeVp^coRb=T;8%MK-iD8@tQKir?OT$4|P&n}3-y}s_SgyMZ7DJuLz4Dw>0 zVSy3Q!h&7_pp@ABHtiJU1;)%24U`E*4s}~TU}WQq>s&J_OE<9eH9=m*2Z0E_6nvia zQP#poCVUCy>Gd1~uR=C6ctQ)-iwd!{!110i`u|^ZhMoaQ!b6b{^emZ%^}EHm-!pkF zH~rXy)hr+Lkm-zSoU9V#`-I^In3rk&>X3(2iI`sdXOY0-+_6!AA&;k$l>%NYlWmh| zvwJJ6Dwh?-!n3j^#JC6HJ!&2%7kY<4A#$Z#c#DyA&q?K=M?iNqA&Epxb#dhm{9Sry zFZ(20CbRCWyGrp^*==BiM)J>{8_REsqWH?4GQ?|b`@Qie?K+Ny(_i!uI*UoeI$5{r zYoV-8E>nk7S%y6Nj3OUvwN$k^1T&UT4ZN{M=J3l2$7#&dKJszl{*eT zxlef*S4bfWe>&He@I*0@Ij2^M8t=~177meKC07qJm{5SoxR=x@N+OxXqNoK3>smmw!C?xzh?M-5KI zz#Oewki1xKi$If3xI*JRhFekWSV67@Yi0&V@1i8-xCY58{9quG8Q+UMisx|fji$D2 z8h#2F<$nM1U23P^C?jmb-KgwI!ZI#|6stm*LqmvBDMuV?nPazxjuNAx&`bFPq3}f& zF?6AUStK6ccK7MEi`wQF0Zkz9#%9KV*-Gz&&|wA3!?5p!obGRGwChj_!EqseNsws6 z#jsll3n4t95HxIApTo`b z;P75!O|2J48V4ZHz;fSjKQQ=B&G|a7yy{&|dcU-mbrhzhn1Oh1Bd&oLG)JW~$Gb^s z(k>vb$ejZ##7EdFi@9c*C=1~S^x(O8VKv|_V1kL*=N#JM?5(e(?`mT5phsyDBz zIjeHAAWG7g2d)^@!+v~m@&cOsP8VE)Q;HE(Mh4n`95}hepcZw3y^KfIurLi19gf@Nbr^Tsd8i zM`W&P!fo_m&1AwP2c!&|O24yB%-6sRj5@FtH#pKce7n7EiB$pY@X_Tkm(de2Oagg+ zC&8mZsG-4sg4X`TOc5%ci^O`?>U~Zo=KVbI3FI4>{2c#g*}hs&KM%+f<5G!eHfaR| zA7flfe4p{*Z(dcC-;M6|TZ-fV-i9KeuT&LX#53%&Kfa0nV$NMjpVa*FB%YT4VEs~} z*|9+ast^RZPE%X+4m%V~-(%S2v%=nA0>oj2N#G3?C!!LGFR&*9^2etez?eA~CZDe<3ZVIs1w*F@J4k4QR(tlnSxT8Dez>I=VR#Xmtgu{fYZa5Xd$ zt>E;9j(w#Fs%l^F>g4*f(4 z@FNbsm2Q&&7x9X3LSH21{ww)Ma%DfBz&8q`a^8i0q}+kWlu-=95QF>Zt601QT+1v1 zMJMp9DlNtadp)OyWGO>_$}qo9nmi*`8itp zyGY=3j-N=iY7Y%XA)7*xc{GC6FE8rNkQ?nAmR{S+lvAcGjiSGdR2*UCt-cM4UaTm~ zFgg%@ncs9fF%W;YJ+SY23C_s`90&SAZTr&@e!00yju}VJWqrnTNp{%K;>9q(r2%uG z18H!M*LT=QMGt16ZBGajJ_OYD!|k80hlrFxo+uPZ6L@#Xs@#0#J4{wcISRw!4bk6% z144oR0YF}mn2h|K7<}r^l7+?zm%Q-og)#VJKAHd_SVM!?P7 zI#2jN>G1!^x?J`5+~~jme|SdXdD0bR4!v6?o?^zlr9!~0Q2|>t5J})Kv=ku*<*4E4 z5DiB|<=|sV2A1D7|Or>;S#chO@SO#WMpi9;fkl`=fA{)XY z&8b+CdzF5I@}h1AlU>^qxqFz6UKhzTVLmW+9)QK|`g$AW0tZyBZTq)Za1Tkb@45YI z#&Rvc>No}vLLkg$v0HqWSf1C=wN=c6#XwF4O=x(=EkStLE95Cq0?y}Y*JS(OIFn%g zBSZrO8?3rMw>iO1*K$t=edhC193xJ}T6J0%aUZGrDcv(W*)pY^U6N*XhoI#!soTJ1 zP-}eWWEc_}ifjt;Yu90|qr8hlkTcvuE6R)HwI@^sUH0bT_!kER|yKqpr(hVU$!I^S*klecM^=z^&d*k zYL4(r@049b`@{otb?w^;D|rAqr9(C*nDG^${2zW7d&;3de1!TWZz8%i(+iv188{&R zgM%=9o1C^5-(lrK%{q>MwixjF)*rU3(Wpf7S7*<#y28o`V51if%0E#OdgfBdMsZ3) zahfLvxAEX<0$r@Of@FDY26^Nyey6Iqx&Gf(hUEkiEIhc`*cs($2HwevP={Pz!SzzZ zZzdgl>(s%i1DEnDn}A_|Sl~Sd91qV&zLgEnGT7#%SZBSc#}S17*o*AizOs3`sgguu z<38NS-Gvq=BmS))Mi_ykH^(+d96K%J2zqFe+pk-EiJS=t9j&sKL8Fez5eN*SfDFBF z3rAumiEM>C61lGhevLSC4dT-k9m+1+2JGx)C;lN^p5qi2cF&z%oGeUj{~XzyAt@fR z3$p+D6_S(`lMwrNs*uRPl4WGr1vD+}EM2VFg+vKyy6ghl>>}&}k6yZ1IN6!HSg;Ey zS-4r7Tj;7PunVYI|4AnNz9d{xvM{%QZow`qOYyG~J&4oZy2D|k3}HR>67{{b9PHdX z%wFW|{nBdmq|k8n03DLhU>-N6%PMp?0D8~ipNLh%ILwvlC|?Dc4U=zO*ZI-}RZ^at zjI<%&C=}bCN;z%QpB`PP8XmRW@Exut(m4qtZFYG=93YzYgl>JM=_&2auPyr|x2_XY zKOz1!^Wp`m>VXo;z)3wQIT@?=rEG8gLBR96@%xQBJkCSs{&5@h)Mu@k*B+WZJLT7+1sMa1 z?cXXBbL-nCTg9yvvaGG?56xR0HjYl;@q?X$+P#hun>?#M>5n4Q^`~F176{Zc5bbdp zq_UPZBqE5)ZLi4B%@ja3*on3-6O~WB-@X(2(m1|l_S!wlH>;~JoryDS9`G$n9A^aC zcQ%GT+)w_xeyk^*$0!%bsZK9qp*)v|$bgdq)bspw|N8mQPYD}x`-kV4!5cckqLYf``|f6u>atU|1I%*SDF0MZ0M|9O^AF$9_m!9Uv0Ms5h-$B z;r1-tf_?Fs|4+M%e3Y;fRg$X@uR3<|7W+{NA;g=T6+&_nC60gI_k0 z(8gYM$)pesd>}}2{}~lafQZATDR!dZ0JZCv-d=j3Mq({bTKY(Kgoxsi&2tA(tjuVd(m812Rv= zM>>*pms%CWW3R`{ANKNKZvkK7vlMkeJDe`ewPZ%Gjxw+IvWs3hCH4)z@s8xXDb)y3 zWx(hMX%;fo=C41LJm}wFW&AWg1FmL}rLJmboVop*=zfSva{`%sJK3c^l_zAkHS2 z$v7|m;<`xSVG!DEuq5xvy#hHma`79fQT#1>&tje#en=|0G-A3c%|hMwiD{O_!LRz( zQ(-%?BGM|F;mEpxmCsZ&JewXLfm3uFK{QRyzs-E^Hcr@=RxMWKOMhzm#Pbo7? zbtH!o4~VD!ZbFCDb5*BX`trt*BCZT}6KlYVv-CgjK2B(5ZRb3;(WN$yD|4>InV-1P^a<(*WM zK%3;7V1YRw^s-cD%9}wU>dGnEiDs|OQq025Ud@WNLb*T22gX;?LU8g+ANsk`cbOHw zqdohp%eBg-#w^AJSyd%+kH04@weGMj*6)y8a9bG8@y@Z#G0&BC>RxFUe0CtB%Y=?h zh^&i@*%qCz>G|0+E?#VHeEt!TcnGuu`Xq8BzDOiajKOOn><8%v)9|)<$N*tE8>A_6 z6nQ-OAU~=H)8n4rlV&1%{_7-c`9p2ESM?Ec_wzDnIe|Haxq+F98Nr++`bCT>#V(~I zWiDkww5{CAfU<(rV9sEn!dNgddA$q%g1hX^!>q!hH4J~BZ0=+}sL&i+_QWzryR7@B zQTzi#iAPmWt6=U55DkGR0w%@KjVxJcMqx&7qiUm}f9I!O_OWMg9;G&6vm&w@P18+t zX3RP9aru3~9D^L`FOue!juD%(KMi?4gr}*;t4DQc!A1tA;LmD%%6qQa%v2<=29x`1_hI}i_u2FT`j?;BmM?!e`aIT> zVq;|P+ZKxaXrA{rTy}w=cO%#I$gS$$HYOC^~s+O|1a+0z}(v$o8WxrG+4IAkt! zoN)X7lNw<^S7#}Hu0IfY`nGI!%&B4y_qC@e)}%?_5qRe|8|(D-^YEL^xH-+D9g`aO zInv>Ty0GK;g)e*yQJY2w7AJ9}Nx`MTeM(6!M&ah_Me6kGKS>~uDt@?@nh-W$!=VVv z_W?w3eYkJd!Q}_#-xat`BR=pMiGc3a3w##M5mc=0v>seX+{~8mi__$F)_+m=F8WM! zS1pn&mHU-GWf`(`%2L%LqZ8V7V}9pX$}hXGtR34O$9`fj#N1si8{E!9PnyKmZKw-F zhKin!*J!&NHPz1SHmtLbxa5SEluSA0JM3?FFyZqxaCq?myhf+$ScN zYPX*xo9P>m_7?pxDxB-u%HFD~d%W79XKLv9jK(_Vc}%%5wzM8xj8q-OEaxr7P5hPC z)HdUKR6|tJZOt*RgVF=T5?Be8cymb``yE<}c}pM=uTbwTa#5k>!pef+xjJkveUOe3!@t@`z{zW)qq1e{gwC-&uM z__-g~TbgyW{I=;^NtOdoVH+ME4ei-3JYW3v-Q9X44-+w!-ypXac$#%=zS9=Bv;+> z_y6Y!6?;M{0x(xIm%m;M?&NCmcUFH0`TL^sBe*I8%BN=W(#^uf+T4_Yu?Y_;SvZ?J zSv$DcJ5dOU|5c8FvK;|+TiX$e*D^KNwYN33`zJ-k+R52P(aO|`T|}4w>rMZ4A}mY* z^pCBdyIB22ql6^IpL+P8A2G>4_+Lci4?X`UA8~O)qfkf)3$y?E3bKm}3H|k)u!Q7= z=OqYdf8F`#4#E?E-}Ud53+4RvPGVwzs1y?l!dfp)EuH`3 zkv~kP@Rw-tKNJ&U=NFX}BG`eVV(daf!oo%r0_p@-w>E!dXZg~CP@=#iXLAbzD@#Za zj{g+)=Y(Hagm9*4>Y!#}ZD~cgC?rAPbr%a;J@$u^>;g~zPNoq1!-Rj5)z~G)2syb~ z{>72(qM`)x(=zq=`%LH$rGK$L!PK-6W+&wJKcws5n&6`0`iJ2NhU?#UEP()F!M}3( z|1nl4y}W(k%B2qO84F!p2_gxejSwD@g#83k1r8vza$wF2bjpWHB`(>u_C zvU30_ls54P0Yu2qSjtOJKi+>s;yp=kq&!!fU$j`dK3`hLR{KCur0PiXb!^XMhX291 zT!V97ZC&m04z8%E2w(J&_3JuPG2DvEOy{&<2)!NWWZ}xGgq(k1ZN%J`@cnx8q_ecN zjN|)D@AYN;mx8z*pZd_=t#EFdrGM3PyNKhtTX|JQ_nRutPf$l`c#ES9$=1LgH|u_j zqp#dA);AmPq(|%|uXv2c4|!jij*-1Gv7Io)Z5#VJagbPjxnKJ2cb202lw4&=4{UC) z#@r5UsJanqaBnOUzUaoq9>i6hdV}@>HtltY-Wc_8un=3Fod)ojc}eMVW8of@+uw3b zfbF<)4Jp4}ec+DOFXmqv_8FHS=ZQ3b8})r_6}KD>}l8KCxRWmU55q7a%q$k#g|s2 zB-Yf!?p&RyOM5d3sct@4lHGq{dF!)COj}vq``?Si`|&%4>z;?;<6niQrByvfBx@o; z%Tm9KeJI+sdwo+qutJ+9Y!KGQMLS#XogaEJ-zNh$*hGXEf(dR3Kk z?PGn9M4#`i2*JtIoBgV`R6jG;i`BpGhirB}bJQ9e+DQoz@GTurGG--{_xu7dEp&Jz zsKG z35d6p<3^knS)1(Tnb!8}U%ZdG4T749jRBjcC(CCZgZYmnG&BnO*>4zxlIkjbQ0rBq zYmN!_+{wh1P3RV}?}jxr--=U)s_p$g6qXi?jOfqV7QP&l!|6+P^9{ya6PnYz&HF82M;-#7AZ=#=t3lZp>nW}a8oFc{^s@=*>e_)x4cMgRqJ1?f^@VMtFrA}m<59BLAQ5v%0@z*xKuJ(a@s3JuchkU zYwU5>_#tW4Ji)xUwVU&XR-n+Z!dK~%juPWsRedbUpyHarj?|veg4tSo5IC^bve((_ z>Jih?%?7spwlVXx5|NS~c{qQ2AoCC7kmF5DO@U*b)#Q=KCADyee| zduLMibyU`lbNHK0wna5!|`$h{koWk z^uu8HABwqm*gjjf-#H;aV=-xYOr}cvI_`Nq^%m)$x)) z>0Y8EhU$P1cg7uvi$dzCrz01Bh8*bo+*%)|H)y!~;kuHtON%B;ZeZ74jdtcOS^du= z$=6IgugL$=--Ic1)@lUqT z=bbhjEDr}ycp73F+s~N>W}nYcn{pO(TgQ%O1m5>|FOj6j3dqYna(3iSe^uFxT>Vst zrOdUtV@z{m5Ycb;tqb`=rsI;e2kR+a?yhw?h3&H!Ijki#$)Lqcv8YzTU(Dri3gxx! zZWnZ)^3vp5{ie>d%*9+jX@J{DtP&?~d>AiaDC@9N8(PV2A&oNNrjTh9Ce0}T+Pl8F z_sgEV#Lr$!OT4wdP^Zt!NSX4b1q6HaMfNU@ZxMZp-6B(P`gYjvwJ+XR!o18nV4m{a2YDlGE@S6cqqOQE_IMvq^Axq(OG zy1JXgf<95Zx-lSF9_3~cn5udRk@>7oax4eQ9~x-;*;hrR>HC; z6`QqRu5Ti$DqRs_LHsnAoB?ABB|}jGTFBp@KKyFR`*PjSA(jmMlOq!qf4hpj;jMCd zY^ULj?S{d?|5w;qM@9K=dz|hPq(>NX1O$c|hHj9M5(Gr0yO9p*A*4Y-8g&5akdW?% zp^=tGLZmz74!?7L_nhNBYu$If|2*Hd_n!UCyJxLg@BXZ3V;~A|x&QsQgX=TW&Yz3o@-7406dz7LiB<`nn(<3M!HB1Nt;(V(rYiC))Xl3o zloeTgUQyF~Z%=xtx(+IoICh9RO|KZTjG1-~jw5-s?0+*Ult zz2IKooY|j-v0JUB{~TS&oH$q53=Pv@@nM*l>QnRuv&kH=<~PCJ4$o)LXnGikvY%`) z?Q5jYIfVRp#A!pwwR{s`W-0wRlqfgjkvgogF0DTzZ(tl|Y>=EcJ5JKxd6@{Ho2^fC z4ulg&w}SYI7ijD%NGa#i(&RgY>RbVySoI#THoQn2g#f*R{%EPZ#z)}KQ7z3*PfV>; zbH(o$+XZQ(9f<2J(um-^o14IDIt+V=9r2vIifBv^jeo;Z>W#6_{eAt(Rx(w6eOF|t zd>KGw@|*b{;)**ajE~OX9-tVHWj3TjENW_^qcYCRyrBZ8;yF%5+Cz1P07b)uhx;?P z!eNnNo1q{DjOs3eFohdM0M7*zfZ+x%q$eV`MGWAH%rZ=rQL)PHE%TGkaaemrp2njp;bS`me2!iWAVT%*2TO6t0e_Mx+1ONEI;Y z(e6qAk@UeLQ5{Yz-crDnK_oRBkii3e7k!T=W^d8uUcPB_-tVhIqt~5nb$IQXPh7;X zDEA6vY;r#ax-bR_4WH@1%vTAjeeY1NQMT3>N4GR@6*Ny|Daf@ZklR(7bL-FQstqi~ zJ7cb5px;*x24yRXXN+j3N>=im8kDAqcEv7b%e;RI+PU|v6V&BW*kMzB>81L`f&%cF zQz~MpwJr;NH#V|or*j@`f-c7qHA0IPA)9(Z(;r6|2aPL|kPl0OrN?{G$ghk&d zf6i)p~NiSj^f68+D(ECtPFF%dOH0^@f8nvyqx{vkf0T0#6{4Zl!>2W}6js32=AoaSXL4J=px?zN?y_(~KFvt4)mKu`lV zBX3GYM3# z$%}hxDceSSjZfLGswEl>O*JV$%E7e)PU=~eUZZt0eMU2FhuA2~pg$RtWu869K$<98 zJt9;#*L-1NA(l&d23xhbm);~iogU=+uDRUE?4Vc1V98v)wJbrNYQSJJL}4>#!137k z{>>#XwWNVx!p~ZJ7sq2bjrXs}=On8K*7MY(E(!v_qM9H0vd~5U-q`)z!+Sk9`U}O# zFBL*tFzc8$&EwMRS_|YxV1z-tZuKSJnm`*pC9FCmBISc!CEI0{PSLO8`8uW{_}g|& zEe4L*hZJX~2}730M;M@T3>Grfu#RpVnr;|TsDtbxL4LuupCBcv(Lz~&* zrP~gv4+4|ce_ElhO0IK0;XYJjJ!AE#l6*NzpQ_;2YON^HAxdNR`4$hLL!_w2-g%p! z##HBZ(HA1Jw>6$uupMA<^5v|K5a^-QOCpfZl~PR-HLrB-;`~Icu~fS6?BOiBK$6V>k2)w#zT->#Nu7CAp~XRx{e1+(RX?L?nJUMurOT zOW`kU#U2?%FO}-18{>5(2J$@?_283zpSd0GOV`w%nLRc!Wc&LtzRYF|lz z-t_h%Y}CZ`Eono9;1iy3p^kBxp_9%2^u2tnl>ng(QnD#lMf}X6!Y@-d(#DaMu!XV} z7}Z6622Zv+>n8}A*D;GU)dlms$Wg)gDixZ3bd;8`j`0?J08}!#zc0&9eV_W|9XIH= z&uPtQPy#aT4d;6W(f#f)cP9mZm+d6oHT=^NE04q%r!+~o@29VJ1k2Ux$a*4h997i` zJa2xR*vE@4NcOa7zVRsBb{|E+t`rl#>NkKwG;9^}az5wNP8xgl#-*ok(byYJkERxi zAtod0C+>T^G{_oSfvS`FT7Si;Q5QtNa4xyP9v+Cq0b$Orin1Z50wu6&)lx@Z{E#C^ z-_z1*6yR3akY_%i@c$ZnHgl~))h{dub&R3U?feu4Wz7?=}7iMvj};t>$+*ied=gM?ng$^1`oZT zd1klSIgd-oWB$aZ>x2Ak}z=T=^^tNJak4d>Z)UUIectj4geFFNxa9~X~7TV^5V zrpJrFX>LCJnxoZ>94;xG+o3(W77xL0-YG`R;4Vh_9lBXw9D+6;@$9dye@^5Pa@zVH zO?pdO^yx|!hc>7Q%iUXUB-D$V9FME8b>Smd@PX3~8rFQ7*O9qk+`` zy;>T6*y$H?TD71Qf7(mc*IM!nI?8l!f>@sFvT$p0zY8YU`0&wW2V17FpMy-K;wbkWRdp@PsoM8^F^^m02fuZ>ee}zWaV~iG*GT zD@)`64@*K1&{P;ZniWzZJP3J2#i}LHhUW*087znpS_rNd!iRr{n%F?)10E4HEY<@v(7jMBDBfNEeY!F_ z)PQWpO6Fl1Sj;fijK2QX^eTp7Ve;g(xENoQQBcIw9>L;)Zt%$BMTMoH%8-?(%Ntcy z53_WZ5Mu_FC9cM{w8yv2egn#V=VITO_J`43LQ60uzsI;^yLh~Cs>xNDH#KIDsQ-l% z%D1nU9=FMFwG;H+;XQ^o66@{I4=r4z4(@d(=T35R3Edh`erUyP;JbIIaf9-}qD^IR z;f-SYql?w%5K8bqw^>)sNDBGQ(km%M#lGM6tKP-cS0g10Q7TTu7}IncMoi`p&|f`$ z7+3ir{Y|cUkzr~|jo;B2ZgEqoB%{|EWU^($=%)-L()Xif-;t=q!t1ju$E9}OWyjc2 zz`l{z4glKv02ehhaF>KCY9eN8XkypIV@~*k6;MeHKU^&@u9#h|GIT&`D1OY%JN*?! z`3wDBx5J8vpLvYJr0=}~>Yt13->2lLcmd#qwNE1g>x6;QIx7k`4Vz*3?dlpv-kbyx z0sHb`7mL?*O^;n)=350f@23xn>in9nbG~ty{}$&lUc{T&;@tClb3L-9t49BP>Dd3~ z8p+$+d#_Zf)5{C_zAjqm>hQTI`%X>TwD2U(ZKu$Zp(vvoUgVxo>9Qo2uv}{ zlYJ_xO823B@XLVH$Uz|dB=wyS$xxvhnd_|7J80_+MuD(QtIY}SLV||?sR+*o<=laR z+yR2pQl!SK*YoLs5ZW7c;}@{Q3IL|Ri*d~Q_a(mVT(dsl7oQ;BuB`2_XXWFu`f5op z_F1Aee)fdFEK?2TBq1Nga87zCP3{3)DdpH1j6z0T?Pm^ds_l2RQMHmJ>X%a#*cNt` z^Lll?cpNg}7cfc&-jWn8)aBK0>J|U`E8f~G)VF=`;@R`4OmEIh%CFZX4KQm8!={?B z4g>e=U*ma?vd-Hh9r>wad40w57MKEgf;$LG-(Kz&Hv9Wie`ZVwC@#TfGaw*{&$@|# zlPnWbC5jB^7kCBy-on77e_XAQMUh-sF-s9&K>-IrM*90N@a1HmTOF5*<58zOtv~WO z=BA;~CXO3%xep(M%RjBPA;AgZyN3z-@-s9lQJ_B>_{?9m1>xa9%w;ZZbesE4%lLC z=OELROFTyP-LCW?YPvEGnKF`{uL%0;>HMRW>NlW0Ye~ZoZX>BRA}JD1T3?$O_e@+G z95XNHk<`r3dLv!>f3T%-M(pa*c+tNNp-t|VFfku7#eXut{Kd$)rdHd#{}?jIvYY6h z-oClxMS~38oFf+SF**;|(4AoB_b0rQX9!ap5RH~0FLM*&=Xgn8KCSspSTiOg>z&!j=hB4O z?mXPQ*`tGM4FRBjN?XYWc;=qvQKg?*Shy3rV!8HDg{T*)2@sZTr(DivDt+j-9_5M* zi*9W@#(8DpE(_RFgxAX@x$JU3o|7?WG-F|9iCa>fOnmy_IHJHS_lC>wW;bo-DhB!H zav@bT)i<3zC+YDmnv0L|Py5HE`0a?OxVNmL23Vh15k`vcV)3o;#-~EXKYw< zoS`DsR?6L4AeJHt;iw|1YaK3vu%Ry`K_u(z)$1T;&}MuFod>569AOEecaiEk1Ul27 z(izrgRtm8-RQb6`roYMe6g4)mRNSjj6#Pz2`GqtEbBFcZnVEV6i}6A3_K&aIA0V#u z4bbx{EyItxrSE(4Vn~sSnY1Y%>RVfwjUTTN*yq)-RCi1*FK%u3J+Y9|cABwMgH+J| zvIy%+vF}w<9(#2ErrCt?AeXgp25B~sPGVWnD&mqgG_gj&St5s($h9#$PnE!C#E|fV z8pHalPl+fnS~?J5Yv8vS=l7uYKF23I0ZnGM?232SZmM4F=hqrhFhn?0zh@ zYZa5+ER;U)g4?)~?WOOQP0KU)eqep0Xl5~AScMx z1@-IwGC8yrnX+@4{M22SF2R-s7_Km1dhqR(Aa2_M?*8M^=QGff zn|uK?9Tz=fFn?q1m*2nla8dak&qac;eaNPU`_qMw-WO_>t8ma#?Ed^6t6Dkh$Vp>J zT|89IF6vTQnB{YfR2WWZfjjW`@Q_mq5>|Cg_^Tr|7{^z@JfxSp&%#ret8Frgwb*s~*)tsiU3|+ULDdvF*n~Pg#n1~^NG^^~B(M&xK2|=(|K7Dy zvQv|Ja>zYTsN@sFY{v;+vR#W^DgnCsQGwFA+QF*9dAPTVCUKe>z)`~9jH^yixFTjQ z+aCH_u1pLD|7{ptyD%1$fIlbRW;EmhA6tkdNtq2xgE>J4r|K+1{* zhPy!^Y)aEW2gfpxT!mECnXZ43UFJ<8j;_28 za^(!ZzE%HR;nrGuRj?3b1siW`BBUA%q=R2zZDqXcOMUymCtSOWMeSFRHNw@dQe;fK zF-E0)+-%9xkyzDRb_cU7|1EYsh%o z7ciL6nthUu<};OqJz6L8wktMxFN;&7`Y>tA%oXZmDnQvxpB`iJF*P3_u_Orx@%aRX zCK-Ftple5G3iw?nBGbNhW!gU=-1y2Vo@k-Ci>*tF*3a0Ckmc72RYUi|dyT&Iibf5q z94!Yu3L_ug3d;(&7S~8zN>GYaie~A4YZw|eT60KW1R7NUe}Kl9Ho|UsS@S5dj(w!D z=PB4{2kbKsZgi$G5GTU5+zvfk6eB8Q3>75m$RqBsB!;72L&mh=MwR z>d%0>Kt3=JA0LkZP{YmG+0`5PR8C$N)vGu6bp4mp9dGfM(_fs+zx2NWl!tO65HO!0 z9~dkE<^x0cgkOTeAk_W8mVXEMi&U|8MfLdk?(#;p(w{mznz@;xQ18DoLkY4drW~~k zAmq;H?=@-{a(9UMUvvgaRCP4FTNC_q{V$5f)7jhtg+M@{1gOsZKQEvF3@5Zv9}f@^ShcX!vHz|t1 zRqVI>k?u!oS1;CjNo9mYXc%ajU`Ts*E_aR!t}@4a`e2v=^Z+YeQIRKrAiMhRj?fbX6j=h19fu5DV0f2`G#?Ic>K*s{c8F)ukA_}hwzHP2T#x}Xr zur_;@a~p-218hKt0rXghEhzJ(m+bpR*9Wes_H=ok;?Ux9Q6(pynbs!ZFYH zG1-rPk5V2o5MD*f=;2BPYei=>ZZ{_>N^(I;!Z&9(-sJbE5^kqWk>Rf8H5n}#GtxI2 zKh5?8DF@vq`|>hFXJTTNMmLxslEbtQMEH9k2Q~?d%)cSlbNwjf{X{wVGV{81AnfsE zziz<&lItns6%6YhHlx@!^c;q(zDaG zyTb#57dhH*NDkuVN)A|yvGzZqQ9^GcA)xCUI#!-ENR`tBzl%G!s&-9&9%Vl{@Q?9q z2=mSs9AtvFq@VP1iix%lG-^xD!RNqFeesR_K$>d9+%I{KorQ-yfYB%jkhkG9(DtB- z<%;h8OcJz?Jcz=xl=VC>dR`Effq1t93VBs97Hs(8`9!7l`SNz<$}uw~cYs(7%~-@G zXG_sPWm2?}G{s>d^gJAj&1TmbN(W*w^c)pMk?0d~myu;q)6o;#=F{b!UrseV6SPhA zIec1VREdt2! znkH4ERVyh3(q%D)@coE~BgCYh=f~=9b#PMR1r=W;Ty7HEs9moHzRY3Y+(R%wXxEN0 zENwe~kGmqxvBnD8dNCGP3wrD%Er|;dQ$T+%#uTPCk&yBKNM-Btd>Kq6Qd}icNf><# z@h}Q8EZ8e^!`eJAG|oVT38Bb^MyvVhgCMeDOzV9zWSW{<#m>IPObgvA$a2aj4g<-_ zpDJC0?q9?}5sH{Q%SkV}+({zLqh(XTJyo{vVtXw<56VpvD%Q{)Q|`=$a%VNoGd(Fl z(FGv;F>Mp!BkC+{cmgVzcA#PuQR9cviI<=N-X0X#YA4V;{d6U_*KhahS`u9wA{G!1cZf)^!(I=g zh`|mqr;cP2pjZf3AFYyu^e$DeaTX;~fC*RE*Z4G7rjEO(iE0d0Q-2G&?yZC<1lT<^ zmC3)#d`LrjUibC9LEF6FsZt9ewpExbDXpVe%K{DBJa-g{-wzo1f=)8#P-^Ce@K8Lb z<;d@yPD_?8CTbG{JzoW+X!uQe8b3gH$z;KjpC;R;9p85ltPKdIvt~T_Qz$Zpc@yo= z`CMiCFVuvEiK8IJ&Rn@bmJ8Ytvq|_weN=^}zQWJCq-3P>e9^(WVf(tc1jRMDQwlA5 z^1I056V4<8jTmA&`4`BVWN2vSAef;>V2}v2APVazkdTeR4g-g{ z19x9Z1myw};`^=N2=2r2GzSR`BvjUMpZ8~(6PPVHB#3o=O23=f808&tvURQgFSGgZ!?VKu@L z)*7pdxqIV&%ohVcCPeZwS3Xs>rh@!>Ll9TqyCT~OZ+kM3)9YQdpIYjwq@Qs`OW(bk z*K@BiC8y4WQ=wtfXLh9zlv0;+Vq-G`6>0b-2~q$Xp8){b(%iXp0&by+tG>Nd{+?UI ziP|Qkx5tnt4)@2ZsqYn!7L$?L9nbiquJtW;TZ*AmWMn3C_jDaq)+3)RrCsYw&}Qz} zFwPA|NN$@XIB@G@7-{i zy{y$RIx10gxG9QMwQsDDeiXHrqSM=nA=5P&3l0<;b1WZjiv_vu&4Jdjry@{FB!LFkTMjG8x^97NlLJIxZNmpe7s~8>A zOzzPq!mOnLmV&RG$!3l{qKVx$){8KB6JytHowEMo*-tN605_;BZOP-Xpj@gh%dS@w z_UtmB`io^FkZAG57sm`19j$Jo{X@m=xj6Hx?8f614~;%a`Rnq0+8Q~*h9}cNM>PQ^%lrjX9UD>}#V$BZ?mXa)0+BMT!!R+9~2f^Zz}okWk|mG-YZ6rsz)-}cVXOgEAs1+C`r zOE^)%WsSowCGz22+W!^1J%A7H&`1GD8nP~%IFjC4fNM^+aJ!$25H%G^A{#doC-(!KnVEzXv>Hr%6y}=Pg>2BJ&al z9OIk2c6#l@C+CN&sFa$BZj(qGSRFRtZTtGps;)jyLnCi(rwF@T4jcpCt0j#g&zIf0fkrdO5dN0>->jB zJB-QD5-KlJ*n*xQAiD+6f6@u`)@Ssi4>#)-2$d?M8OU_;U##;W6Sk9bf*5{{T?%8M zGRMsm%!62H(Y=t_c6 ziSt?!Xv5Cc%-R@jx4Z#soO=_&7+C86DJtKee$}GC3eaEQjI2z|zgmAk|3{sw;9_k6 zpp(%t`u*3|z|tPT^jFO)XJBXLV5?_f2VninA!uc3|K4r~_*Lh=7qyZG`X)L8R?Yx5 z`gaE#2P1%mo>>Fty{`Qe=hwKu>tPvND?NDwdw|+|Fd-2Doq~b0JwO9MCun7EWh-y3 zqh|p4RW=LSF#y9>B={_f(9`0H%Msy}OzIELOpV74RPO?-+~#roRK~ zF#vv#{uP@8!08z_8R6EjLtmfnt^1VeZjiym4UsPvy{`f6@ZX}$GZmZ;lh$n0j{ykdyh1W6!(V1#E_KY5a2?tpxguj$2R zd;=T2j;CY{WMIU|g3c}_+Ult=zb)AP*z)sxBH4Bpj>;(Z59ajn7May#(v6&Ouq^fO zr0YgG?vMtp3gXE?J9iXQQ}?M~fauYZw1)S{vdlvmh0(B2LoPvppuY8R{IEp`d*Com z2Xf9g+71N^5!cN}p8IaHvp-sq)-dQ9&Ms{~mk=5rhC@gk(|@@`dfV#YFd6yTO`V$2fq4}a69f+5jJv3w8X zWQAB%e#KdWGThh1_BhQ@8h($NkmCSmh!dfkXrl0w)_g(P|<}Rxt5|ht^Z=UW2>l(t%BVioAT&M_ArLVpMLCZ4rtBbGX&B}+M21L9nGi}z7C{07;D z^AD<3v@>7CPP=nmcfvLpFFdagYf%J!?c~wWs$gcmh=d6M5_1v-Bpj$cs26|aE@oMu zLTP)VKqQwQbzRD;$a(%B;&^0IacJU!B$#p}lu5Nd3gV_j8f4sLt%PwuIrT+tu~hgp zrOQb&09vGovAiD&+CmgHAM# zDe)?C>t|V9NsL+iQKB2E^tZW0r$jB<400_(ug|af&y66moqV10J~@?&St1*?UEBfU z!pYh3y1}~1x*@uLn=HMuq(5SPVjEDTi}(&ICrR@NaRjFFTqYZ9C2Khs4HoI~McHzn zrs58IuL<^Bub~Y{4b*lhcJOv^c4`LYAiC(a@0sMV^TOl8Tf(ERn0K4Tw#JrND@-)s zeo)3gP+3yB#}maH#skMk6@U3^HG?*jR%}r$Jxy;)W~yVlVEQyeTM{u=Fy@p#mZru0 zw*4G*SlJxn+W2UC(|yQ&7>ARL(}shM^A#tNxsL@q*)sWO@=o#|bN@S}fUN^l-BI1E z)1;42IvrLpB&`YK$SNy8DWI9)$z3VoF4HTlQ8vnvsu@Mqh^19y<8M%JkarT0mY`Fn z)2fg?%i@vED9gxg7j0Mb8tfPcENX}Gr*sx(g=V$ur0e8t=n)skluS_NsOE6>vFp{_ zgkJD$sgYHNq>0ChNBoqOpPyb;&~6^99fLF5H6~*&VQJ~lu3T18DHWN` z^6(LsJ4`t&4PymEi~59Gp5};}K!s8TT-l=bu=25cu_xI~L(ii>&~!_$W;B0gx2~*+ zX3eqv#DgnYqjCkKMXF`&7U7oYiR_61k~_#bs1@OE-rkX-#ouEF`DlNmar7d53zFQ8 zylP6kU@c8$lyVe)GzS(A^Bi-U2FrHBW}^|$HilN8HeAcuI&1ptQv8T*RJZ zk44YQJomy&NlaaeFvpu$sY%6-qHm6%Da>x@V?m1w5QQAv_U0sBMmI zB_4G5IxiqEj*lx>bLV@Hb5GJ>>|mwP`!Km+B4CP;Jg|(=DBuoY-JQUlExrVFlUgL| z(-(Xbt=v(x+97?95iJ}n`|JwW7DFITQ(8`Y* zOx)zHbluE3^n%TUCNrmBQM36bV!lw=sTj6=k9_@dBNk4QLh7diTVqc-(=uE+3?x7D(RPt`?pF}Z*A#FBXfGts z2Q<7NUITYBW@Y>qy*kSqrQKsk*@w;TMqXN8LMLJuF=L_uqIvyYQ4TX)({pTvY~NVB zB4Ychwru*XUe<2}-B3#oWSDZA?!njzIW9K)?+MP*;XW<6gnASokiTTy){m=(s%FhD z&xX|JvYNPkaa%j^o=U?X#i!v-d2_!GzfDT688ng@iy1{vP2tFJ^1Kx23%Cdi!3^S5 zvgc{8-JVP>$1z+?4g04*8%4FtW1@?cPQ&7iV$K1;3FPvoe2O#}hSpUWV|8>M~z7qu| zmhW*Tb@b${EOadY^@y0*+Sv;l>%8}7erFqW{um7Ju!By?MBm={*W#Fd?<+mbuND12 z`TSqa#76%MzWnuJdC%y-Z1%6E{`al>kIncE0;O~;-a*O#vT5czM(=0A_}BIc{05>l z?R{eWJemnkN<{#+A{0F@KWitFa$KPP?FPjm-{0Bh(WitVo|A4^1xFneWBbRhy z@1Tro{zgX`3_`RLXNk44vXTWA&Y;}`p~ox+HAyIz$SjuVZ!hKtn1mrBB&D2u4&*tz z>f_jR9b4PuTyn6uV>`2Q=V7}d)&RBSz-?p^!bT9Z1$DXa0ftdkH6;S#;Q{`@!{hnM z&`^+K68bU`Cu#x9*V?a3XY*|{)7#rSnj(z|D&%s?w;Sm2R0=2)2#A6j0S$R?3-tWz zA|#9P#nGR*2RIafSP0J-2APQv#J_z09etg46{;|e8^vLSHxh`Io(qVAjI8U13lFdd z$IsUZz~Y1TuMJ|)u>|u=1%j}qNAtaYZ9p@Ry%oz1W2dVqC?H21Scrg(tc)|<1929J zxdrkF#s%8|t^!_Wg&T+95PW4G_UnhEuMKK`nZWI^h)D;4fqBcZ^LHYB$EE7RHw5Je zl1T)Gn`Q>)q(z!1FdE@SQ1@;(1O>VTdXu_Sy0##qICi3kf(zto@z!3I`HtU#aR>&y zPhoZmXpL3}LK@zkMc&?q5RC`D1maKQo23X^i}wQ>v~>kSG8OTv+k+6{(}=eGWGPdy zgyCW}m6=}(RwL`p#U-dM#`a^03_S}93JY4)`Ra9{lo;+5`sziZGN8-c+=^Uh>$J-Z z%&)mwa2gHROI?QQhu7gTK+GE{qcGT;f){8L#@pHF`jptX~`vnhEr1dDZg@-wgIw^h1|P@nwle4M?E+czmvI>bAWds|T86J45{Q}rP;ZJ}i@HLFmmJ+F-ff`Dm);MK9qr^(fjKg; zz?Cnk+q>=p?%LCc=WjTN-b>MM_+3^t&ur0eM*M@PQc~?kJ-2S`Z(-Qma1NKRL%`sw zP9&i~s@7=m+HVJ@AWb`T-jcAopbk#2(j_=3{zSfb!wBGpmYD#=jP(p1ft7Drnn<`B z6e#9zkc?i}A`J?5zFmN3YqtH9CErkiR^oQ2y9Rh+rAp$%7i+%?$0P7_aL%hbw187BCOttkPxETwm>r6PoU-- zP(PMfU_*eNWw#w5R*JpMyeZJmyIzISK+cBur2;@M8R#u8h*2Fkw_3fsUlevi;*j&1pK_1pa>I z%Pyn*sht>i8GV*Se*EgdQyqZ=izt8CVgEIoAli3+C)F(~@LPkL14kHyuWAp*#i_1C zP(UIdndKn%=riwa9#^nk35Z|kMR%A4zdD-{kJP^G2XF~>g}G6;7DO*SYnczxbAQ}0g ztJ^%U@)&V_mx^G1W!4yFkq&{nOw+DfEW>!1({@;w3h**~O5!m~*;?Mf6z^S-c%DNZ zD^;Dx(`x?dY1Azl#U}6Z)LKjUW5uaPp?S)}v_2OgT6#KEae>A?t2Dd}uNNGv!+>M=cIHo~!nzQ1cvF=S>@*e6`XX3Lh(}FqXK|jqWvdiZmR~ z?wrzN>yU!Krcyg!>Wv=V1wzrboRg5Rf-R&^^$l?6oNXuGGTe!$Rvj!eeaAiY!Z@PG z)syeG;Y7S?m~1KwiRZlp5NoFUw{#xZA3rEbI`W?*To$haNws>(*a(1JJwLo+TCc7= z@zz-^)m|Z}Ex`C*1@&6bG0-iPNxEY#(-IJbe1#A0sd=94c9Hnp>ub}>bINb$`qM0F zAZo*npO~INxtZ&^iD45Q8PP22D~LL?IojKUWq$-m%Xa5nP>iP)7y^1#54ch|U9sDz zBn2+yPGr( z4=)U7Wjx&4p%gr+t7x>3JpLr&Tbrh8wR3L9W(hj4t+J;#8l&N_xh@x>_0irx$VnKD z6NQpI{YFt@B~*W0O*v*Ja=G1GKYjVZY=asV^VlgIm~yEq;21Q$EZ#ah@_lHMaxCzA zSu}b#m?DHTRmDI9MQ28pCKbylzCWK$*YyJyYxx{55sdU_a7e})$#lkT6><<_rq0F0 z7*nMm!^^zYCJE!TxzLBnOv-`MtM&EzJlK*yI;N?4dP~`G@sHi7`3rweNo8K6>n0UM zb9)036fq1l!8EbAY7-f2oWSTYHysngF12x{ACwF;?E>-#Yu7zXP2ZSbkEzs4`VCX_ z7N;;?-Rm}N((;rR)zW?hMio$5zyJ4hcpO`npu`;I=PPCzT`+vY&!;<&1-w2N=IfDc zFGuxQ#^(0>nCa!0ldrNcU%ZZ|u1n4}B?r_hP9mjoIp!J(n-IV37cJe_wVctga>T6w zxhtioToBibsDFd!EHMu|(|aCF(IuuRr$VmAfQw(Zx-jC*BrMn`>*`hjIFJ(8-5Uqo zLN7J04#m1LV3|?&_WrPHJ0~N%{dC>kR(9S&-cLr|74?~gflOXy0Yc3VY^f=fdWhukznTr~F;; zJOhdas#euc_C9khyl6M2UzO4>!Xl=rlF`~*?VH~a1y8PZg_o>BN?D0 zpq2EVP-5h;-BulSKR-^<7Y>*!%$$kF`(Z>qS5!w>V&V@Ny_kvQ2i^M-S1^`ll`3K>@wi z;b~j5w4qL|E=~}kP&J6e0vt1Ss9Alx_JjaJt5X}PUW|T`Z`?=hME8b-!EcdapB%yo z{Ta}23$sp)HY&49R9iq$MI$JD2GBRZc{U~$$9(xtG~LKo|5NK|GD+Gt#Zdw>6Iex$ zCQ$KS^hCC33TFS1P!EFXPPX;+I>}`f^c1zqq8bi*aa``&llzmv*zUTuq+t-%&x-o*aid~X<E z$sP~d8bw(|@iCPA9Bp($$RMUsQ{ll3ylI2Sh184DZrY0hQX00fC7C zZ3ns_w-o^eehI^~t&1P`tfW=_&d5)>~+sz9#P=>fbI3>@}8$bOp zugsEqI-2*o+(hFGbcr8l2n-mVcw8Er*N89T%u-EmO%CQXl}gEwiSp_Jluhi|U(FEu zWL(nP7!a{@J5GwUJT2qZS>iaQVs1XTqGD5Pin%Sx3Q%+x)ayO$nU5^Bb{3M1G zeNM&p=<@NnSaAwj<3B`@i^$Sbseut1MV)5FCN6Gnl($Oj919Eg(m3$of=cktZueQV zyCM1jU{b?OAb}TNU=xiS8ZVJr&ee({bxiyA33N)R%<_tRHOau;C=J8mRL(E678S}S zb4n^p51uIII9iN#I9cmJGS@SGgj+||{|C%>MNc&R#YomDayuvXGicryH!ms66}M|l zUN$FY%${#^2djGJ^Eh6SFJH%L?>*0DkhF2ek+nuN?>4+q`y+A9oFjFe%L9qK9!hxC ze3AK|({62QRue@q;`}C^Q_}(t?FU&y(6)w89AXS=iE%gOK-W&b)n+SBm@Zpgqo{}b z4X7&%r3W|BA{}(jc&cl#Vv+0hnq2UL-}I#cH_wmnf23`P(0rJgAH682=qFrF-Do44 zX1i^4H?eW|uhVkDe9`ZzX!!ONKUA7HcsldJ5L@R9hLktl$5D}Q8bM>!N%9ury7LFG z7;{G~hgFOF$cMfSFdd7vcHxSrLpgD@l&d5q*L_OCx;5K5JsZ9pkfWXyGnAXP(Rr3A2PkfU8OE3`N*&Q5KLARj)y`c3j>{| zOIC$y+d4FM+NzOLx6}8IV=xAB_<1U=7L^nP^-z{@CQ58nQuc4agvWsbwv|HJp}95mInN|dmmhLJ>*5S8-dXZQ-7 z4+@_S_|8%sFA|lDbsoE(rf3~d4Se%9eGOglj zTg&J*nB(p=*xhv?x)ik3W6RU@TcRBRMQO)bZKyp{udd+d4Yv981^UQX!(IG|)m$bk zs}I`x2b`~N6?^q%-ANv6?(uTeQpqhnY!Fvy72F6+>U4|(%*9ypZ5R=)C@5^a zw*iJ&hO6!`_=2bH>iZ2%dc7xxmu0VcGh_)5`e;W_Mk2dRr}Qy4ET2qiLMA`jP9NH(l{4BUYAB%`NP8tARN{?I-5gBe z+Ni5_*|sv}^;(9bf!C^;M_asfRj@cs1`maF7D9=H((`DnjJjQoOK^#gD$C9RW9QES zl<-CM*~vM<7ZIfix_iBdrL&k<@R|*w%X?;{Jfb_#vR=+x<1Q27h+Sv%zgo555R%qD zqi%8lA4)9ZFd5vNm7EsPS~|zvBa080_4}Fez=qzRbnWYa6AVGhJ0)mw_w6&^m02t( zZaYq3e+y4DhK7GR&ba0G+co5i>fQJ3JnR5kz+ZhD$sqXw8+%#dN)Axq8B8u(9j=IE z%VxP7J*KMLt64>l)#|9E6srndWTue9YFHc^jVz$y>IvzFR-iVWuTp{w{t${#i@I<%L*&LfoY zYwuUQZKkVwBO~0!Xm)3!81>jib#5CD;o6Onyjpkb`sbhb*=OC}u6$sf`xR}(saId| zPlcr@!lv*^@X@gQnbo))@m&*>i4x62KQ4Q{WGdP|ybqy@W3%uYb*D5!<5B~uPyCqC zH#U_gL!cR6~IPFsuZRh_sw3TxO>d)(lRDoJO#!$l=;PrRmM@5AKR9lPY~ zX=HJ6uYdS>n)=IIl~!;I$|^sIPgFWBPt5=PEy< zX7>>XdXA(Ej8kCQLH{`qp(Z#)dQ*0=yt^j(l$)4~X>K;UZY82o*^f4P`!UZWP8LOc zNg7usZ8k>ZKtMi1d4$_DkjJEoDnFQ7^6_qDZQ9Rc37zGB~-Llt69}|(#-{o=ku^-syN%1cwgzRnvmdl zE`=ERf*n|pmG5m|{CY%a#%MoJW}0Os-39p8NzV<#=UxsR&@W)jwj3>#1>M#1u+5OBr3pg8lsj?`!aC$vslmiFH z*^h5AbpxBvuWalP4VgBD(=%Y?c#zBVSm?#PVLc1_X8g>gYfpU5e$DaSFu!9bQRB+) zUTDQsr{=C{%Z&-dDaxK)1gkOzP9v6yL;P@LRUG%sg}PSmVzd;aII=*0tIb-V4EC^4 zeNA|Q)0LRzqf_b17c(fk2LT#b1#v_OcD;j5%F}{)W|Ui|I8zai3$6k?hfC^V7aL-J z$NkZf-cOH&kSW6<$^3|;A9}ueO+FO<_;D`Eqq^Irk^Q7pd{EUrBI>&N;I~jqa@T$( z`DU!}45F?wfppfr@vT{(D;<6fhT-J~sJ*mJWPORcfkPpZp>?HUD#Tp!cRsYUT?|N3r%*BxrM0N5gW1;V5MIY4}J?vSL^S=YFrP zRc;jFrgLqMZ6w>Gpzn5zl|-HB&s$1WyiU&Yf(f{o&g|)4>SNO@HRx*Sor)aTi`0eO z&*@Mw&8!fOJo$D6s#{Za+a4TBKWLc7*3;*I;6B!u@d>ate~@9hHF4x7XXNnhRQ)c= zb=$Yr_Z{3-;3YmZ$xo#)oFpU6$buM9tUu2VZ0Uvqvl~OP|9GB5dHDf;Kb)<2Fu+Bd zxT9$MW~564!3hGU4Ec#^L!o?Ti0BXsWuuKQz;zO#zW-6Em$wM6#nagG_!fN(bsAOr zVY3-|{7wgrt0$|~u_2;Rwdhe6W2E>rXAW_55XpDC2|iveo`%NcyqN7GQnc@|Lx#fT=-ION=Qq1 zoh;T~OC)D<3r2?N*e#81it*r_l#MM@sMST)&Vn49q0e2jRarGp_8iLe1lS|`c-#k=cLcnMXUyY^>IXnC?A)j) zIR|>yUuxvXQ$ychNpS0wVNAd0jI>-1@n^96h$tFPEz2V_lr_R!$fPZyU9H>Zx~`9# zFSLN7ZP0k4c$vFFbFuF}3W>9HbY@Wwq5#qxk+CEc(Ku1xK%d zxVzHO!Ze?MJ^}nla9(VnGfgEssGVqIr{_)W(yfboj|y&lshw6D*S5F=B0m_tcYp1m zC5^h{+fCmciYWJtxP|W4EPm@%q;d2{bRETGvZ8!Ib31IA1mByV(^6_GbHMhvq~8nz zXpo&s)dBO>m?McO5iI55#-7{c)b_#TG#1^5EiE`dv@Q8NLo=LwT>}rpDn|8!d*0#n z86k3~FL}WaIB&Mcn+=;h*u{1SqRDXX44^J)`lK!FEYuN92i2=)wZqj0nZ39v&rKEM z?nc?Z;T+6Wiig#&uBnXGm0Y`)P6M`=KOQ4W_-(qs>GnjMS$qk1EKsV+;0t$@gyEU- zP!i3#?wOLi9P1_53a<_+_=*&Ouc9n#>>zj&M^hF@jIpNcnLCR#y>H4tK`%baNb2KZ znG*pXB^nH9!scX&;8_=MK6ku}b*r^7Ne}3MffQOk`$}Y|9?fc>M(V@t6C)QmHt<eKxxjUULT* zc^w16?-?7R!3uu|*4pJ&F5RDqi7lnpQy~PhEJk=Ny0BR7#7J++>w#t3=8fg7%Dv5yPP8Vu=2+_qi%;LarT zY`wUK8(6v+6bna%HO&HDUXtq~SwdRIkuSGF&xQmn2xqSGOX<{%1x$a(>B_*GJG_j*v;ln578|Y;>EGK zlxV%w3tg1BC$g-__aHaPqjGY=du%)|4WN{LT5y;#x*>{ZtsAiKOqGv?hwpNtY_^da zSjA;J(pt`!kZbi*88FreS@P*rMP&rTw3-^;&I#eRcq>lk}cy0 z&jR#Q`}2C-yInl-P7^%qR8wKu1GrmQ#7T_8taZzQosCa8_z zJKkKAGKT*y6!=Y={vuM@nAn*976JTbPJcNWn3*~LasHxDe>vZU&+Pv=e{rb4oGi@r zfBSw5dw=5u=?5d2T1YNygsbruq^E+hsE2*SI(WuiXG zC4A_3dt%~E*gGwQXAgvcBZ6CAVJPeNklLN+BWXeyP__ZJ`&D z`3y85Et2pB7f(|I?>x_#%~p)(i*;khQ}MOg=QVb{fpMs^&W(YsRmtXLY<|V-d5&9; z)yOX|4(=AvKBx>6uOihG8?oWSj5-2Y$s#2~!mx0s8FirDjZW#RWuIBxP2ajHjUP6d zVl_h8C07LDRYC5($G+x$AM~s91hPoBM*4N~|5YXbds}|p0Y=7uZ`I%WlYh_e*S+|U zll~8B!vAt3eoGVnC<6W{6WAF3C==-41t$Mpnecv({(tHcSULXpx`cPR!oRu%hIi@t zzq*8Xjl(aA!N0nM-;TfU{$D}^0LveJ`d=mkfaQ-o{xADoB<2`$HY!LR)0frv4&9uX~r?Yo=>Wn_RLJ9H3az;GJ6 zP&c52fg4AF1>r6D#_&V$1!rFc*TG*8;emD`-?&z^O1wyY2|eio+1UXr%Y;x`SY6oG zzMWa#>BX$PeURO-d`OY)!AR^lAzTPOupoYd$2R_JRn#z(U~Q;Ju{&z=e=NH#XMD_wUT^96ro5jIUQ`BMivP zO3bM@YB`iKU>G{|3HTw0P*VoT@6sRQ@olby*9bt5W$n+Q4dhnH1PA=c#f1>a`I59n zO8|ZaObu?c2?olZ1mYD{YQt$SM6}-KHRZKd;awc-lV6W9mT~!(_E{GB0QCMU1Pa7m zAlnxRt3Z|yj}7YC2*(5JxPl1$ZM4M4S^xyaODfE4s$J^%rXLSzPwR98k8cC4J+W7Fen= zHv>E9KEQ^R@0olC?Qy6br~qLadH3KpLlzzm%m@tJpGj)is}4C(G2np@|3(K3GLhHx zVM=pLi`K6jNydW&=k`bi_}*ISihvYQZ?33vJYQJlDgP-+GOB@si6FB2EJ{Glbel!#H`Mu3BGz-bi3u zv&|SrTB<%^qUCvmo`xKYJ5rKwq+$}>lYxYx)SzL@$Nb8Ew?m#Z`aHL$q!Cdp!CLr+ zZEc$3Y^B}wfq7MW>b1#QW5WU$^umIN_#xh#DGDeq`U&jpg4eWq$JKeYwLC-GWjo^Q zmCKSM=L{-Gvw5W)WxlYjD(3*E(enV+b}zkJy2mUOJ}hBiluvMqZhw%u^P6@s(cTq! zoFNe+g*CBMz z%{HE70_#M`dy@h|;|$5?3L3~sA=Wg3x^s7Fk2>o{UU^GC88$aBJs=Qg%;G!D*we8> zCbvbK#kHIq!|y8ERD~y{#|~>dyXK)yxfT6HE9Q6bbDI3Pb9#U-=3ncz@6;QYvK}D7 z&mY#Jql*aQgZZeE0P+iKlmv{Y{;RB4aT)?ydGN>VobjZ*H<3#lfjTHU!VI+4u{7ew4M z@IB_No5^W3T{>=FbvzT&`t}-=-2L8TMO0}+Qxd!C`K9aU>68Wq!K8>BV}Sz6qY`_C z4*#1*TiK5L3>{1Y$3K}v;o@gCRaZLmoB^Jr$2YC3Rs&at8^+zU!+ti`oB>(xAvm>N{nZJmK5 z=R;I)Hh^|lR0`QJO9;ViyGqD8Y?2sHAQLnyW}W8kJoC2wMJZN z?AsvNZA7dgK{{DJT2$+dRw_OJG0VPGu(+3**VN-c;p0HrcB`^a?CDXl-smcIaklhk zYdfw;4TOTGKL9@WN%1K?HX3f8+nGGA7Yc(K8t}O#y8P|1UgN9Xr*w{`ooc2OTpp!Y zmhXklk2583O|-6DP23mL4mc=F>B}DzC?njQJg)PEJBZ=j7{8B+9y-VA=gR4toSA{j zs-~}3bn#9_#GjXUOqvu=GwfJF1cD&CA7F`&5wO!&tBkmqL#oZplm+jHI5Vgj&VMkS z-f3U-RCD>f(zc1@CT|^?Wv(Q8rA*$her_QBBe8uRZzWE)Bu8-_g{nX2W18@H&E4pA z@q~%YCXBaQjFkr3azjnkI!hWavD(;xY}H#xBx1iaw7nZFn#ch~Lheq&xB_%toX67A z^9(I%&Dl%RsZll7i84e%w-((fPD_*tvzzcL*eVX*s*39{>VU>8%?fo^cmS|GcY| zn=hY-B5*Laq$>72r50xeR9USFFRCh>r4ZCIZ~Xgw!cM35y6F_TMmfIQIyS}j_GeV_ zdJ;iJ%(n89R4`ZWavrKu&KRQIN*>~ednV8^qF?H$wj6bqp0F!dIm0%+YD1e7ofpc> zioD)L#Yq}=<{Dmo%3WhP+O>Jp5v9kif8OH5th-BGpc9xKn4IOv?7ICT)xCq7w5OV$ zy_7&jSfu&w&d105@M()JT2~a6N1H!2$57kYL1}}bjiPrUT>#W(ru;H z3PUpDr&W2@v4+)POMo;aVmf$c5EMZmqsVtiL=7pcG8=r%Ozf9L+mb}Lf-FzACRI;o zJx=wVxZ1S{8g83!6XlnekiX8-WGVN{y!P|Ncw2-#8G8SX7fsBVT2Q@BN)n2jay)*a zA1EVXnQWiGgBjw6;BRq>TOK2~3e56VkCir!<2Gp{_vfwN@_AY#;q=GBizJ&Li9x1Vo;6#e`#_U#ra=o>E7RB6(8 zv4}mEYY{{Z^1Q-UHOBk=o|k#OL!EgPy>SK;V<(+ZpO}GWDwo|Wx4_jP z-uUxQRWDC;SfBOBdP^>w*{o+Zr)6M^V}(7D!+zXCQk{NqFkte7;uLVUgkDcye({5l zG-9-WV@p>`l%spPPxEEcvV?s@yH10Q?R}$TBW}lU{o4#VWKjuOPm|=NN?ZN%$kb+# zvcRt^#-*ye{=A3=qA`xfBNoT1rC8;vtQO|%qS@6Xb5-LDq}ilwU^{(|$C>5P@G|V~ zQXZ%|t{L8eVB2+dklB!%XU*hd1!6>?E$)kx}d>8SILJRc@(>wm-7`PP=$ z!hMBiM5_Zjbvs*bb_tdBOeF*bGZb*%k#)@qkR01frFksLp0qZ~Wo7hpRb@6A1D7&E z^d`7X9mVx^T0WVk*vH&RP?6lVXeqXY%<^bis!Lk2jQg$jjwv}#b_cUP&{hZ9oW)}) z&TA^p*v!WFz(88bG>B!ms?5|I*1xF|vCg95L=iei1Eb*^B!orj{E!IBQlL z@u1>s^3$cVbS%6Y=Vi14-(1s1#oVaS}f10!ujB2vOGUPtvG#TYVW3jHH9xn%=2xHb_bSzZNeT%9h+HFZ< zZq*GTA7#B@+_K7BXMFSqV{XUk@~9wvuwLgB``iaFmPXl9A@WQ zWLc*3bsT9X0I9oM)sXD~!laEex60X={8<*kh zvoisLP#1*qDRjhvg+w$iA;#Zdp5KprCVj@+Z-r@aW2v8JBNUCwM{jk7vlG7PbvQiAqT?X5 z!jj%oNp^O2XXY%0VpYEy&%Nm#0GY|%edjkOYV&{ELKR9{KWU5#uJdv5MbFMm;zxse83>J5Hw z4BQ2royLYp3kxW4{(x&w&>g?GHPLM|=x$;cbUPotVd zz4`MitR?f!D{*RF zYO_wqgiqlE`3Gi+0C|}T_0p7> z9>u8%!8LHJhSikYhm{ni#F196U=fhprWu%70sX~AiBszBxTVN9;S6wZ%Ym8}@3Im< z4Pjtty~LQLSDpf$#yP{Q_!!MQH8|r1ss zEWPhYj!7A06N$>0$_vF+H<-vj2MJO!g|JTFlKDhu<3sl8aF}u5USvO0fcXj)dj(Rz?Z{XS$&> zex|y#oHAN@{p>1m>-!Yt{>nh>EK<0ghErihhnvS*H$8yb%2O-Cg&yf|ZCZ)~5qFl(4-`??)v)f>XgL>7>?k9bCC zfuaIMCy(}AQ5|{j2;jB-#t>&3c@hkPHy~Y<(#0}}HB>O9Lf5V<4w@VyF9t2Zw#rPf ze}*I?qPjYjFKKJd^17H)AVYJI`A??A^>J#0HH}j?TzaA}Z=&bZiflZMX19CcVc@cy z3_JhULhONwF89XoYMfL~?G_(skO3#7Ixn?TeWKK5d+WXP9kx!8;-?7VPRBCKR|KNd z*SvMS6!R=XGitFO`SFk_BBJ7RWe7Vt9|pGcJ$IExj42hX6c|_oJxvAaJsyoTf~Sed zc`0q^#+}v81b?NeBlKNkIT7-sSsfNW)thLDe0K)#l zvtgC^vkuRQt(s~$$lP%4ej}mGWGtBUe$Ut!;_~cciDJhVmDtm*hHL}5rnaHXi6v$I zxgLC(1KRVOx!KAHkfY*&IhA9{vpNHA+jN1ggI3n*nnk%3uI&%ms7wrdFS5l3r_k*b z(_iVZQ^K_fLz3;ZB$n6Tm+d|d*P&Hi)3;R%QaPeYHpEOEcRA$MUur*RA)WdPq>lWc z5!o2<&k{jm^nTxOzJ=Fp*ry$O!dsBuN**%oO>}@S!G*=fz6=<$G_OKG&dwu3t|Xm? zj-m9ccD_)EY{sD?^roNGJG`+9)9}E5xM=hDor}cE^NAh;^z;rK)n#$UBTY>xFl*&+ z9`AoX1hkZNB?PG3jmo^a&gHY|6VF^UP^?wT=fj-)Awij?E;)}X3F3~Q{ zK$~2Hm``+8XwbT3?{;#T7k;>XTK2su&~CPc6#huP#*Zi9A~cpX*3eo^5MP}iuoNxA zS9{Q->^j@+K|6jc45>Z***(|F&QRO!gCB^=pVp$;$@Gfpm1~`0GMb&2!asf-8=J;5#IDEV zDsL2OE_C3vnEqPiBz#hPAy)1fYd;~?9R^1%dMq7fqP~%T+p~(Gwpl^f!r0ai=XD0p zyonW5KVB@Ad8F9+EaoJl`w`OS1gdtiMDJcrxK8^E)RiT2g_DQnlfV>By6mN!xvz+g zI=q{e123_UvZR%eTthN*-1$B*87u@vUhV1h-sil;ASvWxN?fy+aEiE@2?W?Au(U$u zZKx!qF(Bf{`)Zey3w4PRJL0_rvhexY6pE8w36bCyF*Fww^(g1fVd=6>VfeG)1sx^Z z)v;^QvBv?UL;aXy6kKfXI2dDW{8fkhx1V9WlAN9~1)Sa4Jg2i_CnNMaHD^I^!4R;N z-KJ3r7;=NiqF@{ekFSuO zi=bu5#zkSVZcgIzYJ0pNpAI|)_!S)NN^ZQE2nooB4ChrJHa*!CtWZ|uEsr-%nh9%v zH%c@=7nfKIhA3j)vaSP)YKPRusj!h9;uO;gug;k@6i#SLeMJ#P6RMrd%@iYJH6`7s zMGA(41i5JedeZY$%Gz!-;4-F5Q6pe!aTBP2Ivz5T2!l!bt?x#GEVjVfTg|w9g0$N7 z?#D&G#=rM|`m#GwpAepQC|;=PZl&NhYH^x}{Jp>ZXk+yje&kl68Pg*5(QypzT*>hjnfW8@{(?2$rJZ#Zbgmm!xEh)L4{BKyDjGPhT z{KIsQl^fczZi$t%bFFgTvO~90)TBvL%^2*Sxo)W>K`oN^Fc4g)em~YSxo}lmakUrN zR(f(wUC5D1zS=UUz1fxyg0>Cg`juFh66B*QoQD1J{6Q-azzTI~%?{N`OK_@fGg| zUGgI+YLe0Tbj5?+!pJbUo_zI>wJC8}RL8lPM$H)L~)V0qOk(dM@Hq4*WQd^J-?H8FXiqRacYPNN#%+Rr&1_nO&qkP??{%t$%!@rZiELqko z4G0yYK2C8;g=1Y8ov=C!N8mOxDPjpp4)|?TrZh$7eqkAlV$QdK?giE^HiDo3Nsfov+{=2# ze?SL~|4!Bcfs=LBEvG!}I61^QAc;U_WA@=TFBd_*=i#YW+W%BJtL?)vnR=( zp>pRU*R}0;RElQmq8uvD7Rl40?gzoF<`DgyUBr8Ki@l0Pxj^F0r4N(s&qgvD6m%?= zwQwRlK59r*S~Xa~Z{H;rA!+Mg?_tz_bA|Oofg#=maX?EyuRf-u5E9MC@?w(B%f-12 zjKgRD0JgWFWUC+I+Yj&9soe7O6n5TvRQ&F=N}L(?Zhd7I0cLd+_FLK647+2}Ve7U- z@dnF`__ndc`7-$^2lOj22;XhW75LKovM|D{`LQKs?R|{DS@C3lGKWHcc=cw%z4Oe1 zgR>%kjjL|p6~AVG0_GQ-<^SKI^`AlQAK@(vBkO-*4}Ye$e=O25vi-gImnMOk@ox*< zpSkTHJO71+_)}o^$J)PV-d{8C|4);FfE2$RKmQjCA+P#>n+%x#p&|R*WbpU%{!c8# zm(9S?*2K=tLibCdOk-hU>0tNY$p|Q>{~Cw?ON8+6WW-nc{$FGS6Dt!Q>zAMIU+IWH zfB&yj{VV$Z6W#a<%>Nf%vu5;^X&)`j;FTv7cAJ2Wo-1SEjO?(k*RNJ^Yja|B)HT*g zd@Jph6ZT|2aM3O47fR2|P4+AL>ndc4C=B5vi(caL5j+@Hwkb8h#gw;U(}{6*dMWEJ zDvYDaD8PIJfH$$>*g3Eu=KBOqbo^I&lgNc1a=Vp`OpIZdBxdf+fP<^AS*^)rt8 zr@RS4HX|PhpDQ?-?>%`38lnO#U)TFZ-D8K-`RnVK=j!HAvyRhjvL(|v0+AX{6Bv+9 zJs(yABcvMw0@9Zl5R?j79ufcs6%oWQV5GSjW(VDPS=)%7nh+fdR^$tmQ1=Fc0_)MS z2t|NlmVyoenBT|%#7E@)sUi21{~HXLf6sQCO8%D5&v>G2h#T)UAT?ia_HTd!aW-Ul znjNy%Zs0JEXoHAOx$CsKRYh81IY-s3EZ~=G#R1kxJhrSz#P&QyN(K4(sd+#&| zoN{pJ;blY+`zI%45H@_!1hNnG?M;Bvtb>5lU)nTM_+%>U720fA8=rR*mFRG2T6^!j z&t=$XM|5cjC@>w^No!IVpFyK$LUUbGfHpRr>_W)n=3WFZU#3rxb+C_A*e|r>o@HHo zC5hL%|H=RYIn>@J0Iz)q!mS(b5(d~lo(YsrD|rn7MAr=i!bX^|=75(I&)PT`mU-Lh z0D)Ik3f^1C_+HuV7b(IURMJ5PqpP9#74)YxM~L{P%hr?jdfkq(C#dR@{sc^W;b*&1mGQpUT~EYarvemf(FK(a*W~IJ5wMwn5LYA5KGEmBar2 z0P0^xyXEfl9f(@5T>S~!HXgI{oxE)=Z#HysDSQC;=l9nO{KTNfpZ;}^JbhkSG(VL! z`9wbeKffdnfw4&3B~z_$9Bg%%qC+S_ z*h08brhxhjg7)Nk89|Cr^mXVowpzo?@4y>=EaPg3O<+WNpAgJkkF|lO1$2mbW^HV7 zmuuumEx!Us92{7o!BAv*VK;vR3a#&$PpM931>noU+ceOjlnof@2hheZ$FtDY>Pms} z20{D@gNoDra16hUFKduAL=NPQ_se|Bx*qAF*QVM2qtOpA8X9XS^26fE>-?8@k13#U z?R%U5*lx}xDY8;>muh6i1Mb;Y69CL1s9&sPIDXD!FBU}~W@pk^jWd+{#gA0=U+(cb zt2o4gJ2+m4XW61}3Wm#)o2!lIYF9`bGy{kN`ks{T99!V+l&N*T#&ZgGbgW_*;Y>|RlI8=b9izYXbKPJwKLGYC%yk&FGZ>&X?%~t)ySx| zmVGrV7^{8ymj|I1D&LskQQlVuJlLHS^dtr|};u3C($Y0aS zntSwbwE!HT=*|jlNOscHS;fi@q1BX(OVz+-J1TYu-egum(?plj*%;C=3#8{IeOCP2 zIueIXW)4n&`(zp;*N`88-EEtM*@;iz?-T(Wq8_59ssjE*u<7U0MLl*)A%*Nouy9Ee zephLS+FGfq@{PBq7=b-r1u46t{{}L9KkmI7%(aDGEm#60O1D+6It7>#Wf1IHLSuXX zyuHWF)9;za7eU&PUC3fUAJt>L7qQgKMph}=+6`~9FvJ)>0>jnD7)_vR3fk$5UYf$2 zo~2K-(lljd5#RPTB&juwdSia*GB-`qS(f^p4b-O9GQc=*tw`2Sb_o_)DrWua zScLs$>|nxmg=04)_h{jJqDnYaWYuk{qp}B&qhEe){+MUKRSS!hD;Iap^bNMwK^T1` zM-+Xrx~bL8Q?@~OGQi>RtMl!*zAoF+F-(I|H(GyUw<s8F6PegmX2;X_ z$pO&Z)4@A5xTd4gUIwrZB#!3F)ppj3JB_E05im?5te+%7D`;b{t>=ff@*;8@F~3O2 zIBH>C%^ytgs*P@gaK5Ge26D=!kqOx_x1q93O6t5(8CGL`Xt@V>)t6z-C>;W)BooCun+(Vzn9 zX2ob3haQ^T7|-cyeXP!*WU!^hd6>w+-zkm-zgzeCeRnQ8k^zE0=9pYb!$3>XZ+pz- zFJ=>(h75J&I6lcU6~ z8Yp7!o1%PA+^%&LIMX1*GUO*5+d7i4x*$7b(2zEW#nx<>BYaS*0bjWx^L-iuO&wAd zq+z#CSuR`bmja?=tNKRo+_9BViHkx)#Aqm}=weK;O6+!-w_V=SH9r#DPcu65!YV|- zJ)s%`kmqi1Y1siIb5q{VLH!WnHEk}9y4OS#s*LMkb>yi|+@D^pK?&~ExtdM@scmI; zy0(kX&_YpZFK(K_<&ZZJ;GgF7L#rdEbgMg#FJ8bP+tsYiKIfCmY{Xq^0f28yN71<- zDX$gwcYT#*lfWKsd`d&$M6z+I*GG0yk054RU(xgaWZJ-WX$)uK>vr>PJ@pIjQJnlk zzo+KGD9U0Ww04H0ya{d*WRWqv@nY1FgWzStMtJAuQ07L*rQw_|QV zNp01tmb8yn?hq!seZ!mU)w<~W2Cnp&C%irkuvL0{>K;w-{O@LtwTSzNyYLX$>89;* z3_F|&h*@DUhYvR-xNGP^*U#a8OVhL6T=`eIwd%eu^Zi^WpNJ2U9*f;Ht+*!pD+{$2>AMhl? zd-I6Uq;3EZsoxk!a}zq-Mb+G=i0Y$k@cCTQD6D56Uet^fOX!ET-&-_|^t?WkW-P^E zlwVcl#5*i*3GoK+u&x80f#@j36mw;2$>hCm1v2OANF9- zp(-IBfT98BNM`S@ANP0mK4nm}1V{r1;B&V0w+Z*g!LAbN(T9qpZdqWsZDg5>`y>4X zvv%NqK;lXwnF066WJozU=+~5geKU~t#v1vRxQ`q?Q6QK?`kbd78G6XAwR4My2L7mY zIh|I2t$^6Z(V{J~3XM++ew4E&0D>y3ru)@8;d{(zgg!bNH2hZ2}DMA?NPcT42n+~29| zq94x~dcq#vG*X;7aMp*)DEu0ZFN9-~bu;yAV+%r?ke5GTMZd#$qJ)!^QlPp=w9COe z4E_$AeZZfX!CKRcvN1p_HpRX(k5yf$>9i^1It@H4v8Q&yx|p@iXo4TAi#cjWrmrYB z`&ncq6-e9S3GI`y0nT_6F6gsyzqDS0(m!V*M{$N)dBy(d(GJGeLmY1JF?AnUYw`if z_Fd$l?|APXYFgSkV=hpA%f@q%NG#*q$nEk+hpzWw6tb+M;~5AjbpAK zh-Fh@$qdm^`SKavO=c+ZFuU}QgWjvP)jldx%}?NqVOU~Cf!Y0r183m7+FG0mM!aN@ zBYLgs%!55cN~wZTm7zv^x3V``btgijCl}`4s{S|cg|oY7s#*)23i`CF5GmxU?^ptK zX#*muvz9{HJddPP@z7Oj>g8^9a_(mRre!tL)F@qy-wY@BO|!`vJ4Se>Sp-e}J>|d6 zCw|`Kn@8}$&tJmY!D2`3;sTBrBK7Zf8#UbFi+sEL^&^+xRYN;Rtfr=Tgb1okP&qyF zR3i&`)+rqB`)fJPT0PmQZLA4eAgOwWFv_g)viJgx3dQ0G*&^eG>QTe1gQtmw3WPF~ z0YeP+YTe_lIPr7S2sPUaO6#xo9f8;ASNE+(p^#yzwtfl*SHY6vHRTC^VvN9XsQ**5)6PgD=tIT}7$B#SPS zV-8BxGtBE{$UJ_Q12#+{H@tFr0)E$Sg=!-wsuBN_3-yYO$NNvw6bn{m41FTc=74IVrtoRV2=`f9 z*gMxfo(ZpZ0x^at-;+k%yoai~joIcw4tg-@awS@+`n?F9 z9X6w;kJ|E1uf&xzJ?L{dg%}5B%~50 z$>Vk__Xx9Nv~;s_-GVG&<$=pSPBVQ~L+KSvDf%DwZ<~sn>Ts44uge&8R~4KM4fyqs zp|;ZB87FPGWq$3V*Pfhjr;M8yE7qy3>4{DyX3XfXxHxYE^~rlY&|zD_qJ8@~=)Cj$ z?uTWh-I}h}X8?kpuNs_H;xJcQ1#vufbFx`=U~T1EuUt2=#<0MC$ajs9nEv>%L?e}j ztF&_>30ZZ8@kz;>V3Z-EB-q$!)m0mf3O1oEk&+`JjnaL%x@ zQm;f$Lg$Qt&andZpfYRB+*Da+6!q>xzcTrKNSo%w>7g0D2Qxhozr=uV$PIoM8U?gD z?ipjB)5~C02&hRb>za?O>4m+NR28#quss&yaHQ!`dKxnm-H`TMv3uX+`}|^rWp=MS zVe5izG`%TjsA&rzIOER5@N(i$Hit3V5+E&V!wdn>mmsProFch2nSEeh9ccGlG zwejiq#dL`x#!it)JX+Mff|~Qz3ygOQu$Fv_GR*Q@R+hyOL-1CC$Rt*|&1uPKRmcHd zOM;fA3AK!*riR!)$@QF6Ae%8elQ?||9^V*KkErkwj%S>Lp9NUL3#ERUuXC~EE5$~H zFU`jKDwzLRS8Idd9RDT1oM$6=EFN;)JeZv2`$HLe#l;5Qy_~+U>it)u%hy!*ZIM$f z36nc;;X|T}@N@5&;uY&}M_3K<*MpB!w)++NRzEFNx4lwgwFn}z2fNaDcp7SEoce^5 z?B&HyC_!lVEe{|3F&{^3E;#1FrKE)Eg*-@$C-N7Hy$Wt!n3Ba3=bs-zkPouB>DOjC zig}43oV62SRt+ihJN21}Z9H53@P3<^ z>gQk=mHZ_3{ggaD3v3k6z16^74AiI8|j@_+I4&%GY2 zS!EgeFquyQOZH55hpZ$iVNQD5aN60zqcSs*FYDgOXM-2<7kFj$o)CiLb|!-_tm?u+ zZoGz&s9n6dZ#dS8!4_pDWNx&iR;z0sYtAqUf7v% zJ|YUdUn*k!KWTg>@k*6haR$pCuEE%0SgD>gO_%J@YtN;zn2$R$Sx4 zA=x@~YQ=s25aF=ogHoh7Jd@o?`%w-1`(%OLbMRb}B%~SP2&C>vtuF{PPVt*3-QG7AfS(@6OpPHcO|t>|$Fy zUnig5Ergg4_8|E=gA#cbgr*rr44$LO-!j!>ebPWP*6v!uD)~Ovl(nRFlk?9)g>5Zc zD6~F#LVNWJs^B@rqEiFy&+iY}{K}v>~}Iir5ww&WrWU(|7xZn-NO0)Ge0o8hK;rPX z-_=@%nQ?pA5_vKYP69DqcTpiC_a-)Xd8BYve&0CJYvw!!xGYeKgHZMitV;hlHp(Nk+An z=Lbb_Y=~8FkmVKm8N?jJtz`u=qu;0OBzR_WBc22-xC%Q^qJ@g0>F|-rWGjTODnAr6 z_8C~-H%gV5*4m&HG|FAq)#36>lchHGK0P78pCCzdvzW2$`LbRATVF!mK3+43-AyC< zYX)AcMEskrdg)4hypw~&yQ=|tgv4o!01rZQo=x?r)9d%)oKmqRn}Qjql~lI)c2U`# z;knR7pPOUs;&nxkLMXW})!)Jd^p=@T>+{|Q@NLl3qT%|mnH#5v6alV5FkapyY>ofP zx%yU6K5oD-1b4hN;EUk(s+iY(<$$7I9y3zhy3C5MS{58JvRsBnnkJ&p$ri(5C(sLb zKSv$yV?iJlOzTq&qed}*DtO3g4WeVAUrFR=hF~5>y%R*@E23**dwwj9qE$<~0a6rO zE4yXxQY=%%6^etqzGycy?ZuzZ0-Pag3(+#uFF(;_At@*eVB*!FB_)*9_;*x;_2LZ% zPZs>ouExK3f>jR;j_`RR9@(FrZ2Q;ozoQv? zBi16)R%%;?%BZW0rFGfleStds3bb+Al^q!!aN{>zJn>(UgEB8QOnI@b71 zi_UrW@mig1))*puOSSW&1Hs_8aFo&1Ah`q}*?aUk$f*yhELVIEqI- z_Go5En5dk>x^sA}7N1e-F<^}=S8MSQSSadBruH(<%;&KRVWq!brY`jrSJsSbwI`2f zdZrU8T0y?dlNU3hwQHNIPe-`}j21q13ASrUOBqjAyF9d8n^}MgGZas8FE%g}$nBXS z6)oY$nR_xN~l4SSUbxXTcugN(tx2UaP!)z zNuK{i;o?#By*%>}A?|649M$FiWk z^9=m!dHelS@}LS`^(}w>m|H1G9(XEG^L6c}iS0L!_E46Xxr?1b-G=1%8wD|)PV>=| z469)=navJ7p9$u-UcI&vd)t2AI8$v*==*K_QAF0LY0n20N700hKDJq8-7J!p&(-Ah zcd&_aq$RpLz`Xd}Rmh_E8tpWe!FX(J!}9(7#FEM4SjpA3vcnEs`3^sVh6E(a#Imyl zG`;h*WwH}T>q=VabngDT2L^K!W*H|@hgnI{v+=WdHclH^gbJ#TX!^*2!NO*80s>Yn z+=$A8>O!~uU$Rx-Y=TVFgiO%749o$=6@+m}%b1Fw!BXQ+$tiM-iP~C$_f1^Dja{1L zL5MQ^GJ2pMltif19+{ZsW^qaGitJitCrXzQr>Mz51bNUQm3Ay)Co*t6=DS?&tv0$| zxsfp&^diO(J3Ai=ynh>RN0p*JZZ@@BQcNjAy$xjLy5x#ux}lQBjI3E*qxm60;|1ce5m_4p6@ z>K}>XA6Y639V7D}5C3ueXRP?g0Uaa#--~~F^O?WY^Z&K;kAU%yo&TEX|F!Y&_%2*Kqv5X7hi( z#vdp0?{E4)XUhNm?fw}m|F>FzuP6LREdVVG+kY6o|NpK9_zIl=ktwr$9sN}b@KrkS zb;19Nl^Onh{{GAS|97m+{Et!jzvu7&T=?rm{|O;5|C{%p?yHL6&!PRlW95HB3jf&t z6)XQEtNtgn@IUkdI2o$Mo3$~^eanpx-Y@PZ@W+sA8ETD)!?C zV#MVD0to>0)r<9gB;v#KMt~slk^Vh~7!U(O>Zgf7>m3Qeixl9mPsW-c^UDdQcM&d# z=cq~qfF&Lrj}+hL>axn(+ZPGT&)YW!0GoCa?$VzJ5y}w+JvSSIb@CmTthwOAnzfz? z;rR5F9Kf*`Dx0>kmeUEa5+WVD8z3@3Ut^oLdnysIRp-Z378SINHBk6D!txfFKs@Xu zO1Ka3HIxVla%BIm01lz9H4K0kd$)|h_w1lRLN5-pPse8HC%dn75wORr;FaOUm;mJK z`xrWu5L-^qPbZLBR2@HSf8cwC22g9u<~9J@Zx3^b=fOfdV}Nbmh>)%UI^Lze z+yLRYvsv%DIp`pmK`7k>SY8hhZz*6rMkquQkO%u9BD>YdJZ%cXI@>Z>Pz16@a0)}!fEH4A!Y0a+X7qvt_wW$DdViyLv0NJcZYs?@w^558BYoV3P=lr z4DQ`+f%r4Dt8Q<>I&F*I^Ap|wdpDLpcrhLTykhs3G^#Ucugp)8$F2>p3iMyuhUK{x zgO5i59|_{JhzDTT`)H^@*U%xp0KRyLHr-rrevdqN>)?bR=ily~^kDO0p>S{7wBE8m zN>>h81OV2(Y=gnCrwm$2Iqi1fBdN0np z<;T8WfxBrQeXo66MF9loMfHxYyaHD3894m?Yw zP8MXu{|5Y=XwWQ`fM52^+BY5!S@CUQ3fuQ<#Hpe+bTUYlVUHs-Y~h^glHm32yp*Ex zJUY21>|LDjCKH^pX{eG3fs;W}&LEDm*Z$kOaYVi)VUpj9Bc`p^-Ai8SyL>wZnn%qk z*TlBbMq*>=E{p{jDrB6MHjH&dG)^AzjOHLuZ5JyStVXaaa%Op&qq=zOK`_B&L%M5a zTa$5Uq2F)G{H{Xr?pdcu1gwZq1^BSq;RD;alJ&Bp6(Q;~lln{qCiZ6sm7_4#%=|v` z4U4vc3x_cEbx4cH^KvBfT#zmoteV;EqGJ?!S~iz4#Ojf98OPig%ateKa#1&O{`U)s z6Er38iD@0G$B>wZo|d^GwGqri+*aS_tJD6G^e&CJL(Q>g_SFFr|LT*dP@+^J6z)Kn zOeU+e?saOoq45%r%WXt?e7hUuHY387Ub2vE5*`LjU0rfCL9vt@MV*VK%P~;+2QDtb zNjoPsHRKkO^fAJinR;0qy9IeIljo_(CJ>)1)9jK2SuvbSsk>LL1Is(q)eWg)pewm3 zqaQO7EjFn?WJyH<+!pT|7K5{Y3HuaYuNA~WW9zz^(?II$fDE*<(L_4EV{AI*q(b_W zX@tJ#MJ{noE<(-$v?3p4!pFwGE)_@ws#y%Q+HsIU8uDy)JmIg!mmd|8?dAiV@-QG& zemC1MxVkal88iH)mYZ z3)eJ{J(3+gO{14Jw(AG-(;RXon#3QZ_*r()B=sA|m<6w;_9~i=(kpIP94iJ!=0|@0 zWfR|-5_})v$AB!ts$v_V_|-5O7{$A_7O5O(gb=hdSt{Xynz9cy@Lv6|6pcV0*WoS5 zj^)lRF&Dv)Y-65W=W?f>gBHyPDFL_R=qN&^j6@LO;}$Yd@_QyVD9RKWH9Ff@@dN5Q}d^;7&qmP%S*YZbdXdZc34KGv1O{-H!FFEh3k!Cm!xdyz= zkfElgF9)2JD=xwwK;s%O+?`fzTRBNNZIXa1eA9JkI(^I6A!uyc$GI?#P(nCv&q5{}vtl$lxHG1FMQ$}v?s2lsOMSMB#*QJP9Q z-RSeY-zuZE^dJQT#qGQJC^CF15NoC9>&!FZ&2taU+ivGs>&ToZSP) zH}n98kSc9`JuUU{6c8x{KFGbC@Q9h!m5a%n-&i>a=_L?m=+axFV9o3jp}&lrfOM_AA@V%kLcL_ZN7 zfs=AFF47yYd%im)l6~U0{0m%114Fsxcr(FCU_hiHFKhUn;@P+XH<^>t#~q1ojQ$Fo z>$1r>S`ovh__nOoaB-y&drr>jshnexwMCD|127xu)Y&|La@G%v-AVe&`@55aX1bmq zN^lW9flN>DIj|P$xwmcD{D7fRl<=p?27RSqAxML)KHu{y0$?^sj>2R1U_k?XDGnr7 z0F~!pmbaR}VB{XNp5>$+TlxMavSQ_C0^sRsx2e|Tp6Jh90r%$>?`A>#xQJ79AfqrxnT7ndetZRx3wZ`JnPE9x1Xv_mu) ztVLiXR}fR(tuU47MPPC+Io|;FTk)QLPqCVvY|Wxp1n1eDa2&zz6^frKbC#dn9p z_uWT0A%tYrSRnVZP)!TRQ-A|{WUGVZ)H>s%9z8!O2!67B*a2(bhDhwW z#VS0LF+`9RNf6947{78Q&J=igC*kt#d2(e~8wJoonHj6Agu??uV3~~E`3=j}(JOTn zIf7I7DRu{FRUXV}z$Of;4Um^ z9iw6L;AKaJ@vJ+f4$iXAMkfd2>gBCHhuK+q35=13h8Fxtpn-2<7W_Jb*jkrFj!MyawU zxy;|bak(-BqbnCuK7G(Dg(p1G(XfGbZFJ#zcI}fSZs;xZylKU)qsX)$cNGP!r?v`} zZ6X`T3Aa~Qr)gXk2O@*CLf|a-Jaw|M)EFLdqa1uYo|DShy>)*REVsW}oqZ>TV~p`A z(N^zM*_T3X^s`UmwQoVvm09tVyJ2Y${d*vl^GJ4j%%mABnX7mCay*9oOq;! zrOd)*PS0Zl(BLWV5n3{3RS?@%SjfwOa5l0U--nKC@1MY=#Gl1x<4w1OYnqIgBYr1R z>QaNf?z(lnp23O#Y`wXqQp`$~2s(gnlQ!doJ2;7eu(cVsKF{G?ydBI*TMghfhgfNF z5bp4ct`CYydpLkDy%(0Bz%9A7^=<-6fgz!YtYL;^a(T|eVSDDo29Zs0AL}&8c^|9m z_q0-2BUX`tn|aF8(>& zBiqq0Hgp1yyJ4u}7)He1GYaikwB;Z!-#rVTyRs2k1KX568t-{I{G$gm*(9ss!zX= z#|fVr1&FRuyg4~*&eH_M{W1HpV?7s-vlFu%f7BJUt@`!!fHmmDP1T)H74bP`eQsCS z)JVHPpW7G1L`A)Wv9xa>jsBEJvQ_wKO{vNRO{YWg_{b@Z1hj|A)1A43g|? z*Eh@6W!tvxF56wUZQHhOb-By7ZQHgz_5RLzdCts#B4#2#<;sl6l{@zSvaaX4Z$7A7 zXT}NDgD?4VrfT|azlK49c7xh{-kb<o@V9-I|G?z55lQ3x5`KE!^!WZFGpatVJf5 zc@*k`HCMsw!j4K79Bij7pHwlS=90Kd79!8BXwJ#w*1hd^W-(X(nE1#D!qcS0dvPz6 zbaQHUQB%rACRx@T8z(EEQ9^lZksK|nD}ol4XmOJ@>)8JBfRagOYZ;6|^1Ou@204!o z5(^<7l+EJE1W4gF5my06k~;zBaO9WWazUW+q=Hx3D})e*WA4(pDqDIX;K+21VmB$snoCrH~l6z1;R* z;E@$al+~n7?R?cd1nXdRrHs$P^}D4?}f1EXmPuc zd*CF-juS7+@0ZLfuHMkK|BRVR>kOA-(^xQ+lsG8eT?8KK;oAL(b4ZO51>6{%?xg`a z)4@gO^Ekm4Qy7yp%?beI=99~%j$%W-I=vJcxX!OpQH}on3-S>MCmjD)%&RlYn<8MD z+)!DwIrc3i);>6Q%4yTGTDe}C&nyicbkmJsk{K^4DO5Sm((Ynn9Me$FZ&qQ@q^Zj? zWoB6ehHmz}@$-|mCvvFU%7WCICHQw=l%}JcZg15ytXe|t>qNu(R4%T7Y2{Rg2-t)_ z6%+xC#wTd}WIwbPkMpJa9LrIe!YmwZEgx9UYrTh6*Y6w>yu7?M79f4~Dae(vCS*>0 zi-`?47P5$FIu0BjXMQtXyz?d3gExs*LiL!_;--{?UzhLnKVfl*H?=cdnwhdXu*hsu z9nOoyM;vO(KSNW~5;xzhdt)PNGHaP*baZBug}qe+&kH{4vl}o?Ax`!%mG4 zaf+`5CHm+|7Pb4&!J^<*fRH=|yLq8&Tg({jr8#{z3st6v63Nbvk&Y+Wl~bCY5{G5x zzWy?8Sf_A6ko6i&(c~>8t3l4+-k5qmM>uG2J7{QQv{sh4(MC^bcVA_Flah*|p4Yb1 z=hviFr9D22XB;Uv^;bo`BWt@Hg~-vM<4QwS-v|p3@~4Y$*K{*wt~jbnY9#8`rL#qQ zWa;uXE=G85w2krSUaD<-KZ6OT>jV6$Fss|!NQ`XzMPVHqHXFrgXA)DL}4~uvY{*1nqjpWrC^-G*GCfh z{Oba^!(|{~P#VtkblCa@+#45U2aYVEM(r|X)l3|!xG`>uF3SMS&^KvGy#+)ms$GfN zn;D8PgNAY6aA(%cHfGWzH!} zio(G+f6|~|OAjge@Io|Dl=&bevz68BP5W%1{ORd`g*A#y_X+u%mBnt_Itqb7`ms1f z77hkRZxFQZkwI~|BhFuer8C6JYb9JhsScsif)U2BUGw8pBC z>k18fqV08LR?0`|=|uO1;pgt-$SDz~4qT$Cu58bIg!!^0p*hOdbAoo2^Q*6Hp_cGV zNat!4kbQ2t+2>3UgrG$c6$s!{=8lNj3$*ZTERX~E!MflK4!SqXfrk0xN>=`bruQMaHr$|Mzpb}7`1p;&;t9{S{t@+siOLcK zk^U;39D^*uDDB2&&`>?n#m0uc7Gh~UAxGwtK_FC1$yDoxzc^vKv6s^ z%u|VQzA=O6zGT-1+vIUo>tGYRet=#MS4O|^vL{KkxG4An_2c8m9dUxChyvG}_O)@P zd!B3Ot@ac_a|X6|Qt((ikvriCOrt(cZjGnS3~JQaN!-(D9QSF{q&fqS6T~il*d|NB zt8RuDxtk_jf*Ja@!=y@5IvBv2A)AVat0SC9&}-E%*X)YwEv=?eFZY+9#M+4rHLJDc zwxr~~+9r+ID1#EDWrG$pPn$oLN>a_MHm*GDx14uIFk2^#^^@Vn9c8A!2f$rn9vQnB zoCV7bvKBQndOLd3+C^$AqYJb?V>0wQ^vj#1mX655^rMxkmYmF(t;29Od1mO{`w%d_ zc(=1ZIUJcji&4apLCEdpsv0WRaaKn4+jY9TsWk(9fs`3OpNzK5PSj>Bg(hS>y>L7#*f_!P z-nN)^yJYnh;UpDm#&YUmF-kgLUi#E0*8v&BwcRSIp@pgKY@BY<-3?RJaY4U(nqE#R zEsvnAI@fU9pHj=Au6PWua(>j{--`_W>~U{0@DIzl&XzYGN%E4h3I#`^=$|%d7QrOJ zU^0KkJV9~<-Z^#B`Dt=beA|kM)Xbc9#*^>t`I~b7pth>yi1XC-dB)_@3~QmXg%Gcgn_kcq7?|10_S1u&$dRnlzyA)uaMu&37@NRT`xNKY>* z4ey?|Ab37R;RlC$SseY&U63=W3I|KxN*1dmB}PC#8EVciJl?k75EIZxpxg;=5MD>m zqz}^iVn&8F!&<$YR3$d}SW{-;=$0gx(&0}jX2h@{lFfac_$zbBi!GBxseIQkk}q$; zqpeb>lLw4hyj~4;b}bqUd1H;Y2{Z9>6a%GNGY6wAhuYQCBBGpoBQKk&ugcV1XJL_W zYFm@U9zomJcIM*aLs(wDR+l%Md$?Gpyz?|K4+Z7?oz|Ubf37L#^l&B)jaGW@7m{LW zr6YPCfSY0=~!tZ*mh z^mNrQ8=5EL%w2DOvV$!eLS<|E0RbDB%* zjf>F>*~>{%qSiY$Uc*BydqugBsHU<62Wh5v)9O?&q{FN85??F0pCg{R6U!;HzZpMJ zFFJANfZDf`7$)}UOL|gpoY`yGt++&-oao+PJ(-g>+@dOmaWdjrgjs&#v_o(hj6T~7 z)%BuZ2*%N>Y%-5*Z#*tBZ<}i&#W?i^S`IlV7~c)#N*JJx60NOp2Cm#o?#F?H6gb&_ zz4lP_bq3u_6{FHqS=7}ETpx%S$Vuwj_k+Nxd$OC+w+WrX=w6P2f^TD!li5NR>O>{T)RqpaE0 zPuD;uWR_-1|ieTO4{baHGc?RSaZn<{5ee}^x-gJ8lI_x9N| zkb!2ufGf=o>Y>c*G@{0Zd|nhwM)*6~w9m8LJ2=;|501C&vClAeZnP~uScpB40XF$3 zRA%WQ?f*pVf6>*y5mz>52IhZ&^S{>uFfg*@3J#16URTw0{()n|AE-QtKa_% zyZ<|_{szMTx6-_dl&rLZ>|coee@gS;!S3HF?f>ry`!{<2Mi--!J`ymvNw)_>>f zf1fY-_nrRlT>U@x_`hNGZ_55(Se=oc@&5}}XZ>c}{|(mJzw!Cs!8!~5KdJgRM*pX* z&G>!E|4G%^{xjA7uZ91h>faLve~Z5VZ;H-<{|)f}<^A{W|0C6&?f-46y`z(A;zcJd zMQET{3N(Y`_%sR3Y*u(TJv4nkGy`)ee$;n9FX6_9n7CK~{wyRR0Z{yG4fw}m)1&%P zrbSlQQ-evB#i5tC9bZ@T720rN!4#EARJ}h15dyh3J)Rg)ZfK?o8QJtss6V15}5@CP4&nh+2*3BV5k2tSq` z^TY*zRte~DqP7Mw^9z8v7|3`Oz;9p2N9Ulm)x7DY_dSGezylE9fdOGR?-JnsOx-G5 zauC4jz}$0PnPaRxcu`+oM97f5_AgL>!BN;C`{eDTr~CW;0QQy}0xhc|4mW^o+eDn7 zaED+H558)^)|g-PcM5FwjZZ^~aemu&CWD#M%orUpo?8d zDJ9TnV6HUCSN%$_9DrVI>hIiC0DwavUpM}XXPa%9_AEVLEVAdp$jk1nC5#j3Km2Tf zcOh%t(>@@b*6?uX00*bAcTXQz(LOu~zC8dI?8u;h{8xGrK)!@TGxS(}CXWx=dOHAO z_)YEo0dq61wq#|ex$8v;u{*vnK0UhLN8N+fNhQ{OR==<$v~f>BuMa?hT|oo+0q9kc zq2Y!3zGdxj*l$@oCfBF8jL>-X|r3_Ad}PiY9!b+xX#7_)^QK(tT% zIy5n~f4)!m*VZra^}_cpbnk%M9I?+UP>MD#&d+Rwp{t#DJnK-T^_jP70A{ldc~d}B z!WqV&?;gJy&PBQaV5L)8);CVJI?Bj@sDInq8q8^KJp!Kid3=3=Z4}?O_9CY(^8DrB zY;72u!owe;-Hx%=*BLHQoKPRQFCA@NUZyPqIMY{fY|M0D&G^=)rTN~~H>AkH$#Y$_ zKOq2x)whmieyV~1*f|BcBIT;Y@InB4_L%yq_qBU7VRcW1{LG(52XLJF1i&h!>X}II zInKHxvbF^Ig46UuRtJPvIqRZpEd@TkJPofpW7C*s`Ph5cc%x56gO;G@3JR0}TU!EY z%KkMn<91sWEwOW1n3?+HI{GkeufRQtl)7{9%*1%S^t&+a(Kl)0f~$UCOGeu#jrUrs z)TrVPm2=nV*QfQEDGHmDS0G2)wujUdxA1IWoK+^Vk52w{1Daq6!Kw9;6^6x{wikXF zo`>|4ls_4kTU_mLb+K|~4-+N%U@(%7=9$G>+_IIjZ|m?mHl4>}h2rt03C$Q`MBQxs zRNIVSeAAXl^pYs*4=$fB%&s7;C% zZ88$CsWX>HvqhR5s&}h$PW34V7_#nts{M6IHbx$N(n$p5LJ;|-xjkRLFaWqJuY^hr zjM^eHwyu`4e)4O(_l!!-$OO1=T87{~Xu3njbxN{yhVrC0m8iDdWi0zA<|AlHQVm?) z+CTyD&8YVbd!vC?I~b%oYejhj1Keu@ly?LOAoZ4mdrynWz?xtV7LkDX%W@mdUYx!j zkygDmq_35KwmdnWehyKt{zJ+4;*YeC6M;nlm{4))SF+D;~_E7_b2v_TN-JF=j;t%B|_C{o#9d|m6v zXE(U-41L^BoAhs|tS;_4yO~068n!MQp%m=gN6nKJ}|1Ia_Em#NqmWza@En|%2M8cZst^&3SRiNXE~Q07J2E=OnqD^`QF#Ta?UT1(x&-0=W}K?|!NnC^i`Z1v4rRd5d0Y&= z*3O-ISvkzGOIR>Lf8H%>x21$vRxE- zal2vV#*F6-l8^nZih)Qg!&iAJD~ObA)WY}b)BJv>~4Fm5E=7O8rH7&>vH7Qrd!{mXE=ul>m=W@gM zT-E+`px~{1Dd+0***dAR9+d06#TmR^xY$M?>&aL{41Q9n|L9bTmsi4Vxe<7VyNcKt zQ*i4;Ik`mW(pgetD;}OzO1cE2EwNJI)F-082u`C?s}E*ZDsEZr~F zp44cjBVl_v@9h=u=iz#>vXCzVH@{e4&t_%@Wt*A)Yd=X0+p80{(p&p#1cEVs4#OwY zMgt?!{LRS4$`dKd^s9#r%9QoQE8lidh`bS-m`Fx4&9H*-x~P^4JNSX$k+KImOQxkL z7lPfA(90)Q8C5FtcfxS+LJJ3_p>Ups1L-uCsn20a6%6LDr2}^A&Kx>)lwq41Q;$V@ zBzO-QCtVh014JCUhMJA&HqM?1ZrX#AzJW{z3N?vzn)506#w?GwV%57g{*%`PH{PdXTP> zx_riz+(d9tkx`HRlFy2ltR$!y$eqwYD(sTc`pWFgs+hGoU#d2#wMld%J?bbP9IHRh ztMxtFbC_!jlj~J9uYz?BL555tJ6cctQRNvs8PMY&(w87$pG#MW;9nM_05kH3FKgJ6 zNApkdZFlzGabZ)sBaDZ#gR%*(G%AJnEC|%>`YyCdi+VUs*HQyx%U3|#{D_rwz99`d zRHCt|SkT5In!wZ&Hr@#voyn$uE_4sF$b2XEsU4KEA9Z?X4AC`^mDo;X>5+8cy>(5g z0se3>H6}P+dH9jOvU;gMdMhTLLkx#j8_0s;F(i4 zDr8hMvw968l0~sBk?$e^wDSv5d_h~DLpg@w_UaKK7dQ&pZlAjno)KdsuUm8T7Qs`3 zMW*$m*~y%`Vg(^uaV`@X9VZ{AycKM(`!lJP7cA?~sPE&g`*p@rdrqTB&O4rWPDU}p zoSi>bo1!3G3e9^9s}cI|aq)0b3gD`+LTYpF#2;;lYc@!og7fEi%)ybyljO0SQFCe~ zaOKC_vaIa3VJ!NtjNDnimoVROpsII#e&b9{4T4LJZ^i57+Hwfi~`z+V@C7e~#T74xkE2& zW2ueOx6|I_ezjG`8_z?EG`uxfx7W$z7cpfV8`!0|DQFd*PK`yl7Z7KvO8b$;W-lvt zbHPFn-bPeU(SDR!8NZ|?8E8q$+~~v|W4LLyGxKqGuT(ZixiOzFDUQF5x(%M~JRZP0 zQ;0i~YWqTSZMr8~g-k&g8A!_uERS5mWwVt#7Bo;xgPKj)!$6K6l!_P2R11z@S&npW z6H%qwWtfMp#TD1-xeM?yRf@bC?-ulKgrq24&eLG!I8qppwxj54P(^MSQ*WNR)aZuDz0&>mAn>w1(_T0TwwI(yRImP3UIuj z@USZ8YdrAVMwx7j`Vfz9K(RfU=iZyEg2@r*@!*(3dV&l^hmx@PGfLtC?vmL|Pag9? zdzjLHv`_cYz{G2+xc?sOrM8Kn^p$KqkdfGf)?T@;!5Nt{|B=ZwtEt9woz{i9H3F^{ z%uj$9Kfq!8R&EpSU!e-i%>CP6C z*?u+5)6QvEyq$o7VPCy{vu{-Ns`B76hUcQ|OgGfUYp#%Btf3zr3%A-PT?r?h5zSrL z!gq{^UxD6yT4_oe&WN<0Wbxs!IR8QM(X!-+7?sv5_2sSPMHoGP4d2VA?;_E(5?{XF;+?;J;0Q=f@ zSIWkhG|)G$H%ov|0*GmYeS>%py4ZFTGIRB54_ zuC7(|Rcixv<*GO4Y;#2#(k*5qCal>yx#6BLd5yHu3ak#0dd!rfOQ)S^wk0#ze1R(pHrBI*<+#G!(`&czd$GI)06udn4)T%mapfX0 zM~0xo8tzK`Wo!>dl->H&qC+JrF3WmO2tx;pg`_12642AuoiZL|EPaTFAJEJm^EYTze{Tqmkk<8OruHdi#-#~Q05o3sXr6G8~lTso z=Ov-gMO**UXo@{@QB;j+0PFeG_9JL;veYVQQS)%kv&;d6mIYLXKZElDVJzlxcCL>i z0v4jyb~og3A+vexweYF`RRbKa26<^@#ZLJvHouZSBR@P}jcLp%B1dxe$&{lNXttE> z>@!r;7`);D?AM;wEM%ByU87fcv0RS|Hb9#Dnw>p#mEwfbSz?G$NhKnE88rMbhj`C$& zvKSG)2E{9(WkE0L6KL!Eppy!-kNTD>^;wcQ;!j?PPfW^70W5O!^90-2cB`-YR*RwO z#rYx@S0@i1R*^3pFNKZWs+%7zi4!GG&CX}njgFmR?vaDh01nmlt|S&hqyha$8}=hM zfK3X3$#$?H61_sBN>}tJr3V){bK)P!z$H_K66|;+WakrI5d$a4y2{6 zyEKbp_{{I}d0d&%LGPVlje~{R*7m4cyK51%UzTbuX}=N-0|cmVe~~}FwisLv$s-k` zvc%s5QZVOtK4)#X*xip$L3Sh;uDcu^07iQb_ZB%88Y~LigWb;KI58%Dw+xOC45xNU zOSqQCqcY8V=2FFRU8nnHUUQkAniTA!UEkKW3en*{1wcjjrCsCokPf+oNt~5|c1>KT z_XMTkK$W@U&%MxXpYx_`oiMIFm%w%y{vBLun|Wp z#F7TOKT^GD+QZKsVXpNyu(N97?qmc$6ZKMQlnXQqhxm5iKmUf!=yxMlc!LPJOQ{BS?kX+Wca3I1 z|1snWyV8+&|JYzkhg+QNcK=Q8aZPNjq=D~P!P{j(IX({5XG&dA2BX9HCB(!U0gRPf zd@bE6KvF@D@nS7u0%2;U5PQ9T)kkI2^0ug>j+vk4&mDzZP2A3f2jAcM1O={z6Y@X4 z2e_{`LUN?zT#gA!-sO`fyFVWQhVt2#?wVTG(@I%FE@XriT$O1dj|qo`-MjYBB-Ylj zPvcNO^I2S<6b-!Enrx$+qb+CAwxUvN(8{NIQ3Lii)a}fGlmY;34Z!EI`bF<%5!KGh zQ3Ctign-wann*03WiT@Er#hvaj0cd%DUy(}2Z`6FNMPB=G7iK^@pn*o6MD< zepY|vwLVhW*W_Mn;U+uQeT1O&G3o00|5*qEr*7{*L*d`Z1geAcuw_dR9f#K)IBFRp zQb4`qt>2jzX*yW`(_c>|b2xtEZ!Rt#zCct9!q-!dn5E16X5wTqq`Q@aR#pvID9SKN zeGfq_XVyH~&Kg}Rf>_$(08>F&eZJV*z9f`Y!4@-34hDs$QXXB}eGz{!J|F&RQXslH z*2n}lTNFZ8K^8NXaG6H@OzF=ihup?^ih`TsdrGiXo_UfC@kWPHs)B{AHx4ZDQzuAT zrvi9w6A|as_&IT(C%{tL7>a_L7llUfATcfQPe;vlcJ_5YXsmJ>7+aUYU58DppvD31 z1?m1A2n*LqcE}#l;b2BK4_X^ZYq;$1xwf3qaGnF#0nZ21-C6nsfoH9BPNu`aKlwci zfPmZ_16hkn6!Y?FL*6Q7jNO6iOM{X-8W#Cs{aFFf+oD4zVZb(8!Rf};gH7-&E=WI) zz3bVWem)jeaJi2UHEOEfn2M>VpPS-74Hg!LlD_Wb=*h7T07yG@PVv5_cb!PP=6cOM zjfX;8IPwjf=OefCM0^OX^F47xyU=aR{O(3LFf_~b!&Y;%_C7n_rr7zQ#tw{$6hX|c zawOj=INHg2O~)F;iOnG^(eJqL7>6xwgv3m!0l_nwOp6#q-0a`Pb09Vud5#MplS#w> zlA7zBApXO&9kMO-qN(&XLn;tfOwv88J6CyZ=LNhnthos8{*GBWIv_hj|7OHHa3%P( z4i$F!!}JU+M!>Wd_9E|KWQ0yWoNaRxcUhU!OHph zOKN4k(@Ck~IS@Q+<<*K}MN?c~V{Sx9C$SR_xG%QSKil#_O^@?2S*&AYR6J$kt~qp$ zRb8!QQ{82GugrS)hb=&kc+rJ<^Z8}Q!<8^>D$!UXSHJYMJ|S$R;-g_x{-k@%cm5HBGooPrj9^J|&z_$Sjpi!E?Q>t6%NyH1H|`{$}% z?1N=}-X$}HbHQnTx{kX`RRVXFH}(>`VgeHZ5v}D6>BH|;$7@+4+-H2 z0kkYLGwNB|6W;za>I)-6^?|go!DbL-1HW>hVmi?~Ni*D!)3@Tnkb>m7mU(ApIT>6tB9&H>%l3?&|t>iPDt(_KtpKq3GOFOj;4!(xW5${-olt z^;r3!N!+}llM_suT_!>TP8n0lk=(WRc(jkgfbegGJs5v(GR0;=!#hszUw_+Q%o9Ry z&e5#<@Y2QSCsSA%SDGbmJnl%WQdW;sw(8c-$K^LUg(&S49(ykUBM6WgQU*q0{S|te z%qpJFeFrh~=-vzNP`)S=UYI{-ime*CP4sz-#_Ao8AdyIkd5$CMIyzH$J;hVl5)MCR z3__LQ9xEb8>@f0L6Vt!Bnr-McX*&ka@k&!%^;tSW9HHuLF#(+nq&}^jP-D-{fO?_O z*izc=G-TqLf8$;5yL_g43iKvav{Ou$r;PjhZq_0z&$%clJ<;S7evgoC+vT3KJhL_3 z#mLrcf!Irj`=Ah(gj0bxUo*(4F33`;XUO8YPx3Wyn=yAGKThUNsd;+tUC;*?H^n)r zu)7J##=WUPu&4v+;jpQuGT+Gr^9qOO|FsSNVbh%h@d1|xJdXfoCrprqUj+;D1sa|Q zi~K(^@LxFaFAV%`1pgfa|HTCVw#dND@DJ1aFEIGGMOJ!Nwtsx{@5uLGOlzjU^WuMp ztN%|JSmc+4l!V$h23Gi=6qxNlqtn0nr-6cvm7euKlhgm%3eWtnt?++Kw*ChLW@r1` zzP?}Ip7pnB{SBA@)wKTWSN@Jl|4-@N|GwS-4G6Qa|2Gh3_-+aR|D)vmTi5Fa8s0_v%@JAMp4PfpUUKiP8SdD1{O#LI^^!v_P{(VsW&> zrIh$eq{nx>Q%{{tcN6c~EGXxmgY-C#c=gyvkI0QlC!=sq_p-yT3fKt%e) zY7nrqVq$7A5PZ8!Uy5EdzX#D~0FwitV0z?Tmli~P{_b_0leZzuV7md(?ms_#b*}|_ z5lnS@f%xj7fS}+X!Nwi$0f}rtUS>D00w4Z~56|KD!}l5x-p|(M8l(B!IRavL5SSVd zd>6dgM7QZqk^>?{J_*Nv_r30<_W|+kdnFLK`C7QSVuDA8Y{uVV@5a~(77F;}Crd@B z@;MAl7$OAr!-5B5$OG6vfAKJs#m|ERyFj^@eZJ}g&B##2EIp0*r2VuZW?_-S_eD!d z1nws>!UsU6q<|Pk0L%M|)`u4SR3h5PQ^l#L0*n1hpw5&0l34zVp$Ew83M7Jl=Sn6B z?p6iCzlZC&z-NSK-+_Adk#^X&9Qg|0Fd_c}_y02CRrl7`?&2bLTulEOff6L>@c+C; zdOi&yvfTm@lmmF>6RdZ@1t2OoYX6oLr@0FGpM8WiC+QevS+a|s=ZHmjz_#@1Qlx2*$wRsWB ze^lR-CaY<41fL%|2hG{+4mFQqSm<1{;PE9ZZuz|U8u7Ez3Z#4yhUD*F9x!iOS@st4 zRnHPvKf-#591NJ!!&E~=p;q>c{ee}X4-Zi!#!JIb>~ld-TTF+VjfmA#$iF1#E_M`0 znREL6yJccThO&`I7w<$408(4e=-?T@SNx?zgn4nU!!mWbk6gFmCSi(`;h^z|q-Neo z^dJ188b-ey4@zi7F!LwsY6!BU~_3Ua7 zm&*jY*>6Un*TgxC;ocpB{hYbv3eI(UX^IRAvI6WYDjoJF!s=!s&!>zsspHs?rq;8f zpoUvT*wpv4%`2Wr`r^iQP09}X?DgHKd#O@~+hxp+&-3|srMWUSJ%Y%*<#%<12I+%5 z?pKQ1_;v# z=X?)oZ6+0cIyBbZshoezF^*Sc*HD*hsu=H#4Jk85oRw7;dGyatdJFU0P7N04P!HuA={*q4&GdSJvaw0XLq*u0BTBd@l}ZAla|H>#cd27R&? zyvKyxi_} zA!)v#89wV{t^VeON)~6UsOAN}%G)No6R(bqqoGo^A#oxi-S=JW#(g5+B0}B4rEl@9 zjVN?)sX`}3ylvcZTkXJwhFfiYYtlX*L7GH&)Z7Z}E?(xY{hVh9Pm`o+c}y09nTS`i zX#D6}vajdqy_!(gO`m9qwZb9^&O?W|`KdeB#?MEEcV~vGl{Z(sHKlX;{QkJGM%thn zBeI&rc5`9;lofx0eatR{hZ}~va`dB{vw{w*+@nz1JfWOWi2s%q=zLQ2paJgvvSoN^>-tPA zLwQqixy!_1QrJ5>Tqx<5LJoYj$*S|U@@rf_kt4sCR&N~UQ=#`sw~U3+qP^^I3? zb9ik;J4V{(`Ox-3?uGU80GCX$eLX8#e^T1HB$C*wE%{hHXU{|C{L3`{;h~X8Ts3k- ziuh;*mtjgGA6;c$hSHt(UY$c3?sYf|x9{L?9rKg^63L(xuzc|B`9pTyn83IYpp;s5 zMo7lQQj^0)c z@AKQRy%)A%Hq{hK_5mB*THi-x<>t&N#u95!B;)1w&wH4c&@z^r!b5ez)wQ|!98~L; zC2k8(iO~C%wekhZea8rx2BBLzSb0tA@H5oGG8N1%Da?o4Lq zDxKta#~tppsCxGn$u+o*x%hYB3;BLC#(69%LeJ%ik4Tk?FqMlc%aP|GE7}dYZIlJ& z7`bJ)Jd#lpF*r=@!yh^kH61bfQ@;jEQ@?AtuVD7`i-l0iM`^YgwaDs5nQ$``UUBV( zGLNF%0d_3N&1-GrG)g~~`!}8XW;so$wDQrHo~6#b6v>_IS&ti}Rke2{S(irA2YclC zldFDz=x%PTt%5m_>Jf#zM0zwbgSCh9UL7-~dbq5%-z{pb7Z}Gl1x}@MD=cS{+=_kF zs&baoyZ^XX+20?SseW7@As^PzfCj|9=`U8RvwnZn=vU@tS5&ujz=YN^AXXOg=(R)p33 z+@YI@s?gF(+912TC!0=@r*txGRhb@FjnbNeZ%~A~|5FMt-L#0Aks8A?@v=@zT>Yp*^6+m2sfkKtAq~#W}`EO($+vDoueq@>ZvGdK!3X9NEUh6 z1Q>V^Z(KhAoCK7>0%kS#oC%Sd|pm=I&RN_Le3t#hJzvvr2j=fx}F4z!>aFPw?)bn`&6{O}` z(sF{ND^H$V&cfj!_ai(5in`Q>ZaTJIv~!{GXNHct!}1#lp>q%sCOqUcC*4z0O%VCw z{XIH{obX3pW;_vb8Yybz5kS|?FL$KiC|u6B^;V5Dq^sTzIPmX(ogsq?&}k!#a2(bW z#B**Z*b+g$5gHYpcA5@%Tz2N#t=r1I1o)h+ zT>gR*xf||AXN10?6-;>|HC^5C>)9t0woN=)V^0TUEd&#}&~DTh z)5cZz6`D;OsO2di33o9m4_1O!E;|<< zI$|OcVk^8^Am=n*nsP`HT4hLdDPs!hicJ4KJo1O*5nf-FA6I;9`*-KPp}@tezkbkK zdNu+LvgZ$r_GUW{)#B7I3#4Haf>*?+4iu!KDB{D1?JJ zOWC2`*U=BmU8fum5Yz9`+k>XId+dt+d)X<71y9q*_D*-uHH695Dp;BJY4JlbySCl2 z>0M#c(?N|Hxh7{evh4-%Bby_O4@Po}7*uL4`on4*DrV4p$$UQo5igC0hKxxav!mm; zE7CfMlOiwS_jqcoB?FKSrBlXh5NjvM3=Hywo0q2YT(_)C8(Ae}JJkgYJ9#(Wo@dshVV&s+A%Laz78B<& zGR4z+J)1+osBB$v_G`LRow9XUD%Dy7;C;*ukXC@^)G+lHUviY(xI#RDP$dfMf}EMp z!JKtK9xd>2JR9r%!+waMq5Ma_E6Odn^@GvA5XtlT@(dw&=u%D*+du&9OyP+Ca1Uvu zDm%kRb5P8Ctd!Vzk5a5?Rl=+FsKg|*aN>dEwcgOmk7XmQsg0;KO@u|lJ)h02S*W4d zTTBk()N7TT{lk<+T$Jm@XmIqA+o=^Vb1blP+jRaO*1_&J{KddjX2L*M-3+P?vmqs^ z1|i2)$s$(Nqhf#UAc5362o1+5h?e>ct-=6ont;>B`Ql9i3fQZg%2F;ob8Yhp;?CiK+)e5Bn9JdbQpZN?3->6-#~&Oe0xP`YMWZ~nET zk~>W!aQowJ+D5TGhEe;*+YAOzSqtXkjCHid#e%DC%F5LT;3L06lgafq{Vw7Y5`7^i zcRMTXAPu2o`Q_mmTYRyP0!UCL4#y$BwX=Q{lP#`zY8TB`E8p8!6aFlaC$dH0G7?p-XT zK83d;P{! z!F}?Tx;SH{J^9UTeck!Z@wYT`?-5JLAo4xSJqw%6B1}2zpIKBXvQZ&lwinK@EjR_- zk{yZKP_;X(1d3*1gpE_HUL)4jC)yyNrVXeRmLC&7WgH7&^IlT7UIO(b50vV39?G3E zU&d65`b9q+f)qPk5feED?m5KIp2jO^8YN<)dp1kYwtQ4~&JlgAJF(uYHuA9!P6s+W z=j)4Kx7*I5%MqnS1hcerr5+#rQ#9=7#N8`H?@`%x0#A6C@_l=-O@wdg=KUi8+?>oy z0f>m>kZZUPNx%cVIIALy5O&w0W5XNXZo4NrP2?NOIjA%_$4ZwzS42d_%6#ti=L?DJ z)t+gUCPywbQ$*AhAUG=BWgm>Lu@M|KRR&2c(qQ5$H$J&9V~Iw|Y8m&OK(4ssd^ zEXORP^^UsDL&LQS@JG0AO#@r^S{1kwd><}RnpdA%$EsXU^EDl-Af})+`dm~c=1$v= z*LUUS1`Us)Th!?%Zd1T3q61dK@bIeYD?{gC6irbt-QB6-D!c^pcwR2;yb~#ImVqTn zgL%{(Wt!W{)!Z~bMX7ztmBB`h%PdK#`{nxH%!)ZuS}H2Hn+kf)5^Z1iU^7Kuo^(ss z&&9b=e-cM^VnUZ5QO2_!bpBuLy>(Dr`{p}7WJNI{YjJz6PEX4zF$eJFAMaLM_jr5jhNme;9vV#j zvisM4xAonR*HFi?OU(s4oLrV5W;1+m*Q#5ncm=id)^c}RZ+gCWZfn?l1Ge@Y=YOpq zn_&kLaEg_WP zw7kOYi*zq1y;mPS_dcv)VSl~^jbkmi)k>(i|9-A_)Dg{Q$!ZgF%Yd}4#*3iRIdq#k zF_v}E9X@t5BPh36ei+gS&SRW)t!bNOVe90)UTg=jL%Z__(}9q&Th$e5^n~46fn@`X z{5ecHhifu?6?u7}tG!k21Hy_FwFefHY`8_9bfp561oReW`+}P(+N~hNg%i}Sm7CH) zXHc(wfmEB?b8U^p=+M1acFR1akvLVT2mA(p>zBkmw-W*RKK^tmMfjj`?W}Im;!n3I zIk;GRZAKT)Q@c;O27UU8t>nV7s@7K0f{P^Z@{#FBE)QFB9+cMuN8DHt3}3*Ugvo;U z)JsXpKdUhf?0r>yJ;TZWd^Ob#_q~Ub~$mgH8} z7)P#FKc;V%+y0Qu!+hik9|kq2S1FVlJ}>;>qRnu-ETn&vYEsfT`(V|#;^E(lB*^jb z5Lz)XTI|vzwX}ON=!f5ay^AB3h=+A)#FAEdd?iK+4!5l~=h8#3?sDu|9q(eMPo6%k zlcLsu+1wk%+;%GRMT?k|ol}g!qB>l0gy__3i<=`V>T0cs?$NJHS{qR_P6n#LJImVC z+JT*`cs8qTX^V4o3t(}_8cAcd6Pd7Zz`~^wwl{ig-HkD+AL`({$aj(k!)+`SWw@8&^ea-E$1XK+D)qo|bM~Bs&Fh;F57wi1E}RVw zFmzZ?rjCmA#2Y}8%`)=8p}&8k+V_C$KSjnYe=2_I7-^aQ33~rb%ret5{WC873kLoK zihrTMf4=yC4uAPXq-8`@CO^u{fT-1JCyxzPyT-*+K}p0@1U59o`D&cjgbkLjg~!OWOGzMgK}JL;j0z|62I-jsJshv;HH_{PzgDz<;kcH5`CRUiSsp+0Q~u{A=yn5CuVY`dHH^I^%I``MG{`kl?l0(g&Y>gsO0 zbB25864r%n^u-WF2v{t2*tyyT(&z23g6jMpv#5(nh%dYSdkO7drCytll+$bbvJ)2d z5~!9ei$Ktf{I?|DJ3Xxn93IxuV~``*bf_1cEJ*61mcO=ran;jW;2r^!*K1G2*^L~c zMXu>(9f5QYq)JfH4N-xN4;$T(b*X|k-PVuQbx5Nn;sj^9h`R5)r_%S_z-+?!X=FZ>sX1^U|-f7{@@u1T}%*#cml%!>TV|f?DL(h zv{9zhdA>KmVkvFgOHF0bKJs)F%{0B<^>BH|h4waw;ox$boABxBP zR@O{QPS4EjTPmNo@f4(7rZU)*<9&=NKXjt=7PL`ElcWHR!GR3&F&I^!0Tu=#hNH_o zWAE5UCQFS{CqlPSu#%xC9X5n#rs`wFkG9H+OM3P##k)^qr@i|am;6|&=y{~e{W-It zj?_}CvN~<5F1r<9uc|J%5VmV)OIn!)$6N~Fe9r+E@LEqZDt9>e9V~y$upMraV+3b< zuPrq?7HISHH@0f<#WT-omhBxS$8h<-I4Id!htFOQe(3pjRi1!CIqzWXB@ zh+&#eyZE@&O;~zrmpl#V)NzMWml3sE&XgGwdYMvQNQ6>RcAku=3Yk${&Vp&$a9xHAY@jaWPX649u50w?`?e)5IgFiJWYZne zTWM}UW_=%}Tu)ag1hr$PXNt%!Ekh6p<&=Y3+}*fYic<4YYx&)zSp1bEzud3_u7|w; zH#fGrH^uqVeZHrLde_!}0&O{q-N2rZn2CO$*OyqlTrR3=sRiQhAv&wSs{EdP-l?mE zxHNM(zc4eis{OQQpEyJ?GxyW<8%v#q)cD+3NF~(xZS1(nBqUVM*H+gspT~L_bfa)q%AD)+%O@@+BHU_4*N8P^tByBl7h6}ZvT)}vupSA%R zFlFtW?=yHTPpuOzSuMY%S_bHDp>gZqThY_Qi}_VQ^-ULj*E8s3v0WQ?kziz^*~A;XrA|G5KLFD|Xb|7)Pjzj3C#U%>xwOmty@0t& zzJ4zJ$Li~E$`(3Y)}McG{IlDT9+&lR-G=Wa-9Newg-tCS4DJ3ag^Q!gwBN_iGF)+TQE^c+ahCC!qvnde=Jh+S z)4Q`hm)n8cr`?CI<9nQ5Tg^q*gqZ*Wi(QJcqNxBX9|<93rY0u=z5w7xRpNpZ3J&!d zhIck~zD>#7C3VxO07H^JtaHZF+JHx7$_M@ck69G07(EL6WBFChsRg zFJ%>tPXNvzI=QkUIy1mf-Lp1)GK9~inX3 zp4{G?dw7V%X;A?Lcx?eV8b1JuJvcl0pxNobo(62H50N7Zp z&=;LI>t*Py;J&bsqF_L|Af5Pre@a}^Z4$YGz#N}pQr6vKGW_lNa5o-FDL40!1cLE3 zNIK^3XfS+hWsJL-{D^d}8X)|LJ|f?lNAqZI0L#7DgOH1oLf*!B@@MM-fP;Rx$R?!B zzzqRv?E+5j{*m4>0RsSuFU!gg3y@{3?ZX8r@L)fgjR1h_+g%=&aj1=6`4Jr8`kCmJ zM~c21-UYC$^VRWsd^i)17L`A*C9jMln?F3! z%vvR_Zr%?IwyLBgy}H3x*M&A$gwBTTc*aJJ*FhjInVknuc`DLpQ@4~Hw>+gi%NtoF zxNgSfSIi>m6g=he!3rr4s&zS0!JsA6;BwbfMN9@b!MQGTjeKFwLSDfw@IQ;Y3qEzj zVwKU7ur;7Bh8o);_S}~U;zmS$w^KHN@~~DRr-Mw9zY^TYe>o+25RzBUTQq z1?tkzCBI5sY^`f{IM5V_!%Ck(H%432(jQF{LD?SFBdP<5m}4?Qn@!q)eeYV2JQ*1F zFI!}p5%+eUVt3{2KF~O;X6Z4k*%~$#iXpGUoj{ANap*zIUVV#lJ*4fsPvc&A^6X?X zax;*+->RaV6|?5p+Vv%NuZ|kmwij>hsSBEK>RDPMeL6K1r@ZD$;aGZ8VxXWvv9YwP zT4LSPr#Vc?5?LB-B{U>;XK&SwL1+|$Uu*2{Um6?y;rLwl8hVzKDzkFA-L{h1ukQTP zuwoOrdmQPpydNKg;PPFdmj)dzVnyP*nUCaM;DT%?K2u|r3}=?RVb=28OISnaGN$gt zh@L2~ajP+e#MA9;Ap z<-ZM5tb1=VKcb@<7Z2f5Y$ti=dFL1UPI&5y^^dT}Ynj^D;aQ(|vCSxaDM}R#9{|m< zKf=XCfxfzfOZLiY!NxZL5#rsw6RaOMWL{j;lhbZ;_awKk-8EO9PcA&KT6r+RKD8|i zR5j+3zK7M8H1=;PtoRWI6k^OWTw@)=mt1UG(K)I-?V&H)n-2A02IAYkm>ACh-5%O} zZ3>`5I=4HI1G{9W^e%AWwtpZ#f@iU}mVB&fc6D&Q6Owjr-ZgK34J!spJ!qIZ*|)x& z`H>a}1ASs6r^uzOly-TbC@wrG2rKVwRFXfI_UV4g5-U&uMoU3K?ws=p ze-=l^ir2FHLKMQX;ZjNKFjF8z6sUc;%&ZGhEXf_g1J(ZivsDxwy1=Ikro5s_qXNcz zgpGUufI(;b!`p&%xG95NtsV57QG$+M2i<&RAX zhI9aKv_E=rOXv?Z4zyjbw3JhvK1-Z*O{c5GY+trrgZM}levhtVH>a_?AE9VNw3=G= z^zwsIYGjRr_k~2>MZK=t1c+75qo%I;fdQ27DA9zNggDdxx$}|<&yN>EuP7bwE0p<} z!UaU?xZ1NMH&9)$mfr zI4_CYkrGBTDZHxd;tip-DDx3|O^BINLp>hCt-XCi+d$ww71|#KpvUs$&j;^~Nap8~ z>I)1*ACD&Jz$4G?m|k48#1YSKvul+igKB5xe!Py765p0Oj>3vNYAJI^7_Z2B$Ths)djHz6v{1$?9x}Cg0YjX5%aJjx-eK)vhGEXgH z2v|hON)HojWu166;M6;~z8hTD!3vg*u#$$&Hz}f1)d{%ORauS{2#lUU@ejunl}YNh z@+`3Bx}m?lj}@3cFIG;{GBg%IBQy>ucr*EVJ)#|x!~$B%yDFW(%{ndXp!cROjPO$ z^)snoA(qpd_foT>6LDj{v*#PpOx*!@XfU93mgVM`#wRF1ZZHgZ^>UNrLgvLXBlP&1 zYp@qsYA@zdiF`Cc&|Y zw_Z=4D>%c=c{1hMf4dfinThql)YHCfuPT~ELS_SyB+tf{egQ#;^s>1+aYah$I3OtR zFtJC#Hv;X-2JuuM+Gh{=ZF9Q$>na5WpAg{vZf+h)qTE!8xqVM6NGMHVZHO;Coi^bS z5}Fg>76VS>%dARuAXpb%FRzlyGQehS^Te(}39ssj<* zY_U}F=jCQ)E_R!)=iqEKLDTl#u*uTq7+KyLF+Sxt=i^XU{e1aKYwElm^VH_4rM%I0 zfm;RKyvt{VABs2uEI?~bHf(XZDvzdU65p3vD@HmIZKk!+#n60K3r}Iv;LmNb@oVHvvrZ?^ z6MvK_^{PVq#;Cr?jou(K8sndUt6Y4m~D-H0514Ae?gOS36#EG(3r^qj* z$3l#0y+4CZgqaDtu!uFnuHs$b0tvdUnL=S$B{`xIl@Q#Tv%$Xvdu z{{2;F*L2rWMhub=~tNYs4_xN zrroyjs70`HTA4MUk!tZ$4^@4?ANf%?nEA!L^eI7-n)Rsd^hG?hnoQ)1^>0;sJ<}rX zK?k{E`#{d8OZ~bHz%M^Oz<7dTeoK~W29zFQ3H!`xqe)e}$ zk?D@YV-D@?RST;*S|TH}t0{b+Fwgah;$A6UdyF*wglIcF>lmWMho5mlWM9KMU8?GF zmk?#KbsxJ=?2dUo7r*->B->u21bM7NVQVSXY{mZ+xUkGy8{4V+;Xu`zMc(GNIy-;G z5Ck&iU#iyTA)6Up#mq}0Ft^ppIPxELtv6>a9=rxd3Pe)rQ`H6Nx3z4a`MS;s6xopv zCCL!CmQM}dmgrVLXUHd;{+SIK%+uy@R!0x@2d4;vfD1v<0hF=p19K+RcC_>~*UKd4 z^e%O};`7Kva!G^x)fTKKruJ>;yTAn|+Rm&Gz#cR1>!&eS2VvZw0++8Pm6h=db^A69 zaR--O*Yo1LP=xOS7tTDq1(sVR4Nm!ieZC#(!v_CGF?rw#cm=f-ubmAiD2{FxL+nBe zj8bC4n5$9>2?<5EIOp40tWhZwN-Rj-gGD=Y<4B}pEdH6z^+WUbtEN87JE(eamD6Is0aO zmsmP%)lby?KG@Qp)@SbtQi14#cypCYvk;Y=@s|DwuTH!xJXkkx-rUk-jDnRUy+s;bIZ14~rhX zrDP)@nX7(%op5D~>3StKMExt?!FBFOEQC}C%4W&6!qTzYcrL(0qQJTPIu=?JWDPCw zqIGD}D2JB8iPfY1JSI)gd~za7uk;u0``(Hk<0HdW%0AMQIxKzM{F`euk;Q!ef>kwn zX|0=!YzevqC@-*B(2E|g5al`LDWu8j(zG?Tc=@K6o{wy;87}6QYY(>$w^FICvSZPa z#7Jik5zRY7$n^ zLITFtYZTu|B~$r;3ww6uwdUP8)ccjfn^IyE8IeUiEoD}kBC(=d_=zo@6BDCXZG7$U zQs}}nG{pniU$U19g5WMT8J)kQ=;9O{|}m_&;G5 z952Lq8cF9hhyN6~6ax_51w6E3sJ;ta_R<{PI|Or*gL6dR1ukPT7p0UY$M|1Ub6@XA zjG82NIn#Gzd73O#r1i)IyPSP4iil=g6K-ZX=+l{HPiQ1XwYf}FJjwG#un%)tn{cU7 zDDU>af1^JrG09d@3LD_i8iqhDOVAiiUtEc(3G+`Sd2l(OGFuqaq&nc`#pRB&vZ(RN zG|H!YjJK)q-L>pnDz6CnaQ+jXP{Q_O`P)lts2h0p8^*n*mr?TsxGLZ50bKaQ&(|+JGl~1vVX=H zGP-S*-O-G@&|VV74vEYH7WE8I*lvN$dE>jlrD+{nhbm+=b5I^$-N2r%$6q`qBo%A_ zdXZKgEhz8tC3;h<--*)rhtL5d$}=~GH}{4vhhk_XFPlQj?q*J!*;ZKX;`+H)TWxJG z+8*VS$OxXZ2$cBD{aM3}F@><=h;VKB&`ivgEgUfFx+mG`9WCRo)9|^5bBV;}dyed= z4l_=3^d=&Cz;S%ZUd7%uHGBLd{vOr9!$y|UIkV>ix0yOhV%5m?M!mGwGzU!97S4rL z_l*n;X8=(#KeNohH#qf^;%-&95jyu~H8KJuc{Cz;gxb+81Z28R`lS+l&Q# z*tfUu4M7}a&3UL6`daKoo!(~Lz!ip+TNBoN5{yl+wR5JhN zr%^jeL5RM)P+PsYpMyvGn7KN~%VX`$88v@9aAok}OZt*xdW^&q{zZ0ph~iuTA44S2 zfuqrP8C{F*Y%`B~J8Kw4$I!w(_UG|_P)ua(imc^h6626)LSsRy?A0G7m7C9j3l(Z< zM-IqKv067)pJqcX>r$~Uy=en(Ldw<{)iZK1!`bATw3f>zE6JQ}_EdTr(-;^ZEhZ>D z@vqgNL2d{cvvnUIfX4Mq}W z8K%xAVf=$4+cU=&Y_}bWj6}uQ@6-iHgEod`?j)Mm){Zn{fRJUORDsBz7hxRyNL}Zo zg(Adl;szsEUgwKY=IMJiTTY@svZXx?I+I_1nY;Z)nuN3+BTx$5G|O5k07T5%3L-l? zyQFexrA>+AsFcaus_Cq+A5zh%^S!@+LaL;pH%?HHss)cuqXM(eL`HS`9GINtu}R_p z-DOiFKD+u@gn`4cYc5)!T74?GaGTaPqV0s*D9aNM5+|uwCIO2AX>7m~xw?I$!oKaq zq9KXE1>c0<`-4vmadLSjaC`zYOfGoDqhCWgpjIO1JY4{Dca#)PiVV@~Zu!%ZOaD|t zx4!Li+f29ti7dfFI1G~*)S9~a7~NP2WZY3t#qog(N}=xA#|!=v__)<{i7(S|EOXs3 z9djW~H9B9&GR_s~oIE~gd!MPj7;MZ8HMefF4{WF{bjrArO`Q1MU2z}Age~~vl%x^q z%-v&TkqeAwff|KS+_9cTXE;WT0Uqx17$nEBVjpKtRYO@3^DbC}TKvi;3rLjT^g z_*d-A@ZO{N$K(GNGyis){C1lBcAETln*4T}{C1lBcAETln*4T}{C1lBcAETln*4T} z{C1lBcAETln*4T}{C1lBcAETln*4T}{C1lBcAETln*4T}{C1lBcAEVE?KJs?1Aihy zmcKYnelfwHi+^>R`~rhN7ys%s`9%kRF8&1r{~F=)bM5ab-v0^%OA9HB@{9bRFz~Nn zEF{hUY@iL@&nWf3lF)Qaf0=0WKDp-|X8uEJ!ti&g3ERJi*Z&>~|A*uKUyOwR2oe7U z3I938=;w#?CldZ!viKbd|IK4Uk4yJHaOW>kWQO;Jf6N&AZ=ta3d-mA#jV2ElGC0>i z991)?g|AuuBdUI9FiiaUpJNxyHJ+{5)v4p&uJOkP|2>E-o$U($hNbLLTOXi82H?x3sjhRwYy@if?Vg#t%@J?g>}`Pg2Ox zYo8^cawt%fFPfR&kh?^{K+sq^g*n|&OIQFt((GF|c4Sxh>YT54>3{=oY(fUQ_x!j8;7DZnl$nz~6n4vR z|Dn@n*<7TO0n%3t>=-bR?TaNXYzG6_2Zik$0G-c~ujFtbeBBz8q*|Xw9-0N)%~3xm z#BJ1vf}^02Vt&PMrIv#T^yi-d&t+N97-H{w_b;t?0CS+O%$+tP)}NMp2-_s4a41MZ zoDYEH;6IBP!wG%xf9Mkg=>rCkVF8$d+U#_OvEDy{1ku3Yn>YIm^4eYwuIz)A4_?SK z0vqc3@iDs-TLu9A0QTnYr6SNf0h|xlhYH#cbbZ8xwx5l@0nvC-F?Bpu)`HaiAKsgy+7eEhJUI1)BT`vG|LP(%s zJ+0?AEFl!=rxM{;Z=Km6PT&CGIgMk;)A`;-7=O;5j!_Eq2>dZSs5kuNXKBup)Gec|QNhLmg2w42iLre=Ppm=>or`5tw=kRz3 zNZNx3zHGh*0Uid>DN4AI@{z$UoDljPL>Jr)>gKU+5rA8Z_1$&?pksCmwtyGqKd%p} zYcvMdG510Q`Qcusqwj5$4%7r1uTylnW4uiYYBNGmZ|b>?Gx5_K(OWxYrVI_Kzl{+B zU^KK-DXbNDd2GSWwkleDb5)F;1$ie!s=1iYsSn z*Nx#}r*l(a)|~o&a1h^43)dIPmF-#hTNl4G8uom#Z=j_XF@ynN2q1%2l$wu&Eoat4 zOH0le0AkMz#T*5Q@8i#*6a{AmlIzshm6451xiFf1RTmHpw07OUem^fEld zs==k_r1Ynv%((Ev?@Ak67M9mpq?d%&u^$vx2}}$VcG!{?RI4MU#K1ecUATkpIZHbA z8BWqGMg{0W6k)IEBK*4>n-WP4V_9Ti z{=!z&gEW@LjdTlW2qc08hKu)wQ}>chO>J7TNspy0dkEv9x6jeq;BcN{#c8d^UB1uW zE zCwJM+l}hV3_(^w#7YE%dlo!b~9m3yk7PNpk?5J|AB0tRr)Wof-cR9KnirSiMTorUf z>4*|}p<0ahCg~LjeQP06mM@l=hva3WmPEM7+1vZk|aQCu*h>b@w()`sU{|^m~i9ezIx(0O`{uva*}?W~rd6gbi;5TNC9Rn`z)W7>ZaC2vz%{nEQEH z85X|30H|)Uf5?E&Nsw!P$&?ua>_F@>UEA)>{#CZ^cyq0Vu!+7)t^v$zZ76k9uvs0l zSMB#6k$mM%H*D5=s|54x&|M*ZPqd29*bF-hgg*H6xJ!HRW+)!K={Obp$dzLT!RF}G zs$dao%q)h9a73vaX2_UZbICBCF5?Tr*+a|XrO!xaaXI(Ja1d-V`pJgKPL5t<{41?1 z*uxffYhq~4uC}bRn(6u@V!|=HLsz1+8@4M$LWxQRC*bCJ1z4MlcB?t)6csZK>}-x1 z5jgnai0weS@_O8J6@z(h87w>`3@W*Yt2c(um>aVbEMbp}PEuXRug@ZS`U4FK4?{LD z8zDmpx|+!o4O%Idh~}yZz+H>ZlBg!?z_lD!<1CFbT7Vu2=}8c{ETEc-&}+&INGn|r zaSUTp8Zxq^76hO0$tJePt3^bFR{6w(OGGz>#dIHr(9JgkZOamn#yvi+@mH4!-C3+D zI*gbO4rp>jw?hH$B4`u#sC75AN1Dn4c%( zNpZ3%at^5F(l1Qu2+a;~Y1KM3xxbilC@dlV5F{t$g5@1h*nJ*K<5Xjqdg5KFHRhtU zd*&Yy{=|i%#F(`+7$Ock?C#c#!^}wZ?Qp|eG@XVp^CPi9__QV~v&#=9$QAcX$>P!x zbJ4+OZR|<5)Dw-#_(GmCPkZv1!`HiJsaYuMVJBQ^ukNdDXOaFSebLRqYzsswbxs#} zcKz(*BXXF!Z~EXS(bz0)hKR0WT*{;{B*o+s0p8n0R8wYV{lucBIw7(wqEw;NPJ<6_ zT6{D59MdU*F&;C<#e-O51N_L}J1dU_SM7`iHH2Imp+qSrG$^2O1NAdRGa8RqJqM=)p|R8H{neNTgTFxabr>yq@7&9p>Kq~3q2C>i`-S{-q2-B1y{lG&< z(qRxW8YrlB^(x+H$_mFakfOO>f?#Q3rZm88K!(?=eM+N3N0)D046l2PAwgzyc8%y| zA)6*T5D2YwzX2EH#Q4(9=o^6~r+s2GpfSO?LMH#sp#_q!dFtf>4s0M``=KK$5UQ9< zoC&`tjWvGNjn!IW$Cu;#Yx(w zdXqlhs(LB9icK|O$>VF-aQ0&2j!`l0V}#qm2{j7n3ECHWj}Xup47s!|1b9M(;Axi$ z$*N$nveisCn@uwN_{;W~sok~~ht1uO-;t=@;2AQq zkaTHmS|`4XsmL(9es@%9DHao=owuFJo62Vd%cQEIM+X@7ty>U9^#hC zXRdU$!FA9lkd=pIuWTcs*3-ePbpqXV@GZqo7VP< zcx0+1GqC~d=LBOX;L62B?>rln=R!65i|sn5!kn4B#1Dqa&8SbAMT&!Do@{Nkj8pwl zN{G%;SCHI+OpFKgNIBlnT{e^rS$Z0B5yB|B@m$2Rt&eSAyD!fHtQ($@ZznUgmEp%F z=1nVtmQgqwi3lf??g6VU?#-ibExD&-$7TZ{vIbf(Rw|TDg3J>!E~n9V*2#-w^N5q0 zS|O`i+lWy5B;t9#CR>CqM`zXPdwgc$%9DC@JC5004MK@Kosm33bc?0aUkj}o-61YS z8@3iqi<2nbn3bM|HWgD01e$G7&-wsHxSpfxTAW4MUm=p}qcGdhyi3*)!y58X4D$$5%AAVxgq=(h< zc3s>2Ax9%sk=zav84DJ)RNKxHCnIqp+`TwZc+9H z_xrld@UDUB>TRvAoFR!}N1CJ4_@oA1XX?HVb~Bmx>zV&5+IG>J+Qvrj*bWpKN5HY;JONnb<&ZRA+ ziNn><`p2-Ezt#Sbg>h}F?5s7dK)v)J)p@BJL=Tovf+T^slPoNfKTkukZ>wi1bCn@p zH`7+B*isD_s=m=EhqGv)r7oJ03eR6s3?XCuyfo_XFp5%XuQRKVOMf6l17s<@Q`oZF zxJl)BB(%*#-NNw6`GIB=~X zw6Zy0IA2JOTE>$L+Mv9hs#G!0gCTvV8KKC0fx7jCsUhI_$!;TZ5S<$Igjtht(?wX} zQnxArGX;79B{R!wC)qp!I=<)*Z86hNUbb1`K|+d)JCaD+(C{}h`v*%TC40I zCq{E&#L@&ZW%_o*j32)MP+|>Kd`@HH-3|xCJyH6|lz(x%4RGAKhDRDa3uj-b$>L)FGiv(wbFD54+5t>Vny(5B$8IVDce*)U zx=qyX5QH92!(km|gkDtTE!MZu4mlGB_MVJx<58>b_9l977e+5vb776T@1vqRZ~n$u zP_fWMa2EBeif-;4ckP?Q?l1bfa9^-GdPVm+Uv%V`UbG zNO$vH)^EiWM_>`SGc@e}h&!oUK>gy>oVygD8G~m>))K;$D0TIt{&RYfaQJQnfP6!^ z3y6dZaa-@+D*cc(Ad5WUoUN4qaJL|N+{uE&3}nREL9Um$bb(Y}=&HFolaZEU=ABkRqiM>CN4IL z&jDqh&mrmHxYiG_yuOo5ZXr0E_f|g6W8QtOTP>75$cpIxR_h*`6dTVb5g}+?5=Jg@ zJL?Y9ZuCMj<~Sh+$2|@*f4bMs;~d0NCbIU>At4QqP^vFuT5|?Z3VSv>7M#zyk+zR&u7M4M? zuaQ|o^02sq^|h47(MH{jI38zJdI>9LLfA_;NX<}LmaRLA>E8C&Im-2FzIV-$!BvpT zPO;qajcp%ia87%Snu_!kRPIFh^QQA-=jb8>&Cx>~;Z8dT9E;7q{v3?Bu^KTK@PPd3 zQqEm?UY;w@nvUVfDt?=NRx&cfgi9vL#cmIU+a<^P1Bv$xg(n~tm8q!1mc3X;4USZh zC2-1XvxI`2I?=sl@&FL=$abpsB1rmhm|xX{iDT|}E5uY*NA>fZ+S7;09xei7(Ed0> z!^opv5B+I2o*)O|L6brSepS^Ksns_1N#)%@xMW#r zr7#DK4*1Z20p61H5xl~{>S+K62EO5-lf)w$sl2nj4q&f)UfI5Zbv3E54irmDP_8jy z{K~XvNT|7E`(TK53F|Nh`8k));w`JGepQoJLPLW2RKf?}XuqG#CcID2TAPYoEYpnw zKx2L540f~ats7l-s|3q`z}5k$`N&H8_LjrY!VhQ}VYUcHpEgKA&W1Ec1E+xX2cvT! zM^co($h`t&M>op?*aNriXefJPTHQDx$Amq&gTP@)+w*heS~Z-#-dSn55TZEQQ&uX* zNRWGngR|y$3l{~%((H7%6S$drt#4r<0Vj401?tB!|2 z)qDZDe6cORh2(Ynv^D%Wffp#+_h9VcN0KRVv|6*0z;}BI>vA%eud~Ch_E0eTboO@4 zN68Q?Ym}w-MjgxJ2`qkgjF@R|7 z%DlkL?t+bF?J1w7QgL_AOq^Rtr7h;vm6hGVwEAGtv0c5i;5w1L?J6X70r58B^Ltp4 zI-H)&e|efQv2wsa4w?oITz81bF_94CWaN)eVbyq` zCh=FE#OLN~`FCj_(yrEc_32YL{x9b4DY~|`Ul)8lW81cE+fHU|YsR)`oXps^Z6`Cf zZQHD@wZ8RXpMC1=s#X`(ay5Dz;~j7BEf=HpUw{73JAPUX;?x85h2f7+Hq#uo2Ot|h zH1=F5Kvd@}o5acgL^3Fg-Q3%Ojn6GR-&dg#ea) zGRiq_>zcJW%jMCIAoD9IP)NV!he&h^E`cA{ph9h+j*dX#0xnH)I0c~*xq+fGo3q|32HEE`&wiqbPmVm>X#2biHsdy4~%1H3~i*1Zkq;-q>RI?Y0#8_ z6+{B9I76ujW_0pVb6@n`XuD)>X+F9s);k3owFZkSvfqg> zLCre<4JUjUH{U1gVnkXpV`TOtlaG)S3xH~%;7nR=K5}UIS$emiEfUHzowp=h(gI5k z^^xUce~wmf++j|4cjYJR@v8yY1Lugey;G$oy8g6ro3`yQ^C4k5cJ2oUwVLY#GYk@X z;v9{a_6PetZ($v=yNal-f&B0HRBQqMtv?E`yqivr%+4QmBE9{mS5$rrGrO#%N6a8b z{Ve81!}elu7h!#dPgzV1Lkm-x-Q--D<7PE`rg;&QMEUWn5)~RMDI%WocZV+D(sA92 zA?XyM;qw?E-eI15adB+3y+|5FKNFjsXy{p)qUiepqJ>rkwls7U?Y zpx-sYrtAqyLGfUl!{kM9h;uDMp0_8~nO5u9jhTM*CcF%@OR=n@@Zl?;LE}<=y=hWg znK+6KQA+V)E@!TskXsShgo%mrmtNLOpw1p098`~rX0C@Tuc~;M8V)k@d>EE}aV5g| z>a2Cp5oKHvQ9){X(1=M+uCS4=(~5mYci1?wm|17^pY_2!#g2VAZ)X*ePq|IAgz9ZQ zqdfx5RkXA*l{WxzQ-kmdS zSnNL=GP(*#rA4c2BJU|OOOws=I|jLF@rms~ov=lclj)GlF`IF@W`>N3o~oBEefp#) z7P^5Fv%XasrzR)EEF{qy<~mHP%rykxZ5gB`Q}=1$92BvJCUN<~e@eU4qwz!8`J#EM%P(GsuWxU7Oba|OLbOvP8lCgU7 z^Ezc8irwfWB&AQ6#{Q0*gTw#E!okc7; zdM`F6(Py{T#w0nvR45P`AFEJoMRiR@Z+!IT;=-z#u>_VT#*Z8@Jf<*RS8W%eY+7wF zpE1Q?-Du&aP;+{|=BjMbac4=KmskMC9+2-a#qspwAKPsCd=I(mV!OTl^a=T^wgujl z96e05**8`;@Duo^#WMbX%{g=YU9!T)$o|hr^Pj@`7jQE%{GD_Di#h)kZblZ4e;xh9 zI{yoCGyV~x{eMQ>LXx6lY6|}w;%1=#tDob4Xx#rf?E626o9T^7o1U!`d0>|07?` z@MY=$2w4C1hCj6Z&*vTf*7-lQ{U4LS|Bu@K6~RWb`lO=>1tMIJw?SWDU(W%LV9@Ia zGh`MApCJ%WVir#dbQBN3pZSa0--3BBZwEOJ-6uB>Iai&mAK5N#J$cz~iL`-jIIx;o zgfU=+?19~$`T-#|G%N@KczFSFd3n9LO-zKyXCQ8pFr$~z{p|vJ^>;pZvVDDhW5_cI z!NYE5{rdn;E@T0+0RYIUVUZCIcY&{NufuW}-<<=A`T@i7;fi7Se}2n`4G~zoN=DhD z-2gAn;6Zd6=ZgYhrRM@5CnfE@=fcK6gcjiM!AIwZ3ak%d&$9suNCyD3qeu3?`)ES8 zihB^x|H)2QRa8U*yc`RTEn!Y}y z^?e$v+d4KA9|Xi#kzJq%J{gO$7smux0N`s@9rPSCASW&S5}xTeAFP&dmkBVy4Zx@D zquQM{A^DjLJvekQSDUZihI}$kH|hxp;1Rjy4Sq+A76AO%!2-hG9+=oK;2Qve4E_c3 zkj-BK03-J90Pq%~J`IOpqWs!1HrzJyMXRW8wzJuV~hP{4#SL^GN za^=VG27?p@DkpH3N8jM9%bSB=DP0Cu7X<7} zK49HY%)hQ%HXEEL4+U8Lj|*W!nGX!T$LZV-MQt=3^8PRKtZh96-Yk8Ak8(*aE0!pUzhX$^h8Ohl|;&z)$KvV(sweybhZ(fO)>xL^lS zm&;=ljEGt_(aF1=(DqF<#9nYN<;^3etu_HU=ld&Af}URUIL+l#P#_>a2+&?+hz5@& zBG40%0!V|O>$@ncZ_+m~v0Qrqd7f8bt8MW1RTii)Kv#u5C$RNWA4^|y0YsW^8JN9eJ!7cMTe` z^WPn;q+uON?iM4HJgRzrKhKm>>)%rKVt#Q{U5mO^q7_?hPvy{Dx~IMy9}K%RM0IXx zUInJ`I(At&K#1S7q62$E~}_q?^V$s(wFURJw2w=c%C2kt+PPG5p$q=fol=@bhHo zj!g(TS-?eOmlE{BxbD~)5>`d?*{n3(eH0u(l!{pq?2tbD>Bq}DhC3e7$CB7SlaPw5 zCDC~O`%w^=aPLnK>bAmYD;*xUTk6sw+G~ferx^5&!q*>mErqb`Q`~)E!@-}WhN4M; z$7cMHAp5qa5H9RmxM?bu6M?3=5*dic+YJm_m%hJ5-aV$nTHRVUM_XrtA+6DLX_U${ zp5%3&G^FGEn7pR&TBhx;ZKFvHEK9vDB21QREMe=m{`NNQlZj?i@_Oy4Cum=HsZ(y9 zwYF%?#}_NV7_GWS=2=i1TL(p*ejJp-B2=fst<-Nd!HV0+n0cf4jN_=sB*S*s+YxSE zB<;EHPOSCWp87Usdxj4C3bf#H0u{V z%q$c2KROgH?zJZ(KJwkJ!y99K+sTL-&60#uyaOf>|UkYnSUTf z$G-H41gG6-2s($%tx0q&j3iX~5mV1fQmlnq``8*^t$E@UZ9c?FDwBG!+(u)g5if>J zd-ohQ??5>l7S5UHoIvsKS=sD66oZta7#?2$yb^{nCdd}{4n0CM?Q=*&=9V)8sMSu+ z%;T~#rUU%Kk@_v~a*I#qk26ZGvLTc7f|Xg+56_0}9~lK|E1DVY!O=yOcDwymV^bIk zcx6_Izdz6_=t5xTC#c&cTlT@y8mY9+vMmRbG0G<+LLGaw?bq(rDi zh5of=du_^@O;B`1+S{j$??gh>@MISB0I}Mc|}V4zip6r!nDqb(Ur%60}&HJs*SJZc4pa zQc5J@qxw1_jmokA7>qklC0k2ta*^AQMsX<{QAdgZqEOI6ip{ECt!Q*m6kc_zj2sS| z(`~FV7SU+k&oUqwh78?RNC@-b7gDTTR)B)TRuWF3x{hDLth35{d1{RE;gQzz;TVw+ z52yrM39duB!|wj#B^KWJx@#~ZXxK3}XK$G?+N0ac2_zh@36@lZX{iOiVC2x17(`%u z@k4e1bx1UU=ailB$%G*EGwLU|Qv^XE1Ij~j&bjG!bxxT^8xWFMB)Q)(%1(lJb4qEf zbTZ*wGk@c6-P4&AIs316hi}<{-wkPkRiDJp6-s6yk4}hBjYgrmCF(Y8Q`Flw>>v?b zy#}vX3DX?n6N$dhZ1+@quObtC4vYS*FOm^51Y>$s==iuxaoYgCK&r8>g@#y}QoQr# z;TD`c*s_x`38DO5)tDSVAx>F2hXIl5^{l5|l0*0_mO_A|lTH``$Rc_+B9wtIW8|!u zdL_m~Z=%j=MqQ4e7szt*l*S;GXh1d%zej`XY&&9c^al!Dn_3ZU6Z>fT`oh3wd5GRs z0TxEAVdH(s%oQ`4@C(iG_xkQ(!Ra79C%O=ibwOnTDU-|H>-HyBlA1vlNK&C!XLaT& zz5c$$NFlZPg4>$1ioKrt^+?6Gj)}V!2QU=&9U0Q4I3A^)*ub5uTaYcB>0$GVxkWU2 z)#ofA>)v6P76rVDL@YWS4kK#l@`6-)#NiuN$Sx!Ww9Yo?Jp;6H5An|$AG4be(T<`5 zK_b=y=k%w&*5x{I6D$DCvNwqB-vMa1mMQ(+t%toHV!w(Eh+gLLj2T^c-I`lBiLT=< z)6E~uj~8{+%1IFj3mWk$TG%mEEMW)b-7-2E;4t#L&r5W@ZGLI7#B<8V-s8F>VNmOc zd#p8X5k+87%w1dXv?9CQjfaT-CW01wOULl)_4B%3cM01RIDu7+%rX342Pr&(G{=fT zRNC6CWSh}5`7^>t``C*MJkd9|%WuWuo)8zGNfRxR7)E57O)P$Ns!Vn*UpJb>IU|7^ zcviT==9Xt8#n{s{1J&t5F(A7h3H(R)tZa@U3}Nh9j5zC9s_wB&zIWz0kG@7=J7lt| zH!{vj6l*k@gA4m51mC-dkF3qQ#~m6Un+r2qf5PJNhGFFrrcczn$`tLB_mw>S7rG

YT>1G*$`>zF6i`8A_Vb)NlQVCPEE z5Tuxy+>uQTuZ^HQ8Y%2<+caXcV)2ePIV#4zPh`F_IO8Ipn-0g8i(m+VMHkpYykzYbB;XAyamfl*ZZ{YcWV$$5(TRd*5Ffl$3 z$`B{&89y};_6W{{{i6Yk!9ZD{a&bs$X~<-8b7CIJQRatp^^D3NZ45QNdwSK(tj_I4 z|H>W_q`kkRxww&|*^p~G4crFxc9Ba&|x1MIOl zu;ldmtJ4u04+u5@rogQj%TRCen*&s$u8((A=0<4v0oAAlA8r?fwc9dLyOoma>=zpgu3BFm6K>9&VeI5YWJ(N??R4cWe(i5e%_ z*NAX8p<6VKRXbC>`GGjt49|Hqpsdx^vP3Y5HG$2}{&3THaj}R0rw9ipZ!M_VX)5>W((&HN$xA@b9#FEa_!ZtSKDjkTL%Y0+1b}&S2Al`kMO-V z4F*a86-lIalWK9f@yB;O6$_M<%v--r0$g>fPVHr0b78oow6XGukV2u~J|lG6 z`zwYcSjcd*JzF$1%qZ)6?wwg8&^sn;qeFp91kDYx$0NiMqEs0_&+_QFMEM_a40LW3 zN>H%F@Zbn^%vo5R60-k;31c5xjPq@Ba&l&PR>j4|ynKAVzP?hK|M$`Qn}-OE6jy9& zW}0vp<|mg8C2%*i4)q1fklqp!$Z@SQQLu^gi2U<0g0_H7>|PBQ{fMoS%U{bEoHhGL zYX`TqmuRK4DY8TY0|J=2xRlb?sA=cLi7F=+edF`B?HQmO6;sWy^GK=uYNlT-H(Zm;Yy{;sYioO*b zEG*cG%N+f7TSwz1!NeIrZvs$#29E=a2Jgsf#iWdUFX7_HdubRU%2RzLleYgel6m(5DwPRF(iTb}Nu2p`uuX`g1Z>y*&Ifb1L6b@>63CQ{Eq zrXxjI5mZb80Tl_!Yv4P6n4$jn62NO%By~Gj4~Lz)7!lac>F=p|<=_FcEX>t1`OgNQ zfnMyIz}#X+Kc(eD22LPS$moQd{$NkKoYi3#J4ZoYvkd3iF`HM63l@b3!te3==^q{* z7rGIKk-3p}Fx;Wq3W)WxL6(r_|6sAN_cI*sly}sdnL_Ob3$B{eW#Rv==LKqT#1>*w z(bB#FBioS|Jn7*ITgIy-msVF-dtm2Iz*_hGb`tmnV2$y6B(sbKcj>iiX2AP|D9|JB z0O8-;(T<+ak+7}}&GK(ze5MIe2LoS?+nweXf4SiJOim>iGK-ZCoNICWbTtea=A8Vk z7pDu-gVkbGUK4~yh4Bv8_cx{t*Y#0gj)qnoxzWr^;9BF-O=wD$HA%4kIRYe8?Mok1 z-?wW|sDi=D#C)gB!0CeXV&X>$SMq`>CxIFlCz(xV>&#F>bvqY(((kwnCW>#x5k>>0 zH}RfEudKQoY43-Nhgr1$_|XUnLBzno!{}&cYa0RW$pl31$8N@tJYT{NG|=Io;#H}J zqaAJzI17+c&x#ZVinK?86Dj@6Yf-@B(=sWI?Z+9kWnr@H!4K~*=hixH>wJIliY-S2 zkCKuSVNgH?MHUTVt0)30Htb$BfoTgCw{m|eXmC}0M!EC@H^T&;3SZv>hEbX)Gh??` z(j3l}!9b;sMnpvw48{t?#R=Z%Mo>@#VG)ZE`5Fj9B1+02FmXIKW8-kXwMQK~OyYK~ z0%T;)#=D9Nk6*Z_8ji+9|&W14i1ir{Li0pA>3YrM>f1UYE=Cn zmJ(V%zwRID_Q^1%ZqZ72>*v>85ELo6w0*$A_6h1F5`4%u@5)f22`~-_G(*hzShh}rOG)FZlG2<{;GV_54~3>) zh9Uxi<*5crKpI5mO)BgHiaEpR2Vf+#Peo5925n@~=qX0j4 z4M+J48sIY+T>+Hzpi6=avi-L?MFT8G+QU9*Mn;Aa*niDOO4wip3NfI92i9_&)0fr{ zxM|d99I$uO2rG-Bz!wAr8i5|rlR$Qxz~0yPSCn>K0Cbshn~B`MRN33#`>4tU1cKg6 zW&oyz00;)z0U9nHxaEPptaLx%K@@jVyZ|cUmsh>ckIZ5NuI7S8XmK43ez+Cr;GHJ} z&wm>@`Hg|lws8lK@FuL9&;+sO#)8ZpM6ITK@!uZ>g92=eca;-_)rEAg)q#1CHj^N);=#6{}xLV#8U2`d;uFnXpj5?d|X8tvXqlTVgAkKzmmfS zmjPo3%-CuFE@K%@7q2pkNRiF8yN^LM@chRmW`Da?w9T!pR}12>J1i=i*tw(%{th^G zX1K?&)3rE|Ly9O+;-1GEZsW*ojcg&pN-Qkc1cAM&rna{D`A-@UuI)Seh=6cqy?dJi z?N{u@DXiQGFhC)IsUwE=fq|Z07*rKx=>k?pfo%Jai1h!8s5dK1e1kzQMFz61-6eIa zv2sGF&Xt}gf?QlQW(Nlnzz#gokjF=XT_tK(1EmK8Qfh-VGwNa zVHg_bE1*{)pKE})MW71I$2{nV64le+CnX0efE+Vu{3@SMeK(=MB2fS>J-&bI{{bR{ zX(bR=i18vkPnsD~Zu_g3U_}Hz;=)HgIS`mmWcUE>wTl3ra;Al;Y(jcEE4bIPO<)t| zKSr-m+dL3WKn!{dpC|$d12#D9JJOdFpvs~_T1URrFhGHgeHumqUcveDaVs^ocYTxu zI*4^k2Qgi)c)&HWb8&qKwNQAj*YUzMi$zQVXI%hEhjv<_y-VGR!s;*F@88ERFsKcM zbvci{-&%?2bMy1ByBFduFD~}iMYuvOjWG^IN@Mh^1f()qaXCoX49LkIVFZT~7U`{W z)7%RmqNwEyl_d$s3cnwM^OE_d~KH3Gz09?k1)xxtWtNK>m*#A#Rv6?G>veC z>le1ZxpXJKf8}EKBQZ&MA?y+R-?*V6#I)hIXA#CAMpIBw@N(|O5)80RM%uf)0*@WZ zLO-#G%Kf!KogS|gs->f-0;OQ41A)*77Aau%Y9|LiC9SMXBey0a!~cl^BQ!XqUciU0 z5K&NQZk*kO1;o+OQ4&*-5?f#iV5OE&{6YJxU>>)%)B>)F&+zu2$QIxOH;|28Sshq~ zEnPD#z?KA0y~)Bf;E~Rnu8Y-?TPR5=FO${b5Ub72%^23BWm4dI9{BxxrS>A6_70d( zBFySeEx%DyJsZ5&%LniJ*`@v1{s;!QGzgNPCEk+{@fX1S=zV?!I1r0u4un!HK#h)$ zUmVWh>qdB20J}o4Es66}uBT6oyS+L3wdg2XB%IrM6vMgD z#=?9Z17(ik^Y5*-FjC?8gl<`)%<$O(sU;=bwN9`fc?s6%x#06$goTC2m3-d6e?MGm zc16n;T3c{%uq4Ee(!)HFO1O4}`Dq5?%l=?pf4tT`KCdt>%@@|fZ%^x&dxQvIG0wL} ziKVrkaH^BtQ_T<6BlLl1VGL_vh$|aj2d-}X)T-GDXnSd}^bc^Eos+YZ+ycf+wQh9K zpM637(gNE>(U-sUVNWV-e2uA)k5z!plsIj0ifI;NgH9Et_x|X!+o=ToxtuE5y$2>x zL(@390SAHmxCQKzX<1pvxA_*Rp{@T0`LFO_=j#fMkkNjr)W z`9JhLo3T9GaAnXVmHGDNrI$|VVZp%-U~$bL{ozvdg# zeLHQ3v#Zqi+769|Ufx3U5l00h_x1rq5?DwKYFt%UwqdiP#`8pT{ZXjK?;!?5t|wf# z@zOFMwEyra{vdeQy!{R<>pfMnJ^Sc9G-PoFJ}+Sgj-}R#Z0P}@udJ^2wiCK%AVJYSKuB`0O#8WJ{Jq6s`qjm_-j7$7As#8rtZ-sZoJ?2s8%ALjHb0ALfm@Fh)>)6_u6tRmbWhExeI2b;Yr_4!A@aDwtAjE zeGRdm)t+vbkwK?hd|8D2BfaJgX<2Q;ZL>4}Erl_Q(2|fhI z$j0V!l>F7lwgB`Q>59Gy(yB5vkLir{B-Z3Sh@vf|{u8xfw}+ICJo~7_z8;aOuO2tZs#j3= zDde&|hGR6yR!{z{vxVoEYZ{e@#^iO(h~?P7;gerrQZ)X8Xn*pJ+%pSwXSRz=H~W7j zOpahF2R{EPNIP|Qy5Op>E4%P7Y92Jh%jo?blsh%Q)T8`5M6unwy&&PEx?e zr#aNhfBpaH>`LRQ-u~{-5E6ArkxGU{Wb8_m%pu8~L_~&4QRGU55Kg7297#o*P*GIK zlp$oS?m;e@3SDF-Q#@N!hi}JDQb9kdhHnQ8`I(HhLq5rlu46OW@V>lg*CNt6!z57&O%Mz4zja^C6y#r;r%;EDGLORNpTxCEgTc{hiSeu7&qSsYsD}1+FdiFHAhbFdf(DDK6<&*>eZ@aP9;6k z6PLJ49w+vVWIaqSY291FVJ*&uMK>0k9<&h1#Pu_E&Dr=(AY=kHo({uB@pIQ+||2S5=2F4Cj!9Tmws{Uk{jv+K`@Q>{^)bGRq?WLS;*)wfAD3jS zCHogoPw_0&?u%?XCHSyUvvPxbgS507d0y9@s;ybc$( zrTE~G>-^{skuz5MLSAzUdtVLkzTU%;G%ARm+qb0+>#87OJSeQlB4{92e#+Qj{?5GAIsNmIri&UpOMdSNTa`{h zZYR?|l~Z|T#%I-?+lZXq`R7!r?>}TjbF#9OiMRw@ zeEj%P3++4!`*A2$Ko9C&4%`F2f;%oy$i)-33gmF z=ii``N-mLlfR&uiz(UejN;$XXo;HbtcLAzp)Xm0mYuBy~qlJQ4(3F>f!ClS(Wi1hS{@xhBaVmbEr ze3y#(X0%$+y_Q(H6(2W`U%-i$et&&<_xY9lbUkS~xi}ex&6~RzHQDlIioO}Lp6gzf zKM@L2@)xe37YS>*@%T-ufg)RD**3d_ZZ8?P3m^4z9Q2%G++Lg9l9)KXj=4_rfPXUu zl!oD-un5;eDg+|G#=MMN2i@knsw&Ft>!+8G`k^9Ak*IovQvT9a(VYMNGONTSB-o%* zGUeVN*xEy(!y?Js3xj`kru|6pH8hwI*vri2DU>O^BTv zg>GdVR4#x)cwzHM5!nUd4yC3_6SV|2(*1rJtd+9YF1fh#V~3N`UkBOm5@BIsSYVZ*8;)f#Hd)7; z=CKglDFP;EWreOC7hgSrMGY2ZYcN7ataVkh^uW{F#G}V z917~>rqI-pY8omnGaDNNv_B+2(bWTMGyviyB;`%}WU49Cy;_Fhgh2>g<>l=C{rzA! z>zbLxFlm1j^>Bn>&ioF-cJ!uTm4^Zs13)jCoslx8+UW0&mjr7#(r{xajwrLk@cirB zvJ_gd7cX9*6I%l_G(JGEASWFz4PVMXiD*G|b%>FN+Y9{9&P~Z-g2ah=InaRW-&ffD zp@!%JTtg`PVPR}wtiB{mE+8NZ-r&^KR6#8-MVEJOH zozvn`4N)6dtibW|^3)(qlY4o^v_-)_mx4N_Hc4{>{Db&wAghCFyr!m&8i8P#$VZ8B zDHb1e$P2{JF+H6de8qygyD>4MldsHmxZroQ6cUi3xze0LR1k!!{OPgD+Q5aGzK@NK zBpjk<4ns%TmD3UQ&DAsc?foC!-K=mTA-|IP>{&UHboDpN;_L2d8?$yU}V{D zb)oPDgzS)z#Gy>;%pWc)!;TYP9rKFc)zuZ_kVrrx*egrR6gTeNX`kK>@5?A`3IDP0 zOKtvyGhV48&(dYfJl+&IkB*K$EGV!~!Rkk2ET{}?u8b>Qc^;P5*7~sHql1-bQ}JsM zH0@1*$2P*2@ga8n<``C1 zR#oIXAYVvrskx2{2RIhc-iPVwd(uTZyqn#?8P^k~#njgB#p<+xRJrE>LsG%9=%%z| zmdjFe3kz}Vt#H~x4_r9p(rDCG^=`FVL4XrY@eA9v!&oyDdhwM0_T z>{6h$VTK#KT|Ft1qSTxcQ5E6*5N!lCKi}5T7;~k2adBucf_T{0Wbp=R7Odk)mF})r zf2|Qcg8U$@pb(jr*zM znT8{d*Vxxr4&q}H31d!bQ4G$Lu zX9#DMpfZrQ`6t*h@BoO?boy8EVqM&*Qa+*-q`D(8_2~wbMx{sE;JL0NVChLu>c#8V z@A0v|EZ|~i9jZ*ag>8ih-XC}{W6LW5*13HH zbN6gN&*K1r6B{6!GA>$zV8xHhQ4&oQi@^ z4LlT!we2QnQOoIBJ9OZND&{R)Pv*Z-Vj?$PjnC zx=Ioq8jxCf%euuLyM^1r*I&X56zi{?BO$=OcAgUZn@ZIVG%{*`!nf@;$WlapP4GiV zM4HEX0z6SC4XN=!whS0L{Mxk@z+|gi2N4s9lPlK4(qny*TW~yZ_U5OFw9=Zk?%&aC zw(d>|M8QRDO}f8*BRxTgV_t{#fdf$h*GiCB@D5$oGt&thP#bS`t9^$9l;@ZPlCc3k zGC^c8#~V{trE2e}k+!V_n*sw#q8A0F3t?Yk`}SJ_S9u)Ao0&0J;7^2Tshope@pI=d zojHmrx*(DIlaA#1mfK@<(~kJ@bi{)p029f#i4nrYc5Ti@{apm(4? zI`0}L6G+G``QsN^f)=8Yf7Tu4WZuM;%5IGn|)@8e(H&LJ$=X96Ts4 zEgco#;xP`pE~E6DZd9ms%7;zs5CU>)cr6al5b z;Z4|0F;Y`gV^F~H=}gDxKZcd;O0r=LMMiR} z1bbko53 z8@J4TMHPU*OLTQaoBs~8dHkO<0kz>b+BH0UEh>r&zCp>hzZz6|$_#hPWr_)$o=<)J z;NcI7S&1>4019)9#nWaJOLHYP24vuVi-h4dwUUVfn*>LcquXYRf@XRI$)G1d;EWHE zmw{aY8^Kw(R;i@BYCgM%d{>bd)y<^LqD#>R!zvmFZ2y^?ZZ=j{OzBn--asq-^TCOy zDrwK2>4AdwyaoeL%zpklIwujH414NNZ<^bH=_fzb3!XE_lTcxea2jc}alD_B!itaR z+f-Lu%U+X(ZZYN{R7cocb%hJPiC*XmKY#vAgDoEbUf4tuPBsU%GiY82--C=Iu0%(_ zghhNp3v$3HUXb{;;vfiZJ0Wy$r@y$hDjFhWGD!X}ATHvOoPwO2uHLPYx?l zsn6Wouq%)Y6EXxV?L&vwqxz`8;^g*pw@OnlaMWLHS$09otZy6g+6vS&XqI(NOnA{C z5$1rcDk!6iv(3fH85zqV;R4^M8+8Rm!Q~ALD+u5KJ7`Ny3XE*{hbIpqv@NO0A~x7I zAeAfepvoaQo0)VtT6R)?;8bN?MZChOD0djuB*uK-8JfWh>rla6gy}m3E$C1l6-jmb z!s|Z-Qn50~|8(xt@U?DKZ_dD71(EO!JC!tm%+F$_+O}HWo(ugI@)nUiY0i&?G5)iRG)g;+qYE}H*VQ@jWz8%t!%)NkjF27Q zF)cr;1gmv2nuo9wC*m5M=8aW!@F@5M1j^5Ef)Dh8qChoN$s7B@p+8+IG`(1)jF`f; ze0c=sQ1}+a%?dr_smXS~`8Ow8LgD0lsv{dlAp-bm;Bdf0fyixaX}huIE)f3_IMg7S zVFf;MdRYd}5dk1ktl{|eBjklJ~FijjmmRvIE_@@ z5Hn)z3Dq^RnHX(xPwK+aGPAZ`LV2ZU+>OkTp66IDqku%2m5*GH#*+7Ue$6+(A?IJ7l&NJEJO!DCMrVc4>SARQ!Fr*CEgyVW+#pj2{SsoxZ_-RcK9tPoM%M0WQ0wG z2I?Kux2R695~3X1H`E&MV77A#u-cj7_VpBP-MW9Re_(}Jf?8=5HebY*10NUNA)2}L z$?cal-2tD1Ml1^NZH&A1pAwg~`BlI&ojx%=&(KdTGttExoN;({!fc2bE)cmMN)@BfWvTxE(b zINkQPsMrCWiQyg*I2~Sl1_O`G*M;UhO)~y&6%^5poWG(?|z|km; zYx(kp25_9d6HYAUpFdxRs9=vPHy2lGbKh1ZkJ79yd1wZ0VCABPx|NQ*CYW6e{e86q0?$Xgj$B&&AxEWu!ah1Y zKRx;-&qoTqhOlcQG|J$`wRtdHp@?DE;es7hX`BZX@l8#{6x*Ve%rKD4bDPmt0&DJ- zFN1;@oe?jJllREsdBNcSyhj+yHLg(ET6ae++hGQ686Ds}IL+<$2}no8@e0;k0Iiyb z!_G!dS1+Ny_w;n3vnM8J<&XMEgA`61Vi;MbCp-bw0o{2xWF{#6;q5%uK8Y7xisp>& zco|qGx)yR53UHo{{d2Rk)$@&xj;N!Dv>4}1Rnxt=W|)d9xy z@o}i^ImE~X8~hz|DAS4G3W~bnx@tw9qUr8s^emu8p|sNTkw=`J-zi?P;{1%43#El( zm;M@Z#|;+zIroT>w@y@Tahl&hKYnyVvV=QMW&;K+=C!?8%%YEj9zr;nIC{9xqhfc< zW5`F#J-Y3KnZD#I-xgaGmNbTruvU>J|X0G6I;1IpsI z@`QmX|0{!76a(Vk6W7|(0>B687TtSP@~l7no`^pdaNzjAlg`e}O_A$c$N-_GWCSe* zT7>H}>s^F6(9BI%&kfCD)_B;Kfm;a9O>k|g+0*C&R1T&y58JP8*|cdBe6R&)sIa(A99vm@ha$7%IxKAn8klFeB4+her6YhP0JiiR&RHqXsc+jsA zRt?VR(O18je?CK6mUQUr>m#TU>Y);lZx0_kw)DPP6p*sR$cMfncK#~A`V@v2(0Zcs zLhCP?t=p5|@pLx*=a;~$7p*I15^*Y4fO{fNbvE?!i15P!Z>};#8poo(0<6REi!_? z4ytb5>M^nnM)EfBNQ0@|LFerNkn=b8BY&YO=7wL2@4gDFRwLcOXLzI%pUh3>pITzb zv>g6e6&NnV8@e{Gc~Ed=jz)-VkaS5V0Ow5#~7un-zZ zoEbETx&WJqn--|9lKHTpU3mQBn}wV2>c;OZ5PiI;dK4(jBJEtY5(+}YEkyQ($U$&T zfZJW&?=Qnd%p=Qo4t^wE-~bSTW*S*$gs-V+L{n02wINqSBA~%(e$ju#_{|`)N9VzMjx3>J=|M^>qA13 zV7q~<1`ZdA>erkgSy;D)Qli3w(K23T*@NF(=y-hcN=U33e=vkMBaPgu%9h zZ0T>l^>uZzAZ2aevEu=-K*N3eDhLz=SHM4JUp^2v_gS$cd6&FOBukM8sv*=O-JPAH z=HMCcg)Vjj1+23fdF{=2=FERkGIP{~(jv4)IsH-z^c0|)f z#x6fTie&}Pcsske=z-ly2OjG`KmC$9OX>#X?(%o(~+1a5BIx` z7$*`uB{eNA7O5!~TWC+?5nBcT&nAyVjMT+o(DPrYf?q_$q3=Z@@OoOTp&r3j(7UN2 z)a2|007y)dvE_i*NJd1Vc8dk*v+}-~A!_aqcy6xC$rF?!RTPGb4{-uraGlZ)&LZB55a z(-v-R<%)Yp`#u#12M@iT9^R;~elX?UbasZCOU|2bf~!~WMmwHcd>2{xI*R}6IbI!2 zGYiu1ow<%_-*^P-;%jl@bpf(H>i_W-!c&IkSs!=(pRmqPw*TTgg{=QCpy&U9i#{&0 Z`_ is provided as a demonstration of the usage of the C++ API. The glue-code allows for the simulation of multiple turbines using OpenFAST in serial or in parallel over multiple processors. The message passing interface (MPI) is used to run the different instances of turbines in parallel. An abbrievated version of FAST_Prog.cpp is shown below. The highlighted lines indicate the use of the OpenFAST class. + +.. literalinclude:: files/FAST_Prog.cpp + :emphasize-lines: 1,27,28,32,36,38,40,45,49 + :language: C++ + +All inputs to the OpenFAST class are expected through an object of the :class:`fast::fastInputs`. + + +.. doxygenclass:: fast::fastInputs + :members: + :private-members: + :protected-members: + :undoc-members: + +The object of :class:`~fast::fastInputs` class is expected hold a struct vector of type :class:`~fast::turbineDataType` and size of the number of turbines in the simulation. + +.. doxygenstruct:: fast::turbineDataType + :members: + :private-members: + + +Use of C++ API for Actuator Line Simulations +-------------------------------------------- + +The C++ API was developed mainly to integrate OpenFAST with Computational Fluid Dynamics (CFD) solvers for Fluid-Structure Interaction (FSI) applications. The workhorse FSI algorithm for wind energy applications today is the Actuator Line algorithm :cite:`churchfield2012`. The Actuator Line algorithm represents the effect of a turbine on a flow field as a series of point forces at **actuator points** along aerodynamic surfaces. The use of Blade Element Momentum theory in AeroDyn is modified to interface OpenFAST with CFD solvers for actuator line simulations. The CFD solver becomes the inflow module for OpenFAST that provides velocity information near the turbine. The calculation of the induction factors is turned off in OpenFAST and AeroDyn simply uses look up tables and an optional dynamic stall model to calculate the loads on the turbine based on the inflow field information received from the CFD solver. The induction model should be turned off in OpenFAST by selecting :samp:`WakeMod=0` in the AeroDyn input file. OpenFAST lumps the line forces along the blades and tower into a series of point forces for the actuator line algorithm. :numref:`actuatorline-viz` illustrates the transfer of information between OpenFAST and a CFD solver for actuator line applications. + +.. _actuatorline-viz: + +.. figure:: files/actuatorLine_illustrationViz.pdf + :align: center + :width: 100% + + Illustration of transfer of velocity, loads and deflection between a CFD solver and OpenFAST through the C++ API for actuator line applications. + +The CFD solver is expected to be the *driver program* for actuator line FSI simulations coupled to OpenFAST. The C++ API allows for *substepping* where the driver timestep is an integral multiple of the OpenFAST time step (:math:`\Delta_t^{CFD} = n \Delta_t^{OpenFAST}`). The current implementation of the C++ API for OpenFAST allows for a serial staggered FSI scheme between the fluid (CFD) and structural (OpenFAST) solver. :numref:`actuatorline-css` shows a suggested implementation of a loosely coupled serial staggered FSI scheme to move the simulation from time step `n` to `n+1` for actuator line applications. A strongly coupled FSI scheme can be constructed through the repetition of the coupling algorithm in :numref:`actuatorline-css` through "outer" iterations. + +.. _actuatorline-css: + +.. figure:: files/css_actuatorline.pdf + :align: center + :width: 100% + + A conventional serial staggered FSI scheme that can be constructed through the C++ API for actuator line applications. + + +OpenFAST uses different spatial meshes for the various modules :cite:`fastv8ModFramework`. We define the actuator points to be along the mesh defined in the structural model (ElastoDyn/BeamDyn) of the turbine. The user defines the required number of actuator points along each blade and the tower through the input parameters :samp:`numForcePtsBlade` and :samp:`numForcePtsTower` for each turbine. The number of actuator points have to be the same on all blades. The C++ API uses OpenFAST to create the requested number of actuator points through linear interpolation of the nodes in the structural model. The mesh mapping algorithm in OpenFAST :cite:`fastv8AlgorithmsExamples` is used to transfer deflections from the structural model and loads from AeroDyn to the actuator points. To distinguish the *actuator points* from the Aerodyn points, the OpenFAST C++ uses the term :samp:`forceNodes` for the actuator points and :samp:`velNodes` (velocity nodes) for the Aerodyn points. The following piece of code illustrates how one can use the C++ API to implement a strongly coupled FSI scheme with "outer" iterations for actuator line applications. This sample piece of code sets the velocity at the :samp:`velNodes` and access the coordinates and the lumped forces at the :samp:`forceNodes`. + +.. code-block:: c++ + + std::vector currentCoords(3); + std::vector sampleVel(3); + + for (int iOuter=0; iOuter < nOuterIterations; iOuter++) { + + FAST.predict_states(); //Predict the location and force at the actuator points at time step 'n+1'. + + for(iTurb=0; iTurb < nTurbines; iTurb++) { + for(int i=0; i < FAST.get_numVelPts(iTurb); i++) { + // Get actuator node co-ordinates at time step 'n+1' + FAST.getForceNodeCoordinates(currentCoords, i, iTurb, fast::np1); + //Move the actuator point to this co-ordinate if necessary + // Get force at actuator node at time step 'n+1' + FAST.getForce(actForce, i, iTurb, fast::np1); + //Do something with this force + } + } + + // Predict CFD solver to next time step here + + for(iTurb=0; iTurb < nTurbines; iTurb++) { + for(int i=0; i < FAST.get_numVelPts(iTurb); i++) { + // Get velocity node co-ordinates at time step 'n+1' + FAST.getVelNodeCoordinates(currentCoords, i, iTurb, fast::np1); + //Sample velocity from CFD solver at currentCoords into sampleVel here + // Set velocity at the velocity nodes at time step 'n+1' + FAST.setVelocity(sampleVel, i, iTurb, fast::np1); + } + } + + FAST.update_states_driver_time_step(); // Predict the state of OpenFAST at the next time step + + } + + // Move OpenFAST to next CFD time step + FAST.advance_to_next_driver_time_step(); + +.. toctree:: + :maxdepth: 1 + + api.rst + + +Implementation +-------------- + +The C++ API uses the C-Fortran interface to call the same functions as the Fortran driver internally to advance the OpenFAST in time. FAST_Library.f90 contains all the functions that can be called from the C++ API. Some of the corresponding functions between the C++ API and the Fortran module are shown in the following table. + +.. table:: + + +------------------------------------+---------------------------------+-------------------------------+ + | C++ API - OpenFAST.cpp | Fortran - FAST_Library.f90 | FAST_Subs.f90 | + +====================================+=================================+===============================+ + | init() | FAST_AL_CFD_Init | FAST_InitializeAll_T | + +------------------------------------+---------------------------------+-------------------------------+ + | solution0() | FAST_CFD_Solution0 | FAST_Solution0_T | + +------------------------------------+---------------------------------+-------------------------------+ + | prework() | FAST_CFD_Prework | FAST_Prework_T | + +------------------------------------+---------------------------------+-------------------------------+ + | | FAST_CFD_Store_SS | FAST_Store_SS | + +------------------------------------+---------------------------------+-------------------------------+ + | update_states_driver_time_step() | FAST_CFD_UpdateStates | FAST_UpdateStates_T | + +------------------------------------+---------------------------------+-------------------------------+ + | | FAST_CFD_Reset_SS | FAST_Reset_SS | + +------------------------------------+---------------------------------+-------------------------------+ + | advance_to_next_driver_time_step() | FAST_CFD_AdvanceToNextTimeStep | FAST_AdvanceToNextTimeStep_T | + +------------------------------------+---------------------------------+-------------------------------+ + +The `FAST_Solution_T` subroutine in `FAST_Subs.f90` is split into three different subroutines `FAST_Prework_T`, `FAST_UpdateStates_T` and `FAST_AdvanceToNextTimeStep_T` to allow for multiple *outer* iterations with external driver programs. Extra subroutines `FAST_Store_SS` and `FAST_Reset_SS` are introduced to move OpenFAST back by more than 1 time step when using *sub-stepping* with external driver programs. The typical order in which the Fortran subroutines will be accessed when using the C++ API from an external driver program is shown below. + +.. code-block:: fortran + + call FAST_AL_CFD_Init + + call FAST_CFD_Solution0 + + do i=1, nTimesteps + + if (nSubsteps .gt. 1) + call FAST_CFD_Store_SS + else + call FAST_CFD_Prework + end if + + do iOuter=1, nOuterIterations + + if (nSubsteps .gt. 1) + + if (iOuter .ne. 1) then + ! Reset OpenFAST back when not the first pass + call FAST_CFD_Reset_SS + + end if + + do j=1, nSubsteps + + ! Set external inputs into modules here for the substep + call FAST_CFD_Prework + call FAST_CFD_UpdateStates + call FAST_CFD_AdvanceToNextTimeStep + + end do !Substeps + + else + + call FAST_CFD_UpdateStates + + end if + + end do !Outer iterations + + if (nSubsteps .gt. 1) then + + ! Nothing to do here + + else + + call FAST_CFD_AdvanceToNextTimeStep + + end if + + end do + + + +The mapping of loads and deflections to the actuator points is performed in the :class:`ExternalInflow` module in OpenFAST. The C++ API supports the use of both BeamDyn and ElastoDyn to model the blades. When using BeamDyn to model the blade, the C++ API requires the use of only 1 finite element for each blade along with the choice of trapezoidal quadrature for actuator line simulations. + +Test for mapping procedure +-------------------------- + +The test for the implementation of the mapping procedure is as follows. OpenFAST is run using the C++ API to simulate the NREL-5MW turbine for one time step with a prescribed velocity of :math:`8 m/s` at all the velocity nodes and no induction (:samp:`WakeMod=0`). The number of actuator force nodes is varied from 10 to 100 while the number of velocity nodes is fixed at 17. :numref:`actuator-force-nodes-mapping-test-thrust` and :numref:`actuator-force-nodes-mapping-test-torque` show that the thrust and torque vary by less than :math:`1.1 \times 10^{-6}\%` and :math:`2 \times 10^{-6}\%` respectively when the number of actuator force nodes is varied from :math:`10-100`. + + +.. _actuator-force-nodes-mapping-test-thrust: + +.. figure:: files/thrustXActuatorForcePoints.png + :align: center + :width: 100% + + Variation of thrust using different number of actuator force nodes in `OpenFAST` for the same number of velocity nodes. + +.. _actuator-force-nodes-mapping-test-torque: + +.. figure:: files/torqueXActuatorForcePoints.png + :align: center + :width: 100% + + Variation of torque using different number of actuator force nodes in `OpenFAST` for the same number of velocity nodes. diff --git a/docs/source/dev/index.rst b/docs/source/dev/index.rst index a10aced968..dd833c8ef6 100644 --- a/docs/source/dev/index.rst +++ b/docs/source/dev/index.rst @@ -253,6 +253,17 @@ be found in the following pages: - `Index of Types <../../html/classes.html>`_ - `Source Files <../../html/files.html>`_ +C++ API Reference +~~~~~~~~~~~~~~~~~~~ +C++ API documentation is available. + +.. toctree:: + :maxdepth: 1 + + cppapi/index.rst + + + Other Documentation ~~~~~~~~~~~~~~~~~~~ Additional documentation exists that may be useful for developers seeking deeper diff --git a/docs/source/user/cppapi/files/cDriver.i b/docs/source/user/cppapi/files/cDriver.i index 6a13912191..917208c312 100644 --- a/docs/source/user/cppapi/files/cDriver.i +++ b/docs/source/user/cppapi/files/cDriver.i @@ -3,38 +3,45 @@ # C++ glue-code for OpenFAST - Example input file # -#Total number of turbines in the simulation -nTurbinesGlob: 3 -#Enable debug outputs if set to true -debug: False -#The simulation will not run if dryRun is set to true -dryRun: False -#Flag indicating whether the simulation starts from scratch or restart -simStart: init # init/trueRestart/restartDriverInitFAST -#Start time of the simulation -tStart: 0.0 -#End time of the simulation. tEnd <= tMax -tEnd: 1.0 -#Max time of the simulation -tMax: 4.0 -#Time step for FAST. All turbines should have the same time step. -dtFAST: 0.00625 -#Restart files will be written every so many time steps -nEveryCheckPoint: 160 +n_turbines_glob: 3 # Total number of turbines in the simulation + +debug: False # Enable debug outputs if set to true + +dry_run: False # The simulation will not run if dryRun is set to true + +sim_start: init # Flag indicating whether the simulation starts from scratch or restart + # [init | trueRestart | restartDriverInitFAST] + +coupling_mode: strong # Coupling mode + # [strong | classic] + +t_start: 0.0 # Start time of the simulation + +t_end: 1.0 # End time of the simulation; tEnd <= tMax. + +t_max: 4.0 # Max time of the simulation + +dt_FAST: 0.00625 # Time step for FAST. All turbines should have the same time step. + +n_substeps: 1 # Number of substeps per timestep of the glue-code + +n_checkpoint: 160 # Restart files will be written every so many time steps + +set_exp_law_wind: false # Set velocity at the the turbine using an exponential law profile. Turbine0: - #The position of the turbine base for actuator-line simulations - turbine_base_pos: [ 0.0, 0.0, 0.0 ] - #The number of actuator points along each blade for actuator-line simulations - num_force_pts_blade: 0 - #The number of actuator points along the tower for actuator-line simulations. - num_force_pts_tower: 0 - #The checkpoint file for this turbine when restarting a simulation - restart_filename: "banana" - #The FAST input file for this turbine - FAST_input_filename: "t1_Test05.fst" - #A unique turbine id for each turbine - turb_id: 1 + + turbine_base_pos: [ 0.0, 0.0, 0.0 ] # The position of the turbine base for actuator-line simulations + + num_force_pts_blade: 0 # The number of actuator points along each blade for actuator-line simulations + + num_force_pts_tower: 0 # The number of actuator points along the tower for actuator-line simulations. + + restart_filename: "banana" # The checkpoint file for this turbine when restarting a simulation + + FAST_input_filename: "t1_Test05.fst" # The FAST input file for this turbine + + turb_id: 1 # A unique turbine id for each turbine Turbine1: turbine_base_pos: [ 0.0, 0.0, 0.0 ] diff --git a/docs/source/user/cppapi/index.rst b/docs/source/user/cppapi/index.rst index f364465560..fe970d5aeb 100644 --- a/docs/source/user/cppapi/index.rst +++ b/docs/source/user/cppapi/index.rst @@ -26,7 +26,7 @@ Command line invocation Common input file options ------------------------- -.. confval:: nTurbinesGlob +.. confval:: n_turbines_glob Total number of turbines in the simulation. The input file must contain a number of turbine specific sections (`Turbine0`, `Turbine1`, ..., `Turbine(n-1)`) that is consistent with `nTurbinesGlob`. @@ -34,37 +34,49 @@ Common input file options Enable debug outputs if set to true -.. confval:: dryRun +.. confval:: dry_run The simulation will not run if dryRun is set to true. However, the simulation will read the input files, allocate turbines to processors and prepare to run the individual turbine instances. This flag is useful to test the setup of the simulation before running it. -.. confval:: simStart +.. confval:: sim_start - Flag indicating whether the simulation starts from scratch or restart. ``simStart`` takes on one of three values: + Flag indicating whether the simulation starts from scratch or restart. ``sim_start`` takes on one of three values: * ``init`` - Use this option when starting a simulation from `t=0s`. * ``trueRestart`` - While OpenFAST allows for restart of a turbine simulation, external components like the Bladed style controller may not. Use this option when all components of the simulation are known to restart. * ``restartDriverInitFAST`` - When the ``restartDriverInitFAST`` option is selected, the individual turbine models start from `t=0s` and run up to the specified restart time using the inflow data stored at the actuator nodes from a hdf5 file. The C++ API stores the inflow data at the actuator nodes in a hdf5 file at every OpenFAST time step and then reads it back when using this restart option. This restart option is especially useful when the glue code is a CFD solver. + +.. confval:: coupling_mode + + Choice of coupling mode. ``coupling_mode`` takes one of two values: ``strong`` or ``classic``. ``strong`` coupling mode uses 2 outer iterations for every driver time step while ``classic`` coupling mode calls the `step()` function to use the loose coupling mode. -.. confval:: tStart +.. confval:: t_start Start time of the simulation -.. confval:: tEnd +.. confval:: t_end - End time of the simulation. tEnd <= tMax + End time of the simulation. t_end <= t_max -.. confval:: tMax +.. confval:: t_max Max time of the simulation -.. confval:: dtFAST +.. confval:: dt_fast Time step for FAST. All turbines should have the same time step. -.. confval:: nEveryCheckPoint +.. confval:: n_substeps + + Number of sub-timesteps of OpenFAST per time step of the driver program. + +.. confval:: n_checkpoint + + Restart files will be written every so many time steps + +.. confval:: set_exp_law_wind - Restart files will be written every so many time steps + Boolean value of True/False. When true, set velocity at the Aerodyn nodes using a power law wind profile using an exponent of 0.2 and a reference wind speed of 10 m/s at 90 meters. This option is useful to test the setup for actuator line simulations in individual mode before running massive CFD simulations. Turbine specific input options ------------------------------ diff --git a/docs/source/zrefs.rst b/docs/source/zrefs.rst new file mode 100644 index 0000000000..0bacbc412e --- /dev/null +++ b/docs/source/zrefs.rst @@ -0,0 +1,6 @@ +.. only:: html + + References + ---------- + +.. bibliography:: ../_static/references.bib diff --git a/glue-codes/openfast-cpp/CMakeLists.txt b/glue-codes/openfast-cpp/CMakeLists.txt index 2d23a99790..55823e0465 100644 --- a/glue-codes/openfast-cpp/CMakeLists.txt +++ b/glue-codes/openfast-cpp/CMakeLists.txt @@ -26,7 +26,8 @@ set(CMAKE_CXX_STANDARD_REQUIRED ON) find_package(MPI REQUIRED) find_package(LibXml2 REQUIRED) find_package(ZLIB REQUIRED) -find_package(HDF5 REQUIRED COMPONENTS C HL) +find_package(HDF5 REQUIRED) +find_package(NetCDF REQUIRED COMPONENTS C) find_package(yaml-cpp REQUIRED) add_library(openfastcpplib @@ -36,15 +37,15 @@ add_library(openfastcpplib set_property(TARGET openfastcpplib PROPERTY POSITION_INDEPENDENT_CODE ON) target_link_libraries(openfastcpplib openfastlib - ${HDF5_C_LIBRARIES} - ${HDF5_HL_LIBRARIES} + ${HDF5_LIBRARIES} + ${NETCDF_LIBRARIES} ${ZLIB_LIBRARIES} ${LIBXML2_LIBRARIES} ${MPI_LIBRARIES} ) target_include_directories(openfastcpplib PUBLIC - ${HDF5_INCLUDES} - ${HDF5_INCLUDE_DIR} + ${HDF5_INCLUDE_DIRS} + ${NETCDF_INCLUDE_DIRS} ${ZLIB_INCLUDES} ${LIBXML2_INCLUDE_DIR} ${MPI_INCLUDE_PATH} diff --git a/glue-codes/openfast-cpp/src/FAST_Prog.cpp b/glue-codes/openfast-cpp/src/FAST_Prog.cpp index b46514c56d..ab68e388ef 100644 --- a/glue-codes/openfast-cpp/src/FAST_Prog.cpp +++ b/glue-codes/openfast-cpp/src/FAST_Prog.cpp @@ -1,94 +1,178 @@ #include "OpenFAST.H" #include "yaml-cpp/yaml.h" #include +#include #include inline bool checkFileExists(const std::string& name) { - struct stat buffer; - return (stat (name.c_str(), &buffer) == 0); + struct stat buffer; + return (stat (name.c_str(), &buffer) == 0); } -void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { - //Read turbine data for a given turbine using the YAML node - fi.globTurbineData[iTurb].TurbID = turbNode["turb_id"].as(); - fi.globTurbineData[iTurb].FASTInputFileName = turbNode["FAST_input_filename"].as(); - fi.globTurbineData[iTurb].FASTRestartFileName = turbNode["restart_filename"].as(); - if (turbNode["turbine_base_pos"].IsSequence() ) { - fi.globTurbineData[iTurb].TurbineBasePos = turbNode["turbine_base_pos"].as >(); +/// Optionally read in a value from a yaml node if present, else set it to a default value. Copied from github.com/Exawind/nalu-wind/include/NaluParsing.h +template +void get_if_present(const YAML::Node & node, const std::string& key, T& result, const T& default_if_not_present = T()) +{ + if (node[key]) { + const YAML::Node value = node[key]; + result = value.as(); } - if (turbNode["turbine_hub_pos"].IsSequence() ) { - fi.globTurbineData[iTurb].TurbineHubPos = turbNode["turbine_hub_pos"].as >(); + else { + int rank; + int iErr = MPI_Comm_rank( MPI_COMM_WORLD, &rank); + if(!rank) + std::cout << key << " is missing in the input file. Proceeding with assumption " << key << " = " << default_if_not_present << std::endl ; + result = default_if_not_present; } - fi.globTurbineData[iTurb].numForcePtsBlade = turbNode["num_force_pts_blade"].as(); - fi.globTurbineData[iTurb].numForcePtsTwr = turbNode["num_force_pts_tower"].as(); - if (turbNode["nacelle_cd"]) fi.globTurbineData[iTurb].nacelle_cd = turbNode["nacelle_cd"].as(); - if (turbNode["nacelle_area"]) fi.globTurbineData[iTurb].nacelle_area = turbNode["nacelle_area"].as(); - if (turbNode["air_density"]) fi.globTurbineData[iTurb].air_density = turbNode["air_density"].as(); } -void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, double * tEnd) { +/// Read a 'key' from a yaml node if it exists, else throw an error +template +void get_required(const YAML::Node & node, const std::string& key, T& result) +{ + if (node[key]) { + const YAML::Node value = node[key]; + result = value.as(); + } + else { + throw std::runtime_error("Error: parsing missing required key: " + key); + } +} - fi.comm = MPI_COMM_WORLD; +void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { - // Check if the input file exists and read it - if ( checkFileExists(cInterfaceInputFile) ) { + //Read turbine data for a given turbine using the YAML node - YAML::Node cDriverInp = YAML::LoadFile(cInterfaceInputFile); + get_if_present(turbNode, "turb_id", fi.globTurbineData[iTurb].TurbID, iTurb); + std::string simType; + get_if_present(turbNode, "sim_type", simType, std::string("ext-inflow")); + if (simType == "ext-loads") + fi.globTurbineData[iTurb].sType = fast::EXTLOADS; + else + fi.globTurbineData[iTurb].sType = fast::EXTINFLOW; - fi.nTurbinesGlob = cDriverInp["nTurbinesGlob"].as(); + std::string emptyString = ""; + get_if_present(turbNode, "FAST_input_filename", fi.globTurbineData[iTurb].FASTInputFileName); + get_if_present(turbNode, "restart_filename", fi.globTurbineData[iTurb].FASTRestartFileName); + if ( (fi.globTurbineData[iTurb].FASTRestartFileName == emptyString) && (fi.globTurbineData[iTurb].FASTInputFileName == emptyString) ) + throw std::runtime_error("Both FAST_input_filename and restart_filename are empty or not specified for Turbine " + std::to_string(iTurb)); - if (fi.nTurbinesGlob > 0) { + if (turbNode["turbine_base_pos"].IsSequence() ) { + fi.globTurbineData[iTurb].TurbineBasePos = turbNode["turbine_base_pos"].as >() ; + } else { + fi.globTurbineData[iTurb].TurbineBasePos = std::vector(3,0.0); + } - if(cDriverInp["dryRun"]) { - fi.dryRun = cDriverInp["dryRun"].as(); - } + if (turbNode["turbine_hub_pos"].IsSequence() ) { + fi.globTurbineData[iTurb].TurbineHubPos = turbNode["turbine_hub_pos"].as >() ; + } else { + fi.globTurbineData[iTurb].TurbineHubPos = std::vector(3,0.0); + } - if(cDriverInp["debug"]) { - fi.debug = cDriverInp["debug"].as(); - } + get_if_present(turbNode, "num_force_pts_blade", fi.globTurbineData[iTurb].numForcePtsBlade, 0); + get_if_present(turbNode, "num_force_pts_tower", fi.globTurbineData[iTurb].numForcePtsTwr, 0); - if(cDriverInp["simStart"]) { - if (cDriverInp["simStart"].as() == "init") { - fi.simStart = fast::init; - } else if(cDriverInp["simStart"].as() == "trueRestart") { - fi.simStart = fast::trueRestart; - } else if(cDriverInp["simStart"].as() == "restartDriverInitFAST") { - fi.simStart = fast::restartDriverInitFAST; - } else { - throw std::runtime_error("simStart is not well defined in the input file"); - } - } + float fZero = 0.0; + get_if_present(turbNode, "nacelle_cd", fi.globTurbineData[iTurb].nacelle_cd, fZero); + get_if_present(turbNode, "nacelle_area", fi.globTurbineData[iTurb].nacelle_area, fZero); + get_if_present(turbNode, "air_density", fi.globTurbineData[iTurb].air_density, fZero); + + if (simType == "ext-loads") { + + get_if_present(turbNode, "az_blend_mean", fi.globTurbineData[iTurb].azBlendMean, 20*360.0*M_PI/180.0); //20 revs + get_if_present(turbNode, "az_blend_delta", fi.globTurbineData[iTurb].azBlendDelta, 3.0*360.0*M_PI/180.0); // 3 rev + get_required(turbNode, "vel_mean", fi.globTurbineData[iTurb].velMean); + get_required(turbNode, "wind_dir", fi.globTurbineData[iTurb].windDir); + get_required(turbNode, "z_ref", fi.globTurbineData[iTurb].zRef); + get_required(turbNode, "shear_exp", fi.globTurbineData[iTurb].shearExp); + + } + +} - fi.tStart = cDriverInp["tStart"].as(); - *tEnd = cDriverInp["tEnd"].as(); - fi.nEveryCheckPoint = cDriverInp["nEveryCheckPoint"].as(); - fi.dtFAST = cDriverInp["dtFAST"].as(); - fi.tMax = cDriverInp["tMax"].as(); // tMax is the total duration to which you want to run FAST. This should be the same or greater than the max time given in the FAST fst file. Choose this carefully as FAST writes the output file only at this point if you choose the binary file output. +void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, double *tStart, double * tEnd, int * couplingMode, bool * setExpLawWind, bool * setUniformXBladeForces, int * nIter, double *xBladeForce) { - if(cDriverInp["superController"]) { - fi.scStatus = cDriverInp["superController"].as(); - fi.scLibFile = cDriverInp["scLibFile"].as(); + fi.comm = MPI_COMM_WORLD; + + // Check if the input file exists and read it + if ( checkFileExists(cInterfaceInputFile) ) { + + YAML::Node cDriverInp = YAML::LoadFile(cInterfaceInputFile); + get_required(cDriverInp, "n_turbines_glob", fi.nTurbinesGlob); + + if (fi.nTurbinesGlob > 0) { + + get_if_present(cDriverInp, "dry_run", fi.dryRun, false); + get_if_present(cDriverInp, "debug", fi.debug, false); + + *couplingMode = 0; //CLASSIC is default + if(cDriverInp["coupling_mode"]) { + if ( cDriverInp["coupling_mode"].as() == "strong" ) { + *couplingMode = 1; + } else if ( cDriverInp["coupling_mode"].as() == "classic" ) { + *couplingMode = 0; + } else { + throw std::runtime_error("coupling_mode is not well defined in the input file"); } + } + if (cDriverInp["n_iter"]) { + *nIter = cDriverInp["n_iter"].as(); + if (*nIter < 0) { + *nIter = 1; + } + } else { + *nIter = 1; + } - fi.globTurbineData.resize(fi.nTurbinesGlob); - for (int iTurb=0; iTurb < fi.nTurbinesGlob; iTurb++) { - if (cDriverInp["Turbine" + std::to_string(iTurb)]) { - readTurbineData(iTurb, fi, cDriverInp["Turbine" + std::to_string(iTurb)] ); - } else { - throw std::runtime_error("Node for Turbine" + std::to_string(iTurb) + " not present in input file or I cannot read it"); - } + if(cDriverInp["sim_start"]) { + if (cDriverInp["sim_start"].as() == "init") { + fi.simStart = fast::init; + } else if(cDriverInp["sim_start"].as() == "trueRestart") { + fi.simStart = fast::trueRestart; + } else if(cDriverInp["sim_start"].as() == "restartDriverInitFAST") { + fi.simStart = fast::restartDriverInitFAST; + } else { + throw std::runtime_error("sim_start is not well defined in the input file"); } + } - } else { - throw std::runtime_error("Number of turbines <= 0 "); + get_required(cDriverInp, "t_start", *tStart); + get_required(cDriverInp, "t_end", *tEnd); + get_required(cDriverInp, "restart_freq", fi.restartFreq); + get_if_present(cDriverInp, "output_freq", fi.outputFreq, 100); + get_required(cDriverInp, "dt_driver", fi.dtDriver); + get_required(cDriverInp, "t_max", fi.tMax); // t_max is the total duration to which you want to run FAST. This should be the same or greater than the max time given in the FAST fst file. + get_if_present(cDriverInp, "set_exp_law_wind", *setExpLawWind, false); + get_if_present(cDriverInp, "set_uniform_x_blade_forces", *setUniformXBladeForces, false); + if (setUniformXBladeForces) + get_required(cDriverInp, "x_blade_force", *xBladeForce); + + get_if_present(cDriverInp, "super_controller", fi.scStatus, false); + if(fi.scStatus) { + get_required(cDriverInp, "sc_libfile", fi.scLibFile); + } + + fi.globTurbineData.resize(fi.nTurbinesGlob); + for (int iTurb=0; iTurb < fi.nTurbinesGlob; iTurb++) { + if (cDriverInp["Turbine" + std::to_string(iTurb)]) { + readTurbineData(iTurb, fi, cDriverInp["Turbine" + std::to_string(iTurb)] ); + } else { + throw std::runtime_error("Node for Turbine" + std::to_string(iTurb) + " not present in input file or I cannot read it"); + } } } else { - throw std::runtime_error("Input file " + cInterfaceInputFile + " does not exist or I cannot access it"); + throw std::runtime_error("Number of turbines <= 0 "); } + + } else { + throw std::runtime_error("Input file " + cInterfaceInputFile + " does not exist or I cannot access it"); + } + } int main(int argc, char** argv) { + if (argc != 2) { std::cerr << "Incorrect syntax. Try: openfastcpp inputfile.yaml" << std::endl ; return 1; @@ -98,36 +182,40 @@ int main(int argc, char** argv) { int nProcs; int rank; std::vector torque (3, 0.0); - std::vector thrust (3, 0.0); + std::vector thrust (3, 0.0); iErr = MPI_Init(NULL, NULL); iErr = MPI_Comm_size( MPI_COMM_WORLD, &nProcs); iErr = MPI_Comm_rank( MPI_COMM_WORLD, &rank); - double tEnd ; // This doesn't belong in the FAST - C++ interface - int ntEnd ; // This doesn't belong in the FAST - C++ interface - + int couplingMode ; //CLASSIC (SOWFA style = 0) or STRONG (Conventional Serial Staggered - allow for outer iterations = 1) + double tStart; // This doesn't belong in the C++ API + double tEnd ; // This doesn't belong in the FAST - C++ interface + int ntStart, ntEnd ; // This doesn't belong in the FAST - C++ interface + int nSubsteps; // + bool setExpLawWind; // Set wind speed at Aerodyn nodes based on an exponential profile. Useful for testing the C++ API before running actuator line simulations. + bool setUniformXBladeForces; // Set uniform X blade forces on all blade nodes + int nIter; + double xBladeForce = 0.0; + std::string cDriverInputFile=argv[1]; fast::OpenFAST FAST; fast::fastInputs fi ; try { - readInputFile(fi, cDriverInputFile, &tEnd); + readInputFile(fi, cDriverInputFile, &tStart, &tEnd, &couplingMode, &setExpLawWind, &setUniformXBladeForces, &nIter, &xBladeForce); } catch( const std::runtime_error & ex) { std::cerr << ex.what() << std::endl ; std::cerr << "Program quitting now" << std::endl ; return 1; } - // Calculate the last time step - ntEnd = tEnd/fi.dtFAST; - FAST.setInputs(fi); - FAST.allocateTurbinesToProcsSimple(); + FAST.allocateTurbinesToProcsSimple(); // Or allocate turbines to procs by calling "setTurbineProcNo(iTurbGlob, procId)" for turbine. FAST.init(); - if (FAST.isTimeZero()) FAST.solution0(); + nSubsteps = fi.dtDriver/FAST.get_timestep(); if ( FAST.isDryRun() ) { FAST.end() ; @@ -135,8 +223,46 @@ int main(int argc, char** argv) { return 0; } - for (int nt = FAST.get_ntStart(); nt < ntEnd; nt++) { - FAST.step(); + if (FAST.isTimeZero()) { + if (setExpLawWind) + FAST.setExpLawWindSpeed(0.0); + + FAST.solution0(); + } + + + ntStart = tStart/fi.dtDriver; //Calculate the first time step + ntEnd = tEnd/fi.dtDriver; //Calculate the last time step + + for (int nt = ntStart; nt < ntEnd; nt++) { + if (couplingMode == 0) { + // If running with a CFD solver, sample velocities at the actuator/velocity nodes here + if (setExpLawWind) + FAST.setExpLawWindSpeed( (nt+1)*fi.dtDriver ); + if (setUniformXBladeForces) { + FAST.setUniformXBladeForces(xBladeForce); + } + + for (int iSubstep=1; iSubstep < nSubsteps; iSubstep++) { + FAST.step(); + std::cout << "iSubstep = " << iSubstep << std::endl ; + } + // Get forces at actuator nodes and advance CFD solve by one time step here + } else { + for (int j=0; j < nIter; j++) { + // If running with a CFD solver, use 'FAST.predict_states()' to predict position and force at actuator nodes at the next time step on the first pass + // Run a CFD time step as a 'predictor' to get velocity at the next time step + // Sample and set velocity at the actuator/velocity nodes after the first cfd predictor + if (setExpLawWind) + FAST.setExpLawWindSpeed( (nt+1)*fi.dtDriver ); + if (setUniformXBladeForces) { + FAST.setUniformXBladeForces(xBladeForce); + } + FAST.update_states_driver_time_step(); + } + // Call this after enough outer iterations have been done + FAST.advance_to_next_driver_time_step(); + } if (FAST.isDebug()) { FAST.computeTorqueThrust(0,torque,thrust); std::cout.precision(16); @@ -149,5 +275,4 @@ int main(int argc, char** argv) { MPI_Finalize() ; return 0; - } diff --git a/glue-codes/openfast-cpp/src/OpenFAST.H b/glue-codes/openfast-cpp/src/OpenFAST.H index 21ed980aa3..0f1895944e 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.H +++ b/glue-codes/openfast-cpp/src/OpenFAST.H @@ -6,8 +6,11 @@ #include #include #include +#include #include #include +#include +#include "netcdf.h" #include "dlfcn.h" //TODO: The skip MPICXX is put in place primarily to get around errors in OpenFOAM. This will cause problems if the driver program uses C++ API for MPI. #ifndef OMPI_SKIP_MPICXX @@ -22,20 +25,74 @@ namespace fast { -struct globTurbineDataType { - int TurbID; - std::string FASTInputFileName; - std::string FASTRestartFileName; - std::vector TurbineBasePos; - std::vector TurbineHubPos; - std::string forcePtsBladeDistributionType; - int numForcePtsBlade; - int numForcePtsTwr; - float nacelle_cd{0.0}; - float nacelle_area{0.0}; - float air_density{0.0}; +//! An id to indicate the type of simulation for each turbine - Simple/Actuator with optional externally specified inflow or Blade-Resolved with externally specified loads +enum simType { + EXTINFLOW = 0, + EXTLOADS = 1, + simType_END }; +//! A data structure to hold all turbine related information +struct turbineDataType { + //!Integer id for every turbine + int TurbID; + //! The FAST Input file name. Typically a .fst file. + std::string FASTInputFileName; + //! The restart/checkpoint file name. + std::string FASTRestartFileName; + //! Output file root + std::string outFileRoot; + //! The time step for OpenFAST for this turbine + double dt; + //! The position of the base of the turbine in global coordinates + std::vector TurbineBasePos; + //! The approximate position of the hub of the turbine in global coordinates + std::vector TurbineHubPos; + //! Simulation type + simType sType; + //! Number of blades + int numBlades; + //! Number of velocity nodes (AeroDyn) per blade + int numVelPtsBlade; + //! Number of velocity nodes (AeroDyn) on the tower + int numVelPtsTwr; + //! Total number of velocity nodes (AeroDyn) + int numVelPts; + //! Desired number of actuator points on each blade + int numForcePtsBlade; + //! Desired number of actuator points on the tower + int numForcePtsTwr; + //! Total number of actuator points + int numForcePts; + //! Inflow Type - 1 (InflowWind) or 2 (Externally specified) + int inflowType; + //! Drag coefficient of nacelle + float nacelle_cd; + //! Frontal area of the nacelle + float nacelle_area; + //! Air density around this turbine + float air_density; + //! Number of nodes at which the forces and deflections are computed for blade-resolved FSI on each blade + std::vector nBRfsiPtsBlade; + //! Total number of BR fsi points on all blades combined + int nTotBRfsiPtsBlade; + //! Number of nodes at which the forces and deflections are computed for blade-resolved FSI on the tower + int nBRfsiPtsTwr; + //! The mean azimuth at which the loads are blended between AeroDyn and CFD + double azBlendMean; + //! The delta azimuth over which the the loads are blended between AeroDyn and CFD + double azBlendDelta; + //! Mean velocity at reference height + double velMean; + //! Compass angle of wind direction (in degrees) + double windDir; + //! Reference height for velocity profile + double zRef; + //! Shear exponent of velocity profile + double shearExp; +}; + +//! An id to indicate whether a particular actuator point is on the hub, node or tower enum ActuatorNodeType { HUB = 0, BLADE = 1, @@ -43,6 +100,11 @@ enum ActuatorNodeType { ActuatorNodeType_END }; +/** An id to indicate the start type of a simulation. + * init - Start the simulation from scratch + * trueRestart - Restart from a checkpoint file. Code expects checkpoint files for all parts of the simulation including the controller. + * restartDriverInitFAST - Start all turbines from scratch and use the velocity data in 'velData.h5' file to run upto desired restart time, then continue the simulation like ''trueRestart'. + */ enum simStartType { init = 0, trueRestart = 1, @@ -50,24 +112,133 @@ enum simStartType { simStartType_END }; +//! A data structure to hold all velocity and force node information +struct turbVelForceNodeDataType { + //! Blade location at velocity nodes + std::vector x_vel; + //! Blade velocity at velocity nodes + std::vector xdot_vel; + //! Sampled velocity at velocity nodes + std::vector vel_vel; + //! Reference location at force nodes + std::vector xref_force; + //! Blade location at force nodes + std::vector x_force; + //! Blade velocity at force nodes + std::vector xdot_force; + //! Blade orientation at force nodes + std::vector orient_force; + //! Sampled velocity at force nodes + std::vector vel_force; + //! Actuator force at force nodes + std::vector force; + double x_vel_resid; + double xdot_vel_resid; + double vel_vel_resid; + double x_force_resid; + double xdot_force_resid; + double orient_force_resid; + double vel_force_resid; + double force_resid; +}; + +//! An enum to keep track of information stored at different time steps +enum timeStep { + STATE_NM2 = 0, + STATE_NM1 = 1, + STATE_N = 2, + STATE_NP1 = 3, + timeStep_END +}; + +//! A data structure to hold all loads and deflections information for blade-resolved FSI simulations +struct turbBRfsiDataType { + //! Tower reference position + std::vector twr_ref_pos; + //! Tower deflections + std::vector twr_def; + //! Tower velocity + std::vector twr_vel; + //! Blade radial location + std::vector bld_rloc; + //! Blade chord + std::vector bld_chord; + //! Blade reference position + std::vector bld_ref_pos; + //! Blade deflections + std::vector bld_def; + //! Blade velocity + std::vector bld_vel; + //! Hub reference position + std::vector hub_ref_pos; + //! Hub deflections + std::vector hub_def; + //! Hub velocity + std::vector hub_vel; + //! Nacelle reference position + std::vector nac_ref_pos; + //! Nacelle deflections + std::vector nac_def; + //! Nacelle velocity + std::vector nac_vel; + //! Blade root reference position + std::vector bld_root_ref_pos; + //! Blade root deformation + std::vector bld_root_def; + //! Blade pitch + std::vector bld_pitch; + + //! Tower loads + std::vector twr_ld; + //! Blade loads + std::vector bld_ld; + double twr_def_resid; + double twr_vel_resid; + double bld_def_resid; + double bld_vel_resid; + double twr_ld_resid; + double bld_ld_resid; +}; +/** + * A class to hold all input data for a simulation run through a OpenFAST C++ glue code + */ class fastInputs { public: + //! MPI Communicator MPI_Comm comm; - int nTurbinesGlob; - bool dryRun; - bool debug; - double tStart; + //! Total number of turbines in the simulation + int nTurbinesGlob{0}; + //! The simulation will not run if dryRun is set to true. However, the simulation will read the input files, allocate turbines to processors and prepare to run the individual turbine instances. This flag is useful to test the setup of the simulation before running it. + bool dryRun{false}; + //! Enable debug outputs if set to true + bool debug{false}; + //! Start time of the simulation + double tStart{-1.0}; + //! Start type of the simulation: 'INIT', 'TRUERESTART' or 'RESTARTDRIVERINITFAST'. simStartType simStart; - int nEveryCheckPoint; - double tMax; - double dtFAST; - - bool scStatus; - std::string scLibFile; - std::vector globTurbineData; + //!Restart files will be written every so many time stneps + int restartFreq{-1}; + //!Output files will be written every so many time stneps + int outputFreq{100}; + //! Max time of the simulation + double tMax{0.0}; + //! Time step for driver. + double dtDriver{0.0}; + //! Time step for openfast. + double dtFAST{0.0}; + //! Supercontroller status: True/False. + bool scStatus{false}; + //! Name of the dynamic library containing the supercontroller implementation + std::string scLibFile{""}; + //! Number of inputs and output to the supercontroller from/to each turbine + int numScInputs{0}; + int numScOutputs{0}; + + //! Vector of turbine specific input data + std::vector globTurbineData; // Constructor fastInputs() ; @@ -78,84 +249,180 @@ class fastInputs { }; +/** + * A class to interface OpenFAST's fortran backend with a C++ driver program + */ class OpenFAST { private: + //! MPI Communicator MPI_Comm mpiComm; - bool dryRun; // If this is true, class will simply go through allocation and deallocation of turbine data - bool debug; // Write out extra information if this flags is turned on - std::vector globTurbineData; - int nTurbinesProc; - int nTurbinesGlob; - simStartType simStart; - bool timeZero; - double dtFAST; - double tMax; - std::vector > TurbineBasePos; - std::vector > TurbineHubPos; - std::vector TurbID; - std::vector FASTInputFileName; - std::vector CheckpointFileRoot; - std::vector nacelle_cd; - std::vector nacelle_area; - std::vector air_density; - double tStart; - int nt_global; - int ntStart; // The time step to start the FAST simulation - int nEveryCheckPoint; // Check point files will be written every 'nEveryCheckPoint' time steps - std::vector numBlades; // Number of blades - std::vector forcePtsBladeDistributionType; - std::vector numForcePtsBlade; - std::vector numForcePtsTwr; - std::vector numVelPtsBlade; - std::vector numVelPtsTwr; - + //! The simulation will not run if dryRun is set to true. However, the simulation will read the input files, allocate turbines to processors and prepare to run the individual turbine instances. This flag is useful to test the setup of the simulation before running it. + bool dryRun{false}; // If this is true, class will simply go through allocation and deallocation of turbine data + //! Enable debug outputs if set to true + bool debug{false}; // Write out extra information if this flags is turned on + //! Number of turbines on this MPI rank + int nTurbinesProc{0}; + //! Total number of turbines in the simulation + int nTurbinesGlob{0}; + //! Start type of the simulation: 'INIT', 'TRUERESTART' or 'RESTARTDRIVERINITFAST'. + simStartType simStart{fast::init}; + //! Offset between driver and openfast simulation time - t_driver - t_openfast + double driverOpenfastOffset_{0.0}; + //! Is the time now zero: True/False + bool timeZero{false}; + //! Time step for FAST. All turbines on a given processor should have the same time step. + double dtFAST{-1.0}; + //! Time step for Driver. + double dtDriver{-1.0}; + //! Number of OpenFAST time steps per unit time step of the driver program + int nSubsteps_{-1}; + //! Is this the first pass through a time step + bool firstPass_{true}; + //! Max time of the simulation + double tMax{-1.0}; + //! Start time of the simulation + double tStart{-1.0}; + + //! The current time step number + int nt_global{0}; + //! The current nonlinear iteration + int nlinIter_{0}; + //! The starting time step number + int ntStart{0}; + //! Restart files will be written every so many time steps + int restartFreq_{-1}; + //! Output files will be written every so many time steps + int outputFreq_{100}; + + //! Map of `{variableName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncOutVarNames_; + std::unordered_map ncOutVarIDs_; + + //! Map of `{dimName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncOutDimNames_; + std::unordered_map ncOutDimIDs_; + + //! Map of `{variableName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncRstVarNames_; + std::unordered_map ncRstVarIDs_; + + //! Map of `{dimName : netCDF_ID}` obtained from the NetCDF C interface + std::vector ncRstDimNames_; + std::unordered_map ncRstDimIDs_; + + std::vector globTurbineData; //All turbines + std::vector turbineData; // Only for turbines on the proc + + //! Velocity at force nodes - Store temporarily to interpolate to the velocity nodes std::vector > > forceNodeVel; // Velocity at force nodes - Store temporarily to interpolate to the velocity nodes + //! Position and velocity data at the velocity (aerodyn) nodes - (nTurbines, nTimesteps * nPoints * 6) std::vector > velNodeData; // Position and velocity data at the velocity (aerodyn) nodes - (nTurbines, nTimesteps * nPoints * 6) - hid_t velNodeDataFile; // HDF-5 tag of file containing velocity (aerodyn) node data file + //! Array containing data at the velocity and force nodes + std::vector> velForceNodeData; + //! Array containing forces and deflections data for blade-resolved FSI simulations. + std::vector> brFSIData; - std::vector cDriver_Input_from_FAST; - std::vector cDriver_Output_to_FAST; + //! Data structure to get forces and deflections from ExternalInflow module in OpenFAST + std::vector extinfw_i_f_FAST; // Input from OpenFAST + //! Data structure to send velocity information to ExternalInflow module in OpenFAST + std::vector extinfw_o_t_FAST; // Output to OpenFAST + + //! Data structure to get deflections from ExternalLoads module in OpenFAST + std::vector extld_i_f_FAST; // Input from OpenFAST + //! Data structure to send force information to ExternalLoads module in OpenFAST + std::vector extld_o_t_FAST; // Output to OpenFAST - // Turbine Number is DIFFERENT from TurbID. Turbine Number simply runs from 0:n-1 locally and globally. - std::map turbineMapGlobToProc; // Mapping global turbine number to processor number - std::map turbineMapProcToGlob; // Mapping local to global turbine number - std::map reverseTurbineMapProcToGlob; // Reverse Mapping global turbine number to local turbine number - std::set turbineSetProcs; // Set of processors containing at least one turbine - std::vector turbineProcs; // Same as the turbineSetProcs, but as an integer array - - //Supercontroller stuff - bool scStatus; - SuperController sc; scInitOutData scio; - int fastMPIGroupSize; + // Mapping of local turbine number to global turbine and processor number + // Turbine Number is DIFFERENT from TurbID. Turbine Number simply runs from 0:n-1 locally and globally. + //! Mapping global turbine number to processor number + std::map turbineMapGlobToProc; + //! Mapping local to global turbine number + std::map turbineMapProcToGlob; + //! Reverse Mapping global turbine number to local turbine number + std::map reverseTurbineMapProcToGlob; + //! Set of processors containing atleast one turbine + std::set turbineSetProcs; + //! Same as the turbineSetProcs, but as an integer array + std::vector turbineProcs; + + // Supercontroller stuff + bool scStatus{false}; + std::string scLibFile; + // Dynamic load stuff copied from 'C++ dlopen mini HOWTO' on tldp.org + void *scLibHandle ; + typedef SuperController* create_sc_t(); + create_sc_t * create_SuperController; + typedef void destroy_sc_t(SuperController *); + destroy_sc_t * destroy_SuperController; + std::unique_ptr sc; + + // MPI related book keeping for all processors containing turbines + //! Number of processors in a fastMPIGroup + int fastMPIGroupSize{-1}; + //! An MPI group created among all processors that simulate atleast one turbine MPI_Group fastMPIGroup; + //! An MPI communicator for the MPI group created among all processors that simulate atleast one turbine MPI_Comm fastMPIComm; - int fastMPIRank; + //! MPI rank of processor on the fastMPIComm + int fastMPIRank{-1}; + //! Global MPI group MPI_Group worldMPIGroup; - int worldMPIRank; + //! MPI rank of processor on global MPI Comm + int worldMPIRank{-1}; - static int AbortErrLev; - int ErrStat; + //! Error status and Error message to communicate with OpenFAST + int ErrStat{0}; char ErrMsg[INTERFACE_STRING_LENGTH]; // make sure this is the same size as IntfStrLen in FAST_Library.f90 + static int AbortErrLev; public: - // Constructor + //! Constructor OpenFAST() ; - // Destructor - ~OpenFAST() ; + //! Destructor + ~OpenFAST() {} ; + //! Set inputs to OpenFAST through an object of the class fastInputs. Should be called on all MPI ranks. void setInputs(const fastInputs &); + //! Check and set the number of sub-timesteps + int checkAndSetSubsteps(); + + //! Set driver time step and check point + void setDriverTimeStep(double dt_driver); + void setDriverCheckpoint(int nt_checkpoint_driver); + + //! Initialize the simulation - allocate memory for all data structures and initialize all turbines. Safe to call on all MPI ranks. void init(); - void solution0(); - void step(); - void stepNoWrite(); + //! Call FAST->solution0 for all turbines. Safe to call on all MPI ranks. + void solution0(bool writeFiles=true); + //! Initialize velocity and force node data. Safe to call on all MPI ranks. + void init_velForceNodeData(); + //! Set up before every OpenFAST time step. Safe to call on all MPI ranks. + void prework(); + //! Update states to next time step by calling FAST_AdvanceStates_T and CalcOutputs_And_SolveForInputs. Safe to call on all MPI ranks. + void update_states_driver_time_step(bool writeFiles=true); + //! Copy the final predicted states from step t_global_next to actual states for that step. Safe to call on all MPI ranks. + void advance_to_next_driver_time_step(bool writeFiles=true); + //! Set external inputs for OpenFAST modules by interpolating to substep. Safe to call on all MPI ranks. + void send_data_to_openfast(double ss_time); + //! Set external inputs for OpenFAST modules at time step 't'. Safe to call on all MPI ranks. + void send_data_to_openfast(fast::timeStep t); + //! Get ouput data from OpenFAST modules. Safe to call on all MPI ranks. + void get_data_from_openfast(fast::timeStep t); + //! Extrapolate velocity and force node data to time step 'n+1' using data at 'n', 'n-1' and 'n-2'. Safe to call on all MPI ranks. + void predict_states(); + //! Advance all turbines by 1 OpenFAST timestep. Safe to call on all MPI ranks. + void step(bool writeFiles=true); + //! Step function to be used with sub-stepping fast between time steps of the driver program. Safe to call on all MPI ranks. + void step(double ss_time); + //! Call FAST->end for all turbines. Safe to call on all MPI ranks. void end(); // Compute the nacelle force @@ -169,125 +436,334 @@ class OpenFAST { float & fy, float & fz); - hid_t openVelocityDataFile(bool createFile); - void readVelocityData(int nTimesteps); - void writeVelocityData(hid_t h5file, int iTurb, int iTimestep, OpFM_InputType_t iData, OpFM_OutputType_t oData); - herr_t closeVelocityDataFile(int nt_global, hid_t velDataFile); - void backupVelocityDataFile(int curTimeStep, hid_t & velDataFile); - + //! Allocate turbine number 'iTurbGlob' to the processor with global MPI rank 'procNo'. MUST be called from every MPI rank. void setTurbineProcNo(int iTurbGlob, int procNo) { turbineMapGlobToProc[iTurbGlob] = procNo; } + //! Allocate all turbines to processors in a round-robin fashion. MUST be called from every MPI rank. void allocateTurbinesToProcsSimple(); + + //! Get fast time step on this processor + double get_timestep() { return dtFAST; } + + //! Get the approximate hub position for turbine number 'iTurbGlob'. This is the value specified in the input to OpenFAST. Must be called only from the processor containing the turbine. void getApproxHubPos(double* currentCoords, int iTurbGlob, int nSize=3); - void getHubPos(double* currentCoords, int iTurbGlob, int nSize=3); - void getHubShftDir(double* hubShftVec, int iTurbGlob, int nSize=3); + //! Get the exact hub position for turbine number 'iTurbGlob'. This is avaiable only after OpenFAST has been initialized for a given turbine. Must be called only from the processor containing the turbine. + void getHubPos(double* currentCoords, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Get a vector pointing downstream along the hub for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getHubShftDir(double* hubShftVec, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + + //! Get the node type (HUB, BLADE, TOWER) of velocity node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. ActuatorNodeType getVelNodeType(int iTurbGlob, int iNode); - void getVelNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize=3); + //! Get the coordinates of velocity node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getVelNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Set the velocity at velocity node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. void setVelocity(double* velocity, int iNode, int iTurbGlob, int nSize=3); + //! Set the velocity at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. void setVelocityForceNode(double* velocity, int iNode, int iTurbGlob, int nSize=3); + //! Map the velocity from the force nodes to the velocity nodes using linear interpolation along each blade and the tower. Safe to call from every MPI rank. void interpolateVel_ForceToVelNodes(); + //! Get the node type (HUB, BLADE, TOWER) of force node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. ActuatorNodeType getForceNodeType(int iTurbGlob, int iNode); - void getForceNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize=3); - void getForceNodeOrientation(double* currentOrientation, int iNode, int iTurbGlob, int nSize=9); - void getForce(double* force, int iNode, int iTurbGlob, int nSize=3); - void getRelativeVelForceNode(double* vel, int iNode, int iTurbGlob, int nSize=3); - double getChord(int iNode, int iTurbGlob); + //! Get the coordinates of force node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getForceNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Get the tensor orientation of force node number 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getForceNodeOrientation(double* currentOrientation, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + //! Get the actuator force at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + void getForce(double* force, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + void getRelativeVelForceNode(double* vel, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=3); + + //! Get the chord at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + double getChord(int iNode, int iTurbGlob); + //! Get the radial location/height along blade/tower at force node 'iNode' for turbine number 'iTurbGlob'. Must be called only from the processor containing the turbine. + double getRHloc(int iNode, int iTurbGlob); + + //! Get processor containing turbine 'iTurbGlob' + int getProc(int iTurbGlob) {return turbineMapGlobToProc[iTurbGlob];} + + //! Get the blade chord array 'bldRloc' of turbine number 'iTurbGlob' + void getBladeChord(double * bldChord, int iTurbGlob); + //! Get the blade node radial locations array 'bldRloc' of turbine number 'iTurbGlob' + void getBladeRloc(double * bldRloc, int iTurbGlob); + //! Get the blade reference positions array 'bldRefPos' of turbine number 'iTurbGlob' + void getBladeRefPositions(double* bldRefPos, int iTurbGlob, int nSize=6); + //! Get the blade root reference positions array 'bldRootRefPos' of turbine number 'iTurbGlob' + void getBladeRootRefPositions(double* bldRootRefPos, int iTurbGlob, int nSize=6); + //! Get the blade deflections array 'bldDefl' of turbine number 'iTurbGlob' at time step 't' + void getBladeDisplacements(double* bldDefl, double* bldVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the blade root deflections array 'bldRootDefl' of turbine number 'iTurbGlob' at time step 't' + void getBladeRootDisplacements(double* bldRootDefl, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the blade pitch 'bldPitch' of turbine number 'iTurbGlob' + void getBladePitch(double* bldPitch, int iTurbGlob, int nSize=3); + //! Get the tower reference positions array 'twrRefPos' of turbine number 'iTurbGlob' + void getTowerRefPositions(double* twrRefPos, int iTurbGlob, int nSize=6); + //! Get the tower deflections array 'twrDefl' of turbine number 'iTurbGlob' at time step 't' + void getTowerDisplacements(double* twrDefl, double* twrVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the hub reference position array 'hubRefPos' of turbine number 'iTurbGlob' + void getHubRefPosition(double* hubRefPos, int iTurbGlob, int nSize=6); + //! Get the hub deflections array 'hubDefl' of turbine number 'iTurbGlob' at time step 't' + void getHubDisplacement(double* hubDefl, double* hubVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Get the nacelle reference position array 'nacRefPos' of turbine number 'iTurbGlob' + void getNacelleRefPosition(double* nacRefPos, int iTurbGlob, int nSize=6); + //! Get the nacelle deflections array 'nacDefl' of turbine number 'iTurbGlob' at time step 't' + void getNacelleDisplacement(double* nacDefl, double* nacVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + + //! Set the blade forces array 'bldForce' for blade 'iBlade' of turbine number 'iTurbGlob' at time step 't' + void setBladeForces(double* bldForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + //! Set the tower force array 'twrForce' of turbine number 'iTurbGlob' at time step 't' + void setTowerForces(double* twrForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1, int nSize=6); + + + //! Get all turbine parametric data + void get_turbineParams(int iTurbGlob, turbineDataType & turbData); + //! Get the starting time step of the simulation. Safe to call from every MPI rank. int get_ntStart() { return ntStart; } + //! Return a boolean flag whether the simulation is dryRun. Safe to call from every MPI rank. bool isDryRun() { return dryRun; } + //! Return a boolean flag whether the simulation is debug. Safe to call from every MPI rank. bool isDebug() { return debug; } + //! Get an enum of type 'simStartType' indicating the start type of the simulation. Safe to call from every MPI rank. simStartType get_simStartType() { return simStart; } + //! Is the simulation time zero right now? Safe to call from every MPI rank. bool isTimeZero() { return timeZero; } - int get_procNo(int iTurbGlob) { return turbineMapGlobToProc[iTurbGlob] ; } // Get processor number of a turbine with global id 'iTurbGlob' + //! Get the global MPI rank of the processor containing turbine number 'iTurbGlob'. Safe to call from every MPI rank. + int get_procNo(int iTurbGlob) { return turbineMapGlobToProc[iTurbGlob] ; } + //! Get the local turbine number of the turbine number 'iTurbGlob'. Safe to call from every MPI rank. int get_localTurbNo(int iTurbGlob) { return reverseTurbineMapProcToGlob[iTurbGlob]; } + //! Get the total number of turbines in the simulation. Safe to call from every MPI rank. int get_nTurbinesGlob() { return nTurbinesGlob; } + //! Get the nacelle area of turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. float get_nacelleArea(int iTurbGlob) { return get_nacelleAreaLoc(get_localTurbNo(iTurbGlob)); } + //! Get the nacelle drag coefficient of turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. float get_nacelleCd(int iTurbGlob) { return get_nacelleCdLoc(get_localTurbNo(iTurbGlob)); } + //! Get the air density around turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. float get_airDensity(int iTurbGlob) { return get_airDensityLoc(get_localTurbNo(iTurbGlob)); } + + //! Get the number of blades in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numBlades(int iTurbGlob) { return get_numBladesLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Aerodyn/velocity nodes on each blade in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numVelPtsBlade(int iTurbGlob) { return get_numVelPtsBladeLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Aerodyn/velocity nodes on the tower in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numVelPtsTwr(int iTurbGlob) { return get_numVelPtsTwrLoc(get_localTurbNo(iTurbGlob)); } + //! Get the total number of Aerodyn/velocity nodes in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numVelPts(int iTurbGlob) { return get_numVelPtsLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Actuator/force nodes on each blade in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numForcePtsBlade(int iTurbGlob) { return get_numForcePtsBladeLoc(get_localTurbNo(iTurbGlob)); } + //! Get the number of Actuator/force nodes on the tower in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numForcePtsTwr(int iTurbGlob) { return get_numForcePtsTwrLoc(get_localTurbNo(iTurbGlob)); } + //! Get the total number of Actuator/force nodes in turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. int get_numForcePts(int iTurbGlob) { return get_numForcePtsLoc(get_localTurbNo(iTurbGlob)); } - void computeTorqueThrust(int iTurGlob, std::vector & torque, std::vector & thrust); - + //! Compute the torque and thrust for turbine number 'iTurbGlob'. Must be called only from processor containing the turbine. + void computeTorqueThrust(int iTurGlob, double* torque, double* thrust, int nSize); inline - void getHubPos(std::vector & currentCoords, int iTurbGlob) { - getHubPos(currentCoords.data(), iTurbGlob, currentCoords.size()); + void getApproxHubPos(std::vector& currentCoords, int iTurbGlob) { + getApproxHubPos(currentCoords.data(), iTurbGlob, currentCoords.size()); } inline - void getApproxHubPos(std::vector& currentCoords, int iTurbGlob) { - getApproxHubPos(currentCoords.data(), iTurbGlob, currentCoords.size()); + void getHubPos(std::vector& currentCoords, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getHubPos(currentCoords.data(), iTurbGlob, t, currentCoords.size()); } + inline - void getHubShftDir(std::vector & hubShftVec, int iTurbGlob) { - getHubShftDir(hubShftVec.data(), iTurbGlob, hubShftVec.size()); + void getHubShftDir(std::vector & hubShftVec, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getHubShftDir(hubShftVec.data(), iTurbGlob, t, hubShftVec.size()); } inline - void getVelNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob) { - getVelNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, currentCoords.size()); + void getVelNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getVelNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, t, currentCoords.size()); } inline void setVelocity(std::vector & currentVelocity, int iNode, int iTurbGlob) { - setVelocity(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); + setVelocity(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); } inline void setVelocityForceNode(std::vector & currentVelocity, int iNode, int iTurbGlob) { - setVelocityForceNode(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); + setVelocityForceNode(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); } inline - void getForceNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob) { - getForceNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, currentCoords.size()); + void getForceNodeCoordinates(std::vector & currentCoords, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getForceNodeCoordinates(currentCoords.data(), iNode, iTurbGlob, t, currentCoords.size()); } inline - void getForceNodeOrientation(std::vector & currentOrientation, int iNode, int iTurbGlob) { - getForceNodeOrientation(currentOrientation.data(), iNode, iTurbGlob, currentOrientation.size()); + void getForceNodeOrientation(std::vector & currentOrientation, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getForceNodeOrientation(currentOrientation.data(), iNode, iTurbGlob, t, currentOrientation.size()); } inline - void getForce(std::vector & currentForce, int iNode, int iTurbGlob) { - getForce(currentForce.data(), iNode, iTurbGlob, currentForce.size()); + void getForce(std::vector & currentForce, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getForce(currentForce.data(), iNode, iTurbGlob, t, currentForce.size()); } inline - void getRelativeVelForceNode(std::vector & currentVelocity, int iNode, int iTurbGlob) { - getRelativeVelForceNode(currentVelocity.data(), iNode, iTurbGlob, currentVelocity.size()); + void getRelativeVelForceNode(std::vector & currentVelocity, int iNode, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) { + getRelativeVelForceNode(currentVelocity.data(), iNode, iTurbGlob, t, currentVelocity.size()); } - private: - + inline + void getBladeRefPositions(std::vector & bldRefPos, int iTurbGlob){ + getBladeRefPositions(bldRefPos.data(), nTurbinesGlob); + } + inline + void getBladeDisplacements(std::vector & bldDefl, std::vector & bldVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getBladeDisplacements(bldDefl.data(), bldVel.data(), iTurbGlob, t, bldDefl.size()); + } + inline + void getBladeRootRefPositions(std::vector & bldRootRefPos, int iTurbGlob){ + getBladeRootRefPositions(bldRootRefPos.data(), iTurbGlob); + } + void getBladeRootDisplacements(std::vector & bldRootDefl, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getBladeRootDisplacements(bldRootDefl.data(), iTurbGlob, t, bldRootDefl.size()); + } + inline + void getBladePitch(std::vector & bldPitch, int iTurbGlob) + { + getBladePitch(bldPitch.data(), iTurbGlob, bldPitch.size()); + } + inline + void getTowerRefPositions(std::vector & twrRefPos, int iTurbGlob) + { + getTowerRefPositions(twrRefPos.data(), iTurbGlob, 6); + } + inline + void getTowerDisplacements(std::vector & twrDefl, std::vector & twrVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getTowerDisplacements(twrDefl.data(), twrVel.data(), iTurbGlob, t, twrDefl.size()); + } + inline + void getHubRefPosition(std::vector & hubRefPos, int iTurbGlob) + { + getHubRefPosition(hubRefPos.data(), iTurbGlob, hubRefPos.size()); + } + inline + void getHubDisplacement(std::vector & hubDefl, std::vector & hubVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getHubDisplacement(hubDefl.data(), hubVel.data(), iTurbGlob, t, hubDefl.size()); + } + inline + void getNacelleRefPosition(std::vector & nacRefPos, int iTurbGlob) + { + getNacelleRefPosition(nacRefPos.data(), iTurbGlob, nacRefPos.size()); + } + inline + void getNacelleDisplacement(std::vector & nacDefl, std::vector & nacVel, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + getNacelleDisplacement(nacDefl.data(), nacVel.data(), iTurbGlob, t, nacDefl.size()); + } + + inline + void setBladeForces(std::vector & bldForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + setBladeForces(bldForce.data(), iTurbGlob, t, 6); + } + inline + void setTowerForces(std::vector & twrForce, int iTurbGlob, fast::timeStep t = fast::STATE_NP1) + { + setTowerForces(twrForce.data(), iTurbGlob, t, 6); + } + inline + void computeTorqueThrust(int iTurbGlob, std::vector & torque, std::vector & thrust) + { + computeTorqueThrust(iTurbGlob, torque.data(), thrust.data(), torque.size()); + } + + //! An example function to set velocities at the Aerodyn nodes using a power law wind profile using an exponent of 0.2 and a reference wind speed of 10 m/s at 90 meters. Safe to call from every MPI rank. + void setExpLawWindSpeed(double t) ; // An example to set velocities at the Aerodyn nodes + + //! An example function to set a uniform X force at all blade nodes. Safe to call from every MPI rank. + void setUniformXBladeForces(double loadX); + + +private: + + //! Set state from another state + void set_state_from_state(fast::timeStep fromState, fast::timeStep toState); + + //! Preprare the C+++ output file for a new OpenFAST simulation + void prepareOutputFile(int iTurbLoc); + //! Find the C++ output file for a restarted simulation + void findOutputFile(int iTurbLoc); + //! Write output data to file + void writeOutputFile(int iTurbLoc, int n_t_global); + + //! Find the OpenFAST restart file from the C++ restart file for a restarted simulation + void findRestartFile(int iTurbLoc); + //! Preprare the C+++ restart file for a new OpenFAST simulation + void prepareRestartFile(int iTurbLoc); + + //! Read velocity and force node data at time step 'n', 'n-1' and 'n-2' to allow for a clean restart + void readRestartFile(int iTurbLoc, int n_t_global); + //! Write velocity and force node data at time step 'n', 'n-1' and 'n-2' to allow for a clean restart + void writeRestartFile(int iTurbLoc, int n_t_global); + + //! Create velocity data file in preparation to write velocity data + void prepareVelocityDataFile(int iTurb); + //! Open velocity data file to read velocity data + int openVelocityDataFile(int iTurb); + //! Read the number of nonlinear iterations for a given driver time step + int read_nlin_iters(int iTurb, int iTimestep, int ncid); + //! Read velocity data at the Aerodyn nodes from velocity data file + void readVelocityData(int iTurb, int iTimestep, int iNlinIter, int ncid); + //! Write velocity data at the Aerodyn nodes from velocity data file + void writeVelocityData(int iTurb, int iTimestep, int nlinIter); + + //! Check whether the error status is ok. If not quit gracefully by printing the error message void checkError(const int ErrStat, const char * ErrMsg); + //! Check whether a file with name "name" exists inline bool checkFileExists(const std::string& name); - void allocateMemory(); - - float get_nacelleCdLoc(int iTurbLoc) { return nacelle_cd[iTurbLoc]; } - float get_nacelleAreaLoc(int iTurbLoc) { return nacelle_area[iTurbLoc]; } - float get_airDensityLoc(int iTurbLoc) { return air_density[iTurbLoc]; } - int get_numBladesLoc(int iTurbLoc) { return numBlades[iTurbLoc]; } - int get_numVelPtsBladeLoc(int iTurbLoc) { return numVelPtsBlade[iTurbLoc]; } - int get_numVelPtsTwrLoc(int iTurbLoc) { return numVelPtsTwr[iTurbLoc]; } - int get_numVelPtsLoc(int iTurbLoc) { return 1 + numBlades[iTurbLoc]*numVelPtsBlade[iTurbLoc] + numVelPtsTwr[iTurbLoc]; } - int get_numForcePtsBladeLoc(int iTurbLoc) { return numForcePtsBlade[iTurbLoc]; } - int get_numForcePtsTwrLoc(int iTurbLoc) { return numForcePtsTwr[iTurbLoc]; } - int get_numForcePtsLoc(int iTurbLoc) { return 1 + numBlades[iTurbLoc]*numForcePtsBlade[iTurbLoc] + numForcePtsTwr[iTurbLoc]; } + //! Allocate memory for data structures for all turbines on this processor + void allocateMemory_preInit(); + //! Allocate more memory for each turbine after intialization/restart + void allocateMemory_postInit(int iTurbLoc); + + //! Get the nacelle drag coefficient of local turbine number 'iTurbLoc' + float get_nacelleCdLoc(int iTurbLoc) { return turbineData[iTurbLoc].nacelle_cd; } + //! Get the nacelle area of local turbine number 'iTurbLoc' + float get_nacelleAreaLoc(int iTurbLoc) { return turbineData[iTurbLoc].nacelle_area; } + //! Get the air density around local turbine number 'iTurbLoc' + float get_airDensityLoc(int iTurbLoc) { return turbineData[iTurbLoc].air_density; } + + //! Get the number of blades in local turbine number 'iTurbLoc' + int get_numBladesLoc(int iTurbLoc) { return turbineData[iTurbLoc].numBlades; } + //! Get the number of Aerodyn/velocity nodes on each blade in local turbine number 'iTurbLoc' + int get_numVelPtsBladeLoc(int iTurbLoc) { return turbineData[iTurbLoc].numVelPtsBlade; } + //! Get the number of Aerodyn/velocity nodes on the tower in local turbine number 'iTurbLoc' + int get_numVelPtsTwrLoc(int iTurbLoc) { return turbineData[iTurbLoc].numVelPtsTwr; } + //! Get the total number of Aerodyn/velocity nodes in local turbine number 'iTurbLoc' + int get_numVelPtsLoc(int iTurbLoc) { return turbineData[iTurbLoc].numVelPts; } + //! Get the number of Actuator/force nodes on each blade in local turbine number 'iTurbLoc' + int get_numForcePtsBladeLoc(int iTurbLoc) { return turbineData[iTurbLoc].numForcePtsBlade; } + //! Get the number of Actuator/force nodes on the tower in local turbine number 'iTurbLoc' + int get_numForcePtsTwrLoc(int iTurbLoc) { return turbineData[iTurbLoc].numForcePtsTwr; } + //! Get the total number of Actuator/force nodes in local turbine number 'iTurbLoc' + int get_numForcePtsLoc(int iTurbLoc) { return turbineData[iTurbLoc].numForcePts; } + + //! Get reference positions of blade-resolved FSI nodes from OpenFAST + void get_ref_positions_from_openfast(int iTurb); void loadSuperController(const fastInputs & fi); - void setOutputsToFAST(OpFM_InputType_t cDriver_Input_from_FAST, OpFM_OutputType_t cDriver_Output_to_FAST) ; // An example to set velocities at the Aerodyn nodes - void applyVelocityData(int iPrestart, int iTurb, OpFM_OutputType_t cDriver_Output_to_FAST, std::vector & velData) ; + //! Apply the velocity data at the Aerodyn nodes in 'velData' to turbine number 'iTurb' at time step 'iPrestart' through the data structure 'cDriver_Output_to_FAST' + void applyVelocityData(int iPrestart, int iTurb, ExtInfw_OutputType_t o_t_FAST, std::vector & velData) ; + + //! Compute cross product a x b and store it into aCrossB + void cross(double * a, double * b, double * aCrossB); + //! Apply a Wiener-Milenkovic rotation 'wm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. + void applyWMrotation(double * wm, double * r, double *rRot, double transpose = 1.0); + //! Apply a Direction Cosine Matrix rotation 'dcm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. + void applyDCMrotation(double * dcm, double * r, double *rRot, double transpose = 1.0); }; diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 7a26e2017d..308506a78c 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -1,54 +1,632 @@ #include "OpenFAST.H" #include +#include #include +#include #include #include #include +#include + +inline void check_nc_error(int code, std::string msg) { + if (code != 0) + throw std::runtime_error("OpenFAST C++ API:: NetCDF error: " + msg); +} int fast::OpenFAST::AbortErrLev = ErrID_Fatal; // abort error level; compare with NWTC Library //Constructor fast::fastInputs::fastInputs(): -nTurbinesGlob(0), -dryRun(false), -debug(false), -tStart(-1.0), -nEveryCheckPoint(-1), -tMax(0.0), -dtFAST(0.0), -scStatus(false), -scLibFile("") + nTurbinesGlob(0), + dryRun(false), + debug(false), + tStart(-1.0), + restartFreq(-1), + tMax(0.0), + dtDriver(0.0), + scStatus(false), + scLibFile("") { - //Nothing to do here + //Nothing to do here } +//Constructor +fast::OpenFAST::OpenFAST() +{ + sc = std::unique_ptr(new SuperController); + ncRstVarNames_ = {"time", "rst_filename", "twr_ref_pos", "bld_ref_pos", "nac_ref_pos", "hub_ref_pos", "twr_def", "twr_vel", "twr_ld", "bld_def", "bld_vel", "bld_ld", "hub_def", "hub_vel", "nac_def", "nac_vel", "bld_root_def", "bld_pitch", "x_vel", "xdot_vel", "vel_vel", "x_force", "xdot_force", "orient_force", "vel_force", "force"}; + ncRstDimNames_ = {"n_tsteps", "n_states", "n_twr_data", "n_bld_data", "n_pt_data", "n_bld_root_data", "n_bld_pitch_data", "n_vel_pts_data", "n_force_pts_data", "n_force_pts_orient_data"}; - - -//Constructor -fast::OpenFAST::OpenFAST(): -nTurbinesGlob(0), -nTurbinesProc(0), -scStatus(false), -simStart(fast::init), -timeZero(false) -{ + ncOutVarNames_ = {"time", "twr_ref_pos", "twr_ref_orient", "bld_chord", "bld_rloc", "bld_ref_pos", "bld_ref_orient", "hub_ref_pos", "hub_ref_orient", "nac_ref_pos", "nac_ref_orient", "twr_disp", "twr_orient", "twr_vel", "twr_rotvel", "twr_ld", "twr_moment", "bld_disp", "bld_orient", "bld_vel", "bld_rotvel", "bld_ld", "bld_ld_loc", "bld_moment", "hub_disp", "hub_orient", "hub_vel", "hub_rotvel", "nac_disp", "nac_orient", "nac_vel", "nac_rotvel", "bld_root_ref_pos", "bld_root_ref_orient", "bld_root_disp", "bld_root_orient"}; + ncOutDimNames_ = {"n_tsteps", "n_dim", "n_twr_nds", "n_blds", "n_bld_nds"}; } -fast::OpenFAST::~OpenFAST(){ } - inline bool fast::OpenFAST::checkFileExists(const std::string& name) { struct stat buffer; return (stat (name.c_str(), &buffer) == 0); } +void fast::OpenFAST::findRestartFile(int iTurbLoc) { + + int ncid; + size_t n_tsteps; + size_t count1 = 1; + double latest_time; + + //Find the file and open it in read only mode + std::stringstream rstfile_ss; + rstfile_ss << "turb_" ; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + rstfile_ss << "_rst.nc"; + std::string rst_filename = rstfile_ss.str(); + int ierr = nc_open(rst_filename.c_str(), NC_NOWRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + + for (auto const& dim_name: ncRstDimNames_) { + int tmpDimID; + ierr = nc_inq_dimid(ncid, dim_name.data(), &tmpDimID); + if (ierr == NC_NOERR) + ncRstDimIDs_[dim_name] = tmpDimID; + } + + for (auto const& var_name: ncRstVarNames_) { + int tmpVarID; + ierr = nc_inq_varid(ncid, var_name.data(), &tmpVarID); + if (ierr == NC_NOERR) + ncRstVarIDs_[var_name] = tmpVarID; + } + + ierr = nc_inq_dimlen(ncid, ncRstDimIDs_["n_tsteps"], &n_tsteps); + check_nc_error(ierr, "nc_inq_dimlen"); + n_tsteps -= 1; //To account for 0 based indexing + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["time"], &n_tsteps, &count1, &latest_time); + check_nc_error(ierr, "nc_get_vara_double - getting latest time"); + tStart = latest_time; + + char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + ierr = nc_get_att_text(ncid, NC_GLOBAL, "out_file_root", tmpOutFileRoot); + turbineData[iTurbLoc].outFileRoot.assign(tmpOutFileRoot); + + ierr = nc_get_att_double(ncid, NC_GLOBAL, "dt_fast", &dtFAST); + check_nc_error(ierr, "nc_get_att_double"); + + ierr = nc_get_att_double(ncid, NC_GLOBAL, "dt_driver", &dtDriver); + check_nc_error(ierr, "nc_get_att_double"); + + ierr = nc_get_att_int(ncid, NC_GLOBAL, "output_freq", &outputFreq_); + check_nc_error(ierr, "nc_get_att_int"); + + ierr = nc_get_att_int(ncid, NC_GLOBAL, "restart_freq", &restartFreq_); + check_nc_error(ierr, "nc_get_att_int"); + + int tstep = std::round(latest_time/dtFAST); + + std::stringstream rstfilename; + rstfilename << turbineData[iTurbLoc].outFileRoot << "." << tstep ; + turbineData[iTurbLoc].FASTRestartFileName = rstfilename.str(); + + std::cout << "Restarting from time " << latest_time << " at time step " << tstep << " from file name " << turbineData[iTurbLoc].FASTRestartFileName << std::endl ; + + nc_close(ncid); + +} + +void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { + + int ncid; + //This will destroy any existing file + std::stringstream rstfile_ss; + rstfile_ss << "turb_" ; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + rstfile_ss << "_rst.nc"; + std::string rst_filename = rstfile_ss.str(); + int ierr = nc_create(rst_filename.c_str(), NC_CLOBBER, &ncid); + check_nc_error(ierr, "nc_create"); + + nc_put_att_text(ncid, NC_GLOBAL, "out_file_root", turbineData[iTurbLoc].outFileRoot.size()+1, turbineData[iTurbLoc].outFileRoot.c_str()); + nc_put_att_double(ncid, NC_GLOBAL, "dt_fast", NC_DOUBLE, 1, &dtFAST); + nc_put_att_double(ncid, NC_GLOBAL, "dt_driver", NC_DOUBLE, 1, &dtDriver); + nc_put_att_int(ncid,NC_GLOBAL,"output_freq", NC_INT, 1, &outputFreq_); + nc_put_att_int(ncid,NC_GLOBAL,"restart_freq", NC_INT, 1, &restartFreq_); + + //Define dimensions + int tmpDimID; + ierr = nc_def_dim(ncid, "n_tsteps", NC_UNLIMITED, &tmpDimID); + ncRstDimIDs_["n_tsteps"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_states", 4, &tmpDimID); + ncRstDimIDs_["n_states"] = tmpDimID; + + //Define variables + int tmpVarID; + ierr = nc_def_var(ncid, "time", NC_DOUBLE, 1, &ncRstDimIDs_["n_tsteps"], &tmpVarID); + ncRstVarIDs_["time"] = tmpVarID; + + if (turbineData[iTurbLoc].sType == EXTLOADS) { + + ierr = nc_def_dim(ncid, "n_twr_data", turbineData[iTurbLoc].nBRfsiPtsTwr*6, &tmpDimID); + ncRstDimIDs_["n_twr_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_bld_data", turbineData[iTurbLoc].nTotBRfsiPtsBlade*6, &tmpDimID); + ncRstDimIDs_["n_bld_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_bld_root_data", turbineData[iTurbLoc].numBlades*6, &tmpDimID); + ncRstDimIDs_["n_bld_root_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_bld_pitch_data", turbineData[iTurbLoc].numBlades, &tmpDimID); + ncRstDimIDs_["n_bld_pitch_data"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_pt_data", 6, &tmpDimID); + ncRstDimIDs_["n_pt_data"] = tmpDimID; + + const std::vector twrDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_twr_data"]}; + const std::vector bldDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_data"]}; + const std::vector bldRootDefsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_root_data"]}; + const std::vector bldPitchDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_pitch_data"]}; + const std::vector ptDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_pt_data"],}; + + ierr = nc_def_var(ncid, "twr_def", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["twr_def"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_vel", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["twr_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ld", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["twr_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_def", NC_DOUBLE, 3, bldDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_def"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_vel", NC_DOUBLE, 3, bldDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld", NC_DOUBLE, 3, bldDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_def", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["hub_def"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_vel", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["hub_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_def", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["nac_def"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_vel", NC_DOUBLE, 3, ptDefLoadsDims.data(), &tmpVarID); + ncRstVarIDs_["nac_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_root_def", NC_DOUBLE, 3, bldRootDefsDims.data(), &tmpVarID); + ncRstVarIDs_["bld_root_def"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_pitch", NC_DOUBLE, 3, bldPitchDims.data(), &tmpVarID); + ncRstVarIDs_["bld_pitch"] = tmpVarID; + + } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + ierr = nc_def_dim(ncid, "n_vel_pts_data", turbineData[iTurbLoc].numVelPts*3, &tmpDimID); + ncRstDimIDs_["n_vel_pts_data"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_force_pts_data", turbineData[iTurbLoc].numForcePts*3, &tmpDimID); + ncRstDimIDs_["n_force_pts_data"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_force_pts_orient_data", turbineData[iTurbLoc].numForcePts*9, &tmpDimID); + ncRstDimIDs_["n_force_pts_orient_data"] = tmpDimID; + + const std::vector velPtsDataDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_vel_pts_data"]}; + const std::vector forcePtsDataDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_force_pts_data"],}; + const std::vector forcePtsOrientDataDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_force_pts_orient_data"],}; + + ierr = nc_def_var(ncid, "x_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["x_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "xdot_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["xdot_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "vel_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["vel_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "xref_force", NC_DOUBLE, 1, &ncRstDimIDs_["n_force_pts_data"], &tmpVarID); + ncRstVarIDs_["xref_force"] = tmpVarID; + ierr = nc_def_var(ncid, "x_force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["x_force"] = tmpVarID; + ierr = nc_def_var(ncid, "xdot_force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["xdot_force"] = tmpVarID; + ierr = nc_def_var(ncid, "vel_force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["vel_force"] = tmpVarID; + ierr = nc_def_var(ncid, "force", NC_DOUBLE, 3, forcePtsDataDims.data(), &tmpVarID); + ncRstVarIDs_["force"] = tmpVarID; + ierr = nc_def_var(ncid, "orient_force", NC_DOUBLE, 3, forcePtsOrientDataDims.data(), &tmpVarID); + ncRstVarIDs_["orient_force"] = tmpVarID; + + } + + //! Indicate that we are done defining variables, ready to write data + ierr = nc_enddef(ncid); + check_nc_error(ierr, "nc_enddef"); + + if (turbineData[iTurbLoc].sType == EXTINFLOW) { + int nfpts_data = 3*get_numForcePtsLoc(iTurbLoc); + int ierr = nc_put_var_double(ncid, ncRstVarIDs_["xref_force"], velForceNodeData[iTurbLoc][fast::STATE_NP1].xref_force.data()); + } + + ierr = nc_close(ncid); + check_nc_error(ierr, "nc_close"); + + +} + +void fast::OpenFAST::findOutputFile(int iTurbLoc) { + + int ncid; + size_t n_tsteps; + size_t count1 = 1; + double latest_time; + + //Find the file and open it in read only mode + std::stringstream outfile_ss; + outfile_ss << "turb_" ; + outfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + outfile_ss << "_output.nc"; + std::string out_filename = outfile_ss.str(); + int ierr = nc_open(out_filename.c_str(), NC_NOWRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + + for (auto const& dim_name: ncOutDimNames_) { + int tmpDimID; + ierr = nc_inq_dimid(ncid, dim_name.data(), &tmpDimID); + if (ierr == NC_NOERR) + ncOutDimIDs_[dim_name] = tmpDimID; + } + + for (auto const& var_name: ncOutVarNames_) { + int tmpVarID; + ierr = nc_inq_varid(ncid, var_name.data(), &tmpVarID); + if (ierr == NC_NOERR) + ncOutVarIDs_[var_name] = tmpVarID; + } + + ierr = nc_inq_dimlen(ncid, ncOutDimIDs_["n_tsteps"], &n_tsteps); + check_nc_error(ierr, "nc_inq_dimlen"); + n_tsteps -= 1; //To account for 0 based indexing + ierr = nc_get_vara_double(ncid, ncOutVarIDs_["time"], &n_tsteps, &count1, &latest_time); + check_nc_error(ierr, "nc_get_vara_double - getting latest time"); + nc_close(ncid); + +} + +void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { + + int ncid; + //Create the file - this will destory any file + std::stringstream defloads_fstream; + defloads_fstream << "turb_" ; + defloads_fstream << std::setfill('0') << std::setw(2) << iTurbLoc; + defloads_fstream << "_output.nc"; + std::string defloads_filename = defloads_fstream.str(); + int ierr = nc_create(defloads_filename.c_str(), NC_CLOBBER, &ncid); + check_nc_error(ierr, "nc_create"); + + //Define dimensions + int tmpDimID; + ierr = nc_def_dim(ncid, "n_dim", 3, &tmpDimID); + ncOutDimIDs_["n_dim"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_tsteps", NC_UNLIMITED, &tmpDimID); + ncOutDimIDs_["n_tsteps"] = tmpDimID; + + //Now define variables + int tmpVarID; + ierr = nc_def_var(ncid, "time", NC_DOUBLE, 1, &ncOutDimIDs_["n_tsteps"], &tmpVarID); + ncOutVarIDs_["time"] = tmpVarID; + + if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBlades = turbineData[iTurbLoc].numBlades; + int nTwrPts = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBldPts = nTotBldPts/nBlades; + + ierr = nc_def_dim(ncid, "n_twr_nds", nTwrPts, &tmpDimID); + ncOutDimIDs_["n_twr_nds"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_blds", nBlades, &tmpDimID); + ncOutDimIDs_["n_blds"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_bld_nds", nBldPts, &tmpDimID); + ncOutDimIDs_["n_bld_nds"] = tmpDimID; + + const std::vector twrRefDims{ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector twrDefLoadsDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector bldParamDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRefDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRootRefDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"]}; + const std::vector bldDefLoadsDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRootDefDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"]}; + const std::vector ptRefDims{ncOutDimIDs_["n_dim"]}; + const std::vector ptDefLoadsDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"]}; + + ierr = nc_def_var(ncid, "twr_ref_pos", NC_DOUBLE, 2, twrRefDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ref_orient", NC_DOUBLE, 2, twrRefDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ref_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_chord", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_chord"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_rloc", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_rloc"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ref_pos", NC_DOUBLE, 3, bldRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ref_orient", NC_DOUBLE, 3, bldRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ref_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_root_ref_pos", NC_DOUBLE, 2, bldRootRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_root_ref_orient", NC_DOUBLE, 2, bldRootRefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_ref_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["hub_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_ref_orient", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["hub_ref_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["nac_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_ref_orient", NC_DOUBLE, 1, ptRefDims.data(), &tmpVarID); + ncOutVarIDs_["nac_ref_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "twr_disp", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_orient", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_vel", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_rotvel", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_rotvel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ld", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_moment", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["twr_moment"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_disp", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_orient", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_vel", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_rotvel", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_rotvel"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_root_disp", NC_DOUBLE, 3, bldRootDefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_root_orient", NC_DOUBLE, 3, bldRootDefDims.data(), &tmpVarID); + ncOutVarIDs_["bld_root_orient"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_ld", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld_loc", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld_loc"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_moment", NC_DOUBLE, 4, bldDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["bld_moment"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_disp", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_orient", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_vel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_rotvel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["hub_rotvel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_disp", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_orient", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_orient"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_vel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_rotvel", NC_DOUBLE, 2, ptDefLoadsDims.data(), &tmpVarID); + ncOutVarIDs_["nac_rotvel"] = tmpVarID; + + } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + int nBlades = get_numBladesLoc(iTurbLoc); + int nBldPts = get_numForcePtsBladeLoc(iTurbLoc); + int nTwrPts = get_numForcePtsTwrLoc(iTurbLoc); + + ierr = nc_def_dim(ncid, "n_twr_nds", nTwrPts, &tmpDimID); + ncOutDimIDs_["n_twr_nds"] = tmpDimID; + ierr = nc_def_dim(ncid,"n_blds", nBlades, &tmpDimID); + ncOutDimIDs_["n_blds"] = tmpDimID; + ierr = nc_def_dim(ncid, "n_bld_nds", nBldPts, &tmpDimID); + ncOutDimIDs_["n_bld_nds"] = tmpDimID; + + const std::vector twrRefDataDims{ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector twrDataDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_twr_nds"]}; + const std::vector bldParamDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldRefDataDims{ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector bldDataDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_blds"], ncOutDimIDs_["n_dim"], ncOutDimIDs_["n_bld_nds"]}; + const std::vector ptRefDataDims{ncOutDimIDs_["n_dim"]}; + const std::vector ptDataDims{ncOutDimIDs_["n_tsteps"], ncOutDimIDs_["n_dim"]}; + + ierr = nc_def_var(ncid, "bld_chord", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_chord"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_rloc", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); + ncOutVarIDs_["bld_rloc"] = tmpVarID; + + ierr = nc_def_var(ncid, "twr_ref_pos", NC_DOUBLE, 2, twrRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_disp", NC_DOUBLE, 3, twrDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_vel", NC_DOUBLE, 3, twrDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "twr_ld", NC_DOUBLE, 3, twrDataDims.data(), &tmpVarID); + ncOutVarIDs_["twr_ld"] = tmpVarID; + + ierr = nc_def_var(ncid, "bld_ref_pos", NC_DOUBLE, 3, bldRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_disp", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_vel", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld"] = tmpVarID; + ierr = nc_def_var(ncid, "bld_ld_loc", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); + ncOutVarIDs_["bld_ld_loc"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 2, ptRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_vel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "hub_rotvel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["hub_rotvel"] = tmpVarID; + + ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 2, ptRefDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_ref_pos"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_disp"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_vel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_vel"] = tmpVarID; + ierr = nc_def_var(ncid, "nac_rotvel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); + ncOutVarIDs_["nac_rotvel"] = tmpVarID; + + } + + //! Indicate that we are done defining variables, ready to write data + ierr = nc_enddef(ncid); + check_nc_error(ierr, "nc_enddef"); + + if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBlades = turbineData[iTurbLoc].numBlades; + int nTwrPts = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBldPts = nTotBldPts/nBlades; + + std::vector tmpArray; + + tmpArray.resize(nTwrPts); + { + std::vector count_dim{1,static_cast(nTwrPts)}; + for (size_t idim=0;idim < 3; idim++) { + for (size_t i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ref_pos[i*6+idim]; + std::vector start_dim{idim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ref_pos"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + for (size_t idim=0;idim < 3; idim++) { + for (size_t i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ref_pos[i*6+3+idim]; + std::vector start_dim{idim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ref_orient"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + } + + tmpArray.resize(nBldPts); + { + std::vector count_dim{1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ref_pos[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ref_pos"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ref_pos[(iStart*6)+iDim+3]; + iStart++; + } + std::vector start_dim{iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ref_orient"], start_dim.data(), + count_dim.data(), tmpArray.data()); + } + } + + std::vector param_count_dim{1,static_cast(nBldPts)}; + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (size_t i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_chord[iStart]; + iStart++; + } + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_chord"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (size_t i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_rloc[iStart]; + iStart++; + } + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_rloc"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + } + + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + std::vector start_dim{iBlade,0}; + std::vector count_dim{1,3}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_ref_pos"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_ref_pos[iBlade*6+0]); + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_ref_orient"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_ref_pos[iBlade*6+3]); + } + + ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_pos"], + &brFSIData[iTurbLoc][3].nac_ref_pos[0]); + ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_orient"], + &brFSIData[iTurbLoc][3].nac_ref_pos[3]); + + ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_pos"], + &brFSIData[iTurbLoc][3].hub_ref_pos[0]); + ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_orient"], + &brFSIData[iTurbLoc][3].hub_ref_pos[3]); + + } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + int nBlades = get_numBladesLoc(iTurbLoc); + int nBldPts = get_numForcePtsBladeLoc(iTurbLoc); + int nTwrPts = get_numForcePtsTwrLoc(iTurbLoc); + + std::vector tmpArray; + + { + + tmpArray.resize(nBldPts); + std::vector count_dim{1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ref_pos"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + std::vector param_count_dim{1,static_cast(nBldPts)}; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int iStart = 1 + iBlade*nBldPts; + for (size_t i=0; i < nBldPts; i++) + tmpArray[i] = extinfw_i_f_FAST[iTurbLoc].forceNodesChord[iStart+i]; + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_chord"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int iStart = 1 + iBlade*nBldPts; + for (size_t i=0; i < nBldPts; i++) + tmpArray[i] = extinfw_i_f_FAST[iTurbLoc].forceRHloc[iStart+i]; + std::vector start_dim{iBlade,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_rloc"], start_dim.data(), + param_count_dim.data(), tmpArray.data()); + } + } + } + + ierr = nc_close(ncid); + check_nc_error(ierr, "nc_close"); + +} + + void fast::OpenFAST::init() { - // Temporary buffer to pass filenames to OpenFAST fortran subroutines - char currentFileName[INTERFACE_STRING_LENGTH]; + // Temporary buffer to pass filenames to OpenFAST fortran subroutines + char currentFileName[INTERFACE_STRING_LENGTH]; - allocateMemory(); + allocateMemory_preInit(); if (!dryRun) { switch (simStart) { @@ -56,36 +634,31 @@ void fast::OpenFAST::init() { case fast::trueRestart: for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - /* note that this will set nt_global inside the FAST library */ - std::copy( - CheckpointFileRoot[iTurb].data(), - CheckpointFileRoot[iTurb].data() + (CheckpointFileRoot[iTurb].size() + 1), - currentFileName - ); - FAST_OpFM_Restart( - &iTurb, - currentFileName, - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &ntStart, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); + + findRestartFile(iTurb); + findOutputFile(iTurb); + char tmpRstFileRoot[INTERFACE_STRING_LENGTH]; + strncpy(tmpRstFileRoot, turbineData[iTurb].FASTRestartFileName.c_str(), turbineData[iTurb].FASTRestartFileName.size()); + tmpRstFileRoot[turbineData[iTurb].FASTRestartFileName.size()] = '\0'; + if (turbineData[iTurb].sType == EXTINFLOW) { + /* note that this will set nt_global inside the FAST library */ + FAST_AL_CFD_Restart(&iTurb, tmpRstFileRoot, &AbortErrLev, &turbineData[iTurb].dt, &turbineData[iTurb].inflowType, &turbineData[iTurb].numBlades, &turbineData[iTurb].numVelPtsBlade, &turbineData[iTurb].numVelPtsTwr, &ntStart, &extinfw_i_f_FAST[iTurb], &extinfw_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + } else if(turbineData[iTurb].sType == EXTLOADS) { + FAST_BR_CFD_Restart(&iTurb, tmpRstFileRoot, &AbortErrLev, &turbineData[iTurb].dt, &turbineData[iTurb].numBlades, &ntStart, &extld_i_f_FAST[iTurb], &extld_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + turbineData[iTurb].inflowType = 0; + } + nt_global = ntStart; + allocateMemory_postInit(iTurb); - int nfpts = get_numForcePtsLoc(iTurb); - forceNodeVel[iTurb].resize(nfpts); - for (int k = 0; k < nfpts; k++) forceNodeVel[iTurb][k].resize(3) ; - } + get_ref_positions_from_openfast(iTurb); + + readRestartFile(iTurb, nt_global); - if (nTurbinesProc > 0) velNodeDataFile = openVelocityDataFile(false); + } + checkAndSetSubsteps(); if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; @@ -96,373 +669,796 @@ void fast::OpenFAST::init() { case fast::init: - sc.init(scio, nTurbinesProc); + sc->init(scio, nTurbinesProc); if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.init_sc(scio, nTurbinesProc, turbineMapProcToGlob, fastMPIComm); // sc.calcOutputs_n(0.0); - } - - // this calls the Init() routines of each module + } // this calls the Init() routines of each module for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - int nodeClusterType = 0; - if (forcePtsBladeDistributionType[iTurb] == "chordClustered") - { - nodeClusterType = 1; - } - std::copy( - FASTInputFileName[iTurb].data(), - FASTInputFileName[iTurb].data() + (FASTInputFileName[iTurb].size() + 1), - currentFileName - ); - FAST_OpFM_Init( - &iTurb, - &tMax, - currentFileName, - &TurbID[iTurb], - &scio.nSC2CtrlGlob, - &scio.nSC2Ctrl, - &scio.nCtrl2SC, - scio.from_SCglob.data(), - scio.from_SC[iTurb].data(), - &numForcePtsBlade[iTurb], - &numForcePtsTwr[iTurb], - TurbineBasePos[iTurb].data(), - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &nodeClusterType, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); - timeZero = true; + char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + if (turbineData[iTurb].sType == EXTINFLOW) { + + std::copy( + turbineData[iTurb].FASTInputFileName.data(), + turbineData[iTurb].FASTInputFileName.data() + (turbineData[iTurb].FASTInputFileName.size() + 1), + currentFileName + ); + FAST_AL_CFD_Init( &iTurb, &tMax, turbineData[iTurb].FASTInputFileName.data(), &turbineData[iTurb].TurbID, tmpOutFileRoot, &scio.nSC2CtrlGlob, &scio.nSC2Ctrl, &scio.nCtrl2SC, scio.from_SCglob.data(), scio.from_SC[iTurb].data(), &turbineData[iTurb].numForcePtsBlade, &turbineData[iTurb].numForcePtsTwr, turbineData[iTurb].TurbineBasePos.data(), &AbortErrLev, &dtDriver, &turbineData[iTurb].dt, &turbineData[iTurb].inflowType, &turbineData[iTurb].numBlades, &turbineData[iTurb].numVelPtsBlade, &turbineData[iTurb].numVelPtsTwr, &extinfw_i_f_FAST[iTurb], &extinfw_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + turbineData[iTurb].numVelPtsTwr = extinfw_o_t_FAST[iTurb].u_Len - turbineData[iTurb].numBlades*turbineData[iTurb].numVelPtsBlade - 1; + if(turbineData[iTurb].numVelPtsTwr == 0) { + turbineData[iTurb].numForcePtsTwr = 0; + std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; + } - numVelPtsTwr[iTurb] = cDriver_Output_to_FAST[iTurb].u_Len - numBlades[iTurb]*numVelPtsBlade[iTurb] - 1; - if(numVelPtsTwr[iTurb] == 0) { - numForcePtsTwr[iTurb] = 0; - std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; - } + } else if(turbineData[iTurb].sType == EXTLOADS) { - int nfpts = get_numForcePtsLoc(iTurb); - forceNodeVel[iTurb].resize(nfpts); - for (int k = 0; k < nfpts; k++) forceNodeVel[iTurb][k].resize(3) ; + FAST_BR_CFD_Init(&iTurb, &tMax, turbineData[iTurb].FASTInputFileName.data(), &turbineData[iTurb].TurbID, tmpOutFileRoot, turbineData[iTurb].TurbineBasePos.data(), &AbortErrLev, &dtDriver, &turbineData[iTurb].dt, &turbineData[iTurb].numBlades, &turbineData[iTurb].azBlendMean, &turbineData[iTurb].azBlendDelta, &turbineData[iTurb].velMean, &turbineData[iTurb].windDir, &turbineData[iTurb].zRef, &turbineData[iTurb].shearExp, &extld_i_f_FAST[iTurb], &extld_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + turbineData[iTurb].inflowType = 0; - if ( isDebug() ) { - for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { - std::cout << "Node " << iNode << " Position = " << cDriver_Input_from_FAST[iTurb].pxVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pyVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pzVel[iNode] << " " << std::endl ; - } } - } + timeZero = true; + + turbineData[iTurb].outFileRoot.assign(tmpOutFileRoot, strlen(tmpOutFileRoot)); + + allocateMemory_postInit(iTurb); - if (nTurbinesProc > 0) velNodeDataFile = openVelocityDataFile(true); + get_data_from_openfast(fast::STATE_NM2); + get_data_from_openfast(fast::STATE_NM1); + get_data_from_openfast(fast::STATE_N); + get_data_from_openfast(fast::STATE_NP1); + + get_ref_positions_from_openfast(iTurb); + + } + timeZero = true; + checkAndSetSubsteps(); break ; case fast::restartDriverInitFAST: - sc.init(scio, nTurbinesProc); + //sc->init(scio, nTurbinesProc); if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.init_sc(scio, nTurbinesProc, turbineMapProcToGlob, fastMPIComm); // sc.calcOutputs_n(0.0); } - + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - int nodeClusterType = 0; - if (forcePtsBladeDistributionType[iTurb] == "chordClustered") - { - nodeClusterType = 1; - } - std::copy( - FASTInputFileName[iTurb].data(), - FASTInputFileName[iTurb].data() + (FASTInputFileName[iTurb].size() + 1), - currentFileName - ); - FAST_OpFM_Init( - &iTurb, - &tMax, - currentFileName, - &TurbID[iTurb], - &scio.nSC2CtrlGlob, - &scio.nSC2Ctrl, - &scio.nCtrl2SC, - scio.from_SCglob.data(), - scio.from_SC[iTurb].data(), - &numForcePtsBlade[iTurb], - &numForcePtsTwr[iTurb], - TurbineBasePos[iTurb].data(), - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &nodeClusterType, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); - timeZero = true; + findOutputFile(iTurb); + findRestartFile(iTurb); + char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + if (turbineData[iTurb].sType == EXTINFLOW) { - numVelPtsTwr[iTurb] = cDriver_Output_to_FAST[iTurb].u_Len - numBlades[iTurb]*numVelPtsBlade[iTurb] - 1; - if(numVelPtsTwr[iTurb] == 0) { - numForcePtsTwr[iTurb] = 0; - std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; - } + std::copy( + turbineData[iTurb].FASTInputFileName.data(), + turbineData[iTurb].FASTInputFileName.data() + (turbineData[iTurb].FASTInputFileName.size() + 1), + currentFileName + ); + FAST_AL_CFD_Init( &iTurb, &tMax, turbineData[iTurb].FASTInputFileName.data(), &turbineData[iTurb].TurbID, tmpOutFileRoot, &scio.nSC2CtrlGlob, &scio.nSC2Ctrl, &scio.nCtrl2SC, scio.from_SCglob.data(), scio.from_SC[iTurb].data(), &turbineData[iTurb].numForcePtsBlade, &turbineData[iTurb].numForcePtsTwr, turbineData[iTurb].TurbineBasePos.data(), &AbortErrLev, &dtDriver, &turbineData[iTurb].dt, &turbineData[iTurb].inflowType, &turbineData[iTurb].numBlades, &turbineData[iTurb].numVelPtsBlade, &turbineData[iTurb].numVelPtsTwr, &extinfw_i_f_FAST[iTurb], &extinfw_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); - int nfpts = get_numForcePtsLoc(iTurb); - forceNodeVel[iTurb].resize(nfpts); - for (int k = 0; k < nfpts; k++) forceNodeVel[iTurb][k].resize(3) ; + checkError(ErrStat, ErrMsg); - if ( isDebug() ) { - for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { - std::cout << "Node " << iNode << " Position = " << cDriver_Input_from_FAST[iTurb].pxVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pyVel[iNode] << " " << cDriver_Input_from_FAST[iTurb].pzVel[iNode] << " " << std::endl ; + timeZero = true; + + turbineData[iTurb].numVelPtsTwr = extinfw_o_t_FAST[iTurb].u_Len - turbineData[iTurb].numBlades*turbineData[iTurb].numVelPtsBlade - 1; + if(turbineData[iTurb].numVelPtsTwr == 0) { + turbineData[iTurb].numForcePtsTwr = 0; + std::cout << "Aerodyn doesn't want to calculate forces on the tower. All actuator points on the tower are turned off for turbine " << turbineMapProcToGlob[iTurb] << "." << std::endl ; } - } - } - int nTimesteps; + allocateMemory_postInit(iTurb); - if (nTurbinesProc > 0) { - readVelocityData(ntStart); - } - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - applyVelocityData(0, iTurb, cDriver_Output_to_FAST[iTurb], velNodeData[iTurb]); - } - solution0() ; + get_data_from_openfast(fast::STATE_NM2); + get_data_from_openfast(fast::STATE_NM1); + get_data_from_openfast(fast::STATE_N); + get_data_from_openfast(fast::STATE_NP1); - for (int iPrestart=0 ; iPrestart < ntStart; iPrestart++) { - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - applyVelocityData(iPrestart, iTurb, cDriver_Output_to_FAST[iTurb], velNodeData[iTurb]); + get_ref_positions_from_openfast(iTurb); + + checkAndSetSubsteps(); + + ntStart = int(tStart/dtFAST); + int ntStartDriver; + if( (dtFAST > 0) && (nSubsteps_ > 0)) + ntStartDriver = int(tStart/dtFAST/nSubsteps_); + else + ntStartDriver = 0; //Typically for processors that don't contain any turbines + + std::vector velfile_ncid; + velfile_ncid.resize(nTurbinesProc); + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + velfile_ncid[iTurb] = openVelocityDataFile(iTurb); + readVelocityData(iTurb, 0, 0, velfile_ncid[iTurb]); + } + + int nVelPts = get_numVelPtsLoc(iTurb); + std::cout << std::endl ; + std::cout << "nt_global = " << 0 << " nlin_iter = " << 0 << std::endl ; + for (size_t k = 0; k < nVelPts; k++) + std::cout << k << ", " << velForceNodeData[iTurb][3].vel_vel[k*3 + 0] << " " << velForceNodeData[iTurb][3].vel_vel[k*3 + 1] << " " << velForceNodeData[iTurb][3].vel_vel[k*3 + 2] << " " << std::endl ; + + init_velForceNodeData(); + + solution0(false) ; + + for (int iPrestart=0 ; iPrestart < ntStartDriver; iPrestart++) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int nlinIters = read_nlin_iters(iTurb, iPrestart+1, velfile_ncid[iTurb]); + for (int iNlin=0; iNlin < nlinIters; iNlin++) { + readVelocityData(iTurb, iPrestart+1, iNlin, velfile_ncid[iTurb]); + update_states_driver_time_step(false); + } + advance_to_next_driver_time_step(false); + } + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) + nc_close(velfile_ncid[iTurb]); + + readRestartFile(iTurb, nt_global); + + } else { + + throw std::runtime_error("RESTARTDRIVERINITFAST option not supported for blade-resolved FSI yet"); } - stepNoWrite(); } - if (nTurbinesProc > 0) velNodeDataFile = openVelocityDataFile(false); - break; case fast::simStartType_END: break; - } + } } -void fast::OpenFAST::solution0() { +void fast::OpenFAST::solution0(bool writeFiles) { if (!dryRun) { - // set wind speeds at initial locations - // for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - // setOutputsToFAST(cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); - // } if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.fastSCInputOutput(); } + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + prepareRestartFile(iTurb); + prepareOutputFile(iTurb); + prepareVelocityDataFile(iTurb); + } + } + + // Unfortunately setVelocity only sets the velocity at 'n+1'. Need to copy 'n+1' to 'n' + init_velForceNodeData() ; + send_data_to_openfast(fast::STATE_NP1); + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_OpFM_Solution0(&iTurb, &ErrStat, ErrMsg); + + FAST_CFD_Solution0(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + FAST_CFD_InitIOarrays_SS(&iTurb, &ErrStat, ErrMsg); checkError(ErrStat, ErrMsg); } + get_data_from_openfast(fast::STATE_N); + get_data_from_openfast(fast::STATE_NM1); + get_data_from_openfast(fast::STATE_NM2); + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (turbineData[iTurb].inflowType == 2) + writeVelocityData(iTurb, -nSubsteps_, 0); + } + } + timeZero = false; if (scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; // sc.calcOutputs_n(0.0); // sc.fastSCInputOutput(); } } -} -void fast::OpenFAST::step() { +} - /* ****************************** - set inputs from this code and call FAST: - ********************************* */ +void fast::OpenFAST::set_state_from_state(fast::timeStep fromState, fast::timeStep toState) { for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - // set wind speeds at original locations - // setOutputsToFAST(cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); - - // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: - // (note OpenFOAM could do subcycling around this step) - - writeVelocityData(velNodeDataFile, iTurb, nt_global, cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); - - if ( isDebug() ) { - - std::ofstream fastcpp_velocity_file; - fastcpp_velocity_file.open("fastcpp_velocity.csv") ; - fastcpp_velocity_file << "# x, y, z, Vx, Vy, Vz" << std::endl ; - for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { - fastcpp_velocity_file << cDriver_Input_from_FAST[iTurb].pxVel[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pyVel[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pzVel[iNode] << ", " << cDriver_Output_to_FAST[iTurb].u[iNode] << ", " << cDriver_Output_to_FAST[iTurb].v[iNode] << ", " << cDriver_Output_to_FAST[iTurb].w[iNode] << " " << std::endl ; + if (turbineData[iTurb].sType == EXTINFLOW) { + int nvelpts = get_numVelPtsLoc(iTurb); + int nfpts = get_numForcePtsLoc(iTurb); + for (int i=0; i0.) { - calc_nacelle_force ( - cDriver_Output_to_FAST[iTurb].u[0], - cDriver_Output_to_FAST[iTurb].v[0], - cDriver_Output_to_FAST[iTurb].w[0], - nacelle_cd[iTurb], - nacelle_area[iTurb], - air_density[iTurb], - cDriver_Input_from_FAST[iTurb].fx[0], - cDriver_Input_from_FAST[iTurb].fy[0], - cDriver_Input_from_FAST[iTurb].fz[0] - ); - } - - if ( isDebug() ) { - std::ofstream actuatorForcesFile; - actuatorForcesFile.open("actuator_forces.csv") ; - actuatorForcesFile << "# x, y, z, fx, fy, fz" << std::endl ; - for (int iNode=0; iNode < get_numForcePtsLoc(iTurb); iNode++) { - actuatorForcesFile << cDriver_Input_from_FAST[iTurb].pxForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pyForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pzForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fx[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fy[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fz[iNode] << " " << std::endl ; + for (int i=0; i. - char dummyCheckPointRoot[INTERFACE_STRING_LENGTH] = " "; - // Ensure that we have a null character - dummyCheckPointRoot[1] = 0; +void fast::OpenFAST::init_velForceNodeData() { - if (nTurbinesProc > 0) backupVelocityDataFile(nt_global, velNodeDataFile); + set_state_from_state(fast::STATE_NP1, fast::STATE_N); + set_state_from_state(fast::STATE_NP1, fast::STATE_NM1); + set_state_from_state(fast::STATE_NP1, fast::STATE_NM2); - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_CreateCheckpoint(&iTurb, dummyCheckPointRoot, &ErrStat, ErrMsg); - checkError(ErrStat, ErrMsg); - } - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // if (fastMPIRank == 0) { - // sc.writeRestartFile(nt_global); - // } - } - } } -void fast::OpenFAST::stepNoWrite() { +//! Dot product of two vectors +double dot(double * a, double * b) { - /* ****************************** - set inputs from this code and call FAST: - ********************************* */ + return (a[0]*b[0] + a[1]*b[1] + a[2]*b[2]); - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { +} - // set wind speeds at original locations - // setOutputsToFAST(cDriver_Input_from_FAST[iTurb], cDriver_Output_to_FAST[iTurb]); +//! Cross product of two vectors +void cross(double * a, double * b, double * aCrossb) { - // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: - // (note OpenFOAM could do subcycling around this step) - FAST_OpFM_Step(&iTurb, &ErrStat, ErrMsg); - checkError(ErrStat, ErrMsg); + aCrossb[0] = a[1]*b[2] - a[2]*b[1]; + aCrossb[1] = a[2]*b[0] - a[0]*b[2]; + aCrossb[2] = a[0]*b[1] - a[1]*b[0]; - } +} - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // sc.updateStates( nt_global * dtFAST); // Predict state at 'n+1' based on inputs - // sc.calcOutputs_np1( (nt_global+1) * dtFAST); - // sc.fastSCInputOutput(); - } +//! Compose Wiener-Milenkovic parameters 'p' and 'q' into 'pPlusq'. If a transpose of 'p' is required, set tranposeP to '-1', else leave blank or set to '+1' +void composeWM(double * p, double * q, double * pPlusq, double transposeP, double transposeQ) { - nt_global = nt_global + 1; + double p0 = 2.0 - 0.125*dot(p,p); + double q0 = 2.0 - 0.125*dot(q,q); + std::vector pCrossq(3,0.0); + cross(p, q, pCrossq.data()); + + double delta1 = (4.0-p0)*(4.0-q0); + double delta2 = p0*q0 - transposeP*dot(p,q); + double premultFac = 0.0; + if (delta2 < 0) + premultFac = -4.0/(delta1 - delta2); + else + premultFac = 4.0/(delta1 + delta2); + + for (size_t i=0; i < 3; i++) + pPlusq[i] = premultFac * (transposeQ * p0 * q[i] + transposeP * q0 * p[i] + transposeP * transposeQ * pCrossq[i] ); - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // sc.advanceTime(); // Advance states, inputs and outputs from 'n' to 'n+1' - } } -void fast::OpenFAST::calc_nacelle_force(const float & u, const float & v, const float & w, const float & cd, const float & area, const float & rho, float & fx, float & fy, float & fz) { - // Calculate the force on the nacelle (fx,fy,fz) given the - // velocity sampled at the nacelle point (u,v,w), - // drag coefficient 'cd' and nacelle area 'area' +//! Extrapolate Wiener-Milenkovic parameters from state 'nm2', 'nm1', 'n' to 'np1' +void extrapRotation(double *rnm2, double *rnm1, double *rn, double *rnp1) { - // The velocity magnitude - float Vmag = std::sqrt(u * u + v * v + w * w); + std::array rrnm1{ {0.0,0.0,0.0} }; + std::array rrn{ {0.0,0.0,0.0} }; + std::array rrnp1{ {0.0,0.0,0.0} }; - // Velocity correction based on Martinez-Tossas PhD Thesis 2017 - // The correction samples the velocity at the center of the - // Gaussian kernel and scales it to obtain the inflow velocity - float epsilon_d = std::sqrt(2.0 / M_PI * cd * area); - float correction = 1. / (1.0 - cd * area / (4.0 * M_PI * epsilon_d * epsilon_d)); + composeWM(rnm2, rnm1, rrnm1.data(), -1.0, 1.0); // Remove rigid body rotaiton of rnm2 from rnm1 + composeWM(rnm2, rn, rrn.data(), -1.0, 1.0); // Remove rigid body rotaiton of rnm2 from rnm1 + for(int i=0; i<3; i++) { + rrnp1[i] = 3.0 * ( rrn[i] - rrnm1[i]) ; + } + composeWM(rnm2, rrnp1.data(), rnp1, 1.0, 1.0); //Add rigid body rotation of nm2 back - // Compute the force for each velocity component - fx = rho * 1./2. * cd * area * Vmag * u * correction * correction; - fy = rho * 1./2. * cd * area * Vmag * v * correction * correction; - fz = rho * 1./2. * cd * area * Vmag * w * correction * correction; } -void fast::OpenFAST::setInputs(const fast::fastInputs & fi ) { - mpiComm = fi.comm; +void fast::OpenFAST::predict_states() { - MPI_Comm_rank(mpiComm, &worldMPIRank); + if (firstPass_) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int nvelpts = get_numVelPtsLoc(iTurb); + int nfpts = get_numForcePtsLoc(iTurb); + for (int i=0; i 1) { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_Store_SS(&iTurb, &nt_global, &ErrStat, ErrMsg) ; + checkError(ErrStat, ErrMsg); + } + + } else { + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_Prework(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + } +} + +void fast::OpenFAST::update_states_driver_time_step(bool writeFiles) { + + if (firstPass_) + prework(); + + if (nSubsteps_ > 1) { + + if (!firstPass_) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_Reset_SS(&iTurb, &nSubsteps_, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + } + + for (int iSubstep=1; iSubstep < nSubsteps_+1; iSubstep++) { + double ss_time = double(iSubstep)/double(nSubsteps_); + step(ss_time); + } + + get_data_from_openfast(fast::STATE_NP1); + + if (writeFiles) { + if ( isDebug() ) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + std::ofstream fastcpp_velocity_file; + fastcpp_velocity_file.open("fastcpp_residual." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv", std::ios_base::app) ; + fastcpp_velocity_file << "Time step " << nt_global << " Velocity residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Position residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Force residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].force_resid << std::endl ; + fastcpp_velocity_file.close() ; + } + } + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + velForceNodeData[iTurb][fast::STATE_NP1].x_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].xdot_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].xdot_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].orient_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].force_resid = 0.0; + } + } else { + + send_data_to_openfast(fast::STATE_NP1); + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_UpdateStates(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + // Compute the force from the nacelle only if the drag coefficient is + // greater than zero + if (get_nacelleCdLoc(iTurb) > 0.) { + + calc_nacelle_force ( + + extinfw_o_t_FAST[iTurb].u[0], + extinfw_o_t_FAST[iTurb].v[0], + extinfw_o_t_FAST[iTurb].w[0], + get_nacelleCdLoc(iTurb), + get_nacelleAreaLoc(iTurb), + get_airDensityLoc(iTurb), + extinfw_i_f_FAST[iTurb].fx[0], + extinfw_i_f_FAST[iTurb].fy[0], + extinfw_i_f_FAST[iTurb].fz[0] + + ); + + } + + } + + get_data_from_openfast(fast::STATE_NP1); + + if ( writeFiles ) { + if ( isDebug() ) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + std::ofstream fastcpp_velocity_file; + fastcpp_velocity_file.open("fastcpp_residual." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv", std::ios_base::app) ; + fastcpp_velocity_file << "Time step " << nt_global << " Velocity residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Position residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid << std::endl ; + fastcpp_velocity_file << " " << nt_global << " Force residual at the force nodes = " << velForceNodeData[iTurb][fast::STATE_NP1].force_resid << std::endl ; + fastcpp_velocity_file.close() ; + } + } + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + velForceNodeData[iTurb][fast::STATE_NP1].x_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].xdot_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].x_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].xdot_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].orient_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].vel_force_resid = 0.0; + velForceNodeData[iTurb][fast::STATE_NP1].force_resid = 0.0; + } + + } + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (turbineData[iTurb].inflowType == 2) + writeVelocityData(iTurb, nt_global, nlinIter_); + } + } + + firstPass_ = false; + nlinIter_ +=1 ; +} + +void fast::OpenFAST::advance_to_next_driver_time_step(bool writeFiles) { + + if (nSubsteps_ > 1) { + //Nothing to do here + + } else { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_AdvanceToNextTimeStep(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + + } + + nt_global = nt_global + nSubsteps_; + + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_WriteOutput(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + + set_state_from_state(fast::STATE_NM1, fast::STATE_NM2); + set_state_from_state(fast::STATE_N, fast::STATE_NM1); + set_state_from_state(fast::STATE_NP1, fast::STATE_N); + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int tStepRatio = dtDriver/dtFAST; + if ( (((nt_global - ntStart) % (restartFreq_*tStepRatio)) == 0 ) && (nt_global != ntStart) ) { + turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global + FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + writeRestartFile(iTurb, nt_global); + } + if(scStatus) { + if (fastMPIRank == 0) { + sc->writeRestartFile(nt_global); + } + } + + if ( (((nt_global - ntStart) % (outputFreq_ * tStepRatio) ) == 0 ) && (nt_global != ntStart) ) { + writeOutputFile(iTurb, nt_global); + } + } + + } + + nlinIter_ = 0; + firstPass_ = true ; // Set firstPass_ to true for the next time step +} + +void fast::OpenFAST::calc_nacelle_force(const float & u, const float & v, const float & w, const float & cd, const float & area, const float & rho, float & fx, float & fy, float & fz) { + // Calculate the force on the nacelle (fx,fy,fz) given the + // velocity sampled at the nacelle point (u,v,w), + // drag coefficient 'cd' and nacelle area 'area' + // The velocity magnitude + float Vmag = std::sqrt(u * u + v * v + w * w); + + // Velocity correction based on Martinez-Tossas PhD Thesis 2017 + // The correction samples the velocity at the center of the + // Gaussian kernel and scales it to obtain the inflow velocity + float epsilon_d = std::sqrt(2.0 / M_PI * cd * area); + float correction = 1. / (1.0 - cd * area / (4.0 * M_PI * epsilon_d * epsilon_d)); + + // Compute the force for each velocity component + fx = rho * 1./2. * cd * area * Vmag * u * correction * correction; + fy = rho * 1./2. * cd * area * Vmag * v * correction * correction; + fz = rho * 1./2. * cd * area * Vmag * w * correction * correction; + +} + +/* A version of step allowing for sub-timesteps when the driver program has a larger time step than OpenFAST */ +void fast::OpenFAST::step(double ss_time) { + + /* ****************************** + set inputs from this code and call FAST: + ********************************* */ + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: + FAST_CFD_Prework(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + send_data_to_openfast(ss_time); + FAST_CFD_UpdateStates(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + FAST_CFD_AdvanceToNextTimeStep(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + } + +} + +void fast::OpenFAST::step(bool writeFiles) { + + /* ****************************** + set inputs from this code and call FAST: + ********************************* */ + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + // this advances the states, calls CalcOutput, and solves for next inputs. Predictor-corrector loop is imbeded here: + // (note CFD could do subcycling around this step) + + if (turbineData[iTurb].inflowType == 2) + + writeVelocityData(iTurb, nt_global, 0); + + if (writeFiles) { + if ( isDebug() && (turbineData[iTurb].inflowType == 2) ) { + + std::ofstream fastcpp_velocity_file; + fastcpp_velocity_file.open("fastcpp_velocity." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv") ; + fastcpp_velocity_file << "# x, y, z, Vx, Vy, Vz" << std::endl ; + for (int iNode=0; iNode < get_numVelPtsLoc(iTurb); iNode++) { + fastcpp_velocity_file << extinfw_i_f_FAST[iTurb].pxVel[iNode] << ", " << extinfw_i_f_FAST[iTurb].pyVel[iNode] << ", " << extinfw_i_f_FAST[iTurb].pzVel[iNode] << ", " << extinfw_o_t_FAST[iTurb].u[iNode] << ", " << extinfw_o_t_FAST[iTurb].v[iNode] << ", " << extinfw_o_t_FAST[iTurb].w[iNode] << " " << std::endl ; + } + fastcpp_velocity_file.close() ; + } + } + + FAST_CFD_Prework(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + send_data_to_openfast(fast::STATE_NP1); + FAST_CFD_UpdateStates(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + get_data_from_openfast(fast::STATE_NP1); + FAST_CFD_AdvanceToNextTimeStep(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + + // Compute the force from the nacelle only if the drag coefficient is + // greater than zero + if (get_nacelleCdLoc(iTurb) > 0.) { + + calc_nacelle_force ( + + extinfw_o_t_FAST[iTurb].u[0], + extinfw_o_t_FAST[iTurb].v[0], + extinfw_o_t_FAST[iTurb].w[0], + get_nacelleCdLoc(iTurb), + get_nacelleAreaLoc(iTurb), + get_airDensityLoc(iTurb), + extinfw_i_f_FAST[iTurb].fx[0], + extinfw_i_f_FAST[iTurb].fy[0], + extinfw_i_f_FAST[iTurb].fz[0] + + ); + + } + + if (writeFiles) { + if ( isDebug() && (turbineData[iTurb].inflowType == 2) ) { + std::ofstream actuatorForcesFile; + actuatorForcesFile.open("actuator_forces." + std::to_string(turbineMapProcToGlob[iTurb]) + ".csv") ; + actuatorForcesFile << "# x, y, z, fx, fy, fz" << std::endl ; + for (int iNode=0; iNode < get_numForcePtsLoc(iTurb); iNode++) { + actuatorForcesFile << extinfw_i_f_FAST[iTurb].pxForce[iNode] << ", " << extinfw_i_f_FAST[iTurb].pyForce[iNode] << ", " << extinfw_i_f_FAST[iTurb].pzForce[iNode] << ", " << extinfw_i_f_FAST[iTurb].fx[iNode] << ", " << extinfw_i_f_FAST[iTurb].fy[iNode] << ", " << extinfw_i_f_FAST[iTurb].fz[iNode] << " " << std::endl ; + } + actuatorForcesFile.close() ; + } + } + + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // sc.updateStates(nt_global * dtFAST); // Predict state at 'n+1' based on inputs + // sc.calcOutputs_np1( (nt_global + 1) * dtFAST); + // sc.fastSCInputOutput(); + } + + nt_global = nt_global + 1; + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_CFD_WriteOutput(&iTurb, &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + } + + if (writeFiles) { + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int tStepRatio = dtDriver/dtFAST; + if ( (((nt_global - ntStart) % (restartFreq_ * tStepRatio)) == 0 ) && (nt_global != ntStart) ) { + turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global + FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); + checkError(ErrStat, ErrMsg); + writeRestartFile(iTurb, nt_global); + } + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // if (fastMPIRank == 0) { + // sc.writeRestartFile(nt_global); + // } + } + + if ( (((nt_global - ntStart) % (outputFreq_ * tStepRatio) ) == 0 ) && (nt_global != ntStart) ) { + writeOutputFile(iTurb, nt_global); + } + } + } + +} + +void fast::OpenFAST::setInputs(const fast::fastInputs & fi ) { + + mpiComm = fi.comm; + + MPI_Comm_rank(mpiComm, &worldMPIRank); MPI_Comm_group(mpiComm, &worldMPIGroup); nTurbinesGlob = fi.nTurbinesGlob; if (nTurbinesGlob > 0) { - dryRun = fi.dryRun; + debug = fi.debug; tStart = fi.tStart; simStart = fi.simStart; - nEveryCheckPoint = fi.nEveryCheckPoint; + restartFreq_ = fi.restartFreq; + outputFreq_ = fi.outputFreq; tMax = fi.tMax; loadSuperController(fi); - dtFAST = fi.dtFAST; + dtDriver = fi.dtDriver; - ntStart = int(tStart/dtFAST); - - if (simStart == fast::restartDriverInitFAST) { - nt_global = 0; - } else { - nt_global = ntStart; - } + ///TODO: Check if this is right and necessary + // if (simStart == fast::restartDriverInitFAST) { + // nt_global = 0; + // } else { + // nt_global = ntStart; + // } globTurbineData.resize(nTurbinesGlob); globTurbineData = fi.globTurbineData; @@ -472,568 +1468,1706 @@ void fast::OpenFAST::setInputs(const fast::fastInputs & fi ) { } } -void fast::OpenFAST::checkError(const int ErrStat, const char * ErrMsg){ - if (ErrStat != ErrID_None){ - if (ErrStat >= AbortErrLev){ - throw std::runtime_error(ErrMsg); +int fast::OpenFAST::checkAndSetSubsteps() { + + if ( nTurbinesProc > 0) { + if (dtDriver > 0) { + dtFAST = turbineData[0].dt; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (dtFAST != turbineData[iTurb].dt) { + throw std::runtime_error("All turbines don't have the same time step "); + } + } + if (dtFAST > 0) { + int tStepRatio = dtDriver/dtFAST; + if (std::abs(dtDriver - tStepRatio * dtFAST) < 0.001) {// TODO: Fix arbitrary number 0.001 + nSubsteps_ = tStepRatio; + return 1; + } else { + return -1; + } + } else { + throw std::runtime_error("FAST time step is zero"); + } + + } else { + throw std::runtime_error("Driver time step is not set or set to zero"); } + } else { + return 1; } + } -void fast::OpenFAST::setOutputsToFAST(OpFM_InputType_t cDriver_Input_from_FAST, OpFM_OutputType_t cDriver_Output_to_FAST){ - // routine sets the u-v-w wind speeds used in FAST and the SuperController inputs +void fast::OpenFAST::setDriverTimeStep(double dt_driver) { + dtDriver = dt_driver; +} - for (int j = 0; j < cDriver_Output_to_FAST.u_Len; j++){ - cDriver_Output_to_FAST.u[j] = (float) 10.0*pow((cDriver_Input_from_FAST.pzVel[j] / 90.0), 0.2); // 0.2 power law wind profile using reference 10 m/s at 90 meters - cDriver_Output_to_FAST.v[j] = 0.0; - cDriver_Output_to_FAST.w[j] = 0.0; - } -} +void fast::OpenFAST::setDriverCheckpoint(int nt_checkpoint_driver) { -void fast::OpenFAST::getApproxHubPos(double* currentCoords, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get hub position of Turbine 'iTurbGlob' - for(int i =0; i 0) { + if (nSubsteps_ > 0) { + restartFreq_ = nt_checkpoint_driver; + } else { + throw std::runtime_error("Trying to set driver checkpoint when nSubsteps_ is zero. Set driver time step first may be?"); + } } } -void fast::OpenFAST::getHubPos(double* currentCoords, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get hub position of Turbine 'iTurbGlob' - int iTurbLoc = get_localTurbNo(iTurbGlob); - currentCoords[0] = cDriver_Input_from_FAST[iTurbLoc].pxVel[0] + TurbineBasePos[iTurbLoc][0] ; - currentCoords[1] = cDriver_Input_from_FAST[iTurbLoc].pyVel[0] + TurbineBasePos[iTurbLoc][1] ; - currentCoords[2] = cDriver_Input_from_FAST[iTurbLoc].pzVel[0] + TurbineBasePos[iTurbLoc][2] ; -} +void fast::OpenFAST::get_turbineParams(int iTurbGlob, turbineDataType & turbData) { -void fast::OpenFAST::getHubShftDir(double* hubShftVec, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get hub shaft direction of current turbine - pointing downwind + //TODO: Figure out a better copy operator for the turbineDataType struct int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int i=0; i 0) { + turbData.TurbineBasePos.resize(turbineData[iTurbLoc].TurbineBasePos.size()); + for(int i=0; i < turbineData[iTurbLoc].TurbineBasePos.size(); i++) + turbData.TurbineBasePos[i] = turbineData[iTurbLoc].TurbineBasePos[i]; + } + if(turbineData[iTurbLoc].TurbineHubPos.size() > 0) { + turbData.TurbineHubPos.resize(turbineData[iTurbLoc].TurbineHubPos.size()); + for(int i=0; i < turbineData[iTurbLoc].TurbineHubPos.size(); i++) + turbData.TurbineHubPos[i] = turbineData[iTurbLoc].TurbineHubPos[i]; + } + turbData.sType = turbineData[iTurbLoc].sType; + turbData.numBlades = turbineData[iTurbLoc].numBlades; + turbData.numVelPtsBlade = turbineData[iTurbLoc].numVelPtsBlade; + turbData.numVelPtsTwr = turbineData[iTurbLoc].numVelPtsTwr; + turbData.numVelPts = turbineData[iTurbLoc].numVelPts; + turbData.numForcePtsBlade = turbineData[iTurbLoc].numForcePtsBlade; + turbData.numForcePtsTwr = turbineData[iTurbLoc].numForcePtsTwr; + turbData.numForcePts = turbineData[iTurbLoc].numForcePts; + turbData.inflowType = turbineData[iTurbLoc].inflowType; + turbData.nacelle_cd = turbineData[iTurbLoc].nacelle_cd; + turbData.nacelle_area = turbineData[iTurbLoc].nacelle_area; + turbData.air_density = turbineData[iTurbLoc].air_density; + turbData.nBRfsiPtsBlade.resize(turbData.numBlades); + turbData.nTotBRfsiPtsBlade = 0; + for (int i=0; i < turbData.numBlades; i++) { + turbData.nBRfsiPtsBlade[i] = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + turbData.nTotBRfsiPtsBlade += turbData.nBRfsiPtsBlade[i]; } + turbData.nBRfsiPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + turbData.azBlendMean = turbineData[iTurbLoc].azBlendMean; + turbData.azBlendDelta = turbineData[iTurbLoc].azBlendDelta; + turbData.velMean = turbineData[iTurbLoc].velMean; + turbData.windDir = turbineData[iTurbLoc].windDir; + turbData.zRef = turbineData[iTurbLoc].zRef; + turbData.shearExp = turbineData[iTurbLoc].shearExp; + } -void fast::OpenFAST::getVelNodeCoordinates(double* currentCoords, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set coordinates at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); +void fast::OpenFAST::checkError(const int ErrStat, const char * ErrMsg) +{ + if (ErrStat != ErrID_None){ + + if (ErrStat >= AbortErrLev){ + throw std::runtime_error(std::string(ErrMsg)); + } else { + std::cout << "Warning from OpenFAST: " << ErrMsg << std::endl; + } + } +} + +// Actuator stuff + +void fast::OpenFAST::setExpLawWindSpeed(double t){ + + double sinOmegat = 0.1 * std::sin(10.0*t); + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + // routine sets the u-v-w wind speeds used in FAST + int nVelPts = get_numVelPts(iTurb); + int iTurbGlob = turbineMapProcToGlob[iTurb]; + for (int j = 0; j < nVelPts; j++){ + std::vector coords(3,0.0); + std::vector tmpVel(3,0.0); + getVelNodeCoordinates(coords, j, iTurbGlob, fast::STATE_NP1); + tmpVel[0] = (float) 10.0*pow((coords[2] / 90.0), 0.2) + sinOmegat; // 0.2 power law wind profile using reference 10 m/s at 90 meters + a perturbation + setVelocity(tmpVel, j, iTurbGlob); + } + } +} + +void fast::OpenFAST::getApproxHubPos(double* currentCoords, int iTurbGlob, int nSize) { + assert(nSize==3); + // Get hub position of Turbine 'iTurbGlob' + for(int i =0; i rDistForce(nForcePtsBlade) ; + for(int j=0; j < nForcePtsBlade; j++) { + int iNodeForce = 1 + iBlade * nForcePtsBlade + j ; //The number of actuator force points is always the same for all blades + rDistForce[j] = sqrt( + (extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[0])*(extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[0]) + + (extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[0])*(extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[0]) + + (extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[0])*(extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[0]) + ); + } + + // Interpolate to the velocity nodes + int nVelPtsBlade = get_numVelPtsBladeLoc(iTurb); + for(int j=0; j < nVelPtsBlade; j++) { + int iNodeVel = 1 + iBlade * nVelPtsBlade + j ; //Assumes the same number of velocity (Aerodyn) nodes for all blades + double rDistVel = sqrt( + (extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[0])*(extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[0]) + + (extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[0])*(extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[0]) + + (extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[0])*(extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[0]) + ); + //Find nearest two force nodes + int jForceLower = 0; + while ( (rDistForce[jForceLower+1] < rDistVel) && ( jForceLower < (nForcePtsBlade-2)) ) { + jForceLower = jForceLower + 1; + } + int iNodeForceLower = 1 + iBlade * nForcePtsBlade + jForceLower ; + double rInterp = (rDistVel - rDistForce[jForceLower])/(rDistForce[jForceLower+1]-rDistForce[jForceLower]); + + for (int k=0; k < 3; k++) { + double tmp = velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k] + rInterp * (velForceNodeData[iTurb][fast::STATE_NP1].vel_force[(iNodeForceLower+1)*3+k] - velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k]); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid += (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp)*(velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] = tmp; + } + } + } + + // Now the tower if present and used + int nVelPtsTower = get_numVelPtsTwrLoc(iTurb); + if ( nVelPtsTower > 0 ) { + + // Create interpolating parameter - Distance from first node from ground + int nForcePtsTower = get_numForcePtsTwrLoc(iTurb); + std::vector hDistForce(nForcePtsTower) ; + int iNodeBotTowerForce = 1 + nBlades * get_numForcePtsBladeLoc(iTurb); // The number of actuator force points is always the same for all blades + for(int j=0; j < nForcePtsTower; j++) { + int iNodeForce = iNodeBotTowerForce + j ; + hDistForce[j] = sqrt( + (extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[iNodeBotTowerForce])*(extinfw_i_f_FAST[iTurb].pxForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pxForce[iNodeBotTowerForce]) + + (extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[iNodeBotTowerForce])*(extinfw_i_f_FAST[iTurb].pyForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pyForce[iNodeBotTowerForce]) + + (extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[iNodeBotTowerForce])*(extinfw_i_f_FAST[iTurb].pzForce[iNodeForce] - extinfw_i_f_FAST[iTurb].pzForce[iNodeBotTowerForce]) + ); + } + + int iNodeBotTowerVel = 1 + nBlades * get_numVelPtsBladeLoc(iTurb); // Assumes the same number of velocity (Aerodyn) nodes for all blades + for(int j=0; j < nVelPtsTower; j++) { + int iNodeVel = iNodeBotTowerVel + j ; + double hDistVel = sqrt( + (extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[iNodeBotTowerVel])*(extinfw_i_f_FAST[iTurb].pxVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pxVel[iNodeBotTowerVel]) + + (extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[iNodeBotTowerVel])*(extinfw_i_f_FAST[iTurb].pyVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pyVel[iNodeBotTowerVel]) + + (extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[iNodeBotTowerVel])*(extinfw_i_f_FAST[iTurb].pzVel[iNodeVel] - extinfw_i_f_FAST[iTurb].pzVel[iNodeBotTowerVel]) + ); + //Find nearest two force nodes + int jForceLower = 0; + while ( (hDistForce[jForceLower+1] < hDistVel) && ( jForceLower < (nForcePtsTower-2)) ) { + jForceLower = jForceLower + 1; + } + int iNodeForceLower = iNodeBotTowerForce + jForceLower ; + double rInterp = (hDistVel - hDistForce[jForceLower])/(hDistForce[jForceLower+1]-hDistForce[jForceLower]); + for (int k=0; k < 3; k++) { + double tmp = velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k] + rInterp * (velForceNodeData[iTurb][fast::STATE_NP1].vel_force[(iNodeForceLower+1)*3+k] - velForceNodeData[iTurb][fast::STATE_NP1].vel_force[iNodeForceLower*3+k]); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel_resid += (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp)*(velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] - tmp); + velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+k] = tmp; + } + } + } + + } // End loop over turbines + +} + +void fast::OpenFAST::computeTorqueThrust(int iTurbGlob, double* torque, double* thrust, int nSize) { + + int iTurbLoc = get_localTurbNo(iTurbGlob) ; + if (turbineData[iTurbLoc].sType != EXTINFLOW) + return; + + //Compute the torque and thrust based on the forces at the actuator nodes + std::vector relLoc(3,0.0); + std::vector rPerpShft(3); + thrust[0] = 0.0; thrust[1] = 0.0; thrust[2] = 0.0; + torque[0] = 0.0; torque[1] = 0.0; torque[2] = 0.0; + + std::vector hubShftVec(3); + getHubShftDir(hubShftVec, iTurbGlob, fast::STATE_NP1); + + int nfpts = get_numForcePtsBlade(iTurbLoc); + for (int k=0; k < get_numBladesLoc(iTurbLoc); k++) { + for (int j=0; j < nfpts; j++) { + int iNode = 1 + nfpts*k + j ; + + thrust[0] = thrust[0] + extinfw_i_f_FAST[iTurbLoc].fx[iNode] ; + thrust[1] = thrust[1] + extinfw_i_f_FAST[iTurbLoc].fy[iNode] ; + thrust[2] = thrust[2] + extinfw_i_f_FAST[iTurbLoc].fz[iNode] ; + + relLoc[0] = extinfw_i_f_FAST[iTurbLoc].pxForce[iNode] - extinfw_i_f_FAST[iTurbLoc].pxForce[0] ; + relLoc[1] = extinfw_i_f_FAST[iTurbLoc].pyForce[iNode] - extinfw_i_f_FAST[iTurbLoc].pyForce[0]; + relLoc[2] = extinfw_i_f_FAST[iTurbLoc].pzForce[iNode] - extinfw_i_f_FAST[iTurbLoc].pzForce[0]; + + double rDotHubShftVec = relLoc[0]*hubShftVec[0] + relLoc[1]*hubShftVec[1] + relLoc[2]*hubShftVec[2]; + for (int j=0; j < 3; j++) rPerpShft[j] = relLoc[j] - rDotHubShftVec * hubShftVec[j]; + + torque[0] = torque[0] + rPerpShft[1] * extinfw_i_f_FAST[iTurbLoc].fz[iNode] - rPerpShft[2] * extinfw_i_f_FAST[iTurbLoc].fy[iNode] + extinfw_i_f_FAST[iTurbLoc].momentx[iNode] ; + torque[1] = torque[1] + rPerpShft[2] * extinfw_i_f_FAST[iTurbLoc].fx[iNode] - rPerpShft[0] * extinfw_i_f_FAST[iTurbLoc].fz[iNode] + extinfw_i_f_FAST[iTurbLoc].momenty[iNode] ; + torque[2] = torque[2] + rPerpShft[0] * extinfw_i_f_FAST[iTurbLoc].fy[iNode] - rPerpShft[1] * extinfw_i_f_FAST[iTurbLoc].fx[iNode] + extinfw_i_f_FAST[iTurbLoc].momentz[iNode] ; + + } + } +} + +fast::ActuatorNodeType fast::OpenFAST::getVelNodeType(int iTurbGlob, int iNode) { + // Return the type of velocity node for the given node number. The node ordering (from FAST) is + // Node 0 - Hub node + // Blade 1 nodes + // Blade 2 nodes + // Blade 3 nodes + // Tower nodes + + int iTurbLoc = get_localTurbNo(iTurbGlob); + for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numVelPtsLoc(iTurbGlob); + if (iNode) { + if ( (iNode + 1 - (get_numVelPts(iTurbLoc) - get_numVelPtsTwr(iTurbLoc)) ) > 0) { + return TOWER; + } + else { + return BLADE; + } + } + else { + return HUB; + } + +} + +fast::ActuatorNodeType fast::OpenFAST::getForceNodeType(int iTurbGlob, int iNode) { + // Return the type of actuator force node for the given node number. The node ordering (from FAST) is + // Node 0 - Hub node + // Blade 1 nodes + // Blade 2 nodes + // Blade 3 nodes + // Tower nodes + + int iTurbLoc = get_localTurbNo(iTurbGlob); + for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbGlob); + if (iNode) { + if ( (iNode + 1 - (get_numForcePts(iTurbLoc) - get_numForcePtsTwr(iTurbLoc)) ) > 0) { + return TOWER; + } + else { + return BLADE; + } + } + else { + return HUB; + } +} + +void fast::OpenFAST::allocateMemory_preInit() { + + for (int iTurb=0; iTurb < nTurbinesGlob; iTurb++) { + if (dryRun) { + if(worldMPIRank == 0) { + std::cout << "iTurb = " << iTurb << " turbineMapGlobToProc[iTurb] = " << turbineMapGlobToProc[iTurb] << std::endl ; + } + } + if(worldMPIRank == turbineMapGlobToProc[iTurb]) { + turbineMapProcToGlob[nTurbinesProc] = iTurb; + reverseTurbineMapProcToGlob[iTurb] = nTurbinesProc; + nTurbinesProc++ ; + } + turbineSetProcs.insert(turbineMapGlobToProc[iTurb]); + } + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // scio.from_SC.resize(nTurbinesProc); + } + + int nProcsWithTurbines=0; + turbineProcs.resize(turbineSetProcs.size()); + + for (std::set::const_iterator p = turbineSetProcs.begin(); p != turbineSetProcs.end(); p++) { + turbineProcs[nProcsWithTurbines] = *p; + nProcsWithTurbines++ ; + } + + if (dryRun) { + if (nTurbinesProc > 0) { + std::ofstream turbineAllocFile; + turbineAllocFile.open("turbineAlloc." + std::to_string(worldMPIRank) + ".txt") ; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + turbineAllocFile << "Proc " << worldMPIRank << " loc iTurb " << iTurb << " glob iTurb " << turbineMapProcToGlob[iTurb] << std::endl ; + } + turbineAllocFile.flush(); + turbineAllocFile.close() ; + } + } + + // // Construct a group containing all procs running atleast 1 turbine in FAST + // MPI_Group_incl(worldMPIGroup, nProcsWithTurbines, &turbineProcs[0], &fastMPIGroup) ; + // int fastMPIcommTag = MPI_Comm_create(mpiComm, fastMPIGroup, &fastMPIComm); + // if (MPI_COMM_NULL != fastMPIComm) { + // MPI_Comm_rank(fastMPIComm, &fastMPIRank); + // } + + turbineData.resize(nTurbinesProc); + velForceNodeData.resize(nTurbinesProc); + brFSIData.resize(nTurbinesProc); + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + turbineData[iTurb].TurbineBasePos.resize(3); + turbineData[iTurb].TurbineHubPos.resize(3); + + int iTurbGlob = turbineMapProcToGlob[iTurb]; + turbineData[iTurb].TurbID = globTurbineData[iTurbGlob].TurbID; + turbineData[iTurb].sType = globTurbineData[iTurbGlob].sType; + turbineData[iTurb].FASTInputFileName = globTurbineData[iTurbGlob].FASTInputFileName ; + turbineData[iTurb].FASTRestartFileName = globTurbineData[iTurbGlob].FASTRestartFileName ; + for(int i=0;i<3;i++) { + turbineData[iTurb].TurbineBasePos[i] = globTurbineData[iTurbGlob].TurbineBasePos[i]; + turbineData[iTurb].TurbineHubPos[i] = globTurbineData[iTurbGlob].TurbineHubPos[i]; + } + turbineData[iTurb].numForcePtsBlade = globTurbineData[iTurbGlob].numForcePtsBlade; + turbineData[iTurb].numForcePtsTwr = globTurbineData[iTurbGlob].numForcePtsTwr; + turbineData[iTurb].azBlendMean = globTurbineData[iTurbGlob].azBlendMean; + turbineData[iTurb].azBlendDelta = globTurbineData[iTurbGlob].azBlendDelta; + turbineData[iTurb].velMean = globTurbineData[iTurbGlob].velMean; + turbineData[iTurb].windDir = globTurbineData[iTurbGlob].windDir; + turbineData[iTurb].zRef = globTurbineData[iTurbGlob].zRef; + turbineData[iTurb].shearExp = globTurbineData[iTurbGlob].shearExp; + + velForceNodeData[iTurb].resize(4); // To hold data for 4 time steps + brFSIData[iTurb].resize(4); + + } + + // Allocate memory for Turbine datastructure for all turbines + FAST_AllocateTurbines(&nTurbinesProc, &ErrStat, ErrMsg); + + // Allocate memory for ExtInfw Input types in FAST + extinfw_i_f_FAST.resize(nTurbinesProc) ; + extinfw_o_t_FAST.resize(nTurbinesProc) ; + + // Allocate memory for ExtLd Input types in FAST + extld_i_f_FAST.resize(nTurbinesProc) ; + extld_o_t_FAST.resize(nTurbinesProc) ; + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // scio.from_SC.resize(nTurbinesProc); + } + +} + +void fast::OpenFAST::allocateMemory_postInit(int iTurbLoc) { + + if (turbineData[iTurbLoc].sType == EXTINFLOW) { + turbineData[iTurbLoc].nBRfsiPtsBlade = std::vector(turbineData[iTurbLoc].numBlades,0); + turbineData[iTurbLoc].nBRfsiPtsTwr = 0; + + if ( turbineData[iTurbLoc].inflowType == 1) { + // Inflow data is coming from inflow module + turbineData[iTurbLoc].numForcePtsTwr = 0; + turbineData[iTurbLoc].numForcePtsBlade = 0; + turbineData[iTurbLoc].numForcePts = 0; + turbineData[iTurbLoc].numVelPtsTwr = 0; + turbineData[iTurbLoc].numVelPtsBlade = 0; + turbineData[iTurbLoc].numVelPts = 0; + } else { + //Inflow data is coming from external program like a CFD solver + turbineData[iTurbLoc].numForcePts = 1 + turbineData[iTurbLoc].numForcePtsTwr + turbineData[iTurbLoc].numBlades * turbineData[iTurbLoc].numForcePtsBlade ; + turbineData[iTurbLoc].numVelPts = 1 + turbineData[iTurbLoc].numVelPtsTwr + turbineData[iTurbLoc].numBlades * turbineData[iTurbLoc].numVelPtsBlade ; + + int nfpts = get_numForcePtsLoc(iTurbLoc); + int nvelpts = get_numVelPtsLoc(iTurbLoc); + + velForceNodeData[iTurbLoc][3].xref_force.resize(3*nfpts); + for(int k=0; k<4; k++) { + velForceNodeData[iTurbLoc][k].x_vel.resize(3*nvelpts) ; + velForceNodeData[iTurbLoc][k].xdot_vel.resize(3*nvelpts) ; + velForceNodeData[iTurbLoc][k].vel_vel.resize(3*nvelpts) ; + velForceNodeData[iTurbLoc][k].x_force.resize(3*nfpts) ; + velForceNodeData[iTurbLoc][k].xdot_force.resize(3*nfpts) ; + velForceNodeData[iTurbLoc][k].orient_force.resize(9*nfpts) ; + velForceNodeData[iTurbLoc][k].vel_force.resize(3*nfpts) ; + velForceNodeData[iTurbLoc][k].force.resize(3*nfpts) ; + } + + if ( isDebug() ) { + for (int iNode=0; iNode < get_numVelPtsLoc(iTurbLoc); iNode++) { + std::cout << "Node " << iNode << " Position = " << extinfw_i_f_FAST[iTurbLoc].pxVel[iNode] << " " << extinfw_i_f_FAST[iTurbLoc].pyVel[iNode] << " " << extinfw_i_f_FAST[iTurbLoc].pzVel[iNode] << " " << std::endl ; + } + } + } + + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { + turbineData[iTurbLoc].nBRfsiPtsBlade.resize(turbineData[iTurbLoc].numBlades); + int nTotBldNds = 0; + for(int i=0; i < turbineData[iTurbLoc].numBlades; i++) { + nTotBldNds += extld_i_f_FAST[iTurbLoc].nBladeNodes[i]; + turbineData[iTurbLoc].nBRfsiPtsBlade[i] = extld_i_f_FAST[iTurbLoc].nBladeNodes[i]; + turbineData[iTurbLoc].nTotBRfsiPtsBlade += turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + } + turbineData[iTurbLoc].nBRfsiPtsTwr = extld_i_f_FAST[iTurbLoc].nTowerNodes[0]; + + // Allocate memory for reference position only for 1 time step - np1 + for(int k=0; k<4; k++) { + brFSIData[iTurbLoc][k].twr_ref_pos.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].twr_def.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].twr_vel.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].bld_rloc.resize(nTotBldNds); + brFSIData[iTurbLoc][k].bld_chord.resize(nTotBldNds); + brFSIData[iTurbLoc][k].bld_ref_pos.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].bld_def.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].bld_vel.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].twr_ld.resize(6*turbineData[iTurbLoc].nBRfsiPtsTwr); + brFSIData[iTurbLoc][k].bld_ld.resize(6*nTotBldNds); + brFSIData[iTurbLoc][k].hub_ref_pos.resize(6); + brFSIData[iTurbLoc][k].hub_def.resize(6); + brFSIData[iTurbLoc][k].hub_vel.resize(6); + brFSIData[iTurbLoc][k].nac_ref_pos.resize(6); + brFSIData[iTurbLoc][k].nac_def.resize(6); + brFSIData[iTurbLoc][k].nac_vel.resize(6); + brFSIData[iTurbLoc][k].hub_ref_pos.resize(6); + brFSIData[iTurbLoc][k].bld_pitch.resize(turbineData[iTurbLoc].numBlades); + brFSIData[iTurbLoc][k].bld_root_ref_pos.resize(6*turbineData[iTurbLoc].numBlades); + brFSIData[iTurbLoc][k].bld_root_def.resize(6*turbineData[iTurbLoc].numBlades); + } + } + +} + +void fast::OpenFAST::allocateTurbinesToProcsSimple() { + // Allocate turbines to each processor - round robin fashion + int nProcs ; + MPI_Comm_size(mpiComm, &nProcs); + for(int j = 0; j < nTurbinesGlob; j++) turbineMapGlobToProc[j] = j % nProcs ; +} + +void fast::OpenFAST::end() { + + // Deallocate types we allocated earlier + + if ( !dryRun) { + bool stopTheProgram = false; + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + FAST_End(&iTurb, &stopTheProgram); + } + } + + // MPI_Group_free(&fastMPIGroup); + // if (MPI_COMM_NULL != fastMPIComm) { + // MPI_Comm_free(&fastMPIComm); + // } + // MPI_Group_free(&worldMPIGroup); + + if(scStatus) { + std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; + // sc.end(); + } + +} + +int fast::OpenFAST::read_nlin_iters(int iTurb, int n_t_global, int ncid) { + + int nlin_iters = 0; + size_t count1 = 1; + size_t n_tsteps = n_t_global; + int ierr = nc_get_vara_int(ncid, 1, &n_tsteps, &count1, &nlin_iters); + + return nlin_iters; + +} + + +void fast::OpenFAST::readVelocityData(int iTurb, int n_t_global, int nlinIter, int ncid) { + + size_t n_tsteps = n_t_global; + const std::vector start_dim{n_tsteps, static_cast(nlinIter), 0}; + int nVelPts = get_numVelPtsLoc(iTurb); + const std::vector velPtsDataDims{1, 1, static_cast(3*nVelPts)}; + int ierr = nc_get_vara_double(ncid, 2, start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurb][fast::STATE_NP1].vel_vel.data()); +} + +int fast::OpenFAST::openVelocityDataFile(int iTurb) { + + int ncid; + std::stringstream velfile_fstream; + velfile_fstream << "turb_" ; + velfile_fstream << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurb]; + velfile_fstream << "_veldata.nc"; + std::string velfile_filename = velfile_fstream.str(); + int ierr = nc_open(velfile_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); + return ncid; + +} + +void fast::OpenFAST::prepareVelocityDataFile(int iTurb) { + + // Open the file in create mode - this will destory any file + int ncid; + std::stringstream velfile_fstream; + velfile_fstream << "turb_" ; + velfile_fstream << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurb]; + velfile_fstream << "_veldata.nc"; + std::string velfile_filename = velfile_fstream.str(); + int ierr = nc_create(velfile_filename.c_str(), NC_CLOBBER, &ncid); + check_nc_error(ierr, "nc_create"); + + //Define dimensions + int tmpDimID; + ierr = nc_def_dim(ncid, "n_tsteps", NC_UNLIMITED, &tmpDimID); + ierr = nc_def_dim(ncid, "n_nonlin_iters_max", 2, &tmpDimID); + ierr = nc_def_dim(ncid, "n_vel_pts_data", turbineData[iTurb].numVelPts*3, &tmpDimID); + + int tmpVarID; + tmpDimID = 0; + ierr = nc_def_var(ncid, "time", NC_DOUBLE, 1, &tmpDimID, &tmpVarID); + ierr = nc_def_var(ncid, "nlin_iters", NC_INT, 1, &tmpDimID, &tmpVarID); + const std::vector velPtsDataDims{0, 1, 2}; + ierr = nc_def_var(ncid, "vel_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); + + //! Indicate that we are done defining variables, ready to write data + ierr = nc_enddef(ncid); + check_nc_error(ierr, "nc_enddef"); + ierr = nc_close(ncid); + check_nc_error(ierr, "nc_close"); +} + +void fast::OpenFAST::writeVelocityData(int iTurb, int n_t_global, int nlinIter) { + + /* // NetCDF stuff to write velocity data to file */ + int ncid; + //Find the file and open it in append mode + std::stringstream velfile_ss; + velfile_ss << "turb_" ; + velfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurb]; + velfile_ss << "_veldata.nc"; + std::string vel_filename = velfile_ss.str(); + int ierr = nc_open(vel_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + size_t count1=1; + size_t n_tsteps = (n_t_global/nSubsteps_)+1; + double curTime = (n_t_global + nSubsteps_) * dtFAST; + ierr = nc_put_vara_double(ncid, 0, &n_tsteps, &count1, &curTime); + int nVelPts = get_numVelPtsLoc(iTurb) ; + const std::vector velPtsDataDims{1, 1, static_cast(3*nVelPts)}; + const std::vector start_dim{static_cast(n_tsteps),static_cast(nlinIter),0}; + + std::cout << "Writing velocity data at time step " << n_tsteps << ", nonlinear iteration " << nlinIter << std::endl ; + ierr = nc_put_vara_double(ncid, 2, start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurb][3].vel_vel.data()); + nlinIter += 1; // To account for 0-based indexing + ierr = nc_put_vara_int(ncid, 1, &n_tsteps, &count1, &nlinIter); + + nc_close(ncid); + } -void fast::OpenFAST::getForceNodeOrientation(double* currentOrientation, int iNode, int iTurbGlob, int nSize) { - assert(nSize==9); - // Set orientation at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - for(int i=0;i<9;i++) { - currentOrientation[i] = cDriver_Input_from_FAST[iTurbLoc].pOrientation[iNode*9+i] ; +void fast::OpenFAST::send_data_to_openfast(fast::timeStep t) { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if ( (turbineData[iTurb].sType == EXTINFLOW) && (turbineData[iTurb].inflowType == 2) ) { + int nvelpts = get_numVelPtsLoc(iTurb); + for (int iNodeVel=0; iNodeVel < nvelpts; iNodeVel++) { + extinfw_o_t_FAST[iTurb].u[iNodeVel] = velForceNodeData[iTurb][t].vel_vel[iNodeVel*3+0]; + extinfw_o_t_FAST[iTurb].v[iNodeVel] = velForceNodeData[iTurb][t].vel_vel[iNodeVel*3+1]; + extinfw_o_t_FAST[iTurb].w[iNodeVel] = velForceNodeData[iTurb][t].vel_vel[iNodeVel*3+2]; + } + } else if(turbineData[iTurb].sType == EXTLOADS) { + + int nBlades = turbineData[iTurb].numBlades; + int iRunTot = 0; + for(int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; + for (int j=0; j < nPtsBlade; j++) { + for (int k=0; k<6; k++) { + extld_o_t_FAST[iTurb].bldLd[iRunTot*6+k] = brFSIData[iTurb][t].bld_ld[iRunTot*6+k]; + } + iRunTot++; + } + } + + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr*6; i++) + extld_o_t_FAST[iTurb].twrLd[i] = brFSIData[iTurb][t].twr_ld[i]; + + } + + } +} + +void fast::OpenFAST::send_data_to_openfast(double ss_time) { + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + if (turbineData[iTurb].inflowType == 2) { + int nvelpts = get_numVelPtsLoc(iTurb); + for (int iNodeVel=0; iNodeVel < nvelpts; iNodeVel++) { + extinfw_o_t_FAST[iTurb].u[iNodeVel] = velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+0] + ss_time * (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+0] - velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+0]); + extinfw_o_t_FAST[iTurb].v[iNodeVel] = velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+1] + ss_time * (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+1] - velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+1]); + extinfw_o_t_FAST[iTurb].w[iNodeVel] = velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+2] + ss_time * (velForceNodeData[iTurb][fast::STATE_NP1].vel_vel[iNodeVel*3+2] - velForceNodeData[iTurb][fast::STATE_N].vel_vel[iNodeVel*3+2]); + } + } else if(turbineData[iTurb].sType == EXTLOADS) { + + int nBlades = turbineData[iTurb].numBlades; + int iRunTot = 0; + for(int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; + for (int j=0; j < nPtsBlade; j++) { + for (int k=0; k<6; k++) { + extld_o_t_FAST[iTurb].bldLd[iRunTot*6+k] = brFSIData[iTurb][fast::STATE_N].bld_ld[iRunTot*6+k] + ss_time * (brFSIData[iTurb][fast::STATE_NP1].bld_ld[iRunTot*6+k] - brFSIData[iTurb][fast::STATE_N].bld_ld[iRunTot*6+k]); + } + iRunTot++; + } + } + + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr*6; i++) + extld_o_t_FAST[iTurb].twrLd[i] = brFSIData[iTurb][fast::STATE_N].twr_ld[i] + ss_time * (brFSIData[iTurb][fast::STATE_NP1].twr_ld[i] - brFSIData[iTurb][fast::STATE_N].twr_ld[i]); + + } + } + +} + +void fast::OpenFAST::get_data_from_openfast(timeStep t) { + + + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + + if(turbineData[iTurb].sType == EXTINFLOW) { + + if (turbineData[iTurb].inflowType == 2) { + int nvelpts = get_numVelPtsLoc(iTurb); + int nfpts = get_numForcePtsLoc(iTurb); + for (int i=0; i velPtsDataDims{1, 1, static_cast(3*nvelpts)}; + const std::vector forcePtsDataDims{1, 1, static_cast(3*nfpts)}; + const std::vector forcePtsOrientDataDims{1, 1, static_cast(9*nfpts)}; + + ierr = nc_get_var_double(ncid, ncRstVarIDs_["xref_force"], velForceNodeData[iTurbLoc][fast::STATE_NP1].xref_force.data()); + + for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 + + const std::vector start_dim{n_tsteps,j,0}; + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["x_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["xdot_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["vel_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["x_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["xdot_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["vel_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].force.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["orient_force"], start_dim.data(), forcePtsOrientDataDims.data(), velForceNodeData[iTurbLoc][j].orient_force.data()); + + } + + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBRfsiPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBRfsiPtsBlade = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBlades = turbineData[iTurbLoc].numBlades; + const std::vector twrDataDims{1, 1, static_cast(6*nBRfsiPtsTwr)}; + const std::vector bldDataDims{1, 1, static_cast(6*nTotBRfsiPtsBlade)}; + const std::vector bldRootDataDims{1, 1, static_cast(6*nBlades)}; + const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; + const std::vector ptDataDims{1, 1, 6}; + + for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 + + const std::vector start_dim{n_tsteps, j, 0}; + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["twr_def"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["twr_vel"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["twr_ld"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_ld.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_def"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_vel"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_vel.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_ld"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_ld.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["hub_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["hub_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_vel.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["nac_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["nac_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_vel.data()); + + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_root_def"], start_dim.data(), bldRootDataDims.data(), brFSIData[iTurbLoc][j].bld_root_def.data()); + ierr = nc_get_vara_double(ncid, ncRstVarIDs_["bld_pitch"], start_dim.data(), bldPitchDataDims.data(), brFSIData[iTurbLoc][j].bld_pitch.data()); + + } + + + + } + + nc_close(ncid); + +} + +void fast::OpenFAST::cross(double * a, double * b, double * aCrossb) { + + aCrossb[0] = a[1]*b[2] - a[2]*b[1]; + aCrossb[1] = a[2]*b[0] - a[0]*b[2]; + aCrossb[2] = a[0]*b[1] - a[1]*b[0]; + +} + + +//! Apply a DCM rotation 'dcm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. +void fast::OpenFAST::applyDCMrotation(double * dcm, double * r, double *rRot, double transpose) { + + if (transpose > 0) { + for(size_t i=0; i < 3; i++) { + rRot[i] = 0.0; + for(size_t j=0; j < 3; j++) + rRot[i] += dcm[i*3+j] * r[j]; + } + } else { + for(size_t i=0; i < 3; i++) { + rRot[i] = 0.0; + for(size_t j=0; j < 3; j++) + rRot[i] += dcm[j*3+i] * r[j]; + } + } +} + +//! Apply a Wiener-Milenkovic rotation 'wm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. +void fast::OpenFAST::applyWMrotation(double * wm, double * r, double *rRot, double transpose) { + + double wm0 = 2.0-0.125*dot(wm, wm); + double nu = 2.0/(4.0-wm0); + double cosPhiO2 = 0.5*wm0*nu; + std::vector wmCrossR(3,0.0); + cross(wm, r, wmCrossR.data()); + std::vector wmCrosswmCrossR(3,0.0); + cross(wm, wmCrossR.data(), wmCrosswmCrossR.data()); + + for(size_t i=0; i < 3; i++) + rRot[i] = r[i] + transpose * nu * cosPhiO2 * wmCrossR[i] + 0.5 * nu * nu * wmCrosswmCrossR[i]; + +} + + +void fast::OpenFAST::writeOutputFile(int iTurbLoc, int n_t_global) { + + int ncid; + //Open the file in append mode + std::stringstream outfile_ss; + outfile_ss << "turb_" ; + outfile_ss << std::setfill('0') << std::setw(2) << iTurbLoc; + outfile_ss << "_output.nc"; + std::string defloads_filename = outfile_ss.str(); + int ierr = nc_open(defloads_filename.c_str(), NC_WRITE, &ncid); + check_nc_error(ierr, "nc_open"); + + size_t count1=1; + int tStepRatio = dtDriver/dtFAST; + size_t n_tsteps = n_t_global/tStepRatio/outputFreq_ - 1; + double curTime = n_t_global * dtFAST; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["time"], &n_tsteps, &count1, &curTime); + + if (turbineData[iTurbLoc].sType == EXTINFLOW) { + + // Nothing to do here yet + int nBlades = get_numBladesLoc(iTurbLoc); + int nBldPts = get_numForcePtsBladeLoc(iTurbLoc); + int nTwrPts = get_numForcePtsTwrLoc(iTurbLoc); + std::vector tmpArray; + + tmpArray.resize(nTwrPts); + { + int node_twr_start = (1 + nBlades * nBldPts)*3; + std::vector count_dim{1,1,static_cast(nTwrPts)}; + for (size_t iDim=0; iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[node_twr_start+i*3+iDim] - velForceNodeData[iTurbLoc][3].xref_force[node_twr_start+i*3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0; iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].xdot_force[node_twr_start+i*3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].force[node_twr_start+i*3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + tmpArray.resize(nBldPts); + { + std::vector count_dim{1,1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[(node_bld_start+i)*3+iDim] - velForceNodeData[iTurbLoc][3].xref_force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].xdot_force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].force[(node_bld_start+i)*3+iDim] ; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + std::vector ld_loc(3*nBlades*nBldPts,0.0); + for (auto iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (1 + iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) { + applyDCMrotation(&velForceNodeData[iTurbLoc][3].orient_force[(node_bld_start + i)*9], &velForceNodeData[iTurbLoc][3].force[(node_bld_start+i)*3], &ld_loc[(node_bld_start-1)*3]); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + int node_bld_start = (iBlade * nBldPts); + for (auto i=0; i < nBldPts; i++) + tmpArray[i] = ld_loc[(node_bld_start+i)*3+iDim]; + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld_loc"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + } + + tmpArray.resize(3); + for (auto i=0; i < 3; i++) + tmpArray[i] = velForceNodeData[iTurbLoc][3].x_force[i] - velForceNodeData[iTurbLoc][3].xref_force[i]; + std::vector start_dim{n_tsteps, 0}; + std::vector count_dim{1,3}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_vel"], start_dim.data(), count_dim.data(), &velForceNodeData[iTurbLoc][3].xdot_force[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_ld"], start_dim.data(), count_dim.data(), &velForceNodeData[iTurbLoc][3].force[0]); + + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { + + int nBlades = turbineData[iTurbLoc].numBlades; + int nTwrPts = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBldPts = nTotBldPts/nBlades; + + std::vector tmpArray; + tmpArray.resize(nTwrPts); + std::vector count_dim{1,1,static_cast(nTwrPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].twr_def[i*6+iDim] ; + // std::cerr << "Twr displacement Node " << i << ", dimension " << iDim << " = " + // << brFSIData[iTurbLoc][3].twr_ref_pos[i*6+iDim] << " " + // << brFSIData[iTurbLoc][3].twr_def[i*6+iDim] << std::endl; + } + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_def[i*6+3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_orient"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_vel[i*6+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_vel[i*6+3+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_rotvel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ld[i*6+iDim] ; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + for (size_t iDim=0;iDim < 3; iDim++) { + for (auto i=0; i < nTwrPts; i++) + tmpArray[i] = brFSIData[iTurbLoc][3].twr_ld[i*6+3+iDim]; + std::vector start_dim{n_tsteps,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["twr_moment"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + + tmpArray.resize(nBldPts); + { + std::vector count_dim{1,1,1,static_cast(nBldPts)}; + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_def[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_disp"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_def[(iStart*6)+3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_orient"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_vel[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_vel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0; iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_vel[(iStart*6)+3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_rotvel"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ld[(iStart*6)+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + std::vector ld_loc(3*nTotBldPts,0.0); + for (auto i=0; i < nTotBldPts; i++) { + applyWMrotation(&brFSIData[iTurbLoc][3].bld_def[i*6+3], &brFSIData[iTurbLoc][3].bld_ld[i*6], &ld_loc[i*3]); + } + for (size_t iDim=0;iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = ld_loc[iStart*3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_ld_loc"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + for (size_t iDim=0; iDim < 3; iDim++) { + int iStart = 0 ; + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + for (auto i=0; i < nBldPts; i++) { + tmpArray[i] = brFSIData[iTurbLoc][3].bld_ld[(iStart*6)+3+iDim]; + iStart++; + } + std::vector start_dim{n_tsteps,iBlade,iDim,0}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_moment"], start_dim.data(), count_dim.data(), tmpArray.data()); + } + } + + } + + { + for (size_t iBlade=0; iBlade < nBlades; iBlade++) { + + std::vector start_dim{n_tsteps, iBlade, 0}; + std::vector count_dim{1,1,3}; + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_disp"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_def[iBlade*6+0]); + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_root_orient"], + start_dim.data(), + count_dim.data(), + &brFSIData[iTurbLoc][3].bld_root_def[iBlade*6+3]); + } + } + + { + std::vector start_dim{n_tsteps, 0}; + std::vector count_dim{1,3}; + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_disp"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_def[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_orient"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_def[3]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_vel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_vel[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["hub_rotvel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].hub_vel[3]); + + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_disp"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_def[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_orient"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_def[3]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_vel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_vel[0]); + ierr = nc_put_vara_double(ncid, ncOutVarIDs_["nac_rotvel"], start_dim.data(), count_dim.data(), &brFSIData[iTurbLoc][3].nac_vel[3]); } -} -void fast::OpenFAST::getRelativeVelForceNode(double* currentVelocity, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Get relative velocity at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); + } - currentVelocity[0] = forceNodeVel[iTurbLoc][iNode][0] - cDriver_Input_from_FAST[iTurbLoc].xdotForce[iNode]; - currentVelocity[1] = forceNodeVel[iTurbLoc][iNode][1] - cDriver_Input_from_FAST[iTurbLoc].ydotForce[iNode]; - currentVelocity[2] = forceNodeVel[iTurbLoc][iNode][2] - cDriver_Input_from_FAST[iTurbLoc].zdotForce[iNode]; -} + nc_close(ncid); -void fast::OpenFAST::getForce(double* currentForce, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set forces at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - currentForce[0] = -cDriver_Input_from_FAST[iTurbLoc].fx[iNode] ; - currentForce[1] = -cDriver_Input_from_FAST[iTurbLoc].fy[iNode] ; - currentForce[2] = -cDriver_Input_from_FAST[iTurbLoc].fz[iNode] ; -} -double fast::OpenFAST::getChord(int iNode, int iTurbGlob) { - // Return blade chord/tower diameter at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - return cDriver_Input_from_FAST[iTurbLoc].forceNodesChord[iNode] ; -} -void fast::OpenFAST::setVelocity(double* currentVelocity, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set velocity at current node of current turbine - - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numVelPtsLoc(iTurbLoc); - cDriver_Output_to_FAST[iTurbLoc].u[iNode] = currentVelocity[0]; - cDriver_Output_to_FAST[iTurbLoc].v[iNode] = currentVelocity[1]; - cDriver_Output_to_FAST[iTurbLoc].w[iNode] = currentVelocity[2]; } -void fast::OpenFAST::setVelocityForceNode(double* currentVelocity, int iNode, int iTurbGlob, int nSize) { - assert(nSize==3); - // Set velocity at current node of current turbine - - int iTurbLoc = get_localTurbNo(iTurbGlob); - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); +void fast::OpenFAST::writeRestartFile(int iTurbLoc, int n_t_global) { - for(int i=0; i rDistForce(nForcePtsBlade) ; - for(int j=0; j < nForcePtsBlade; j++) { - int iNodeForce = 1 + iBlade * nForcePtsBlade + j ; //The number of actuator force points is always the same for all blades - rDistForce[j] = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[0])*(cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[0]) - + (cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[0])*(cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[0]) - + (cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[0])*(cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[0]) - ); - } + int nvelpts = get_numVelPtsLoc(iTurbLoc); + int nfpts = get_numForcePtsLoc(iTurbLoc); - // Interpolate to the velocity nodes - int nVelPtsBlade = get_numVelPtsBladeLoc(iTurb); - for(int j=0; j < nVelPtsBlade; j++) { - int iNodeVel = 1 + iBlade * nVelPtsBlade + j ; //Assumes the same number of velocity (Aerodyn) nodes for all blades - double rDistVel = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[0])*(cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[0]) - + (cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[0])*(cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[0]) - + (cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[0])*(cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[0]) - ); - //Find nearest two force nodes - int jForceLower = 0; - while ( (rDistForce[jForceLower+1] < rDistVel) && ( jForceLower < (nForcePtsBlade-2)) ) { - jForceLower = jForceLower + 1; - } - int iNodeForceLower = 1 + iBlade * nForcePtsBlade + jForceLower ; - double rInterp = (rDistVel - rDistForce[jForceLower])/(rDistForce[jForceLower+1]-rDistForce[jForceLower]); - cDriver_Output_to_FAST[iTurb].u[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][0] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][0] - forceNodeVel[iTurb][iNodeForceLower][0] ); - cDriver_Output_to_FAST[iTurb].v[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][1] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][1] - forceNodeVel[iTurb][iNodeForceLower][1] ); - cDriver_Output_to_FAST[iTurb].w[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][2] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][2] - forceNodeVel[iTurb][iNodeForceLower][2] ); - } + const std::vector velPtsDataDims{1, 1, static_cast(3*nvelpts)}; + const std::vector forcePtsDataDims{1, 1, static_cast(3*nfpts)}; + const std::vector forcePtsOrientDataDims{1, 1, static_cast(9*nfpts)}; + + for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 + + const std::vector start_dim{n_tsteps,j,0}; + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["x_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["xdot_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["vel_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["x_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["xdot_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["vel_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].force.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["orient_force"], start_dim.data(), forcePtsOrientDataDims.data(), velForceNodeData[iTurbLoc][j].orient_force.data()); } - // Now the tower if present and used - int nVelPtsTower = get_numVelPtsTwrLoc(iTurb); - if ( nVelPtsTower > 0 ) { + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { - // Create interpolating parameter - Distance from first node from ground - int nForcePtsTower = get_numForcePtsTwrLoc(iTurb); - std::vector hDistForce(nForcePtsTower) ; - int iNodeBotTowerForce = 1 + nBlades * get_numForcePtsBladeLoc(iTurb); // The number of actuator force points is always the same for all blades - for(int j=0; j < nForcePtsTower; j++) { - int iNodeForce = iNodeBotTowerForce + j ; - hDistForce[j] = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[iNodeBotTowerForce])*(cDriver_Input_from_FAST[iTurb].pxForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pxForce[iNodeBotTowerForce]) - + (cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[iNodeBotTowerForce])*(cDriver_Input_from_FAST[iTurb].pyForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pyForce[iNodeBotTowerForce]) - + (cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[iNodeBotTowerForce])*(cDriver_Input_from_FAST[iTurb].pzForce[iNodeForce] - cDriver_Input_from_FAST[iTurb].pzForce[iNodeBotTowerForce]) - ); - } + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + int nTotBldPts = turbineData[iTurbLoc].nTotBRfsiPtsBlade; + int nBlades = turbineData[iTurbLoc].numBlades; + const std::vector twrDataDims{1, 1, static_cast(6*nPtsTwr)}; + const std::vector bldDataDims{1, 1, static_cast(6*nTotBldPts)}; + const std::vector bldRootDataDims{1, 1, static_cast(6*nBlades)}; + const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; + const std::vector ptDataDims{1, 1, 6}; - int iNodeBotTowerVel = 1 + nBlades * get_numVelPtsBladeLoc(iTurb); // Assumes the same number of velocity (Aerodyn) nodes for all blades - for(int j=0; j < nVelPtsTower; j++) { - int iNodeVel = iNodeBotTowerVel + j ; - double hDistVel = std::sqrt( - (cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[iNodeBotTowerVel])*(cDriver_Input_from_FAST[iTurb].pxVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pxVel[iNodeBotTowerVel]) - + (cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[iNodeBotTowerVel])*(cDriver_Input_from_FAST[iTurb].pyVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pyVel[iNodeBotTowerVel]) - + (cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[iNodeBotTowerVel])*(cDriver_Input_from_FAST[iTurb].pzVel[iNodeVel] - cDriver_Input_from_FAST[iTurb].pzVel[iNodeBotTowerVel]) - ); - //Find nearest two force nodes - int jForceLower = 0; - while ( (hDistForce[jForceLower+1] < hDistVel) && ( jForceLower < (nForcePtsTower-2)) ) { - jForceLower = jForceLower + 1; - } - int iNodeForceLower = iNodeBotTowerForce + jForceLower ; - double rInterp = (hDistVel - hDistForce[jForceLower])/(hDistForce[jForceLower+1]-hDistForce[jForceLower]); - cDriver_Output_to_FAST[iTurb].u[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][0] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][0] - forceNodeVel[iTurb][iNodeForceLower][0] ); - cDriver_Output_to_FAST[iTurb].v[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][1] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][1] - forceNodeVel[iTurb][iNodeForceLower][1] ); - cDriver_Output_to_FAST[iTurb].w[iNodeVel] = forceNodeVel[iTurb][iNodeForceLower][2] + rInterp * (forceNodeVel[iTurb][iNodeForceLower+1][2] - forceNodeVel[iTurb][iNodeForceLower][2] ); - } + for (size_t j=0; j < 4; j++) { // Loop over states - STATE_NM2, STATE_NM1, STATE_N, STATE_NP1 + + const std::vector start_dim{n_tsteps, j, 0}; + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["twr_def"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["twr_vel"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["twr_ld"], start_dim.data(), twrDataDims.data(), brFSIData[iTurbLoc][j].twr_ld.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_def"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_vel"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_vel.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_ld"], start_dim.data(), bldDataDims.data(), brFSIData[iTurbLoc][j].bld_ld.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["hub_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["hub_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].hub_vel.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["nac_def"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["nac_vel"], start_dim.data(), ptDataDims.data(), brFSIData[iTurbLoc][j].nac_vel.data()); + + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_root_def"], start_dim.data(), bldRootDataDims.data(), brFSIData[iTurbLoc][j].bld_root_def.data()); + ierr = nc_put_vara_double(ncid, ncRstVarIDs_["bld_pitch"], start_dim.data(), bldPitchDataDims.data(), brFSIData[iTurbLoc][j].bld_pitch.data()); } + } + + nc_close(ncid); + + } -void fast::OpenFAST::computeTorqueThrust(int iTurbGlob, std::vector & torque, std::vector & thrust) { +// Mostly Blade-resolved stuff after this - //Compute the torque and thrust based on the forces at the actuator nodes - std::vector relLoc(3,0.0); - std::vector rPerpShft(3); - thrust[0] = 0.0; thrust[1] = 0.0; thrust[2] = 0.0; - torque[0] = 0.0; torque[1] = 0.0; torque[2] = 0.0; +void fast::OpenFAST::get_ref_positions_from_openfast(int iTurb) { - std::vector hubShftVec(3); - getHubShftDir(hubShftVec, iTurbGlob); + if(turbineData[iTurb].sType == EXTLOADS) { - int iTurbLoc = get_localTurbNo(iTurbGlob) ; - for (int k=0; k < get_numBladesLoc(iTurbLoc); k++) { - for (int j=0; j < numForcePtsBlade[iTurbLoc]; j++) { - int iNode = 1 + numForcePtsBlade[iTurbLoc]*k + j ; + for (int i=0; i < 3; i++) { + brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i] = extld_i_f_FAST[iTurb].hubRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i] = extld_i_f_FAST[iTurb].nacRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + } + + int nBlades = turbineData[iTurb].numBlades; + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; + for (int j=0; j < nPtsBlade; j++) { + for (int k=0; k < 3; k++) { + brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k] = extld_i_f_FAST[iTurb].bldRefPos[iRunTot*6+k] + turbineData[iTurb].TurbineBasePos[k]; + brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k+3] = extld_i_f_FAST[iTurb].bldRefPos[iRunTot*6+k+3]; + } + brFSIData[iTurb][fast::STATE_NP1].bld_chord[iRunTot] = extld_i_f_FAST[iTurb].bldChord[iRunTot]; + brFSIData[iTurb][fast::STATE_NP1].bld_rloc[iRunTot] = extld_i_f_FAST[iTurb].bldRloc[iRunTot]; + iRunTot++; + } - thrust[0] = thrust[0] + cDriver_Input_from_FAST[iTurbLoc].fx[iNode] ; - thrust[1] = thrust[1] + cDriver_Input_from_FAST[iTurbLoc].fy[iNode] ; - thrust[2] = thrust[2] + cDriver_Input_from_FAST[iTurbLoc].fz[iNode] ; + for (int k=0; k < 3; k++) { + brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k] = extld_i_f_FAST[iTurb].bldRootRefPos[i*6+k] + turbineData[iTurb].TurbineBasePos[k]; + brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k+3] = extld_i_f_FAST[iTurb].bldRootRefPos[i*6+k+3]; + } - relLoc[0] = cDriver_Input_from_FAST[iTurbLoc].pxForce[iNode] - cDriver_Input_from_FAST[iTurbLoc].pxForce[0]; - relLoc[1] = cDriver_Input_from_FAST[iTurbLoc].pyForce[iNode] - cDriver_Input_from_FAST[iTurbLoc].pyForce[0]; - relLoc[2] = cDriver_Input_from_FAST[iTurbLoc].pzForce[iNode] - cDriver_Input_from_FAST[iTurbLoc].pzForce[0]; + } - double rDotHubShftVec = relLoc[0]*hubShftVec[0] + relLoc[1]*hubShftVec[1] + relLoc[2]*hubShftVec[2]; - for (int j=0; j < 3; j++) rPerpShft[j] = relLoc[j] - rDotHubShftVec * hubShftVec[j]; + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) { + for (int j = 0; j < 3; j++) { + brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j] = extld_i_f_FAST[iTurb].twrRefPos[i*6+j] + turbineData[iTurb].TurbineBasePos[j]; + brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j+3] = extld_i_f_FAST[iTurb].twrRefPos[i*6+j+3]; + } + } - torque[0] = torque[0] + rPerpShft[1] * cDriver_Input_from_FAST[iTurbLoc].fz[iNode] - rPerpShft[2] * cDriver_Input_from_FAST[iTurbLoc].fy[iNode] + cDriver_Input_from_FAST[iTurbLoc].momentx[iNode] ; - torque[1] = torque[1] + rPerpShft[2] * cDriver_Input_from_FAST[iTurbLoc].fx[iNode] - rPerpShft[0] * cDriver_Input_from_FAST[iTurbLoc].fz[iNode] + cDriver_Input_from_FAST[iTurbLoc].momenty[iNode] ; - torque[2] = torque[2] + rPerpShft[0] * cDriver_Input_from_FAST[iTurbLoc].fy[iNode] - rPerpShft[1] * cDriver_Input_from_FAST[iTurbLoc].fx[iNode] + cDriver_Input_from_FAST[iTurbLoc].momentz[iNode] ; + } else if(turbineData[iTurb].sType == EXTINFLOW) { + + if (turbineData[iTurb].inflowType == 2) { + int nfpts = get_numForcePtsLoc(iTurb); + for (auto i=0; i 0 ) { - return TOWER; - } else { - return BLADE; + int nBlades = get_numBladesLoc(iTurbLoc); + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + for(int j=0; j 0 ) { - return TOWER; - } else { - return BLADE; + int nBlades = get_numBladesLoc(iTurbLoc); + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + for(int j=0; j 0) closeVelocityDataFile(nt_global, velNodeDataFile); +} - if ( !dryRun) { - bool stopTheProgram = false; - for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_End(&iTurb, &stopTheProgram); - } - FAST_DeallocateTurbines(&ErrStat, ErrMsg); - } +void fast::OpenFAST::getTowerRefPositions(double* twrRefPos, int iTurbGlob, int nSize) { - MPI_Group_free(&fastMPIGroup); - if (MPI_COMM_NULL != fastMPIComm) { - MPI_Comm_free(&fastMPIComm); + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) { + for (int j=0; j < nSize; j++) { + twrRefPos[i*6+j] = brFSIData[iTurbLoc][fast::STATE_NP1].twr_ref_pos[i*6+j]; + } } - MPI_Group_free(&worldMPIGroup); - if(scStatus) { - std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; - // sc.end(); - } } -void fast::OpenFAST::readVelocityData(int nTimesteps) { +void fast::OpenFAST::getTowerDisplacements(double* twrDefl, double* twrVel, int iTurbGlob, fast::timeStep t, int nSize) { - int nTurbines; - - hid_t velDataFile = H5Fopen(("velDatafile." + std::to_string(worldMPIRank) + ".h5").c_str(), H5F_ACC_RDWR, H5P_DEFAULT); - - { - hid_t attr = H5Aopen(velDataFile, "nTurbines", H5P_DEFAULT); - herr_t ret = H5Aread(attr, H5T_NATIVE_INT, &nTurbines) ; - H5Aclose(attr); + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) { + for (int j=0; j < nSize; j++) { + twrDefl[i*6+j] = brFSIData[iTurbLoc][t].twr_def[i*6+j]; + twrVel[i*6+j] = brFSIData[iTurbLoc][t].twr_vel[i*6+j]; + } } - // Allocate memory and read the velocity data. - velNodeData.resize(nTurbines); - for (int iTurb=0; iTurb < nTurbines; iTurb++) { - int nVelPts = get_numVelPtsLoc(iTurb) ; - velNodeData[iTurb].resize(nTimesteps*nVelPts*6) ; - hid_t dset_id = H5Dopen2(velDataFile, ("/turbine" + std::to_string(iTurb)).c_str(), H5P_DEFAULT); - hid_t dspace_id = H5Dget_space(dset_id); +} - hsize_t start[3]; start[1] = 0; start[2] = 0; - hsize_t count[3]; count[0] = 1; count[1] = nVelPts; count[2] = 6; - hid_t mspace_id = H5Screate_simple(3, count, NULL); +void fast::OpenFAST::getHubRefPosition(double* hubRefPos, int iTurbGlob, int nSize) { - for (int iStep=0; iStep < nTimesteps; iStep++) { - start[0] = iStep; - H5Sselect_hyperslab(dspace_id, H5S_SELECT_SET, start, NULL, count, NULL); - herr_t status = H5Dread(dset_id, H5T_NATIVE_DOUBLE, mspace_id, dspace_id, H5P_DEFAULT, &velNodeData[iTurb][iStep*nVelPts*6] ); - } + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) + hubRefPos[j] = brFSIData[iTurbLoc][fast::STATE_NP1].hub_ref_pos[j]; - herr_t status = H5Dclose(dset_id); - } } -hid_t fast::OpenFAST::openVelocityDataFile(bool createFile) { +void fast::OpenFAST::getHubDisplacement(double* hubDefl, double* hubVel, int iTurbGlob, fast::timeStep t, int nSize) { - hid_t velDataFile; - if (createFile) { - // Open the file in create mode - velDataFile = H5Fcreate(("velDatafile." + std::to_string(worldMPIRank) + ".h5").c_str(), H5F_ACC_TRUNC, H5P_DEFAULT, H5P_DEFAULT); + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) { + hubDefl[j] = brFSIData[iTurbLoc][t].hub_def[j]; + hubVel[j] = brFSIData[iTurbLoc][t].hub_vel[j]; + } - { - hsize_t dims[1]; - dims[0] = 1; - hid_t dataSpace = H5Screate_simple(1, dims, NULL); - hid_t attr = H5Acreate2(velDataFile, "nTurbines", H5T_NATIVE_INT, dataSpace, H5P_DEFAULT, H5P_DEFAULT) ; - herr_t status = H5Awrite(attr, H5T_NATIVE_INT, &nTurbinesProc); - status = H5Aclose(attr); - status = H5Sclose(dataSpace); - - dataSpace = H5Screate_simple(1, dims, NULL); - attr = H5Acreate2(velDataFile, "nTimesteps", H5T_NATIVE_INT, dataSpace, H5P_DEFAULT, H5P_DEFAULT) ; - status = H5Aclose(attr); - status = H5Sclose(dataSpace); - } +} - int ntMax = tMax/dtFAST ; +void fast::OpenFAST::getNacelleRefPosition(double* nacRefPos, int iTurbGlob, int nSize) { - for (int iTurb = 0; iTurb < nTurbinesProc; iTurb++) { - int nVelPts = get_numVelPtsLoc(iTurb); - hsize_t dims[3]; - dims[0] = ntMax; dims[1] = nVelPts; dims[2] = 6 ; + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) + nacRefPos[j] = brFSIData[iTurbLoc][fast::STATE_NP1].nac_ref_pos[j]; - hsize_t chunk_dims[3]; - chunk_dims[0] = 1; chunk_dims[1] = nVelPts; chunk_dims[2] = 6; - hid_t dcpl_id = H5Pcreate(H5P_DATASET_CREATE); - H5Pset_chunk(dcpl_id, 3, chunk_dims); +} - hid_t dataSpace = H5Screate_simple(3, dims, NULL); - hid_t dataSet = H5Dcreate(velDataFile, ("/turbine" + std::to_string(iTurb)).c_str(), H5T_NATIVE_DOUBLE, dataSpace, H5P_DEFAULT, dcpl_id, H5P_DEFAULT); - herr_t status = H5Pclose(dcpl_id); - status = H5Dclose(dataSet); - status = H5Sclose(dataSpace); - } +void fast::OpenFAST::getNacelleDisplacement(double* nacDefl, double* nacVel, int iTurbGlob, fast::timeStep t, int nSize) { - } else { - // Open the file in append mode - velDataFile = H5Fopen(("velDatafile." + std::to_string(worldMPIRank) + ".h5").c_str(), H5F_ACC_RDWR, H5P_DEFAULT); + int iTurbLoc = get_localTurbNo(iTurbGlob); + for (int j=0; j < nSize; j++) { + nacDefl[j] = brFSIData[iTurbLoc][t].nac_def[j]; + nacVel[j] = brFSIData[iTurbLoc][t].nac_vel[j]; } - return velDataFile; - } -herr_t fast::OpenFAST::closeVelocityDataFile(int nt_global, hid_t velDataFile) { - herr_t status = H5Fclose(velDataFile) ; - return status; -} +void fast::OpenFAST::setBladeForces(double* bldForces, int iTurbGlob, fast::timeStep t, int nSize) { -void fast::OpenFAST::backupVelocityDataFile(int curTimeStep, hid_t & velDataFile) { + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nBlades = get_numBladesLoc(iTurbLoc); + int iRunTot = 0; + for (int i=0; i < nBlades; i++) { + int nPtsBlade = turbineData[iTurbLoc].nBRfsiPtsBlade[i]; + for(int j=0; j < nPtsBlade; j++) { + for(int k=0; k < nSize; k++) { + brFSIData[iTurbLoc][t].bld_ld[6*iRunTot+k] = bldForces[6*iRunTot+k]; + } + iRunTot++; + } + } - closeVelocityDataFile(curTimeStep, velDataFile); + //TODO: May be calculate the residual as well. +} - std::ifstream source("velDatafile." + std::to_string(worldMPIRank) + ".h5", std::ios::binary); - std::ofstream dest("velDatafile." + std::to_string(worldMPIRank) + ".h5." + std::to_string(curTimeStep) + ".bak", std::ios::binary); +void fast::OpenFAST::setTowerForces(double* twrForces, int iTurbGlob, fast::timeStep t, int nSize) { - dest << source.rdbuf(); - source.close(); - dest.close(); + int iTurbLoc = get_localTurbNo(iTurbGlob); + int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; + for (int i=0; i < nPtsTwr; i++) + for (int j=0; j < nSize; j++) + brFSIData[iTurbLoc][t].twr_ld[i*6+j] = twrForces[i*6+j]; + //TODO: May be calculate the residual as well. - velDataFile = openVelocityDataFile(false); } -void fast::OpenFAST::writeVelocityData(hid_t h5File, int iTurb, int iTimestep, OpFM_InputType_t iData, OpFM_OutputType_t oData) { +//! Sets a uniform X force at all blade nodes +void fast::OpenFAST::setUniformXBladeForces(double loadX) { - hsize_t start[3]; start[0] = iTimestep; start[1] = 0; start[2] = 0; - int nVelPts = get_numVelPtsLoc(iTurb) ; - hsize_t count[3]; count[0] = 1; count[1] = nVelPts; count[2] = 6; - - std::vector tmpVelData; - tmpVelData.resize(nVelPts * 6); + for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { + int iTurbGlob = turbineMapProcToGlob[iTurb]; + int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; + std::vector fsiForceTower(6*nPtsTwr,0.0); + setTowerForces(fsiForceTower, iTurbGlob, fast::STATE_NP1); - for (int iNode=0 ; iNode < nVelPts; iNode++) { - tmpVelData[iNode*6 + 0] = iData.pxVel[iNode]; - tmpVelData[iNode*6 + 1] = iData.pyVel[iNode]; - tmpVelData[iNode*6 + 2] = iData.pzVel[iNode]; - tmpVelData[iNode*6 + 3] = oData.u[iNode]; - tmpVelData[iNode*6 + 4] = oData.v[iNode]; - tmpVelData[iNode*6 + 5] = oData.w[iNode]; - } + size_t nBlades = get_numBladesLoc(iTurb); + size_t nTotPtsBlade = 0; + for(int iBlade=0; iBlade < nBlades; iBlade++) + nTotPtsBlade += turbineData[iTurb].nBRfsiPtsBlade[iBlade]; - hid_t dset_id = H5Dopen2(h5File, ("/turbine" + std::to_string(iTurb)).c_str(), H5P_DEFAULT); - hid_t dspace_id = H5Dget_space(dset_id); - H5Sselect_hyperslab(dspace_id, H5S_SELECT_SET, start, NULL, count, NULL); - hid_t mspace_id = H5Screate_simple(3, count, NULL); - H5Dwrite(dset_id, H5T_NATIVE_DOUBLE, mspace_id, dspace_id, H5P_DEFAULT, tmpVelData.data()); + std::vector fsiForceBlade(6*nTotPtsBlade, 0.0); + std::vector dr(nTotPtsBlade, 0.0); - H5Dclose(dset_id); - H5Sclose(dspace_id); - H5Sclose(mspace_id); + size_t iNode=0; + for(int iBlade=0; iBlade < nBlades; iBlade++) { + int nBldPts = turbineData[iTurb].nBRfsiPtsBlade[iBlade]; + dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode+1] - brFSIData[iTurb][3].bld_rloc[iNode]); + iNode++; + + for(int i=1; i < nBldPts-1; i++) { + dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode+1] - brFSIData[iTurb][3].bld_rloc[iNode-1]); + iNode++; + } + dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode] - brFSIData[iTurb][3].bld_rloc[iNode-1]); + iNode++; + } - hid_t attr_id = H5Aopen_by_name(h5File, ".", "nTimesteps", H5P_DEFAULT, H5P_DEFAULT); - herr_t status = H5Awrite(attr_id, H5T_NATIVE_INT, &iTimestep); - status = H5Aclose(attr_id); + for(int i=0; i < nTotPtsBlade; i++) + fsiForceBlade[i*6] = loadX * dr[i]; // X component of force -} + setBladeForces(fsiForceBlade, iTurbGlob, fast::STATE_NP1); -void fast::OpenFAST::applyVelocityData(int iPrestart, int iTurb, OpFM_OutputType_t cDriver_Output_to_FAST, std::vector & velData) { - int nVelPts = get_numVelPtsLoc(iTurb); - for (int j = 0; j < nVelPts; j++){ - cDriver_Output_to_FAST.u[j] = velData[(iPrestart*nVelPts+j)*6 + 3]; - cDriver_Output_to_FAST.v[j] = velData[(iPrestart*nVelPts+j)*6 + 4]; - cDriver_Output_to_FAST.w[j] = velData[(iPrestart*nVelPts+j)*6 + 5]; } } @@ -1045,6 +3179,8 @@ void fast::OpenFAST::loadSuperController(const fast::fastInputs & fi) { // sc.load(fi.nTurbinesGlob, fi.scLibFile, scio); } else { + scStatus = false; } + } diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index f4251c35cd..0951880194 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -34,11 +34,12 @@ matlab_add_mex( $ $ $ + $ $ $ $ $ - $ + $ $ $ $ @@ -50,7 +51,7 @@ matlab_add_mex( $ # MATLAB Specific $ $ - $ + $ $ ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS} diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 9f84c675b2..e91e5c9fde 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -882,6 +882,11 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) InitOut%Ver = BeamDyn_Ver + call AllocAry(InitOut%QPtN, p%nqp, 'InitOut%QPtN', ErrStat2,ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if(ErrStat >= AbortErrLev) return + + InitOut%QPtN = (p%QPtN + 1.0)*0.5 ! Set the info in WriteOutputHdr and WriteOutputUnt for BldNd sections. CALL BldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 2855508d9e..baa88b5194 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -63,6 +63,7 @@ MODULE BeamDyn_Types TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] INTEGER(IntKi) :: kp_total !< Total number of key points [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtN !< Quadrature (QuadPt) point locations in natural frame [-1, 1] [-] 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 [-] @@ -685,6 +686,18 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate ENDIF DstInitOutputData%kp_total = SrcInitOutputData%kp_total +IF (ALLOCATED(SrcInitOutputData%QPtN)) THEN + i1_l = LBOUND(SrcInitOutputData%QPtN,1) + i1_u = UBOUND(SrcInitOutputData%QPtN,1) + IF (.NOT. ALLOCATED(DstInitOutputData%QPtN)) THEN + ALLOCATE(DstInitOutputData%QPtN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%QPtN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%QPtN = SrcInitOutputData%QPtN +ENDIF IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) @@ -815,6 +828,9 @@ SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN DEALLOCATE(InitOutputData%kp_coordinate) ENDIF +IF (ALLOCATED(InitOutputData%QPtN)) THEN + DEALLOCATE(InitOutputData%QPtN) +ENDIF IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) ENDIF @@ -910,6 +926,11 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate END IF Int_BufSz = Int_BufSz + 1 ! kp_total + Int_BufSz = Int_BufSz + 1 ! QPtN allocated yes/no + IF ( ALLOCATED(InData%QPtN) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! QPtN upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%QPtN) ! QPtN + END IF Int_BufSz = Int_BufSz + 1 ! 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 @@ -1061,6 +1082,21 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF IntKiBuf(Int_Xferred) = InData%kp_total Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) + DbKiBuf(Db_Xferred) = InData%QPtN(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1322,6 +1358,24 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END IF OutData%kp_total = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%QPtN)) DEALLOCATE(OutData%QPtN) + ALLOCATE(OutData%QPtN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) + OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 108a743e24..0593f22ba8 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -44,6 +44,7 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType R8Ki kp_coordinate {:}{:} - - "Key point coordinates array" - typedef ^ InitOutputType IntKi kp_total - - - "Total number of key points" - +typedef ^ InitOutputType R8Ki QPtN {:} - - "Quadrature (QuadPt) point locations in natural frame [-1, 1]" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - #typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 36d7222ce6..0183457854 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -287,7 +287,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%Ver = ED_Ver InitOut%NumBl = p%NumBl InitOut%BladeLength = p%TipRad - p%HubRad - InitOut%TowerHeight = p%TwrFlexL + InitOut%TowerFlexL = p%TwrFlexL InitOut%TowerBaseHeight = p%TowerBsHt ! Platform reference point wrt to global origin (0,0,0) diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 4d1038aebf..935d2ccc46 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -36,7 +36,7 @@ typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and da typedef ^ InitOutputType IntKi NumBl - - - "Number of blades on the turbine" - typedef ^ InitOutputType ReKi BlPitch {:} - - "Initial blade pitch angles" radians typedef ^ InitOutputType ReKi BladeLength - - - "Blade length (for AeroDyn)" meters -typedef ^ InitOutputType ReKi TowerHeight - - - "Tower Height" meters +typedef ^ InitOutputType ReKi TowerFlexL - - - "Tower Flexible Length" meters typedef ^ InitOutputType ReKi TowerBaseHeight - - - "Tower Base Height" meters typedef ^ InitOutputType ReKi HubHt - - - "Height of the hub" meters typedef ^ InitOutputType ReKi BldRNodes {:} - - "Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL )" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index e4831db34a..a49c29ed6b 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -56,7 +56,7 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] REAL(ReKi) :: BladeLength !< Blade length (for AeroDyn) [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] + REAL(ReKi) :: TowerFlexL !< Tower Flexible Length [meters] REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] REAL(ReKi) :: HubHt !< Height of the hub [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldRNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] @@ -1093,7 +1093,7 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch ENDIF DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength - DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight + DstInitOutputData%TowerFlexL = SrcInitOutputData%TowerFlexL DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight DstInitOutputData%HubHt = SrcInitOutputData%HubHt IF (ALLOCATED(SrcInitOutputData%BldRNodes)) THEN @@ -1361,7 +1361,7 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch END IF Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight + Re_BufSz = Re_BufSz + 1 ! TowerFlexL Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight Re_BufSz = Re_BufSz + 1 ! HubHt Int_BufSz = Int_BufSz + 1 ! BldRNodes allocated yes/no @@ -1531,7 +1531,7 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF ReKiBuf(Re_Xferred) = InData%BladeLength Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight + ReKiBuf(Re_Xferred) = InData%TowerFlexL Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%TowerBaseHeight Re_Xferred = Re_Xferred + 1 @@ -1857,7 +1857,7 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END IF OutData%BladeLength = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf(Re_Xferred) + OutData%TowerFlexL = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 diff --git a/modules/externalinflow/CMakeLists.txt b/modules/externalinflow/CMakeLists.txt index eba5bbf1e4..6c730023a1 100644 --- a/modules/externalinflow/CMakeLists.txt +++ b/modules/externalinflow/CMakeLists.txt @@ -35,8 +35,7 @@ set_target_properties(extinflowlib PROPERTIES PUBLIC_HEADER src/ExternalInflow_T install(TARGETS extinflowtypeslib extinflowlib EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin - ARCHIVE DESTINATION lib LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib PUBLIC_HEADER DESTINATION include ) - diff --git a/modules/extloads/CMakeLists.txt b/modules/extloads/CMakeLists.txt new file mode 100644 index 0000000000..b649f69557 --- /dev/null +++ b/modules/extloads/CMakeLists.txt @@ -0,0 +1,39 @@ +# +# Copyright 2016 National Renewable Energy Laboratory +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# + +if (GENERATE_TYPES) + generate_f90_types(src/ExtLoadsDX_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ExtLoadsDX_Types.f90 -ccode) + generate_f90_types(src/ExtLoads_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/ExtLoads_Types.f90) +endif() + +add_library(extloadslib STATIC + src/ExtLoads.f90 + src/ExtLoads_Types.f90 + src/ExtLoadsDX_Types.f90 +) +target_include_directories(extloadslib PUBLIC + $ +) +target_link_libraries(extloadslib beamdynlib nwtclibs versioninfolib) +set_target_properties(extloadslib PROPERTIES PUBLIC_HEADER "src/ExtLoadsDX_Types.h") + +install(TARGETS extloadslib + EXPORT "${CMAKE_PROJECT_NAME}Libraries" + RUNTIME DESTINATION bin + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib + PUBLIC_HEADER DESTINATION include +) diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 new file mode 100644 index 0000000000..84f034f13b --- /dev/null +++ b/modules/extloads/src/ExtLoads.f90 @@ -0,0 +1,931 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2015-2016 National Renewable Energy Laboratory +! +! This file is part of ExtLoads. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +!********************************************************************************************************************************** +! File last committed: $Date$ +! (File) Revision #: $Rev$ +! URL: $HeadURL$ +!********************************************************************************************************************************** +!> ExtLoads is a time-domain loads module for horizontal-axis wind turbines. +module ExtLoads + + use NWTC_Library + use ExtLoads_Types + + implicit none + + private + + ! ..... Public Subroutines ................................................................................................... + + public :: ExtLd_Init ! Initialization routine + public :: ExtLd_End ! Ending routine (includes clean up) + public :: ExtLd_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + public :: ExtLd_CalcOutput ! Routine for computing outputs + public :: ExtLd_ConvertOpDataForOpenFAST ! Routine to convert Output data for OpenFAST + public :: ExtLd_ConvertInpDataForExtProg ! Routine to convert Input data for external programs + +contains +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., +!! FAST) +subroutine ExtLd_SetInitOut(p, InitOut, errStat, errMsg) + + type(ExtLd_InitOutputType), intent( out) :: InitOut ! output data + type(ExtLd_ParameterType), intent(in ) :: p ! Parameters + integer(IntKi), intent( out) :: errStat ! Error status of the operation + character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None + + + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_SetInitOut' + + + + integer(IntKi) :: i, j, k, f + integer(IntKi) :: NumCoords +#ifdef DBG_OUTS + integer(IntKi) :: m + character(5) ::chanPrefix +#endif + ! Initialize variables for this routine + + errStat = ErrID_None + errMsg = "" + +end subroutine ExtLd_SetInitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the start of the simulation to perform initialization steps. +!! The parameters are set here and not changed during the simulation. +!! The initial states and initial guess for the input are defined. +subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrMsg ) +!.................................................................................................................................. + + type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(ExtLd_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(ExtLd_DiscreteStateType), intent( out) :: xd !< An initial guess for the discrete states + type(ExtLd_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; + type(ExtLd_MiscVarType), intent( out) :: m !< Miscellaneous variables + type(ExtLd_ParameterType), intent( out) :: p !< Parameter variables + !! only the output mesh is initialized) + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + !! (1) ExtLd_UpdateStates() is called in loose coupling & + !! (2) ExtLd_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. + type(ExtLd_InitOutputType), intent( out) :: InitOut !< Output for initialization routine + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + integer(IntKi) :: i ! loop counter + + integer(IntKi) :: errStat2 ! temporary error status of the operation + character(ErrMsgLen) :: errMsg2 ! temporary error message + + character(*), parameter :: RoutineName = 'ExtLd_Init' + + + ! Initialize variables for this routine + + errStat = ErrID_None + errMsg = "" + + ! Initialize the NWTC Subroutine Library + + ! Set parameters here + p%NumBlds = InitInp%NumBlades + call AllocAry(p%NumBldNds, p%NumBlds, 'NumBldNds', ErrStat2,ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + p%NumBldNds(:) = InitInp%NumBldNodes(:) + p%nTotBldNds = sum(p%NumBldNds(:)) + p%NumTwrNds = InitInp%NumTwrNds + p%TwrAero = .true. + + p%az_blend_mean = InitInp%az_blend_mean + p%az_blend_delta = InitInp%az_blend_delta + p%vel_mean = InitInp%vel_mean + p%wind_dir = InitInp%wind_dir + p%z_ref = InitInp%z_ref + p%shear_exp = InitInp%shear_exp + + !............................................................................................ + ! Define and initialize inputs here + !............................................................................................ + + write(*,*) 'Initializing U ' + + call Init_u( u, p, InitInp, errStat2, errMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + + ! Initialize discrete states + m%az = 0.0 + m%phi_cfd = 0.0 + + write(*,*) 'Initializing y ' + ! + !............................................................................................ + ! Define outputs here + !............................................................................................ + call Init_y(y, u, m, p, errStat2, errMsg2) ! do this after input meshes have been initialized + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call Cleanup() + return + end if + + write(*,*) 'Initializing InitOut ' + + !............................................................................................ + ! Define initialization output here + !............................................................................................ + call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call Cleanup() + +contains + subroutine Cleanup() + + end subroutine Cleanup + +end subroutine ExtLd_Init +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes ExtLoads meshes and output array variables for use during the simulation. +subroutine Init_y(y, u, m, p, errStat, errMsg) + type(ExtLd_OutputType), intent( out) :: y !< Module outputs + type(ExtLd_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy + type(ExtLd_MiscVarType), intent(inout) :: m !< Module misc var + type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + integer(intKi) :: k ! loop counter for blades + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_y' + + ! Initialize variables for this routine + + errStat = ErrID_None + errMsg = "" + + if (p%TwrAero) then + + call MeshCopy ( SrcMesh = u%TowerMotion & + , DestMesh = y%TowerLoad & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) RETURN + + call MeshCopy ( SrcMesh = u%TowerMotion & + , DestMesh = y%TowerLoadAD & + , CtrlCode = MESH_COUSIN & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) RETURN + + !call MeshCommit(y%TowerLoadAD, errStat2, errMsg2 ) + !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + !y%TowerLoad%force = 0.0_ReKi ! shouldn't have to initialize this + !y%TowerLoad%moment= 0.0_ReKi ! shouldn't have to initialize this + else + y%TowerLoad%nnodes = 0 + y%TowerLoadAD%nnodes = 0 + end if + + allocate( y%BladeLoad(p%NumBlds), stat=ErrStat2 ) + if (errStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) + return + end if + + allocate( y%BladeLoadAD(p%NumBlds), stat=ErrStat2 ) + if (errStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) + return + end if + + do k = 1, p%NumBlds + + call MeshCopy ( SrcMesh = u%BladeMotion(k) & + , DestMesh = y%BladeLoad(k) & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call MeshCopy ( SrcMesh = u%BladeMotion(k) & + , DestMesh = y%BladeLoadAD(k) & + , CtrlCode = MESH_COUSIN & + , IOS = COMPONENT_OUTPUT & + , force = .TRUE. & + , moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !call MeshCommit(y%BladeLoadAD(k), errStat2, errMsg2 ) + !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + + end do + + CALL AllocPAry( y%DX_y%twrLd, p%NumTwrNds*6, 'twrLd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( y%DX_y%bldLd, p%nTotBldNds*6, 'bldLd', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + y%DX_y%c_obj%twrLd_Len = p%NumTwrNds*6; y%DX_y%c_obj%twrLd = C_LOC( y%DX_y%twrLd(1) ) + y%DX_y%c_obj%bldLd_Len = p%nTotBldNds*6; y%DX_y%c_obj%bldLd = C_LOC( y%DX_y%bldLd(1) ) + + call ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +end subroutine Init_y +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes ExtLoads meshes and input array variables for use during the simulation. +subroutine Init_u( u, p, InitInp, errStat, errMsg ) +!.................................................................................................................................. + + USE BeamDyn_IO, ONLY: BD_CrvExtractCrv + + type(ExtLd_InputType), intent( out) :: u !< Input data + type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for ExtLd initialization routine + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + real(reKi) :: position(3) ! node reference position + real(reKi) :: positionL(3) ! node local position + real(R8Ki) :: theta(3) ! Euler angles + real(R8Ki) :: orientation(3,3) ! node reference orientation + real(R8Ki) :: orientationL(3,3) ! node local orientation + + real(R8Ki) :: wm_crv(3) ! Wiener-Milenkovic parameters + integer(IntKi) :: j ! counter for nodes + integer(IntKi) :: jTot ! counter for blade nodes + integer(IntKi) :: k ! counter for blades + + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_u' + + ! Initialize variables for this routine + + ErrStat = ErrID_None + ErrMsg = "" + + + u%az = 0.0 + ! Meshes for motion inputs (ElastoDyn and/or BeamDyn) + !................ + ! tower + !................ + if (p%NumTwrNds > 0) then + + call MeshCreate ( BlankMesh = u%TowerMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = p%NumTwrNds & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + ! set node initial position/orientation + position = 0.0_ReKi + do j=1,p%NumTwrNds + position(:) = InitInp%TwrPos(:,j) + + call MeshPositionNode(u%TowerMotion, j, position, errStat2, errMsg2) ! orientation is identity by default + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do !j + + ! create point elements + do j=1,p%NumTwrNds + call MeshConstructElement( u%TowerMotion, ELEMENT_POINT, errStat2, errMsg2, p1=j ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do !j + + call MeshCommit(u%TowerMotion, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + u%TowerMotion%Orientation = u%TowerMotion%RefOrientation + u%TowerMotion%TranslationDisp = 0.0_R8Ki + u%TowerMotion%TranslationVel = 0.0_ReKi + u%TowerMotion%RotationVel = 0.0_ReKi + + end if ! we compute tower loads + + !................ + ! hub + !................ + + call MeshCreate ( BlankMesh = u%HubMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + call MeshPositionNode(u%HubMotion, 1, InitInp%HubPos, errStat2, errMsg2, InitInp%HubOrient) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshConstructElement( u%HubMotion, ELEMENT_POINT, errStat2, errMsg2, p1=1 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshCommit(u%HubMotion, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + u%HubMotion%Orientation = u%HubMotion%RefOrientation + u%HubMotion%TranslationDisp = 0.0_R8Ki + u%HubMotion%TranslationVel = 0.0_R8Ki + u%HubMotion%RotationVel = 0.0_R8Ki + + !................ + ! nacelle + !................ + + call MeshCreate ( BlankMesh = u%NacelleMotion & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + call MeshPositionNode(u%NacelleMotion, 1, InitInp%NacellePos, errStat2, errMsg2, InitInp%NacelleOrient) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshConstructElement( u%NacelleMotion, ELEMENT_POINT, errStat2, errMsg2, p1=1 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshCommit(u%NacelleMotion, errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + u%NacelleMotion%Orientation = u%NacelleMotion%RefOrientation + u%NacelleMotion%TranslationDisp = 0.0_R8Ki + u%NacelleMotion%TranslationVel = 0.0_R8Ki + u%NacelleMotion%RotationVel = 0.0_R8Ki + + !................ + ! blades + !................ + + allocate( u%BladeRootMotion(p%NumBlds), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeRootMotion array.', ErrStat, ErrMsg, RoutineName ) + return + end if + + allocate( u%BladeMotion(p%NumBlds), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeMotion array.', ErrStat, ErrMsg, RoutineName ) + return + end if + + do k=1,p%NumBlds + + call MeshCreate ( BlankMesh = u%BladeRootMotion(k) & + ,IOS = COMPONENT_INPUT & + ,Nnodes = 1 & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + call MeshPositionNode(u%BladeRootMotion(k), 1, InitInp%BldRootPos(:,k), errStat2, errMsg2, InitInp%BldRootOrient(:,:,k)) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshConstructElement( u%BladeRootMotion(k), ELEMENT_POINT, errStat2, errMsg2, p1=1 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + call MeshCommit(u%BladeRootMotion(k), errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + u%BladeRootMotion(k)%Orientation = u%BladeRootMotion(k)%RefOrientation + u%BladeRootMotion(k)%TranslationDisp = 0.0_R8Ki + u%BladeRootMotion(k)%TranslationVel = 0.0_R8Ki + u%BladeRootMotion(k)%RotationVel = 0.0_R8Ki + + call MeshCreate ( BlankMesh = u%BladeMotion(k) & + ,IOS = COMPONENT_INPUT & + ,Nnodes = InitInp%NumBldNodes(k) & + ,ErrStat = ErrStat2 & + ,ErrMess = ErrMsg2 & + ,Orientation = .true. & + ,TranslationDisp = .true. & + ,TranslationVel = .true. & + ,RotationVel = .true. & + ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + + do j=1,InitInp%NumBldNodes(k) + + ! reference position of the jth node in the kth blade: + position(:) = InitInp%BldPos(:,j,k) + + ! reference orientation of the jth node in the kth blade + orientation(:,:) = InitInp%BldOrient(:,:,j,k) + + + call MeshPositionNode(u%BladeMotion(k), j, position, errStat2, errMsg2, orientation) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + end do ! j=blade nodes + + ! create point elements + do j=1,InitInp%NumBldNodes(k) + call MeshConstructElement( u%BladeMotion(k), ELEMENT_POINT, errStat2, errMsg2, p1=j ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + end do !j + + call MeshCommit(u%BladeMotion(k), errStat2, errMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + + if (errStat >= AbortErrLev) return + + u%BladeMotion(k)%Orientation = u%BladeMotion(k)%RefOrientation + u%BladeMotion(k)%TranslationDisp = 0.0_R8Ki + u%BladeMotion(k)%TranslationVel = 0.0_R8Ki + u%BladeMotion(k)%RotationVel = 0.0_R8Ki + + end do !k=numBlades + + ! Set the parameters first + CALL AllocPAry( u%DX_u%nTowerNodes, 1, 'nTowerNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + u%DX_u%c_obj%nTowerNodes_Len = 1; u%DX_u%c_obj%nTowerNodes = C_LOC( u%DX_u%nTowerNodes(1) ) + u%DX_u%nTowerNodes(1) = p%NumTwrNds + CALL AllocPAry( u%DX_u%nBlades, 1, 'nBlades', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + u%DX_u%c_obj%nBlades_Len = 1; u%DX_u%c_obj%nBlades = C_LOC( u%DX_u%nBlades(1) ) + u%DX_u%nBlades(1) = p%NumBlds + CALL AllocPAry( u%DX_u%nBladeNodes, p%NumBlds, 'nBladeNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + u%DX_u%c_obj%nBladeNodes_Len = p%NumBlds; u%DX_u%c_obj%nBladeNodes = C_LOC( u%DX_u%nBladeNodes(1) ) + u%DX_u%nBladeNodes(:) = p%NumBldNds(:) + + ! Set the reference positions next + CALL AllocPAry( u%DX_u%twrRefPos, p%NumTwrNds*6, 'twrRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldRefPos, p%nTotBldNds*6, 'bldRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%hubRefPos, 6, 'hubRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%nacRefPos, 6, 'nacRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry (u%DX_u%bldRootRefPos, p%NumBlds*6, 'bldRootRefPos', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + u%DX_u%c_obj%twrRefPos_Len = p%NumTwrNds*6; u%DX_u%c_obj%twrRefPos = C_LOC( u%DX_u%twrRefPos(1) ) + u%DX_u%c_obj%bldRefPos_Len = p%nTotBldNds*6; u%DX_u%c_obj%bldRefPos = C_LOC( u%DX_u%bldRefPos(1) ) + u%DX_u%c_obj%hubRefPos_Len = 6; u%DX_u%c_obj%hubRefPos = C_LOC( u%DX_u%hubRefPos(1) ) + u%DX_u%c_obj%nacRefPos_Len = 6; u%DX_u%c_obj%nacRefPos = C_LOC( u%DX_u%nacRefPos(1) ) + u%DX_u%c_obj%bldRootRefPos_Len = p%NumBlds*6; u%DX_u%c_obj%bldRootRefPos = C_LOC( u%DX_u%bldRootRefPos(1) ) + + if (p%TwrAero) then + do j=1,p%NumTwrNds + call BD_CrvExtractCrv(u%TowerMotion%RefOrientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + u%DX_u%twrRefPos((j-1)*6+1:(j-1)*6+3) = u%TowerMotion%Position(:,j) + u%DX_u%twrRefPos((j-1)*6+4:(j-1)*6+6) = wm_crv + end do + end if + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + call BD_CrvExtractCrv(u%BladeMotion(k)%RefOrientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%bldRefPos((jTot-1)*6+1:(jTot-1)*6+3) = u%BladeMotion(k)%Position(:,j) + u%DX_u%bldRefPos((jTot-1)*6+4:(jTot-1)*6+6) = wm_crv + jTot = jTot+1 + end do + end do + + call BD_CrvExtractCrv(u%HubMotion%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%hubRefPos(1:3) = u%HubMotion%Position(:,1) + u%DX_u%hubRefPos(4:6) = wm_crv + + call BD_CrvExtractCrv(u%NacelleMotion%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%nacRefPos(1:3) = u%NacelleMotion%Position(:,1) + u%DX_u%nacRefPos(4:6) = wm_crv + + do k=1,p%NumBlds + call BD_CrvExtractCrv(u%BladeRootMotion(k)%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%bldRootRefPos((k-1)*6+1:(k-1)*6+3) = u%BladeRootMotion(k)%Position(:,1) + u%DX_u%bldRootRefPos((k-1)*6+4:(k-1)*6+6) = wm_crv + end do + + + ! Now the displacements + CALL AllocPAry( u%DX_u%twrDef, p%NumTwrNds*12, 'twrDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldDef, p%nTotBldNds*12, 'bldDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%hubDef, 12, 'hubDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%nacDef, 12, 'nacDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldRootDef, p%NumBlds*12, 'bldRootDef', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + u%DX_u%c_obj%twrDef_Len = p%NumTwrNds*12; u%DX_u%c_obj%twrDef = C_LOC( u%DX_u%twrDef(1) ) + u%DX_u%c_obj%bldDef_Len = p%nTotBldNds*12; u%DX_u%c_obj%bldDef = C_LOC( u%DX_u%bldDef(1) ) + u%DX_u%c_obj%hubDef_Len = 12; u%DX_u%c_obj%hubDef = C_LOC( u%DX_u%hubDef(1) ) + u%DX_u%c_obj%nacDef_Len = 12; u%DX_u%c_obj%nacDef = C_LOC( u%DX_u%nacDef(1) ) + u%DX_u%c_obj%bldRootDef_Len = p%NumBlds*12; u%DX_u%c_obj%bldRootDef = C_LOC( u%DX_u%bldRootDef(1) ) + call ExtLd_ConvertInpDataForExtProg(u, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AllocPAry( u%DX_u%bldChord, p%nTotBldNds, 'bldChord', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldRloc, p%nTotBldNds, 'bldRloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%twrdia, p%NumTwrNds, 'twrDia', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%twrHloc, p%NumTwrNds, 'twrHloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( u%DX_u%bldPitch, p%NumBlds, 'bldPitch', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! make sure the C versions are synced with these arrays + u%DX_u%c_obj%bldChord_Len = p%nTotBldNds; u%DX_u%c_obj%bldChord = C_LOC( u%DX_u%bldChord(1) ) + u%DX_u%c_obj%bldRloc_Len = p%nTotBldNds; u%DX_u%c_obj%bldRloc = C_LOC( u%DX_u%bldRloc(1) ) + u%DX_u%c_obj%twrDia_Len = p%NumTwrNds; u%DX_u%c_obj%twrDia = C_LOC( u%DX_u%twrDia(1) ) + u%DX_u%c_obj%twrHloc_Len = p%NumTwrNds; u%DX_u%c_obj%twrHloc = C_LOC( u%DX_u%twrHloc(1) ) + u%DX_u%c_obj%bldPitch_Len = p%NumBlds; u%DX_u%c_obj%bldPitch = C_LOC( u%DX_u%bldPitch(1) ) + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + u%DX_u%bldChord(jTot) = InitInp%bldChord(j,k) + u%DX_u%bldRloc(jTot) = InitInp%bldRloc(j,k) + jTot = jTot+1 + end do + end do + + do j=1,p%NumTwrNds + u%DX_u%twrDia(j) = InitInp%twrDia(j) + u%DX_u%twrHloc(j) = InitInp%twrHloc(j) + end do + +end subroutine Init_u +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine converts the displacement data in the meshes in the input into a simple array format that can be accessed by external programs +subroutine ExtLd_ConvertInpDataForExtProg(u, p, errStat, errMsg ) +!.................................................................................................................................. + USE BeamDyn_IO, ONLY: BD_CrvExtractCrv + + type(ExtLd_InputType), intent(inout) :: u !< Input data + type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + real(R8Ki) :: wm_crv(3) ! Wiener-Milenkovic parameters + integer(intKi) :: j ! counter for nodes + integer(intKi) :: jTot ! counter for nodes + integer(intKi) :: k ! counter for blades + real(reki) :: cref(3) + real(reki) :: xloc(3) + real(reki) :: yloc(3) + real(reki) :: zloc(3) + + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_ConvertInpDataForExtProg' + + ! Initialize variables for this routine + + ErrStat = ErrID_None + ErrMsg = "" + + if (p%TwrAero) then + do j=1,p%NumTwrNds + call BD_CrvExtractCrv(u%TowerMotion%Orientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + u%DX_u%twrDef((j-1)*12+1:(j-1)*12+3) = u%TowerMotion%TranslationDisp(:,j) + u%DX_u%twrDef((j-1)*12+4:(j-1)*12+6) = u%TowerMotion%TranslationVel(:,j) + u%DX_u%twrDef((j-1)*12+7:(j-1)*12+9) = wm_crv + u%DX_u%twrDef((j-1)*12+10:(j-1)*12+12) = u%TowerMotion%RotationVel(:,j) + end do + end if + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + call BD_CrvExtractCrv(u%BladeMotion(k)%Orientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + u%DX_u%bldDef((jTot-1)*12+1:(jTot-1)*12+3) = u%BladeMotion(k)%TranslationDisp(:,j) + u%DX_u%bldDef((jTot-1)*12+4:(jTot-1)*12+6) = u%BladeMotion(k)%TranslationVel(:,j) + u%DX_u%bldDef((jTot-1)*12+7:(jTot-1)*12+9) = wm_crv + u%DX_u%bldDef((jTot-1)*12+10:(jTot-1)*12+12) = u%BladeMotion(k)%RotationVel(:,j) + jTot = jTot+1 + end do + end do + + call BD_CrvExtractCrv(u%HubMotion%Orientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%hubDef(1:3) = u%HubMotion%TranslationDisp(:,1) + u%DX_u%hubDef(4:6) = u%HubMotion%TranslationVel(:,1) + u%DX_u%hubDef(7:9) = wm_crv + u%DX_u%hubDef(10:12) = u%HubMotion%RotationVel(:,1) + + call BD_CrvExtractCrv(u%NacelleMotion%Orientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%nacDef(1:3) = u%NacelleMotion%TranslationDisp(:,1) + u%DX_u%nacDef(4:6) = u%NacelleMotion%TranslationVel(:,1) + u%DX_u%nacDef(7:9) = wm_crv + u%DX_u%nacDef(10:12) = u%NacelleMotion%RotationVel(:,1) + + do k=1,p%NumBlds + call BD_CrvExtractCrv(u%BladeRootMotion(k)%Orientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + u%DX_u%bldRootDef( (k-1)*12+1:(k-1)*12+3 ) = u%BladeRootMotion(k)%TranslationDisp(:,1) + u%DX_u%bldRootDef( (k-1)*12+4:(k-1)*12+6 ) = u%BladeRootMotion(k)%TranslationVel(:,1) + u%DX_u%bldRootDef( (k-1)*12+7:(k-1)*12+9 ) = wm_crv + u%DX_u%bldRootDef( (k-1)*12+10:(k-1)*12+12 ) = u%BladeRootMotion(k)%RotationVel(:,1) + end do + +end subroutine ExtLd_ConvertInpDataForExtProg +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine converts the data in the simple array format in the output data type into OpenFAST mesh format +subroutine ExtLd_ConvertOpDataForOpenFAST(y, u, m, p, errStat, errMsg ) +!.................................................................................................................................. + + type(ExtLd_OutputType), intent(inout) :: y !< Ouput data + type(ExtLd_InputType), intent(in ) :: u !< Input data + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc var + type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + + ! Local variables + integer(intKi) :: j ! counter for nodes + integer(intKi) :: jTot ! counter for nodes + integer(intKi) :: k ! counter for blades + real(ReKi) :: tmp_az, delta_az ! temporary variable for azimuth + + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_ConvertInpDataForExtProg' + + ! Initialize variables for this routine + + ErrStat = ErrID_None + ErrMsg = "" + + tmp_az = m%az + call Zero2TwoPi(tmp_az) + delta_az = u%az - tmp_az + if ( delta_az .lt. -1.0 ) then + m%az = m%az + delta_az + PI + else + m%az = m%az + delta_az + end if + if (m%az > (p%az_blend_mean - 0.5 * p%az_blend_delta)) then + m%phi_cfd = 0.5 * ( tanh( (m%az - p%az_blend_mean)/p%az_blend_delta ) + 1.0 ) + else + m%phi_cfd = 0.0 + end if + + if (p%TwrAero) then + do j=1,p%NumTwrNds + y%TowerLoad%Force(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+1:(j-1)*6+3) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Force(:,j) + y%TowerLoad%Moment(:,j) = m%phi_cfd * y%DX_y%twrLd((j-1)*6+4:(j-1)*6+6) + (1.0 - m%phi_cfd) * y%TowerLoadAD%Moment(:,j) + end do + end if + + jTot = 1 + do k=1,p%NumBlds + do j=1,p%NumBldNds(k) + y%BladeLoad(k)%Force(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+1:(jTot-1)*6+3) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Force(:,j) + y%BladeLoad(k)%Moment(:,j) = m%phi_cfd * y%DX_y%bldLd((jTot-1)*6+4:(jTot-1)*6+6) + (1.0 - m%phi_cfd) * y%BladeLoadAD(k)%Moment(:,j) + jTot = jTot+1 + end do + end do + + +end subroutine ExtLd_ConvertOpDataForOpenFAST +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine ExtLd_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + TYPE(ExtLd_InputType), INTENT(INOUT) :: u !< System inputs + TYPE(ExtLd_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(ExtLd_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + TYPE(ExtLd_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states + TYPE(ExtLd_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + TYPE(ExtLd_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y !< System outputs + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Place any last minute operations or calculations here: + + + ! Close files here: + + + ! Destroy the input data: + + +END SUBROUTINE ExtLd_End +!---------------------------------------------------------------------------------------------------------------------------------- +!> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. +!! Continuous, constraint, discrete, and other states are updated for t + Interval +subroutine ExtLd_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat, errMsg ) +!.................................................................................................................................. + + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... + type(ExtLd_InputType), intent(inout) :: u(:) !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) + real(DbKi), intent(in ) :: utimes(:) !< Times associated with u(:), in seconds + type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + type(ExtLd_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; + !! Output: Continuous states at t + Interval + type(ExtLd_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + type(ExtLd_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; + !! Output: Constraint states at t+dt + type(ExtLd_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; + !! Output: Other states at t+dt + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + type(ExtLd_InputType) :: uInterp ! Interpolated/Extrapolated input + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'ExtLd_UpdateStates' + + ErrStat = ErrID_None + ErrMsg = "" + + +end subroutine ExtLd_UpdateStates +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for computing outputs, used in both loose and tight coupling. +!! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. +!! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for +!! for a complete description of each output parameter. +subroutine ExtLd_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +! NOTE: no matter how many channels are selected for output, all of the outputs are calculated +! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are +! placed in the y%WriteOutput(:) array. +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(ExtLd_InputType), INTENT(IN ) :: u !< Inputs at Time t + TYPE(ExtLd_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(ExtLd_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(ExtLd_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(ExtLd_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(ExtLd_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + type(ExtLd_MiscVarType), intent(inout) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer(intKi) :: i + integer(intKi) :: j + + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtLd_CalcOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + end subroutine ExtLd_CalcOutput + + subroutine apply_wm(c, v, vrot, transpose) + + real(reki), intent(in) :: c(:) ! The Wiener-Milenkovic parameter + real(reki), intent(in) :: v(:) ! The vector to be rotated + real(reki), intent(inout) :: vrot(:) !Hold the rotated vector + real(reki), intent(in) :: transpose !Whether to transpose the rotation + + real(reki) :: magC, c0, nu, cosPhiO2 + real(reki) :: cCrossV(3) + real(reki) :: cCrosscCrossV(3) + + magC = c(1)*c(1) + c(2)*c(2) + c(3)*c(3) + c0 = 2.0-0.125*magC + nu = 2.0/(4.0-c0) + cosPhiO2 = 0.5*c0*nu + cCrossV(1) = c(2)*v(3) - c(3)*v(2) + cCrossV(2) = c(3)*v(1) - c(1)*v(3) + cCrossV(3) = c(1)*v(2) - c(2)*v(1) + + !write(*,*) ' c = ', c(1), ', ', c(2), ', ', c(3) + !write(*,*) ' cCrossV = ', cCrossV(1), ', ', cCrossV(2), ', ', cCrossV(3) + + cCrosscCrossV(1) = c(2)*cCrossV(3) - c(3)*cCrossV(2) + cCrosscCrossV(2) = c(3)*cCrossV(1) - c(1)*cCrossV(3) + cCrosscCrossV(3) = c(1)*cCrossV(2) - c(2)*cCrossV(1) + + vrot(1) = v(1) + transpose * nu * cosPhiO2 * cCrossV(1) + 0.5 * nu * nu * cCrosscCrossV(1) + vrot(2) = v(2) + transpose * nu * cosPhiO2 * cCrossV(2) + 0.5 * nu * nu * cCrosscCrossV(2) + vrot(3) = v(3) + transpose * nu * cosPhiO2 * cCrossV(3) + 0.5 * nu * nu * cCrosscCrossV(3) + + end subroutine apply_wm + +END MODULE ExtLoads diff --git a/modules/extloads/src/ExtLoadsDX_Registry.txt b/modules/extloads/src/ExtLoadsDX_Registry.txt new file mode 100644 index 0000000000..7f09fae1ca --- /dev/null +++ b/modules/extloads/src/ExtLoadsDX_Registry.txt @@ -0,0 +1,44 @@ +################################################################################################################################### +# Registry for ExternalLoadsDX in the FAST Modularization Framework +# This Registry file is used to create ExtLoadsDX_Types which contains data used in the ExtLoads module for data exchange with external drivers. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +# File last committed $Date$ +# (File) Revision #: $Rev$ +# URL: $HeadURL$ +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt + +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: +typedef ExtLoadsDX/ExtLdDX InputType R8Ki twrDef {:} - - "Deformations on the tower - to send to external driver" +typedef ^ InputType R8Ki bldDef {:} - - "Deformations on all blades - to send to external driver" +typedef ^ InputType R8Ki hubDef {:} - - "Deformations on the hub - to send to external driver" +typedef ^ InputType R8Ki nacDef {:} - - "Deformations the nacelle - to send to external driver" +typedef ^ InputType R8Ki bldRootDef {:} - - "Deformations of the blade root nodes - to send to external driver" +typedef ^ InputType R8Ki twrRefPos {:} - - "Reference position of the tower nodes - to send to external driver" +typedef ^ InputType R8Ki bldRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" +typedef ^ InputType R8Ki hubRefPos {:} - - "Reference position of the tower nodes - to send to external driver" +typedef ^ InputType R8Ki nacRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" +typedef ^ InputType R8Ki bldRootRefPos {:} - - "Reference position of the blade root nodes - to send to external driver" +typedef ^ InputType IntKi nBlades {:} - - "Number of blades" +typedef ^ InputType IntKi nBladeNodes {:} - - "Number of blade nodes for each blade" - +typedef ^ InputType IntKi nTowerNodes {:} - - "Number of tower nodes for each blade" - +typedef ^ InputType R8Ki bldChord {:} - - "Blade chord" m +typedef ^ InputType R8Ki bldRloc {:} - - "Radial location along the blade" m +typedef ^ InputType R8Ki twrDia {:} - - "Tower diameter" m +typedef ^ InputType R8Ki twrHloc {:} - - "Height location along the tower" m +typedef ^ InputType R8Ki bldPitch {:} - - "Pitch angle of blade" + + +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +typedef ^ OutputType R8Ki twrLd {:} - - "Loads on the tower - Externally supplied" +typedef ^ OutputType R8Ki bldLd {:} - - "Loads on all blades - Externally supplied" diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 new file mode 100644 index 0000000000..6fd8494e49 --- /dev/null +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -0,0 +1,2674 @@ +!STARTOFREGISTRYGENERATEDFILE 'ExtLoadsDX_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! ExtLoadsDX_Types +!................................................................................................................................. +! This file is part of ExtLoadsDX. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in ExtLoadsDX. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE ExtLoadsDX_Types +!--------------------------------------------------------------------------------------------------------------------------------- +!USE, INTRINSIC :: ISO_C_Binding +USE NWTC_Library +IMPLICIT NONE +! ========= ExtLdDX_InputType_C ======= + TYPE, BIND(C) :: ExtLdDX_InputType_C + TYPE(C_PTR) :: object = C_NULL_PTR + TYPE(C_ptr) :: twrDef = C_NULL_PTR + INTEGER(C_int) :: twrDef_Len = 0 + TYPE(C_ptr) :: bldDef = C_NULL_PTR + INTEGER(C_int) :: bldDef_Len = 0 + TYPE(C_ptr) :: hubDef = C_NULL_PTR + INTEGER(C_int) :: hubDef_Len = 0 + TYPE(C_ptr) :: nacDef = C_NULL_PTR + INTEGER(C_int) :: nacDef_Len = 0 + TYPE(C_ptr) :: bldRootDef = C_NULL_PTR + INTEGER(C_int) :: bldRootDef_Len = 0 + TYPE(C_ptr) :: twrRefPos = C_NULL_PTR + INTEGER(C_int) :: twrRefPos_Len = 0 + TYPE(C_ptr) :: bldRefPos = C_NULL_PTR + INTEGER(C_int) :: bldRefPos_Len = 0 + TYPE(C_ptr) :: hubRefPos = C_NULL_PTR + INTEGER(C_int) :: hubRefPos_Len = 0 + TYPE(C_ptr) :: nacRefPos = C_NULL_PTR + INTEGER(C_int) :: nacRefPos_Len = 0 + TYPE(C_ptr) :: bldRootRefPos = C_NULL_PTR + INTEGER(C_int) :: bldRootRefPos_Len = 0 + TYPE(C_ptr) :: nBlades = C_NULL_PTR + INTEGER(C_int) :: nBlades_Len = 0 + TYPE(C_ptr) :: nBladeNodes = C_NULL_PTR + INTEGER(C_int) :: nBladeNodes_Len = 0 + TYPE(C_ptr) :: nTowerNodes = C_NULL_PTR + INTEGER(C_int) :: nTowerNodes_Len = 0 + TYPE(C_ptr) :: bldChord = C_NULL_PTR + INTEGER(C_int) :: bldChord_Len = 0 + TYPE(C_ptr) :: bldRloc = C_NULL_PTR + INTEGER(C_int) :: bldRloc_Len = 0 + TYPE(C_ptr) :: twrDia = C_NULL_PTR + INTEGER(C_int) :: twrDia_Len = 0 + TYPE(C_ptr) :: twrHloc = C_NULL_PTR + INTEGER(C_int) :: twrHloc_Len = 0 + TYPE(C_ptr) :: bldPitch = C_NULL_PTR + INTEGER(C_int) :: bldPitch_Len = 0 + END TYPE ExtLdDX_InputType_C + TYPE, PUBLIC :: ExtLdDX_InputType + TYPE( ExtLdDX_InputType_C ) :: C_obj + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDef => NULL() !< Deformations on the tower - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldDef => NULL() !< Deformations on all blades - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubDef => NULL() !< Deformations on the hub - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacDef => NULL() !< Deformations the nacelle - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootDef => NULL() !< Deformations of the blade root nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootRefPos => NULL() !< Reference position of the blade root nodes - to send to external driver [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBlades => NULL() !< Number of blades [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBladeNodes => NULL() !< Number of blade nodes for each blade [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nTowerNodes => NULL() !< Number of tower nodes for each blade [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldChord => NULL() !< Blade chord [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRloc => NULL() !< Radial location along the blade [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDia => NULL() !< Tower diameter [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrHloc => NULL() !< Height location along the tower [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldPitch => NULL() !< Pitch angle of blade [-] + END TYPE ExtLdDX_InputType +! ======================= +! ========= ExtLdDX_OutputType_C ======= + TYPE, BIND(C) :: ExtLdDX_OutputType_C + TYPE(C_PTR) :: object = C_NULL_PTR + TYPE(C_ptr) :: twrLd = C_NULL_PTR + INTEGER(C_int) :: twrLd_Len = 0 + TYPE(C_ptr) :: bldLd = C_NULL_PTR + INTEGER(C_int) :: bldLd_Len = 0 + END TYPE ExtLdDX_OutputType_C + TYPE, PUBLIC :: ExtLdDX_OutputType + TYPE( ExtLdDX_OutputType_C ) :: C_obj + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrLd => NULL() !< Loads on the tower - Externally supplied [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldLd => NULL() !< Loads on all blades - Externally supplied [-] + END TYPE ExtLdDX_OutputType +! ======================= +CONTAINS + SUBROUTINE ExtLdDX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLdDX_InputType), INTENT(IN) :: SrcInputData + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ASSOCIATED(SrcInputData%twrDef)) THEN + i1_l = LBOUND(SrcInputData%twrDef,1) + i1_u = UBOUND(SrcInputData%twrDef,1) + IF (.NOT. ASSOCIATED(DstInputData%twrDef)) THEN + ALLOCATE(DstInputData%twrDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%twrDef_Len = SIZE(DstInputData%twrDef) + IF (DstInputData%c_obj%twrDef_Len > 0) & + DstInputData%c_obj%twrDef = C_LOC( DstInputData%twrDef( i1_l ) ) + END IF + DstInputData%twrDef = SrcInputData%twrDef +ENDIF +IF (ASSOCIATED(SrcInputData%bldDef)) THEN + i1_l = LBOUND(SrcInputData%bldDef,1) + i1_u = UBOUND(SrcInputData%bldDef,1) + IF (.NOT. ASSOCIATED(DstInputData%bldDef)) THEN + ALLOCATE(DstInputData%bldDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldDef_Len = SIZE(DstInputData%bldDef) + IF (DstInputData%c_obj%bldDef_Len > 0) & + DstInputData%c_obj%bldDef = C_LOC( DstInputData%bldDef( i1_l ) ) + END IF + DstInputData%bldDef = SrcInputData%bldDef +ENDIF +IF (ASSOCIATED(SrcInputData%hubDef)) THEN + i1_l = LBOUND(SrcInputData%hubDef,1) + i1_u = UBOUND(SrcInputData%hubDef,1) + IF (.NOT. ASSOCIATED(DstInputData%hubDef)) THEN + ALLOCATE(DstInputData%hubDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%hubDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%hubDef_Len = SIZE(DstInputData%hubDef) + IF (DstInputData%c_obj%hubDef_Len > 0) & + DstInputData%c_obj%hubDef = C_LOC( DstInputData%hubDef( i1_l ) ) + END IF + DstInputData%hubDef = SrcInputData%hubDef +ENDIF +IF (ASSOCIATED(SrcInputData%nacDef)) THEN + i1_l = LBOUND(SrcInputData%nacDef,1) + i1_u = UBOUND(SrcInputData%nacDef,1) + IF (.NOT. ASSOCIATED(DstInputData%nacDef)) THEN + ALLOCATE(DstInputData%nacDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nacDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%nacDef_Len = SIZE(DstInputData%nacDef) + IF (DstInputData%c_obj%nacDef_Len > 0) & + DstInputData%c_obj%nacDef = C_LOC( DstInputData%nacDef( i1_l ) ) + END IF + DstInputData%nacDef = SrcInputData%nacDef +ENDIF +IF (ASSOCIATED(SrcInputData%bldRootDef)) THEN + i1_l = LBOUND(SrcInputData%bldRootDef,1) + i1_u = UBOUND(SrcInputData%bldRootDef,1) + IF (.NOT. ASSOCIATED(DstInputData%bldRootDef)) THEN + ALLOCATE(DstInputData%bldRootDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRootDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldRootDef_Len = SIZE(DstInputData%bldRootDef) + IF (DstInputData%c_obj%bldRootDef_Len > 0) & + DstInputData%c_obj%bldRootDef = C_LOC( DstInputData%bldRootDef( i1_l ) ) + END IF + DstInputData%bldRootDef = SrcInputData%bldRootDef +ENDIF +IF (ASSOCIATED(SrcInputData%twrRefPos)) THEN + i1_l = LBOUND(SrcInputData%twrRefPos,1) + i1_u = UBOUND(SrcInputData%twrRefPos,1) + IF (.NOT. ASSOCIATED(DstInputData%twrRefPos)) THEN + ALLOCATE(DstInputData%twrRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%twrRefPos_Len = SIZE(DstInputData%twrRefPos) + IF (DstInputData%c_obj%twrRefPos_Len > 0) & + DstInputData%c_obj%twrRefPos = C_LOC( DstInputData%twrRefPos( i1_l ) ) + END IF + DstInputData%twrRefPos = SrcInputData%twrRefPos +ENDIF +IF (ASSOCIATED(SrcInputData%bldRefPos)) THEN + i1_l = LBOUND(SrcInputData%bldRefPos,1) + i1_u = UBOUND(SrcInputData%bldRefPos,1) + IF (.NOT. ASSOCIATED(DstInputData%bldRefPos)) THEN + ALLOCATE(DstInputData%bldRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldRefPos_Len = SIZE(DstInputData%bldRefPos) + IF (DstInputData%c_obj%bldRefPos_Len > 0) & + DstInputData%c_obj%bldRefPos = C_LOC( DstInputData%bldRefPos( i1_l ) ) + END IF + DstInputData%bldRefPos = SrcInputData%bldRefPos +ENDIF +IF (ASSOCIATED(SrcInputData%hubRefPos)) THEN + i1_l = LBOUND(SrcInputData%hubRefPos,1) + i1_u = UBOUND(SrcInputData%hubRefPos,1) + IF (.NOT. ASSOCIATED(DstInputData%hubRefPos)) THEN + ALLOCATE(DstInputData%hubRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%hubRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%hubRefPos_Len = SIZE(DstInputData%hubRefPos) + IF (DstInputData%c_obj%hubRefPos_Len > 0) & + DstInputData%c_obj%hubRefPos = C_LOC( DstInputData%hubRefPos( i1_l ) ) + END IF + DstInputData%hubRefPos = SrcInputData%hubRefPos +ENDIF +IF (ASSOCIATED(SrcInputData%nacRefPos)) THEN + i1_l = LBOUND(SrcInputData%nacRefPos,1) + i1_u = UBOUND(SrcInputData%nacRefPos,1) + IF (.NOT. ASSOCIATED(DstInputData%nacRefPos)) THEN + ALLOCATE(DstInputData%nacRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nacRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%nacRefPos_Len = SIZE(DstInputData%nacRefPos) + IF (DstInputData%c_obj%nacRefPos_Len > 0) & + DstInputData%c_obj%nacRefPos = C_LOC( DstInputData%nacRefPos( i1_l ) ) + END IF + DstInputData%nacRefPos = SrcInputData%nacRefPos +ENDIF +IF (ASSOCIATED(SrcInputData%bldRootRefPos)) THEN + i1_l = LBOUND(SrcInputData%bldRootRefPos,1) + i1_u = UBOUND(SrcInputData%bldRootRefPos,1) + IF (.NOT. ASSOCIATED(DstInputData%bldRootRefPos)) THEN + ALLOCATE(DstInputData%bldRootRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRootRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldRootRefPos_Len = SIZE(DstInputData%bldRootRefPos) + IF (DstInputData%c_obj%bldRootRefPos_Len > 0) & + DstInputData%c_obj%bldRootRefPos = C_LOC( DstInputData%bldRootRefPos( i1_l ) ) + END IF + DstInputData%bldRootRefPos = SrcInputData%bldRootRefPos +ENDIF +IF (ASSOCIATED(SrcInputData%nBlades)) THEN + i1_l = LBOUND(SrcInputData%nBlades,1) + i1_u = UBOUND(SrcInputData%nBlades,1) + IF (.NOT. ASSOCIATED(DstInputData%nBlades)) THEN + ALLOCATE(DstInputData%nBlades(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nBlades.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%nBlades_Len = SIZE(DstInputData%nBlades) + IF (DstInputData%c_obj%nBlades_Len > 0) & + DstInputData%c_obj%nBlades = C_LOC( DstInputData%nBlades( i1_l ) ) + END IF + DstInputData%nBlades = SrcInputData%nBlades +ENDIF +IF (ASSOCIATED(SrcInputData%nBladeNodes)) THEN + i1_l = LBOUND(SrcInputData%nBladeNodes,1) + i1_u = UBOUND(SrcInputData%nBladeNodes,1) + IF (.NOT. ASSOCIATED(DstInputData%nBladeNodes)) THEN + ALLOCATE(DstInputData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%nBladeNodes_Len = SIZE(DstInputData%nBladeNodes) + IF (DstInputData%c_obj%nBladeNodes_Len > 0) & + DstInputData%c_obj%nBladeNodes = C_LOC( DstInputData%nBladeNodes( i1_l ) ) + END IF + DstInputData%nBladeNodes = SrcInputData%nBladeNodes +ENDIF +IF (ASSOCIATED(SrcInputData%nTowerNodes)) THEN + i1_l = LBOUND(SrcInputData%nTowerNodes,1) + i1_u = UBOUND(SrcInputData%nTowerNodes,1) + IF (.NOT. ASSOCIATED(DstInputData%nTowerNodes)) THEN + ALLOCATE(DstInputData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%nTowerNodes_Len = SIZE(DstInputData%nTowerNodes) + IF (DstInputData%c_obj%nTowerNodes_Len > 0) & + DstInputData%c_obj%nTowerNodes = C_LOC( DstInputData%nTowerNodes( i1_l ) ) + END IF + DstInputData%nTowerNodes = SrcInputData%nTowerNodes +ENDIF +IF (ASSOCIATED(SrcInputData%bldChord)) THEN + i1_l = LBOUND(SrcInputData%bldChord,1) + i1_u = UBOUND(SrcInputData%bldChord,1) + IF (.NOT. ASSOCIATED(DstInputData%bldChord)) THEN + ALLOCATE(DstInputData%bldChord(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldChord_Len = SIZE(DstInputData%bldChord) + IF (DstInputData%c_obj%bldChord_Len > 0) & + DstInputData%c_obj%bldChord = C_LOC( DstInputData%bldChord( i1_l ) ) + END IF + DstInputData%bldChord = SrcInputData%bldChord +ENDIF +IF (ASSOCIATED(SrcInputData%bldRloc)) THEN + i1_l = LBOUND(SrcInputData%bldRloc,1) + i1_u = UBOUND(SrcInputData%bldRloc,1) + IF (.NOT. ASSOCIATED(DstInputData%bldRloc)) THEN + ALLOCATE(DstInputData%bldRloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldRloc_Len = SIZE(DstInputData%bldRloc) + IF (DstInputData%c_obj%bldRloc_Len > 0) & + DstInputData%c_obj%bldRloc = C_LOC( DstInputData%bldRloc( i1_l ) ) + END IF + DstInputData%bldRloc = SrcInputData%bldRloc +ENDIF +IF (ASSOCIATED(SrcInputData%twrDia)) THEN + i1_l = LBOUND(SrcInputData%twrDia,1) + i1_u = UBOUND(SrcInputData%twrDia,1) + IF (.NOT. ASSOCIATED(DstInputData%twrDia)) THEN + ALLOCATE(DstInputData%twrDia(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrDia.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%twrDia_Len = SIZE(DstInputData%twrDia) + IF (DstInputData%c_obj%twrDia_Len > 0) & + DstInputData%c_obj%twrDia = C_LOC( DstInputData%twrDia( i1_l ) ) + END IF + DstInputData%twrDia = SrcInputData%twrDia +ENDIF +IF (ASSOCIATED(SrcInputData%twrHloc)) THEN + i1_l = LBOUND(SrcInputData%twrHloc,1) + i1_u = UBOUND(SrcInputData%twrHloc,1) + IF (.NOT. ASSOCIATED(DstInputData%twrHloc)) THEN + ALLOCATE(DstInputData%twrHloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrHloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%twrHloc_Len = SIZE(DstInputData%twrHloc) + IF (DstInputData%c_obj%twrHloc_Len > 0) & + DstInputData%c_obj%twrHloc = C_LOC( DstInputData%twrHloc( i1_l ) ) + END IF + DstInputData%twrHloc = SrcInputData%twrHloc +ENDIF +IF (ASSOCIATED(SrcInputData%bldPitch)) THEN + i1_l = LBOUND(SrcInputData%bldPitch,1) + i1_u = UBOUND(SrcInputData%bldPitch,1) + IF (.NOT. ASSOCIATED(DstInputData%bldPitch)) THEN + ALLOCATE(DstInputData%bldPitch(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldPitch.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstInputData%c_obj%bldPitch_Len = SIZE(DstInputData%bldPitch) + IF (DstInputData%c_obj%bldPitch_Len > 0) & + DstInputData%c_obj%bldPitch = C_LOC( DstInputData%bldPitch( i1_l ) ) + END IF + DstInputData%bldPitch = SrcInputData%bldPitch +ENDIF + END SUBROUTINE ExtLdDX_CopyInput + + SUBROUTINE ExtLdDX_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ASSOCIATED(InputData%twrDef)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%twrDef) + InputData%twrDef => NULL() + InputData%C_obj%twrDef = C_NULL_PTR + InputData%C_obj%twrDef_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldDef)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldDef) + InputData%bldDef => NULL() + InputData%C_obj%bldDef = C_NULL_PTR + InputData%C_obj%bldDef_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%hubDef)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%hubDef) + InputData%hubDef => NULL() + InputData%C_obj%hubDef = C_NULL_PTR + InputData%C_obj%hubDef_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%nacDef)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%nacDef) + InputData%nacDef => NULL() + InputData%C_obj%nacDef = C_NULL_PTR + InputData%C_obj%nacDef_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldRootDef)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldRootDef) + InputData%bldRootDef => NULL() + InputData%C_obj%bldRootDef = C_NULL_PTR + InputData%C_obj%bldRootDef_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%twrRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%twrRefPos) + InputData%twrRefPos => NULL() + InputData%C_obj%twrRefPos = C_NULL_PTR + InputData%C_obj%twrRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldRefPos) + InputData%bldRefPos => NULL() + InputData%C_obj%bldRefPos = C_NULL_PTR + InputData%C_obj%bldRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%hubRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%hubRefPos) + InputData%hubRefPos => NULL() + InputData%C_obj%hubRefPos = C_NULL_PTR + InputData%C_obj%hubRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%nacRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%nacRefPos) + InputData%nacRefPos => NULL() + InputData%C_obj%nacRefPos = C_NULL_PTR + InputData%C_obj%nacRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldRootRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldRootRefPos) + InputData%bldRootRefPos => NULL() + InputData%C_obj%bldRootRefPos = C_NULL_PTR + InputData%C_obj%bldRootRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%nBlades)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%nBlades) + InputData%nBlades => NULL() + InputData%C_obj%nBlades = C_NULL_PTR + InputData%C_obj%nBlades_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%nBladeNodes)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%nBladeNodes) + InputData%nBladeNodes => NULL() + InputData%C_obj%nBladeNodes = C_NULL_PTR + InputData%C_obj%nBladeNodes_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%nTowerNodes)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%nTowerNodes) + InputData%nTowerNodes => NULL() + InputData%C_obj%nTowerNodes = C_NULL_PTR + InputData%C_obj%nTowerNodes_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldChord)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldChord) + InputData%bldChord => NULL() + InputData%C_obj%bldChord = C_NULL_PTR + InputData%C_obj%bldChord_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldRloc)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldRloc) + InputData%bldRloc => NULL() + InputData%C_obj%bldRloc = C_NULL_PTR + InputData%C_obj%bldRloc_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%twrDia)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%twrDia) + InputData%twrDia => NULL() + InputData%C_obj%twrDia = C_NULL_PTR + InputData%C_obj%twrDia_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%twrHloc)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%twrHloc) + InputData%twrHloc => NULL() + InputData%C_obj%twrHloc = C_NULL_PTR + InputData%C_obj%twrHloc_Len = 0 +ENDIF +IF (ASSOCIATED(InputData%bldPitch)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(InputData%bldPitch) + InputData%bldPitch => NULL() + InputData%C_obj%bldPitch = C_NULL_PTR + InputData%C_obj%bldPitch_Len = 0 +ENDIF + END SUBROUTINE ExtLdDX_DestroyInput + + SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_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 ! twrDef allocated yes/no + IF ( ASSOCIATED(InData%twrDef) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrDef upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrDef) ! twrDef + END IF + Int_BufSz = Int_BufSz + 1 ! bldDef allocated yes/no + IF ( ASSOCIATED(InData%bldDef) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldDef upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldDef) ! bldDef + END IF + Int_BufSz = Int_BufSz + 1 ! hubDef allocated yes/no + IF ( ASSOCIATED(InData%hubDef) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! hubDef upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%hubDef) ! hubDef + END IF + Int_BufSz = Int_BufSz + 1 ! nacDef allocated yes/no + IF ( ASSOCIATED(InData%nacDef) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nacDef upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%nacDef) ! nacDef + END IF + Int_BufSz = Int_BufSz + 1 ! bldRootDef allocated yes/no + IF ( ASSOCIATED(InData%bldRootDef) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRootDef upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRootDef) ! bldRootDef + END IF + Int_BufSz = Int_BufSz + 1 ! twrRefPos allocated yes/no + IF ( ASSOCIATED(InData%twrRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrRefPos) ! twrRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! bldRefPos allocated yes/no + IF ( ASSOCIATED(InData%bldRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRefPos) ! bldRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! hubRefPos allocated yes/no + IF ( ASSOCIATED(InData%hubRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! hubRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%hubRefPos) ! hubRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! nacRefPos allocated yes/no + IF ( ASSOCIATED(InData%nacRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nacRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%nacRefPos) ! nacRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! bldRootRefPos allocated yes/no + IF ( ASSOCIATED(InData%bldRootRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRootRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRootRefPos) ! bldRootRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! nBlades allocated yes/no + IF ( ASSOCIATED(InData%nBlades) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nBlades upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nBlades) ! nBlades + END IF + Int_BufSz = Int_BufSz + 1 ! nBladeNodes allocated yes/no + IF ( ASSOCIATED(InData%nBladeNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nBladeNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nBladeNodes) ! nBladeNodes + END IF + Int_BufSz = Int_BufSz + 1 ! nTowerNodes allocated yes/no + IF ( ASSOCIATED(InData%nTowerNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nTowerNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nTowerNodes) ! nTowerNodes + END IF + Int_BufSz = Int_BufSz + 1 ! bldChord allocated yes/no + IF ( ASSOCIATED(InData%bldChord) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldChord upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldChord) ! bldChord + END IF + Int_BufSz = Int_BufSz + 1 ! bldRloc allocated yes/no + IF ( ASSOCIATED(InData%bldRloc) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRloc upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRloc) ! bldRloc + END IF + Int_BufSz = Int_BufSz + 1 ! twrDia allocated yes/no + IF ( ASSOCIATED(InData%twrDia) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrDia upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrDia) ! twrDia + END IF + Int_BufSz = Int_BufSz + 1 ! twrHloc allocated yes/no + IF ( ASSOCIATED(InData%twrHloc) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrHloc upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrHloc) ! twrHloc + END IF + Int_BufSz = Int_BufSz + 1 ! bldPitch allocated yes/no + IF ( ASSOCIATED(InData%bldPitch) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldPitch upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldPitch) ! bldPitch + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ASSOCIATED(InData%twrDef) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrDef,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrDef,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrDef,1), UBOUND(InData%twrDef,1) + DbKiBuf(Db_Xferred) = InData%twrDef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldDef) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldDef,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldDef,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldDef,1), UBOUND(InData%bldDef,1) + DbKiBuf(Db_Xferred) = InData%bldDef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%hubDef) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%hubDef,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubDef,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%hubDef,1), UBOUND(InData%hubDef,1) + DbKiBuf(Db_Xferred) = InData%hubDef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nacDef) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nacDef,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nacDef,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nacDef,1), UBOUND(InData%nacDef,1) + DbKiBuf(Db_Xferred) = InData%nacDef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRootDef) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRootDef,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRootDef,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRootDef,1), UBOUND(InData%bldRootDef,1) + DbKiBuf(Db_Xferred) = InData%bldRootDef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%twrRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrRefPos,1), UBOUND(InData%twrRefPos,1) + DbKiBuf(Db_Xferred) = InData%twrRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRefPos,1), UBOUND(InData%bldRefPos,1) + DbKiBuf(Db_Xferred) = InData%bldRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%hubRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%hubRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%hubRefPos,1), UBOUND(InData%hubRefPos,1) + DbKiBuf(Db_Xferred) = InData%hubRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nacRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nacRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nacRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nacRefPos,1), UBOUND(InData%nacRefPos,1) + DbKiBuf(Db_Xferred) = InData%nacRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRootRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRootRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRootRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRootRefPos,1), UBOUND(InData%bldRootRefPos,1) + DbKiBuf(Db_Xferred) = InData%bldRootRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nBlades) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nBlades,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBlades,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nBlades,1), UBOUND(InData%nBlades,1) + IntKiBuf(Int_Xferred) = InData%nBlades(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nBladeNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nBladeNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBladeNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nBladeNodes,1), UBOUND(InData%nBladeNodes,1) + IntKiBuf(Int_Xferred) = InData%nBladeNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nTowerNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nTowerNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nTowerNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nTowerNodes,1), UBOUND(InData%nTowerNodes,1) + IntKiBuf(Int_Xferred) = InData%nTowerNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldChord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldChord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldChord,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldChord,1), UBOUND(InData%bldChord,1) + DbKiBuf(Db_Xferred) = InData%bldChord(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRloc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRloc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRloc,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRloc,1), UBOUND(InData%bldRloc,1) + DbKiBuf(Db_Xferred) = InData%bldRloc(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%twrDia) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrDia,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrDia,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrDia,1), UBOUND(InData%twrDia,1) + DbKiBuf(Db_Xferred) = InData%twrDia(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%twrHloc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrHloc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrHloc,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrHloc,1), UBOUND(InData%twrHloc,1) + DbKiBuf(Db_Xferred) = InData%twrHloc(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldPitch) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldPitch,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldPitch,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldPitch,1), UBOUND(InData%bldPitch,1) + DbKiBuf(Db_Xferred) = InData%bldPitch(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_PackInput + + SUBROUTINE ExtLdDX_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(ExtLdDX_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_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 ! twrDef not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%twrDef)) DEALLOCATE(OutData%twrDef) + ALLOCATE(OutData%twrDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrDef_Len = SIZE(OutData%twrDef) + IF (OutData%c_obj%twrDef_Len > 0) & + OutData%c_obj%twrDef = C_LOC( OutData%twrDef( i1_l ) ) + DO i1 = LBOUND(OutData%twrDef,1), UBOUND(OutData%twrDef,1) + OutData%twrDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldDef not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldDef)) DEALLOCATE(OutData%bldDef) + ALLOCATE(OutData%bldDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldDef_Len = SIZE(OutData%bldDef) + IF (OutData%c_obj%bldDef_Len > 0) & + OutData%c_obj%bldDef = C_LOC( OutData%bldDef( i1_l ) ) + DO i1 = LBOUND(OutData%bldDef,1), UBOUND(OutData%bldDef,1) + OutData%bldDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubDef not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%hubDef)) DEALLOCATE(OutData%hubDef) + ALLOCATE(OutData%hubDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%hubDef_Len = SIZE(OutData%hubDef) + IF (OutData%c_obj%hubDef_Len > 0) & + OutData%c_obj%hubDef = C_LOC( OutData%hubDef( i1_l ) ) + DO i1 = LBOUND(OutData%hubDef,1), UBOUND(OutData%hubDef,1) + OutData%hubDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nacDef not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nacDef)) DEALLOCATE(OutData%nacDef) + ALLOCATE(OutData%nacDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nacDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nacDef_Len = SIZE(OutData%nacDef) + IF (OutData%c_obj%nacDef_Len > 0) & + OutData%c_obj%nacDef = C_LOC( OutData%nacDef( i1_l ) ) + DO i1 = LBOUND(OutData%nacDef,1), UBOUND(OutData%nacDef,1) + OutData%nacDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRootDef not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldRootDef)) DEALLOCATE(OutData%bldRootDef) + ALLOCATE(OutData%bldRootDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRootDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldRootDef_Len = SIZE(OutData%bldRootDef) + IF (OutData%c_obj%bldRootDef_Len > 0) & + OutData%c_obj%bldRootDef = C_LOC( OutData%bldRootDef( i1_l ) ) + DO i1 = LBOUND(OutData%bldRootDef,1), UBOUND(OutData%bldRootDef,1) + OutData%bldRootDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%twrRefPos)) DEALLOCATE(OutData%twrRefPos) + ALLOCATE(OutData%twrRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrRefPos_Len = SIZE(OutData%twrRefPos) + IF (OutData%c_obj%twrRefPos_Len > 0) & + OutData%c_obj%twrRefPos = C_LOC( OutData%twrRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%twrRefPos,1), UBOUND(OutData%twrRefPos,1) + OutData%twrRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldRefPos)) DEALLOCATE(OutData%bldRefPos) + ALLOCATE(OutData%bldRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldRefPos_Len = SIZE(OutData%bldRefPos) + IF (OutData%c_obj%bldRefPos_Len > 0) & + OutData%c_obj%bldRefPos = C_LOC( OutData%bldRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%bldRefPos,1), UBOUND(OutData%bldRefPos,1) + OutData%bldRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%hubRefPos)) DEALLOCATE(OutData%hubRefPos) + ALLOCATE(OutData%hubRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%hubRefPos_Len = SIZE(OutData%hubRefPos) + IF (OutData%c_obj%hubRefPos_Len > 0) & + OutData%c_obj%hubRefPos = C_LOC( OutData%hubRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%hubRefPos,1), UBOUND(OutData%hubRefPos,1) + OutData%hubRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nacRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nacRefPos)) DEALLOCATE(OutData%nacRefPos) + ALLOCATE(OutData%nacRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nacRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nacRefPos_Len = SIZE(OutData%nacRefPos) + IF (OutData%c_obj%nacRefPos_Len > 0) & + OutData%c_obj%nacRefPos = C_LOC( OutData%nacRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%nacRefPos,1), UBOUND(OutData%nacRefPos,1) + OutData%nacRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRootRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldRootRefPos)) DEALLOCATE(OutData%bldRootRefPos) + ALLOCATE(OutData%bldRootRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRootRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldRootRefPos_Len = SIZE(OutData%bldRootRefPos) + IF (OutData%c_obj%bldRootRefPos_Len > 0) & + OutData%c_obj%bldRootRefPos = C_LOC( OutData%bldRootRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%bldRootRefPos,1), UBOUND(OutData%bldRootRefPos,1) + OutData%bldRootRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBlades not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nBlades)) DEALLOCATE(OutData%nBlades) + ALLOCATE(OutData%nBlades(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBlades.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nBlades_Len = SIZE(OutData%nBlades) + IF (OutData%c_obj%nBlades_Len > 0) & + OutData%c_obj%nBlades = C_LOC( OutData%nBlades( i1_l ) ) + DO i1 = LBOUND(OutData%nBlades,1), UBOUND(OutData%nBlades,1) + OutData%nBlades(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBladeNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nBladeNodes)) DEALLOCATE(OutData%nBladeNodes) + ALLOCATE(OutData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nBladeNodes_Len = SIZE(OutData%nBladeNodes) + IF (OutData%c_obj%nBladeNodes_Len > 0) & + OutData%c_obj%nBladeNodes = C_LOC( OutData%nBladeNodes( i1_l ) ) + DO i1 = LBOUND(OutData%nBladeNodes,1), UBOUND(OutData%nBladeNodes,1) + OutData%nBladeNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nTowerNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nTowerNodes)) DEALLOCATE(OutData%nTowerNodes) + ALLOCATE(OutData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nTowerNodes_Len = SIZE(OutData%nTowerNodes) + IF (OutData%c_obj%nTowerNodes_Len > 0) & + OutData%c_obj%nTowerNodes = C_LOC( OutData%nTowerNodes( i1_l ) ) + DO i1 = LBOUND(OutData%nTowerNodes,1), UBOUND(OutData%nTowerNodes,1) + OutData%nTowerNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldChord not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldChord)) DEALLOCATE(OutData%bldChord) + ALLOCATE(OutData%bldChord(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldChord_Len = SIZE(OutData%bldChord) + IF (OutData%c_obj%bldChord_Len > 0) & + OutData%c_obj%bldChord = C_LOC( OutData%bldChord( i1_l ) ) + DO i1 = LBOUND(OutData%bldChord,1), UBOUND(OutData%bldChord,1) + OutData%bldChord(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRloc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldRloc)) DEALLOCATE(OutData%bldRloc) + ALLOCATE(OutData%bldRloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldRloc_Len = SIZE(OutData%bldRloc) + IF (OutData%c_obj%bldRloc_Len > 0) & + OutData%c_obj%bldRloc = C_LOC( OutData%bldRloc( i1_l ) ) + DO i1 = LBOUND(OutData%bldRloc,1), UBOUND(OutData%bldRloc,1) + OutData%bldRloc(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrDia not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%twrDia)) DEALLOCATE(OutData%twrDia) + ALLOCATE(OutData%twrDia(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrDia.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrDia_Len = SIZE(OutData%twrDia) + IF (OutData%c_obj%twrDia_Len > 0) & + OutData%c_obj%twrDia = C_LOC( OutData%twrDia( i1_l ) ) + DO i1 = LBOUND(OutData%twrDia,1), UBOUND(OutData%twrDia,1) + OutData%twrDia(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrHloc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%twrHloc)) DEALLOCATE(OutData%twrHloc) + ALLOCATE(OutData%twrHloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrHloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrHloc_Len = SIZE(OutData%twrHloc) + IF (OutData%c_obj%twrHloc_Len > 0) & + OutData%c_obj%twrHloc = C_LOC( OutData%twrHloc( i1_l ) ) + DO i1 = LBOUND(OutData%twrHloc,1), UBOUND(OutData%twrHloc,1) + OutData%twrHloc(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldPitch not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldPitch)) DEALLOCATE(OutData%bldPitch) + ALLOCATE(OutData%bldPitch(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldPitch.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldPitch_Len = SIZE(OutData%bldPitch) + IF (OutData%c_obj%bldPitch_Len > 0) & + OutData%c_obj%bldPitch = C_LOC( OutData%bldPitch( i1_l ) ) + DO i1 = LBOUND(OutData%bldPitch,1), UBOUND(OutData%bldPitch,1) + OutData%bldPitch(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_UnPackInput + + SUBROUTINE ExtLdDX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- twrDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrDef ) ) THEN + NULLIFY( InputData%twrDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%twrDef, InputData%twrDef, (/InputData%C_obj%twrDef_Len/)) + END IF + END IF + + ! -- bldDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldDef ) ) THEN + NULLIFY( InputData%bldDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldDef, InputData%bldDef, (/InputData%C_obj%bldDef_Len/)) + END IF + END IF + + ! -- hubDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%hubDef ) ) THEN + NULLIFY( InputData%hubDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%hubDef, InputData%hubDef, (/InputData%C_obj%hubDef_Len/)) + END IF + END IF + + ! -- nacDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nacDef ) ) THEN + NULLIFY( InputData%nacDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%nacDef, InputData%nacDef, (/InputData%C_obj%nacDef_Len/)) + END IF + END IF + + ! -- bldRootDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRootDef ) ) THEN + NULLIFY( InputData%bldRootDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldRootDef, InputData%bldRootDef, (/InputData%C_obj%bldRootDef_Len/)) + END IF + END IF + + ! -- twrRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrRefPos ) ) THEN + NULLIFY( InputData%twrRefPos ) + ELSE + CALL C_F_POINTER(InputData%C_obj%twrRefPos, InputData%twrRefPos, (/InputData%C_obj%twrRefPos_Len/)) + END IF + END IF + + ! -- bldRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRefPos ) ) THEN + NULLIFY( InputData%bldRefPos ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldRefPos, InputData%bldRefPos, (/InputData%C_obj%bldRefPos_Len/)) + END IF + END IF + + ! -- hubRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%hubRefPos ) ) THEN + NULLIFY( InputData%hubRefPos ) + ELSE + CALL C_F_POINTER(InputData%C_obj%hubRefPos, InputData%hubRefPos, (/InputData%C_obj%hubRefPos_Len/)) + END IF + END IF + + ! -- nacRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nacRefPos ) ) THEN + NULLIFY( InputData%nacRefPos ) + ELSE + CALL C_F_POINTER(InputData%C_obj%nacRefPos, InputData%nacRefPos, (/InputData%C_obj%nacRefPos_Len/)) + END IF + END IF + + ! -- bldRootRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRootRefPos ) ) THEN + NULLIFY( InputData%bldRootRefPos ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldRootRefPos, InputData%bldRootRefPos, (/InputData%C_obj%bldRootRefPos_Len/)) + END IF + END IF + + ! -- nBlades Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nBlades ) ) THEN + NULLIFY( InputData%nBlades ) + ELSE + CALL C_F_POINTER(InputData%C_obj%nBlades, InputData%nBlades, (/InputData%C_obj%nBlades_Len/)) + END IF + END IF + + ! -- nBladeNodes Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nBladeNodes ) ) THEN + NULLIFY( InputData%nBladeNodes ) + ELSE + CALL C_F_POINTER(InputData%C_obj%nBladeNodes, InputData%nBladeNodes, (/InputData%C_obj%nBladeNodes_Len/)) + END IF + END IF + + ! -- nTowerNodes Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nTowerNodes ) ) THEN + NULLIFY( InputData%nTowerNodes ) + ELSE + CALL C_F_POINTER(InputData%C_obj%nTowerNodes, InputData%nTowerNodes, (/InputData%C_obj%nTowerNodes_Len/)) + END IF + END IF + + ! -- bldChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldChord ) ) THEN + NULLIFY( InputData%bldChord ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldChord, InputData%bldChord, (/InputData%C_obj%bldChord_Len/)) + END IF + END IF + + ! -- bldRloc Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRloc ) ) THEN + NULLIFY( InputData%bldRloc ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldRloc, InputData%bldRloc, (/InputData%C_obj%bldRloc_Len/)) + END IF + END IF + + ! -- twrDia Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrDia ) ) THEN + NULLIFY( InputData%twrDia ) + ELSE + CALL C_F_POINTER(InputData%C_obj%twrDia, InputData%twrDia, (/InputData%C_obj%twrDia_Len/)) + END IF + END IF + + ! -- twrHloc Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrHloc ) ) THEN + NULLIFY( InputData%twrHloc ) + ELSE + CALL C_F_POINTER(InputData%C_obj%twrHloc, InputData%twrHloc, (/InputData%C_obj%twrHloc_Len/)) + END IF + END IF + + ! -- bldPitch Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldPitch ) ) THEN + NULLIFY( InputData%bldPitch ) + ELSE + CALL C_F_POINTER(InputData%C_obj%bldPitch, InputData%bldPitch, (/InputData%C_obj%bldPitch_Len/)) + END IF + END IF + END SUBROUTINE ExtLdDX_C2Fary_CopyInput + + SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- twrDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%twrDef)) THEN + InputData%c_obj%twrDef_Len = 0 + InputData%c_obj%twrDef = C_NULL_PTR + ELSE + InputData%c_obj%twrDef_Len = SIZE(InputData%twrDef) + IF (InputData%c_obj%twrDef_Len > 0) & + InputData%c_obj%twrDef = C_LOC( InputData%twrDef( LBOUND(InputData%twrDef,1) ) ) + END IF + END IF + + ! -- bldDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldDef)) THEN + InputData%c_obj%bldDef_Len = 0 + InputData%c_obj%bldDef = C_NULL_PTR + ELSE + InputData%c_obj%bldDef_Len = SIZE(InputData%bldDef) + IF (InputData%c_obj%bldDef_Len > 0) & + InputData%c_obj%bldDef = C_LOC( InputData%bldDef( LBOUND(InputData%bldDef,1) ) ) + END IF + END IF + + ! -- hubDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%hubDef)) THEN + InputData%c_obj%hubDef_Len = 0 + InputData%c_obj%hubDef = C_NULL_PTR + ELSE + InputData%c_obj%hubDef_Len = SIZE(InputData%hubDef) + IF (InputData%c_obj%hubDef_Len > 0) & + InputData%c_obj%hubDef = C_LOC( InputData%hubDef( LBOUND(InputData%hubDef,1) ) ) + END IF + END IF + + ! -- nacDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%nacDef)) THEN + InputData%c_obj%nacDef_Len = 0 + InputData%c_obj%nacDef = C_NULL_PTR + ELSE + InputData%c_obj%nacDef_Len = SIZE(InputData%nacDef) + IF (InputData%c_obj%nacDef_Len > 0) & + InputData%c_obj%nacDef = C_LOC( InputData%nacDef( LBOUND(InputData%nacDef,1) ) ) + END IF + END IF + + ! -- bldRootDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldRootDef)) THEN + InputData%c_obj%bldRootDef_Len = 0 + InputData%c_obj%bldRootDef = C_NULL_PTR + ELSE + InputData%c_obj%bldRootDef_Len = SIZE(InputData%bldRootDef) + IF (InputData%c_obj%bldRootDef_Len > 0) & + InputData%c_obj%bldRootDef = C_LOC( InputData%bldRootDef( LBOUND(InputData%bldRootDef,1) ) ) + END IF + END IF + + ! -- twrRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%twrRefPos)) THEN + InputData%c_obj%twrRefPos_Len = 0 + InputData%c_obj%twrRefPos = C_NULL_PTR + ELSE + InputData%c_obj%twrRefPos_Len = SIZE(InputData%twrRefPos) + IF (InputData%c_obj%twrRefPos_Len > 0) & + InputData%c_obj%twrRefPos = C_LOC( InputData%twrRefPos( LBOUND(InputData%twrRefPos,1) ) ) + END IF + END IF + + ! -- bldRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldRefPos)) THEN + InputData%c_obj%bldRefPos_Len = 0 + InputData%c_obj%bldRefPos = C_NULL_PTR + ELSE + InputData%c_obj%bldRefPos_Len = SIZE(InputData%bldRefPos) + IF (InputData%c_obj%bldRefPos_Len > 0) & + InputData%c_obj%bldRefPos = C_LOC( InputData%bldRefPos( LBOUND(InputData%bldRefPos,1) ) ) + END IF + END IF + + ! -- hubRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%hubRefPos)) THEN + InputData%c_obj%hubRefPos_Len = 0 + InputData%c_obj%hubRefPos = C_NULL_PTR + ELSE + InputData%c_obj%hubRefPos_Len = SIZE(InputData%hubRefPos) + IF (InputData%c_obj%hubRefPos_Len > 0) & + InputData%c_obj%hubRefPos = C_LOC( InputData%hubRefPos( LBOUND(InputData%hubRefPos,1) ) ) + END IF + END IF + + ! -- nacRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%nacRefPos)) THEN + InputData%c_obj%nacRefPos_Len = 0 + InputData%c_obj%nacRefPos = C_NULL_PTR + ELSE + InputData%c_obj%nacRefPos_Len = SIZE(InputData%nacRefPos) + IF (InputData%c_obj%nacRefPos_Len > 0) & + InputData%c_obj%nacRefPos = C_LOC( InputData%nacRefPos( LBOUND(InputData%nacRefPos,1) ) ) + END IF + END IF + + ! -- bldRootRefPos Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldRootRefPos)) THEN + InputData%c_obj%bldRootRefPos_Len = 0 + InputData%c_obj%bldRootRefPos = C_NULL_PTR + ELSE + InputData%c_obj%bldRootRefPos_Len = SIZE(InputData%bldRootRefPos) + IF (InputData%c_obj%bldRootRefPos_Len > 0) & + InputData%c_obj%bldRootRefPos = C_LOC( InputData%bldRootRefPos( LBOUND(InputData%bldRootRefPos,1) ) ) + END IF + END IF + + ! -- nBlades Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%nBlades)) THEN + InputData%c_obj%nBlades_Len = 0 + InputData%c_obj%nBlades = C_NULL_PTR + ELSE + InputData%c_obj%nBlades_Len = SIZE(InputData%nBlades) + IF (InputData%c_obj%nBlades_Len > 0) & + InputData%c_obj%nBlades = C_LOC( InputData%nBlades( LBOUND(InputData%nBlades,1) ) ) + END IF + END IF + + ! -- nBladeNodes Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%nBladeNodes)) THEN + InputData%c_obj%nBladeNodes_Len = 0 + InputData%c_obj%nBladeNodes = C_NULL_PTR + ELSE + InputData%c_obj%nBladeNodes_Len = SIZE(InputData%nBladeNodes) + IF (InputData%c_obj%nBladeNodes_Len > 0) & + InputData%c_obj%nBladeNodes = C_LOC( InputData%nBladeNodes( LBOUND(InputData%nBladeNodes,1) ) ) + END IF + END IF + + ! -- nTowerNodes Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%nTowerNodes)) THEN + InputData%c_obj%nTowerNodes_Len = 0 + InputData%c_obj%nTowerNodes = C_NULL_PTR + ELSE + InputData%c_obj%nTowerNodes_Len = SIZE(InputData%nTowerNodes) + IF (InputData%c_obj%nTowerNodes_Len > 0) & + InputData%c_obj%nTowerNodes = C_LOC( InputData%nTowerNodes( LBOUND(InputData%nTowerNodes,1) ) ) + END IF + END IF + + ! -- bldChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldChord)) THEN + InputData%c_obj%bldChord_Len = 0 + InputData%c_obj%bldChord = C_NULL_PTR + ELSE + InputData%c_obj%bldChord_Len = SIZE(InputData%bldChord) + IF (InputData%c_obj%bldChord_Len > 0) & + InputData%c_obj%bldChord = C_LOC( InputData%bldChord( LBOUND(InputData%bldChord,1) ) ) + END IF + END IF + + ! -- bldRloc Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldRloc)) THEN + InputData%c_obj%bldRloc_Len = 0 + InputData%c_obj%bldRloc = C_NULL_PTR + ELSE + InputData%c_obj%bldRloc_Len = SIZE(InputData%bldRloc) + IF (InputData%c_obj%bldRloc_Len > 0) & + InputData%c_obj%bldRloc = C_LOC( InputData%bldRloc( LBOUND(InputData%bldRloc,1) ) ) + END IF + END IF + + ! -- twrDia Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%twrDia)) THEN + InputData%c_obj%twrDia_Len = 0 + InputData%c_obj%twrDia = C_NULL_PTR + ELSE + InputData%c_obj%twrDia_Len = SIZE(InputData%twrDia) + IF (InputData%c_obj%twrDia_Len > 0) & + InputData%c_obj%twrDia = C_LOC( InputData%twrDia( LBOUND(InputData%twrDia,1) ) ) + END IF + END IF + + ! -- twrHloc Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%twrHloc)) THEN + InputData%c_obj%twrHloc_Len = 0 + InputData%c_obj%twrHloc = C_NULL_PTR + ELSE + InputData%c_obj%twrHloc_Len = SIZE(InputData%twrHloc) + IF (InputData%c_obj%twrHloc_Len > 0) & + InputData%c_obj%twrHloc = C_LOC( InputData%twrHloc( LBOUND(InputData%twrHloc,1) ) ) + END IF + END IF + + ! -- bldPitch Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%bldPitch)) THEN + InputData%c_obj%bldPitch_Len = 0 + InputData%c_obj%bldPitch = C_NULL_PTR + ELSE + InputData%c_obj%bldPitch_Len = SIZE(InputData%bldPitch) + IF (InputData%c_obj%bldPitch_Len > 0) & + InputData%c_obj%bldPitch = C_LOC( InputData%bldPitch( LBOUND(InputData%bldPitch,1) ) ) + END IF + END IF + END SUBROUTINE ExtLdDX_F2C_CopyInput + + SUBROUTINE ExtLdDX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLdDX_OutputType), INTENT(IN) :: SrcOutputData + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ASSOCIATED(SrcOutputData%twrLd)) THEN + i1_l = LBOUND(SrcOutputData%twrLd,1) + i1_u = UBOUND(SrcOutputData%twrLd,1) + IF (.NOT. ASSOCIATED(DstOutputData%twrLd)) THEN + ALLOCATE(DstOutputData%twrLd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%twrLd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstOutputData%c_obj%twrLd_Len = SIZE(DstOutputData%twrLd) + IF (DstOutputData%c_obj%twrLd_Len > 0) & + DstOutputData%c_obj%twrLd = C_LOC( DstOutputData%twrLd( i1_l ) ) + END IF + DstOutputData%twrLd = SrcOutputData%twrLd +ENDIF +IF (ASSOCIATED(SrcOutputData%bldLd)) THEN + i1_l = LBOUND(SrcOutputData%bldLd,1) + i1_u = UBOUND(SrcOutputData%bldLd,1) + IF (.NOT. ASSOCIATED(DstOutputData%bldLd)) THEN + ALLOCATE(DstOutputData%bldLd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%bldLd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstOutputData%c_obj%bldLd_Len = SIZE(DstOutputData%bldLd) + IF (DstOutputData%c_obj%bldLd_Len > 0) & + DstOutputData%c_obj%bldLd = C_LOC( DstOutputData%bldLd( i1_l ) ) + END IF + DstOutputData%bldLd = SrcOutputData%bldLd +ENDIF + END SUBROUTINE ExtLdDX_CopyOutput + + SUBROUTINE ExtLdDX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ASSOCIATED(OutputData%twrLd)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(OutputData%twrLd) + OutputData%twrLd => NULL() + OutputData%C_obj%twrLd = C_NULL_PTR + OutputData%C_obj%twrLd_Len = 0 +ENDIF +IF (ASSOCIATED(OutputData%bldLd)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(OutputData%bldLd) + OutputData%bldLd => NULL() + OutputData%C_obj%bldLd = C_NULL_PTR + OutputData%C_obj%bldLd_Len = 0 +ENDIF + END SUBROUTINE ExtLdDX_DestroyOutput + + SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_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 ! twrLd allocated yes/no + IF ( ASSOCIATED(InData%twrLd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrLd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrLd) ! twrLd + END IF + Int_BufSz = Int_BufSz + 1 ! bldLd allocated yes/no + IF ( ASSOCIATED(InData%bldLd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldLd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldLd) ! bldLd + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ASSOCIATED(InData%twrLd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrLd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrLd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrLd,1), UBOUND(InData%twrLd,1) + DbKiBuf(Db_Xferred) = InData%twrLd(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldLd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldLd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldLd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldLd,1), UBOUND(InData%bldLd,1) + DbKiBuf(Db_Xferred) = InData%bldLd(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_PackOutput + + SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_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 ! twrLd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%twrLd)) DEALLOCATE(OutData%twrLd) + ALLOCATE(OutData%twrLd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrLd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrLd_Len = SIZE(OutData%twrLd) + IF (OutData%c_obj%twrLd_Len > 0) & + OutData%c_obj%twrLd = C_LOC( OutData%twrLd( i1_l ) ) + DO i1 = LBOUND(OutData%twrLd,1), UBOUND(OutData%twrLd,1) + OutData%twrLd(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldLd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldLd)) DEALLOCATE(OutData%bldLd) + ALLOCATE(OutData%bldLd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldLd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldLd_Len = SIZE(OutData%bldLd) + IF (OutData%c_obj%bldLd_Len > 0) & + OutData%c_obj%bldLd = C_LOC( OutData%bldLd( i1_l ) ) + DO i1 = LBOUND(OutData%bldLd,1), UBOUND(OutData%bldLd,1) + OutData%bldLd(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_UnPackOutput + + SUBROUTINE ExtLdDX_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- twrLd Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%twrLd ) ) THEN + NULLIFY( OutputData%twrLd ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%twrLd, OutputData%twrLd, (/OutputData%C_obj%twrLd_Len/)) + END IF + END IF + + ! -- bldLd Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%bldLd ) ) THEN + NULLIFY( OutputData%bldLd ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%bldLd, OutputData%bldLd, (/OutputData%C_obj%bldLd_Len/)) + END IF + END IF + END SUBROUTINE ExtLdDX_C2Fary_CopyOutput + + SUBROUTINE ExtLdDX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- twrLd Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%twrLd)) THEN + OutputData%c_obj%twrLd_Len = 0 + OutputData%c_obj%twrLd = C_NULL_PTR + ELSE + OutputData%c_obj%twrLd_Len = SIZE(OutputData%twrLd) + IF (OutputData%c_obj%twrLd_Len > 0) & + OutputData%c_obj%twrLd = C_LOC( OutputData%twrLd( LBOUND(OutputData%twrLd,1) ) ) + END IF + END IF + + ! -- bldLd Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%bldLd)) THEN + OutputData%c_obj%bldLd_Len = 0 + OutputData%c_obj%bldLd = C_NULL_PTR + ELSE + OutputData%c_obj%bldLd_Len = SIZE(OutputData%bldLd) + IF (OutputData%c_obj%bldLd_Len > 0) & + OutputData%c_obj%bldLd = C_LOC( OutputData%bldLd( LBOUND(OutputData%bldLd,1) ) ) + END IF + END IF + END SUBROUTINE ExtLdDX_F2C_CopyOutput + + + SUBROUTINE ExtLdDX_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(ExtLdDX_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .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 ExtLdDX_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL ExtLdDX_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 ExtLdDX_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 ExtLdDX_Input_ExtrapInterp + + + SUBROUTINE ExtLdDX_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(ExtLdDX_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(ExtLdDX_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ASSOCIATED(u_out%twrDef) .AND. ASSOCIATED(u1%twrDef)) THEN + DO i1 = LBOUND(u_out%twrDef,1),UBOUND(u_out%twrDef,1) + b = -(u1%twrDef(i1) - u2%twrDef(i1)) + u_out%twrDef(i1) = u1%twrDef(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldDef) .AND. ASSOCIATED(u1%bldDef)) THEN + DO i1 = LBOUND(u_out%bldDef,1),UBOUND(u_out%bldDef,1) + b = -(u1%bldDef(i1) - u2%bldDef(i1)) + u_out%bldDef(i1) = u1%bldDef(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%hubDef) .AND. ASSOCIATED(u1%hubDef)) THEN + DO i1 = LBOUND(u_out%hubDef,1),UBOUND(u_out%hubDef,1) + b = -(u1%hubDef(i1) - u2%hubDef(i1)) + u_out%hubDef(i1) = u1%hubDef(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%nacDef) .AND. ASSOCIATED(u1%nacDef)) THEN + DO i1 = LBOUND(u_out%nacDef,1),UBOUND(u_out%nacDef,1) + b = -(u1%nacDef(i1) - u2%nacDef(i1)) + u_out%nacDef(i1) = u1%nacDef(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRootDef) .AND. ASSOCIATED(u1%bldRootDef)) THEN + DO i1 = LBOUND(u_out%bldRootDef,1),UBOUND(u_out%bldRootDef,1) + b = -(u1%bldRootDef(i1) - u2%bldRootDef(i1)) + u_out%bldRootDef(i1) = u1%bldRootDef(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%twrRefPos) .AND. ASSOCIATED(u1%twrRefPos)) THEN + DO i1 = LBOUND(u_out%twrRefPos,1),UBOUND(u_out%twrRefPos,1) + b = -(u1%twrRefPos(i1) - u2%twrRefPos(i1)) + u_out%twrRefPos(i1) = u1%twrRefPos(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRefPos) .AND. ASSOCIATED(u1%bldRefPos)) THEN + DO i1 = LBOUND(u_out%bldRefPos,1),UBOUND(u_out%bldRefPos,1) + b = -(u1%bldRefPos(i1) - u2%bldRefPos(i1)) + u_out%bldRefPos(i1) = u1%bldRefPos(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%hubRefPos) .AND. ASSOCIATED(u1%hubRefPos)) THEN + DO i1 = LBOUND(u_out%hubRefPos,1),UBOUND(u_out%hubRefPos,1) + b = -(u1%hubRefPos(i1) - u2%hubRefPos(i1)) + u_out%hubRefPos(i1) = u1%hubRefPos(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%nacRefPos) .AND. ASSOCIATED(u1%nacRefPos)) THEN + DO i1 = LBOUND(u_out%nacRefPos,1),UBOUND(u_out%nacRefPos,1) + b = -(u1%nacRefPos(i1) - u2%nacRefPos(i1)) + u_out%nacRefPos(i1) = u1%nacRefPos(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRootRefPos) .AND. ASSOCIATED(u1%bldRootRefPos)) THEN + DO i1 = LBOUND(u_out%bldRootRefPos,1),UBOUND(u_out%bldRootRefPos,1) + b = -(u1%bldRootRefPos(i1) - u2%bldRootRefPos(i1)) + u_out%bldRootRefPos(i1) = u1%bldRootRefPos(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%nBlades) .AND. ASSOCIATED(u1%nBlades)) THEN +END IF ! check if allocated +IF (ASSOCIATED(u_out%nBladeNodes) .AND. ASSOCIATED(u1%nBladeNodes)) THEN +END IF ! check if allocated +IF (ASSOCIATED(u_out%nTowerNodes) .AND. ASSOCIATED(u1%nTowerNodes)) THEN +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldChord) .AND. ASSOCIATED(u1%bldChord)) THEN + DO i1 = LBOUND(u_out%bldChord,1),UBOUND(u_out%bldChord,1) + b = -(u1%bldChord(i1) - u2%bldChord(i1)) + u_out%bldChord(i1) = u1%bldChord(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRloc) .AND. ASSOCIATED(u1%bldRloc)) THEN + DO i1 = LBOUND(u_out%bldRloc,1),UBOUND(u_out%bldRloc,1) + b = -(u1%bldRloc(i1) - u2%bldRloc(i1)) + u_out%bldRloc(i1) = u1%bldRloc(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%twrDia) .AND. ASSOCIATED(u1%twrDia)) THEN + DO i1 = LBOUND(u_out%twrDia,1),UBOUND(u_out%twrDia,1) + b = -(u1%twrDia(i1) - u2%twrDia(i1)) + u_out%twrDia(i1) = u1%twrDia(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%twrHloc) .AND. ASSOCIATED(u1%twrHloc)) THEN + DO i1 = LBOUND(u_out%twrHloc,1),UBOUND(u_out%twrHloc,1) + b = -(u1%twrHloc(i1) - u2%twrHloc(i1)) + u_out%twrHloc(i1) = u1%twrHloc(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldPitch) .AND. ASSOCIATED(u1%bldPitch)) THEN + DO i1 = LBOUND(u_out%bldPitch,1),UBOUND(u_out%bldPitch,1) + b = -(u1%bldPitch(i1) - u2%bldPitch(i1)) + u_out%bldPitch(i1) = u1%bldPitch(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE ExtLdDX_Input_ExtrapInterp1 + + + SUBROUTINE ExtLdDX_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(ExtLdDX_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtLdDX_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(ExtLdDX_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: 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 = 'ExtLdDX_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ASSOCIATED(u_out%twrDef) .AND. ASSOCIATED(u1%twrDef)) THEN + DO i1 = LBOUND(u_out%twrDef,1),UBOUND(u_out%twrDef,1) + b = (t(3)**2*(u1%twrDef(i1) - u2%twrDef(i1)) + t(2)**2*(-u1%twrDef(i1) + u3%twrDef(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%twrDef(i1) + t(3)*u2%twrDef(i1) - t(2)*u3%twrDef(i1) ) * scaleFactor + u_out%twrDef(i1) = u1%twrDef(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldDef) .AND. ASSOCIATED(u1%bldDef)) THEN + DO i1 = LBOUND(u_out%bldDef,1),UBOUND(u_out%bldDef,1) + b = (t(3)**2*(u1%bldDef(i1) - u2%bldDef(i1)) + t(2)**2*(-u1%bldDef(i1) + u3%bldDef(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldDef(i1) + t(3)*u2%bldDef(i1) - t(2)*u3%bldDef(i1) ) * scaleFactor + u_out%bldDef(i1) = u1%bldDef(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%hubDef) .AND. ASSOCIATED(u1%hubDef)) THEN + DO i1 = LBOUND(u_out%hubDef,1),UBOUND(u_out%hubDef,1) + b = (t(3)**2*(u1%hubDef(i1) - u2%hubDef(i1)) + t(2)**2*(-u1%hubDef(i1) + u3%hubDef(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%hubDef(i1) + t(3)*u2%hubDef(i1) - t(2)*u3%hubDef(i1) ) * scaleFactor + u_out%hubDef(i1) = u1%hubDef(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%nacDef) .AND. ASSOCIATED(u1%nacDef)) THEN + DO i1 = LBOUND(u_out%nacDef,1),UBOUND(u_out%nacDef,1) + b = (t(3)**2*(u1%nacDef(i1) - u2%nacDef(i1)) + t(2)**2*(-u1%nacDef(i1) + u3%nacDef(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%nacDef(i1) + t(3)*u2%nacDef(i1) - t(2)*u3%nacDef(i1) ) * scaleFactor + u_out%nacDef(i1) = u1%nacDef(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRootDef) .AND. ASSOCIATED(u1%bldRootDef)) THEN + DO i1 = LBOUND(u_out%bldRootDef,1),UBOUND(u_out%bldRootDef,1) + b = (t(3)**2*(u1%bldRootDef(i1) - u2%bldRootDef(i1)) + t(2)**2*(-u1%bldRootDef(i1) + u3%bldRootDef(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldRootDef(i1) + t(3)*u2%bldRootDef(i1) - t(2)*u3%bldRootDef(i1) ) * scaleFactor + u_out%bldRootDef(i1) = u1%bldRootDef(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%twrRefPos) .AND. ASSOCIATED(u1%twrRefPos)) THEN + DO i1 = LBOUND(u_out%twrRefPos,1),UBOUND(u_out%twrRefPos,1) + b = (t(3)**2*(u1%twrRefPos(i1) - u2%twrRefPos(i1)) + t(2)**2*(-u1%twrRefPos(i1) + u3%twrRefPos(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%twrRefPos(i1) + t(3)*u2%twrRefPos(i1) - t(2)*u3%twrRefPos(i1) ) * scaleFactor + u_out%twrRefPos(i1) = u1%twrRefPos(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRefPos) .AND. ASSOCIATED(u1%bldRefPos)) THEN + DO i1 = LBOUND(u_out%bldRefPos,1),UBOUND(u_out%bldRefPos,1) + b = (t(3)**2*(u1%bldRefPos(i1) - u2%bldRefPos(i1)) + t(2)**2*(-u1%bldRefPos(i1) + u3%bldRefPos(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldRefPos(i1) + t(3)*u2%bldRefPos(i1) - t(2)*u3%bldRefPos(i1) ) * scaleFactor + u_out%bldRefPos(i1) = u1%bldRefPos(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%hubRefPos) .AND. ASSOCIATED(u1%hubRefPos)) THEN + DO i1 = LBOUND(u_out%hubRefPos,1),UBOUND(u_out%hubRefPos,1) + b = (t(3)**2*(u1%hubRefPos(i1) - u2%hubRefPos(i1)) + t(2)**2*(-u1%hubRefPos(i1) + u3%hubRefPos(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%hubRefPos(i1) + t(3)*u2%hubRefPos(i1) - t(2)*u3%hubRefPos(i1) ) * scaleFactor + u_out%hubRefPos(i1) = u1%hubRefPos(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%nacRefPos) .AND. ASSOCIATED(u1%nacRefPos)) THEN + DO i1 = LBOUND(u_out%nacRefPos,1),UBOUND(u_out%nacRefPos,1) + b = (t(3)**2*(u1%nacRefPos(i1) - u2%nacRefPos(i1)) + t(2)**2*(-u1%nacRefPos(i1) + u3%nacRefPos(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%nacRefPos(i1) + t(3)*u2%nacRefPos(i1) - t(2)*u3%nacRefPos(i1) ) * scaleFactor + u_out%nacRefPos(i1) = u1%nacRefPos(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRootRefPos) .AND. ASSOCIATED(u1%bldRootRefPos)) THEN + DO i1 = LBOUND(u_out%bldRootRefPos,1),UBOUND(u_out%bldRootRefPos,1) + b = (t(3)**2*(u1%bldRootRefPos(i1) - u2%bldRootRefPos(i1)) + t(2)**2*(-u1%bldRootRefPos(i1) + u3%bldRootRefPos(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldRootRefPos(i1) + t(3)*u2%bldRootRefPos(i1) - t(2)*u3%bldRootRefPos(i1) ) * scaleFactor + u_out%bldRootRefPos(i1) = u1%bldRootRefPos(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%nBlades) .AND. ASSOCIATED(u1%nBlades)) THEN +END IF ! check if allocated +IF (ASSOCIATED(u_out%nBladeNodes) .AND. ASSOCIATED(u1%nBladeNodes)) THEN +END IF ! check if allocated +IF (ASSOCIATED(u_out%nTowerNodes) .AND. ASSOCIATED(u1%nTowerNodes)) THEN +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldChord) .AND. ASSOCIATED(u1%bldChord)) THEN + DO i1 = LBOUND(u_out%bldChord,1),UBOUND(u_out%bldChord,1) + b = (t(3)**2*(u1%bldChord(i1) - u2%bldChord(i1)) + t(2)**2*(-u1%bldChord(i1) + u3%bldChord(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldChord(i1) + t(3)*u2%bldChord(i1) - t(2)*u3%bldChord(i1) ) * scaleFactor + u_out%bldChord(i1) = u1%bldChord(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldRloc) .AND. ASSOCIATED(u1%bldRloc)) THEN + DO i1 = LBOUND(u_out%bldRloc,1),UBOUND(u_out%bldRloc,1) + b = (t(3)**2*(u1%bldRloc(i1) - u2%bldRloc(i1)) + t(2)**2*(-u1%bldRloc(i1) + u3%bldRloc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldRloc(i1) + t(3)*u2%bldRloc(i1) - t(2)*u3%bldRloc(i1) ) * scaleFactor + u_out%bldRloc(i1) = u1%bldRloc(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%twrDia) .AND. ASSOCIATED(u1%twrDia)) THEN + DO i1 = LBOUND(u_out%twrDia,1),UBOUND(u_out%twrDia,1) + b = (t(3)**2*(u1%twrDia(i1) - u2%twrDia(i1)) + t(2)**2*(-u1%twrDia(i1) + u3%twrDia(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%twrDia(i1) + t(3)*u2%twrDia(i1) - t(2)*u3%twrDia(i1) ) * scaleFactor + u_out%twrDia(i1) = u1%twrDia(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%twrHloc) .AND. ASSOCIATED(u1%twrHloc)) THEN + DO i1 = LBOUND(u_out%twrHloc,1),UBOUND(u_out%twrHloc,1) + b = (t(3)**2*(u1%twrHloc(i1) - u2%twrHloc(i1)) + t(2)**2*(-u1%twrHloc(i1) + u3%twrHloc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%twrHloc(i1) + t(3)*u2%twrHloc(i1) - t(2)*u3%twrHloc(i1) ) * scaleFactor + u_out%twrHloc(i1) = u1%twrHloc(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(u_out%bldPitch) .AND. ASSOCIATED(u1%bldPitch)) THEN + DO i1 = LBOUND(u_out%bldPitch,1),UBOUND(u_out%bldPitch,1) + b = (t(3)**2*(u1%bldPitch(i1) - u2%bldPitch(i1)) + t(2)**2*(-u1%bldPitch(i1) + u3%bldPitch(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%bldPitch(i1) + t(3)*u2%bldPitch(i1) - t(2)*u3%bldPitch(i1) ) * scaleFactor + u_out%bldPitch(i1) = u1%bldPitch(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE ExtLdDX_Input_ExtrapInterp2 + + + SUBROUTINE ExtLdDX_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .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 ExtLdDX_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL ExtLdDX_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 ExtLdDX_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 ExtLdDX_Output_ExtrapInterp + + + SUBROUTINE ExtLdDX_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) +IF (ASSOCIATED(y_out%twrLd) .AND. ASSOCIATED(y1%twrLd)) THEN + DO i1 = LBOUND(y_out%twrLd,1),UBOUND(y_out%twrLd,1) + b = -(y1%twrLd(i1) - y2%twrLd(i1)) + y_out%twrLd(i1) = y1%twrLd(i1) + b * ScaleFactor + END DO +END IF ! check if allocated +IF (ASSOCIATED(y_out%bldLd) .AND. ASSOCIATED(y1%bldLd)) THEN + DO i1 = LBOUND(y_out%bldLd,1),UBOUND(y_out%bldLd,1) + b = -(y1%bldLd(i1) - y2%bldLd(i1)) + y_out%bldLd(i1) = y1%bldLd(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE ExtLdDX_Output_ExtrapInterp1 + + + SUBROUTINE ExtLdDX_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(ExtLdDX_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: 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 = 'ExtLdDX_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) +IF (ASSOCIATED(y_out%twrLd) .AND. ASSOCIATED(y1%twrLd)) THEN + DO i1 = LBOUND(y_out%twrLd,1),UBOUND(y_out%twrLd,1) + b = (t(3)**2*(y1%twrLd(i1) - y2%twrLd(i1)) + t(2)**2*(-y1%twrLd(i1) + y3%twrLd(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%twrLd(i1) + t(3)*y2%twrLd(i1) - t(2)*y3%twrLd(i1) ) * scaleFactor + y_out%twrLd(i1) = y1%twrLd(i1) + b + c * t_out + END DO +END IF ! check if allocated +IF (ASSOCIATED(y_out%bldLd) .AND. ASSOCIATED(y1%bldLd)) THEN + DO i1 = LBOUND(y_out%bldLd,1),UBOUND(y_out%bldLd,1) + b = (t(3)**2*(y1%bldLd(i1) - y2%bldLd(i1)) + t(2)**2*(-y1%bldLd(i1) + y3%bldLd(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%bldLd(i1) + t(3)*y2%bldLd(i1) - t(2)*y3%bldLd(i1) ) * scaleFactor + y_out%bldLd(i1) = y1%bldLd(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE ExtLdDX_Output_ExtrapInterp2 + +END MODULE ExtLoadsDX_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoadsDX_Types.h b/modules/extloads/src/ExtLoadsDX_Types.h new file mode 100644 index 0000000000..23d47a3a35 --- /dev/null +++ b/modules/extloads/src/ExtLoadsDX_Types.h @@ -0,0 +1,57 @@ +//!STARTOFREGISTRYGENERATEDFILE 'ExtLoadsDX_Types.h' +//! +//! WARNING This file is generated automatically by the FAST registry. +//! Do not edit. Your changes to this file will be lost. +//! + +#ifndef _ExtLoadsDX_TYPES_H +#define _ExtLoadsDX_TYPES_H + + +#ifdef _WIN32 //define something for Windows (32-bit) +# include "stdbool.h" +# define CALL __declspec( dllexport ) +#elif _WIN64 //define something for Windows (64-bit) +# include "stdbool.h" +# define CALL __declspec( dllexport ) +#else +# include +# define CALL +#endif + + + typedef struct ExtLdDX_InputType { + void * object ; + double * twrDef ; int twrDef_Len ; + double * bldDef ; int bldDef_Len ; + double * hubDef ; int hubDef_Len ; + double * nacDef ; int nacDef_Len ; + double * bldRootDef ; int bldRootDef_Len ; + double * twrRefPos ; int twrRefPos_Len ; + double * bldRefPos ; int bldRefPos_Len ; + double * hubRefPos ; int hubRefPos_Len ; + double * nacRefPos ; int nacRefPos_Len ; + double * bldRootRefPos ; int bldRootRefPos_Len ; + int * nBlades ; int nBlades_Len ; + int * nBladeNodes ; int nBladeNodes_Len ; + int * nTowerNodes ; int nTowerNodes_Len ; + double * bldChord ; int bldChord_Len ; + double * bldRloc ; int bldRloc_Len ; + double * twrDia ; int twrDia_Len ; + double * twrHloc ; int twrHloc_Len ; + double * bldPitch ; int bldPitch_Len ; + } ExtLdDX_InputType_t ; + typedef struct ExtLdDX_OutputType { + void * object ; + double * twrLd ; int twrLd_Len ; + double * bldLd ; int bldLd_Len ; + } ExtLdDX_OutputType_t ; + typedef struct ExtLdDX_UserData { + ExtLdDX_InputType_t ExtLdDX_Input ; + ExtLdDX_OutputType_t ExtLdDX_Output ; + } ExtLdDX_t ; + +#endif // _ExtLoadsDX_TYPES_H + + +//!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt new file mode 100644 index 0000000000..66f457ee8a --- /dev/null +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -0,0 +1,103 @@ +################################################################################################################################### +# Registry for ExternalLoads in the FAST Modularization Framework +# This Registry file is used to create ExtLoads_Types which contains data used in the ExtLoads module. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# See the NWTC Programmer's Handbook for further information on the format/contents of this file. +# +# Entries are of the form +# +# +# Use ^ as a shortcut for the value in the same column from the previous line. +################################################################################################################################### +# File last committed $Date$ +# (File) Revision #: $Rev$ +# URL: $HeadURL$ +################################################################################################################################### +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt +usefrom ExtLoadsDX_Registry.txt + +# ..... Initialization data ....................................................................................................... +# Define inputs that the initialization routine may need here: +typedef ExtLoads/ExtLd InitInputType IntKi NumBlades - - - "Number of blades on the turbine" - +typedef ^ InitInputType IntKi NumBldNodes {:} - - "Number of blade nodes for each blade" - +typedef ^ InitInputType Logical TwrAero - .false. - "Flag that tells this module if the tower aero is on." - +typedef ^ InitInputType IntKi NumTwrNds - - - "Number of tower nodes for each blade" - +typedef ^ InitInputType ReKi HubPos {3} - - "X-Y-Z reference position of hub" m +typedef ^ InitInputType R8Ki HubOrient {3}{3} - - "DCM reference orientation of hub" - +typedef ^ InitInputType ReKi NacellePos {3} - - "X-Y-Z reference position of Nacelle" m +typedef ^ InitInputType R8Ki NacelleOrient {3}{3} - - "DCM reference orientation of Nacelle" - +typedef ^ InitInputType ReKi BldRootPos {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m +typedef ^ InitInputType R8Ki BldRootOrient {:}{:}{:} - - "DCM reference orientation of blade root (3x3 x NumBlades )" - +typedef ^ InitInputType ReKi BldPos {:}{:}{:} - - "X-Y-Z reference position of each blade (3 x NumBladeNodesMax x NumBlades)" m +typedef ^ InitInputType R8Ki BldOrient {:}{:}{:}{:} - - "DCM reference orientation of blade (3x3 x NumBladeNodesMax x NumBlades )" - +typedef ^ InitInputType ReKi TwrPos {:}{:} - - "X-Y-Z reference position of tower (3 x NumTowerNodes)" m +typedef ^ InitInputType R8Ki TwrOrient {:}{:}{:} - - "DCM reference orientation of tower (3x3 x NumTowerNodes)" - +typedef ^ InitInputType ReKi az_blend_mean - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ InitInputType ReKi az_blend_delta - - - "The width of the tanh function over which to blend the external and aerodyn loads" - +typedef ^ InitInputType ReKi vel_mean - - - "Mean velocity at reference height" m/s +typedef ^ InitInputType ReKi wind_dir - - - "Wind direction" degrees +typedef ^ InitInputType ReKi z_ref - - - "Reference height for velocity profile" m +typedef ^ InitInputType ReKi shear_exp - - - "Shear exponent" - +typedef ^ InitInputType ReKi BldChord {:}{:} - - "Blade chord (NumBladeNodesMax x NumBlades)" m +typedef ^ InitInputType ReKi BldRloc {:}{:} - - "Radial location of each node along the blade" m +typedef ^ InitInputType ReKi TwrDia {:} - - "Tower diameter (NumTwrNodes)" m +typedef ^ InitInputType ReKi TwrHloc {:} - - "Height location of each node along the tower" m + +# Define outputs from the initialization routine here: +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 + +# ..... States .................................................................................................................... +# Define continuous (differentiable) states here: +typedef ^ ContinuousStateType ReKi blah - - - "Something" - + +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi blah - - - "Something" - + +#Defin misc variables here +typedef ^ MiscVarType ReKi az - - - "Current azimuth" - +typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - + +# Define constraint states here: +typedef ^ ConstraintStateType ReKi blah - - - "Something" - + +# Define "other" states here: +typedef ^ OtherStateType ReKi blah - - - "Something" - + +# Define misc/optimization variables (any data that are not considered actual states) here: + + +# ..... Parameters ................................................................................................................ +# Define parameters here: +typedef ^ ParameterType IntKi NumBlds - - - "Number of blades on the turbine" - +typedef ^ ParameterType IntKi NumBldNds {:} - - "Number of blade nodes for each blade" - +typedef ^ ParameterType IntKi nTotBldNds - - - "Total number of blade nodes" - +typedef ^ ParameterType Logical TwrAero - .FALSE. - "Flag that tells this module if the tower aero is on." - +typedef ^ ParameterType IntKi NumTwrNds - - - "Number of tower nodes" - +typedef ^ ParameterType ReKi az_blend_mean - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ ParameterType ReKi az_blend_delta - - - "The width of the tanh function over which to blend the external and aerodyn loads" - +typedef ^ ParameterType ReKi vel_mean - - - "Mean velocity at reference height" m/s +typedef ^ ParameterType ReKi wind_dir - - - "Wind direction" m +typedef ^ ParameterType ReKi z_ref - - - "Reference height for velocity profile" degrees +typedef ^ ParameterType ReKi shear_exp - - - "Shear exponent" - + +# ..... Inputs .................................................................................................................... +# Define inputs that are contained on the mesh here: +typedef ^ InputType ExtLdDX_InputType DX_u - - - "Data to send to external driver" +typedef ^ InputType ReKi az - - - "Azimuth of rotor" +typedef ^ InputType MeshType TowerMotion - - - "motion on the tower" - +typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - +typedef ^ InputType MeshType NacelleMotion - - - "motion on the nacelle" - +typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - +typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - + +# ..... Outputs ................................................................................................................... +# Define outputs that are contained on the mesh here: +typedef ^ OutputType ExtLdDX_OutputType DX_y - - - "Data to get from external driver" +typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - +typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - +typedef ^ OutputType MeshType TowerLoadAD - - - "loads on the tower from aerodyn" - +typedef ^ OutputType MeshType BladeLoadAD {:} - - "loads on each blade from aerodyn" - diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 new file mode 100644 index 0000000000..8b6debb03f --- /dev/null +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -0,0 +1,4274 @@ +!STARTOFREGISTRYGENERATEDFILE 'ExtLoads_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! ExtLoads_Types +!................................................................................................................................. +! This file is part of ExtLoads. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in ExtLoads. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE ExtLoads_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE ExtLoadsDX_Types +USE NWTC_Library +IMPLICIT NONE +! ========= ExtLd_InitInputType ======= + TYPE, PUBLIC :: ExtLd_InitInputType + INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNodes !< Number of blade nodes for each blade [-] + LOGICAL :: TwrAero = .false. !< Flag that tells this module if the tower aero is on. [-] + INTEGER(IntKi) :: NumTwrNds !< Number of tower nodes for each blade [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPos !< X-Y-Z reference position of hub [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrient !< DCM reference orientation of hub [-] + REAL(ReKi) , DIMENSION(1:3) :: NacellePos !< X-Y-Z reference position of Nacelle [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrient !< DCM reference orientation of Nacelle [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldRootPos !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BldRootOrient !< DCM reference orientation of blade root (3x3 x NumBlades ) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BldPos !< X-Y-Z reference position of each blade (3 x NumBladeNodesMax x NumBlades) [m] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: BldOrient !< DCM reference orientation of blade (3x3 x NumBladeNodesMax x NumBlades ) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrPos !< X-Y-Z reference position of tower (3 x NumTowerNodes) [m] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: TwrOrient !< DCM reference orientation of tower (3x3 x NumTowerNodes) [-] + REAL(ReKi) :: az_blend_mean !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: az_blend_delta !< The width of the tanh function over which to blend the external and aerodyn loads [-] + REAL(ReKi) :: vel_mean !< Mean velocity at reference height [m/s] + REAL(ReKi) :: wind_dir !< Wind direction [degrees] + REAL(ReKi) :: z_ref !< Reference height for velocity profile [m] + REAL(ReKi) :: shear_exp !< Shear exponent [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldChord !< Blade chord (NumBladeNodesMax x NumBlades) [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldRloc !< Radial location of each node along the blade [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDia !< Tower diameter (NumTwrNodes) [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHloc !< Height location of each node along the tower [m] + END TYPE ExtLd_InitInputType +! ======================= +! ========= ExtLd_InitOutputType ======= + TYPE, PUBLIC :: ExtLd_InitOutputType + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + REAL(ReKi) :: AirDens !< Air density [kg/m^3] + END TYPE ExtLd_InitOutputType +! ======================= +! ========= ExtLd_ContinuousStateType ======= + TYPE, PUBLIC :: ExtLd_ContinuousStateType + REAL(ReKi) :: blah !< Something [-] + END TYPE ExtLd_ContinuousStateType +! ======================= +! ========= ExtLd_DiscreteStateType ======= + TYPE, PUBLIC :: ExtLd_DiscreteStateType + REAL(ReKi) :: blah !< Something [-] + END TYPE ExtLd_DiscreteStateType +! ======================= +! ========= ExtLd_MiscVarType ======= + TYPE, PUBLIC :: ExtLd_MiscVarType + REAL(ReKi) :: az !< Current azimuth [-] + REAL(ReKi) :: phi_cfd !< Blending ratio of load from external driver [0-1] [-] + END TYPE ExtLd_MiscVarType +! ======================= +! ========= ExtLd_ConstraintStateType ======= + TYPE, PUBLIC :: ExtLd_ConstraintStateType + REAL(ReKi) :: blah !< Something [-] + END TYPE ExtLd_ConstraintStateType +! ======================= +! ========= ExtLd_OtherStateType ======= + TYPE, PUBLIC :: ExtLd_OtherStateType + REAL(ReKi) :: blah !< Something [-] + END TYPE ExtLd_OtherStateType +! ======================= +! ========= ExtLd_ParameterType ======= + TYPE, PUBLIC :: ExtLd_ParameterType + INTEGER(IntKi) :: NumBlds !< Number of blades on the turbine [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNds !< Number of blade nodes for each blade [-] + INTEGER(IntKi) :: nTotBldNds !< Total number of blade nodes [-] + LOGICAL :: TwrAero = .FALSE. !< Flag that tells this module if the tower aero is on. [-] + INTEGER(IntKi) :: NumTwrNds !< Number of tower nodes [-] + REAL(ReKi) :: az_blend_mean !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: az_blend_delta !< The width of the tanh function over which to blend the external and aerodyn loads [-] + REAL(ReKi) :: vel_mean !< Mean velocity at reference height [m/s] + REAL(ReKi) :: wind_dir !< Wind direction [m] + REAL(ReKi) :: z_ref !< Reference height for velocity profile [degrees] + REAL(ReKi) :: shear_exp !< Shear exponent [-] + END TYPE ExtLd_ParameterType +! ======================= +! ========= ExtLd_InputType ======= + TYPE, PUBLIC :: ExtLd_InputType + TYPE(ExtLdDX_InputType) :: DX_u !< Data to send to external driver [-] + REAL(ReKi) :: az !< Azimuth of rotor [-] + TYPE(MeshType) :: TowerMotion !< motion on the tower [-] + TYPE(MeshType) :: HubMotion !< motion on the hub [-] + TYPE(MeshType) :: NacelleMotion !< motion on the nacelle [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeRootMotion !< motion on each blade root [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeMotion !< motion on each blade [-] + END TYPE ExtLd_InputType +! ======================= +! ========= ExtLd_OutputType ======= + TYPE, PUBLIC :: ExtLd_OutputType + TYPE(ExtLdDX_OutputType) :: DX_y !< Data to get from external driver [-] + TYPE(MeshType) :: TowerLoad !< loads on the tower [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoad !< loads on each blade [-] + TYPE(MeshType) :: TowerLoadAD !< loads on the tower from aerodyn [-] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLoadAD !< loads on each blade from aerodyn [-] + END TYPE ExtLd_OutputType +! ======================= +CONTAINS + SUBROUTINE ExtLd_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(ExtLd_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_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 = 'ExtLd_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%NumBlades = SrcInitInputData%NumBlades +IF (ALLOCATED(SrcInitInputData%NumBldNodes)) THEN + i1_l = LBOUND(SrcInitInputData%NumBldNodes,1) + i1_u = UBOUND(SrcInitInputData%NumBldNodes,1) + IF (.NOT. ALLOCATED(DstInitInputData%NumBldNodes)) THEN + ALLOCATE(DstInitInputData%NumBldNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%NumBldNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%NumBldNodes = SrcInitInputData%NumBldNodes +ENDIF + DstInitInputData%TwrAero = SrcInitInputData%TwrAero + DstInitInputData%NumTwrNds = SrcInitInputData%NumTwrNds + DstInitInputData%HubPos = SrcInitInputData%HubPos + DstInitInputData%HubOrient = SrcInitInputData%HubOrient + DstInitInputData%NacellePos = SrcInitInputData%NacellePos + DstInitInputData%NacelleOrient = SrcInitInputData%NacelleOrient +IF (ALLOCATED(SrcInitInputData%BldRootPos)) THEN + i1_l = LBOUND(SrcInitInputData%BldRootPos,1) + i1_u = UBOUND(SrcInitInputData%BldRootPos,1) + i2_l = LBOUND(SrcInitInputData%BldRootPos,2) + i2_u = UBOUND(SrcInitInputData%BldRootPos,2) + IF (.NOT. ALLOCATED(DstInitInputData%BldRootPos)) THEN + ALLOCATE(DstInitInputData%BldRootPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldRootPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BldRootPos = SrcInitInputData%BldRootPos +ENDIF +IF (ALLOCATED(SrcInitInputData%BldRootOrient)) THEN + i1_l = LBOUND(SrcInitInputData%BldRootOrient,1) + i1_u = UBOUND(SrcInitInputData%BldRootOrient,1) + i2_l = LBOUND(SrcInitInputData%BldRootOrient,2) + i2_u = UBOUND(SrcInitInputData%BldRootOrient,2) + i3_l = LBOUND(SrcInitInputData%BldRootOrient,3) + i3_u = UBOUND(SrcInitInputData%BldRootOrient,3) + IF (.NOT. ALLOCATED(DstInitInputData%BldRootOrient)) THEN + ALLOCATE(DstInitInputData%BldRootOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldRootOrient.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BldRootOrient = SrcInitInputData%BldRootOrient +ENDIF +IF (ALLOCATED(SrcInitInputData%BldPos)) THEN + i1_l = LBOUND(SrcInitInputData%BldPos,1) + i1_u = UBOUND(SrcInitInputData%BldPos,1) + i2_l = LBOUND(SrcInitInputData%BldPos,2) + i2_u = UBOUND(SrcInitInputData%BldPos,2) + i3_l = LBOUND(SrcInitInputData%BldPos,3) + i3_u = UBOUND(SrcInitInputData%BldPos,3) + IF (.NOT. ALLOCATED(DstInitInputData%BldPos)) THEN + ALLOCATE(DstInitInputData%BldPos(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BldPos = SrcInitInputData%BldPos +ENDIF +IF (ALLOCATED(SrcInitInputData%BldOrient)) THEN + i1_l = LBOUND(SrcInitInputData%BldOrient,1) + i1_u = UBOUND(SrcInitInputData%BldOrient,1) + i2_l = LBOUND(SrcInitInputData%BldOrient,2) + i2_u = UBOUND(SrcInitInputData%BldOrient,2) + i3_l = LBOUND(SrcInitInputData%BldOrient,3) + i3_u = UBOUND(SrcInitInputData%BldOrient,3) + i4_l = LBOUND(SrcInitInputData%BldOrient,4) + i4_u = UBOUND(SrcInitInputData%BldOrient,4) + IF (.NOT. ALLOCATED(DstInitInputData%BldOrient)) THEN + ALLOCATE(DstInitInputData%BldOrient(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 DstInitInputData%BldOrient.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BldOrient = SrcInitInputData%BldOrient +ENDIF +IF (ALLOCATED(SrcInitInputData%TwrPos)) THEN + i1_l = LBOUND(SrcInitInputData%TwrPos,1) + i1_u = UBOUND(SrcInitInputData%TwrPos,1) + i2_l = LBOUND(SrcInitInputData%TwrPos,2) + i2_u = UBOUND(SrcInitInputData%TwrPos,2) + IF (.NOT. ALLOCATED(DstInitInputData%TwrPos)) THEN + ALLOCATE(DstInitInputData%TwrPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%TwrPos = SrcInitInputData%TwrPos +ENDIF +IF (ALLOCATED(SrcInitInputData%TwrOrient)) THEN + i1_l = LBOUND(SrcInitInputData%TwrOrient,1) + i1_u = UBOUND(SrcInitInputData%TwrOrient,1) + i2_l = LBOUND(SrcInitInputData%TwrOrient,2) + i2_u = UBOUND(SrcInitInputData%TwrOrient,2) + i3_l = LBOUND(SrcInitInputData%TwrOrient,3) + i3_u = UBOUND(SrcInitInputData%TwrOrient,3) + IF (.NOT. ALLOCATED(DstInitInputData%TwrOrient)) THEN + ALLOCATE(DstInitInputData%TwrOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrOrient.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%TwrOrient = SrcInitInputData%TwrOrient +ENDIF + DstInitInputData%az_blend_mean = SrcInitInputData%az_blend_mean + DstInitInputData%az_blend_delta = SrcInitInputData%az_blend_delta + DstInitInputData%vel_mean = SrcInitInputData%vel_mean + DstInitInputData%wind_dir = SrcInitInputData%wind_dir + DstInitInputData%z_ref = SrcInitInputData%z_ref + DstInitInputData%shear_exp = SrcInitInputData%shear_exp +IF (ALLOCATED(SrcInitInputData%BldChord)) THEN + i1_l = LBOUND(SrcInitInputData%BldChord,1) + i1_u = UBOUND(SrcInitInputData%BldChord,1) + i2_l = LBOUND(SrcInitInputData%BldChord,2) + i2_u = UBOUND(SrcInitInputData%BldChord,2) + IF (.NOT. ALLOCATED(DstInitInputData%BldChord)) THEN + ALLOCATE(DstInitInputData%BldChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BldChord = SrcInitInputData%BldChord +ENDIF +IF (ALLOCATED(SrcInitInputData%BldRloc)) THEN + i1_l = LBOUND(SrcInitInputData%BldRloc,1) + i1_u = UBOUND(SrcInitInputData%BldRloc,1) + i2_l = LBOUND(SrcInitInputData%BldRloc,2) + i2_u = UBOUND(SrcInitInputData%BldRloc,2) + IF (.NOT. ALLOCATED(DstInitInputData%BldRloc)) THEN + ALLOCATE(DstInitInputData%BldRloc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BldRloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%BldRloc = SrcInitInputData%BldRloc +ENDIF +IF (ALLOCATED(SrcInitInputData%TwrDia)) THEN + i1_l = LBOUND(SrcInitInputData%TwrDia,1) + i1_u = UBOUND(SrcInitInputData%TwrDia,1) + IF (.NOT. ALLOCATED(DstInitInputData%TwrDia)) THEN + ALLOCATE(DstInitInputData%TwrDia(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrDia.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%TwrDia = SrcInitInputData%TwrDia +ENDIF +IF (ALLOCATED(SrcInitInputData%TwrHloc)) THEN + i1_l = LBOUND(SrcInitInputData%TwrHloc,1) + i1_u = UBOUND(SrcInitInputData%TwrHloc,1) + IF (.NOT. ALLOCATED(DstInitInputData%TwrHloc)) THEN + ALLOCATE(DstInitInputData%TwrHloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrHloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%TwrHloc = SrcInitInputData%TwrHloc +ENDIF + END SUBROUTINE ExtLd_CopyInitInput + + SUBROUTINE ExtLd_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyInitInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(InitInputData%NumBldNodes)) THEN + DEALLOCATE(InitInputData%NumBldNodes) +ENDIF +IF (ALLOCATED(InitInputData%BldRootPos)) THEN + DEALLOCATE(InitInputData%BldRootPos) +ENDIF +IF (ALLOCATED(InitInputData%BldRootOrient)) THEN + DEALLOCATE(InitInputData%BldRootOrient) +ENDIF +IF (ALLOCATED(InitInputData%BldPos)) THEN + DEALLOCATE(InitInputData%BldPos) +ENDIF +IF (ALLOCATED(InitInputData%BldOrient)) THEN + DEALLOCATE(InitInputData%BldOrient) +ENDIF +IF (ALLOCATED(InitInputData%TwrPos)) THEN + DEALLOCATE(InitInputData%TwrPos) +ENDIF +IF (ALLOCATED(InitInputData%TwrOrient)) THEN + DEALLOCATE(InitInputData%TwrOrient) +ENDIF +IF (ALLOCATED(InitInputData%BldChord)) THEN + DEALLOCATE(InitInputData%BldChord) +ENDIF +IF (ALLOCATED(InitInputData%BldRloc)) THEN + DEALLOCATE(InitInputData%BldRloc) +ENDIF +IF (ALLOCATED(InitInputData%TwrDia)) THEN + DEALLOCATE(InitInputData%TwrDia) +ENDIF +IF (ALLOCATED(InitInputData%TwrHloc)) THEN + DEALLOCATE(InitInputData%TwrHloc) +ENDIF + END SUBROUTINE ExtLd_DestroyInitInput + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! NumBlades + Int_BufSz = Int_BufSz + 1 ! NumBldNodes allocated yes/no + IF ( ALLOCATED(InData%NumBldNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NumBldNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NumBldNodes) ! NumBldNodes + END IF + Int_BufSz = Int_BufSz + 1 ! TwrAero + Int_BufSz = Int_BufSz + 1 ! NumTwrNds + Re_BufSz = Re_BufSz + SIZE(InData%HubPos) ! HubPos + Db_BufSz = Db_BufSz + SIZE(InData%HubOrient) ! HubOrient + Re_BufSz = Re_BufSz + SIZE(InData%NacellePos) ! NacellePos + Db_BufSz = Db_BufSz + SIZE(InData%NacelleOrient) ! NacelleOrient + Int_BufSz = Int_BufSz + 1 ! BldRootPos allocated yes/no + IF ( ALLOCATED(InData%BldRootPos) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BldRootPos upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BldRootPos) ! BldRootPos + END IF + Int_BufSz = Int_BufSz + 1 ! BldRootOrient allocated yes/no + IF ( ALLOCATED(InData%BldRootOrient) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BldRootOrient upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%BldRootOrient) ! BldRootOrient + END IF + Int_BufSz = Int_BufSz + 1 ! BldPos allocated yes/no + IF ( ALLOCATED(InData%BldPos) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BldPos upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BldPos) ! BldPos + END IF + Int_BufSz = Int_BufSz + 1 ! BldOrient allocated yes/no + IF ( ALLOCATED(InData%BldOrient) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! BldOrient upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%BldOrient) ! BldOrient + END IF + Int_BufSz = Int_BufSz + 1 ! TwrPos allocated yes/no + IF ( ALLOCATED(InData%TwrPos) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TwrPos upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrPos) ! TwrPos + END IF + Int_BufSz = Int_BufSz + 1 ! TwrOrient allocated yes/no + IF ( ALLOCATED(InData%TwrOrient) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! TwrOrient upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%TwrOrient) ! TwrOrient + END IF + Re_BufSz = Re_BufSz + 1 ! az_blend_mean + Re_BufSz = Re_BufSz + 1 ! az_blend_delta + Re_BufSz = Re_BufSz + 1 ! vel_mean + Re_BufSz = Re_BufSz + 1 ! wind_dir + Re_BufSz = Re_BufSz + 1 ! z_ref + Re_BufSz = Re_BufSz + 1 ! shear_exp + Int_BufSz = Int_BufSz + 1 ! BldChord allocated yes/no + IF ( ALLOCATED(InData%BldChord) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BldChord upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BldChord) ! BldChord + END IF + Int_BufSz = Int_BufSz + 1 ! BldRloc allocated yes/no + IF ( ALLOCATED(InData%BldRloc) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BldRloc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BldRloc) ! BldRloc + END IF + Int_BufSz = Int_BufSz + 1 ! TwrDia allocated yes/no + IF ( ALLOCATED(InData%TwrDia) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrDia upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrDia) ! TwrDia + END IF + Int_BufSz = Int_BufSz + 1 ! TwrHloc allocated yes/no + IF ( ALLOCATED(InData%TwrHloc) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TwrHloc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TwrHloc) ! TwrHloc + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%NumBldNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NumBldNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NumBldNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NumBldNodes,1), UBOUND(InData%NumBldNodes,1) + IntKiBuf(Int_Xferred) = InData%NumBldNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 + 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%HubOrient,2), UBOUND(InData%HubOrient,2) + DO i1 = LBOUND(InData%HubOrient,1), UBOUND(InData%HubOrient,1) + DbKiBuf(Db_Xferred) = InData%HubOrient(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%NacellePos,1), UBOUND(InData%NacellePos,1) + ReKiBuf(Re_Xferred) = InData%NacellePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%NacelleOrient,2), UBOUND(InData%NacelleOrient,2) + DO i1 = LBOUND(InData%NacelleOrient,1), UBOUND(InData%NacelleOrient,1) + DbKiBuf(Db_Xferred) = InData%NacelleOrient(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IF ( .NOT. ALLOCATED(InData%BldRootPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRootPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRootPos,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRootPos,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRootPos,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BldRootPos,2), UBOUND(InData%BldRootPos,2) + DO i1 = LBOUND(InData%BldRootPos,1), UBOUND(InData%BldRootPos,1) + ReKiBuf(Re_Xferred) = InData%BldRootPos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldRootOrient) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRootOrient,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRootOrient,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRootOrient,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRootOrient,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRootOrient,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRootOrient,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%BldRootOrient,3), UBOUND(InData%BldRootOrient,3) + DO i2 = LBOUND(InData%BldRootOrient,2), UBOUND(InData%BldRootOrient,2) + DO i1 = LBOUND(InData%BldRootOrient,1), UBOUND(InData%BldRootOrient,1) + DbKiBuf(Db_Xferred) = InData%BldRootOrient(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldPos,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldPos,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldPos,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldPos,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldPos,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%BldPos,3), UBOUND(InData%BldPos,3) + DO i2 = LBOUND(InData%BldPos,2), UBOUND(InData%BldPos,2) + DO i1 = LBOUND(InData%BldPos,1), UBOUND(InData%BldPos,1) + ReKiBuf(Re_Xferred) = InData%BldPos(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldOrient) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldOrient,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldOrient,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldOrient,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldOrient,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldOrient,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldOrient,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldOrient,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldOrient,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%BldOrient,4), UBOUND(InData%BldOrient,4) + DO i3 = LBOUND(InData%BldOrient,3), UBOUND(InData%BldOrient,3) + DO i2 = LBOUND(InData%BldOrient,2), UBOUND(InData%BldOrient,2) + DO i1 = LBOUND(InData%BldOrient,1), UBOUND(InData%BldOrient,1) + DbKiBuf(Db_Xferred) = InData%BldOrient(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrPos,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrPos,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrPos,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TwrPos,2), UBOUND(InData%TwrPos,2) + DO i1 = LBOUND(InData%TwrPos,1), UBOUND(InData%TwrPos,1) + ReKiBuf(Re_Xferred) = InData%TwrPos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrOrient) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrOrient,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrOrient,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrOrient,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrOrient,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrOrient,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrOrient,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%TwrOrient,3), UBOUND(InData%TwrOrient,3) + DO i2 = LBOUND(InData%TwrOrient,2), UBOUND(InData%TwrOrient,2) + DO i1 = LBOUND(InData%TwrOrient,1), UBOUND(InData%TwrOrient,1) + DbKiBuf(Db_Xferred) = InData%TwrOrient(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%az_blend_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%az_blend_delta + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%vel_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wind_dir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z_ref + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%shear_exp + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldChord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldChord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldChord,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldChord,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldChord,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BldChord,2), UBOUND(InData%BldChord,2) + DO i1 = LBOUND(InData%BldChord,1), UBOUND(InData%BldChord,1) + ReKiBuf(Re_Xferred) = InData%BldChord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldRloc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRloc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRloc,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRloc,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRloc,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BldRloc,2), UBOUND(InData%BldRloc,2) + DO i1 = LBOUND(InData%BldRloc,1), UBOUND(InData%BldRloc,1) + ReKiBuf(Re_Xferred) = InData%BldRloc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrDia) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDia,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDia,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrDia,1), UBOUND(InData%TwrDia,1) + ReKiBuf(Re_Xferred) = InData%TwrDia(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TwrHloc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrHloc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHloc,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TwrHloc,1), UBOUND(InData%TwrHloc,1) + ReKiBuf(Re_Xferred) = InData%TwrHloc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLd_PackInitInput + + SUBROUTINE ExtLd_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(ExtLd_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NumBldNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NumBldNodes)) DEALLOCATE(OutData%NumBldNodes) + ALLOCATE(OutData%NumBldNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NumBldNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NumBldNodes,1), UBOUND(OutData%NumBldNodes,1) + OutData%NumBldNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%HubPos,1) + i1_u = UBOUND(OutData%HubPos,1) + DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) + OutData%HubPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%HubOrient,1) + i1_u = UBOUND(OutData%HubOrient,1) + i2_l = LBOUND(OutData%HubOrient,2) + i2_u = UBOUND(OutData%HubOrient,2) + DO i2 = LBOUND(OutData%HubOrient,2), UBOUND(OutData%HubOrient,2) + DO i1 = LBOUND(OutData%HubOrient,1), UBOUND(OutData%HubOrient,1) + OutData%HubOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%NacellePos,1) + i1_u = UBOUND(OutData%NacellePos,1) + DO i1 = LBOUND(OutData%NacellePos,1), UBOUND(OutData%NacellePos,1) + OutData%NacellePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%NacelleOrient,1) + i1_u = UBOUND(OutData%NacelleOrient,1) + i2_l = LBOUND(OutData%NacelleOrient,2) + i2_u = UBOUND(OutData%NacelleOrient,2) + DO i2 = LBOUND(OutData%NacelleOrient,2), UBOUND(OutData%NacelleOrient,2) + DO i1 = LBOUND(OutData%NacelleOrient,1), UBOUND(OutData%NacelleOrient,1) + OutData%NacelleOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRootPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldRootPos)) DEALLOCATE(OutData%BldRootPos) + ALLOCATE(OutData%BldRootPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRootPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BldRootPos,2), UBOUND(OutData%BldRootPos,2) + DO i1 = LBOUND(OutData%BldRootPos,1), UBOUND(OutData%BldRootPos,1) + OutData%BldRootPos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRootOrient not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldRootOrient)) DEALLOCATE(OutData%BldRootOrient) + ALLOCATE(OutData%BldRootOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRootOrient.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BldRootOrient,3), UBOUND(OutData%BldRootOrient,3) + DO i2 = LBOUND(OutData%BldRootOrient,2), UBOUND(OutData%BldRootOrient,2) + DO i1 = LBOUND(OutData%BldRootOrient,1), UBOUND(OutData%BldRootOrient,1) + OutData%BldRootOrient(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 ! BldPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldPos)) DEALLOCATE(OutData%BldPos) + ALLOCATE(OutData%BldPos(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BldPos,3), UBOUND(OutData%BldPos,3) + DO i2 = LBOUND(OutData%BldPos,2), UBOUND(OutData%BldPos,2) + DO i1 = LBOUND(OutData%BldPos,1), UBOUND(OutData%BldPos,1) + OutData%BldPos(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 ! BldOrient not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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%BldOrient)) DEALLOCATE(OutData%BldOrient) + ALLOCATE(OutData%BldOrient(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%BldOrient.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%BldOrient,4), UBOUND(OutData%BldOrient,4) + DO i3 = LBOUND(OutData%BldOrient,3), UBOUND(OutData%BldOrient,3) + DO i2 = LBOUND(OutData%BldOrient,2), UBOUND(OutData%BldOrient,2) + DO i1 = LBOUND(OutData%BldOrient,1), UBOUND(OutData%BldOrient,1) + OutData%BldOrient(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 ! TwrPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrPos)) DEALLOCATE(OutData%TwrPos) + ALLOCATE(OutData%TwrPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TwrPos,2), UBOUND(OutData%TwrPos,2) + DO i1 = LBOUND(OutData%TwrPos,1), UBOUND(OutData%TwrPos,1) + OutData%TwrPos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrOrient not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrOrient)) DEALLOCATE(OutData%TwrOrient) + ALLOCATE(OutData%TwrOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrOrient.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%TwrOrient,3), UBOUND(OutData%TwrOrient,3) + DO i2 = LBOUND(OutData%TwrOrient,2), UBOUND(OutData%TwrOrient,2) + DO i1 = LBOUND(OutData%TwrOrient,1), UBOUND(OutData%TwrOrient,1) + OutData%TwrOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%az_blend_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%az_blend_delta = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%vel_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wind_dir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z_ref = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%shear_exp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldChord not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldChord)) DEALLOCATE(OutData%BldChord) + ALLOCATE(OutData%BldChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BldChord,2), UBOUND(OutData%BldChord,2) + DO i1 = LBOUND(OutData%BldChord,1), UBOUND(OutData%BldChord,1) + OutData%BldChord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRloc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldRloc)) DEALLOCATE(OutData%BldRloc) + ALLOCATE(OutData%BldRloc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BldRloc,2), UBOUND(OutData%BldRloc,2) + DO i1 = LBOUND(OutData%BldRloc,1), UBOUND(OutData%BldRloc,1) + OutData%BldRloc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDia not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrDia)) DEALLOCATE(OutData%TwrDia) + ALLOCATE(OutData%TwrDia(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDia.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrDia,1), UBOUND(OutData%TwrDia,1) + OutData%TwrDia(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHloc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TwrHloc)) DEALLOCATE(OutData%TwrHloc) + ALLOCATE(OutData%TwrHloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TwrHloc,1), UBOUND(OutData%TwrHloc,1) + OutData%TwrHloc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLd_UnPackInitInput + + SUBROUTINE ExtLd_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(ExtLd_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInitOutputData%AirDens = SrcInitOutputData%AirDens + END SUBROUTINE ExtLd_CopyInitOutput + + SUBROUTINE ExtLd_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyInitOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE ExtLd_DestroyInitOutput + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + 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 + 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 ExtLd_PackInitOutput + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackInitOutput + + SUBROUTINE ExtLd_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(ExtLd_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstContStateData%blah = SrcContStateData%blah + END SUBROUTINE ExtLd_CopyContState + + SUBROUTINE ExtLd_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyContState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE ExtLd_DestroyContState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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 ! blah + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%blah + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_PackContState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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%blah = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackContState + + SUBROUTINE ExtLd_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(ExtLd_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%blah = SrcDiscStateData%blah + END SUBROUTINE ExtLd_CopyDiscState + + SUBROUTINE ExtLd_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyDiscState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE ExtLd_DestroyDiscState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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 ! blah + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%blah + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_PackDiscState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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%blah = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackDiscState + + SUBROUTINE ExtLd_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%az = SrcMiscData%az + DstMiscData%phi_cfd = SrcMiscData%phi_cfd + END SUBROUTINE ExtLd_CopyMisc + + SUBROUTINE ExtLd_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE ExtLd_DestroyMisc + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! az + Re_BufSz = Re_BufSz + 1 ! phi_cfd + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%az + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%phi_cfd + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_PackMisc + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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%az = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%phi_cfd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackMisc + + SUBROUTINE ExtLd_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(ExtLd_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%blah = SrcConstrStateData%blah + END SUBROUTINE ExtLd_CopyConstrState + + SUBROUTINE ExtLd_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyConstrState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE ExtLd_DestroyConstrState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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 ! blah + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%blah + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_PackConstrState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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%blah = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackConstrState + + SUBROUTINE ExtLd_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(ExtLd_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%blah = SrcOtherStateData%blah + END SUBROUTINE ExtLd_CopyOtherState + + SUBROUTINE ExtLd_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyOtherState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE ExtLd_DestroyOtherState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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 ! blah + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%blah + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_PackOtherState + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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%blah = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackOtherState + + SUBROUTINE ExtLd_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_ParameterType), INTENT(IN) :: SrcParamData + TYPE(ExtLd_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%NumBlds = SrcParamData%NumBlds +IF (ALLOCATED(SrcParamData%NumBldNds)) THEN + i1_l = LBOUND(SrcParamData%NumBldNds,1) + i1_u = UBOUND(SrcParamData%NumBldNds,1) + IF (.NOT. ALLOCATED(DstParamData%NumBldNds)) THEN + ALLOCATE(DstParamData%NumBldNds(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NumBldNds.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NumBldNds = SrcParamData%NumBldNds +ENDIF + DstParamData%nTotBldNds = SrcParamData%nTotBldNds + DstParamData%TwrAero = SrcParamData%TwrAero + DstParamData%NumTwrNds = SrcParamData%NumTwrNds + DstParamData%az_blend_mean = SrcParamData%az_blend_mean + DstParamData%az_blend_delta = SrcParamData%az_blend_delta + DstParamData%vel_mean = SrcParamData%vel_mean + DstParamData%wind_dir = SrcParamData%wind_dir + DstParamData%z_ref = SrcParamData%z_ref + DstParamData%shear_exp = SrcParamData%shear_exp + END SUBROUTINE ExtLd_CopyParam + + SUBROUTINE ExtLd_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(ParamData%NumBldNds)) THEN + DEALLOCATE(ParamData%NumBldNds) +ENDIF + END SUBROUTINE ExtLd_DestroyParam + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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 ! NumBlds + Int_BufSz = Int_BufSz + 1 ! NumBldNds allocated yes/no + IF ( ALLOCATED(InData%NumBldNds) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NumBldNds upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NumBldNds) ! NumBldNds + END IF + Int_BufSz = Int_BufSz + 1 ! nTotBldNds + Int_BufSz = Int_BufSz + 1 ! TwrAero + Int_BufSz = Int_BufSz + 1 ! NumTwrNds + Re_BufSz = Re_BufSz + 1 ! az_blend_mean + Re_BufSz = Re_BufSz + 1 ! az_blend_delta + Re_BufSz = Re_BufSz + 1 ! vel_mean + Re_BufSz = Re_BufSz + 1 ! wind_dir + Re_BufSz = Re_BufSz + 1 ! z_ref + Re_BufSz = Re_BufSz + 1 ! shear_exp + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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%NumBlds + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%NumBldNds) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NumBldNds,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NumBldNds,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NumBldNds,1), UBOUND(InData%NumBldNds,1) + IntKiBuf(Int_Xferred) = InData%NumBldNds(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nTotBldNds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%az_blend_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%az_blend_delta + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%vel_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wind_dir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z_ref + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%shear_exp + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_PackParam + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_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%NumBlds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NumBldNds not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NumBldNds)) DEALLOCATE(OutData%NumBldNds) + ALLOCATE(OutData%NumBldNds(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NumBldNds.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NumBldNds,1), UBOUND(OutData%NumBldNds,1) + OutData%NumBldNds(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%nTotBldNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%az_blend_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%az_blend_delta = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%vel_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wind_dir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z_ref = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%shear_exp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE ExtLd_UnPackParam + + SUBROUTINE ExtLd_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_InputType), INTENT(INOUT) :: SrcInputData + TYPE(ExtLd_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ExtLdDX_CopyInput( SrcInputData%DX_u, DstInputData%DX_u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInputData%az = SrcInputData%az + CALL MeshCopy( SrcInputData%TowerMotion, DstInputData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcInputData%NacelleMotion, DstInputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInputData%BladeRootMotion)) THEN + i1_l = LBOUND(SrcInputData%BladeRootMotion,1) + i1_u = UBOUND(SrcInputData%BladeRootMotion,1) + IF (.NOT. ALLOCATED(DstInputData%BladeRootMotion)) THEN + ALLOCATE(DstInputData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputData%BladeRootMotion,1), UBOUND(SrcInputData%BladeRootMotion,1) + CALL MeshCopy( SrcInputData%BladeRootMotion(i1), DstInputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcInputData%BladeMotion)) THEN + i1_l = LBOUND(SrcInputData%BladeMotion,1) + i1_u = UBOUND(SrcInputData%BladeMotion,1) + IF (.NOT. ALLOCATED(DstInputData%BladeMotion)) THEN + ALLOCATE(DstInputData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladeMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputData%BladeMotion,1), UBOUND(SrcInputData%BladeMotion,1) + CALL MeshCopy( SrcInputData%BladeMotion(i1), DstInputData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE ExtLd_CopyInput + + SUBROUTINE ExtLd_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL ExtLdDX_DestroyInput( InputData%DX_u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( InputData%TowerMotion, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( InputData%NacelleMotion, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InputData%BladeRootMotion)) THEN +DO i1 = LBOUND(InputData%BladeRootMotion,1), UBOUND(InputData%BladeRootMotion,1) + CALL MeshDestroy( InputData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InputData%BladeRootMotion) +ENDIF +IF (ALLOCATED(InputData%BladeMotion)) THEN +DO i1 = LBOUND(InputData%BladeMotion,1), UBOUND(InputData%BladeMotion,1) + CALL MeshDestroy( InputData%BladeMotion(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InputData%BladeMotion) +ENDIF + END SUBROUTINE ExtLd_DestroyInput + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! DX_u: size of buffers for each call to pack subtype + CALL ExtLdDX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DX_u, ErrStat2, ErrMsg2, .TRUE. ) ! DX_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! DX_u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! DX_u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! DX_u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Re_BufSz = Re_BufSz + 1 ! az + Int_BufSz = Int_BufSz + 3 ! TowerMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TowerMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TowerMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TowerMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HubMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HubMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HubMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no + IF ( ALLOCATED(InData%BladeRootMotion) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) + Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BladeMotion allocated yes/no + IF ( ALLOCATED(InData%BladeMotion) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeMotion upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) + Int_BufSz = Int_BufSz + 3 ! BladeMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END 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 ExtLdDX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DX_u, ErrStat2, ErrMsg2, OnlySize ) ! DX_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 + ReKiBuf(Re_Xferred) = InData%az + Re_Xferred = Re_Xferred + 1 + CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) + CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BladeMotion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeMotion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeMotion,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) + CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + END SUBROUTINE ExtLd_PackInput + + SUBROUTINE ExtLd_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(ExtLd_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtLdDX_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%DX_u, ErrStat2, ErrMsg2 ) ! DX_u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%az = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) + ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeMotion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeMotion)) DEALLOCATE(OutData%BladeMotion) + ALLOCATE(OutData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeMotion,1), UBOUND(OutData%BladeMotion,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + END SUBROUTINE ExtLd_UnPackInput + + SUBROUTINE ExtLd_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLd_OutputType), INTENT(INOUT) :: SrcOutputData + TYPE(ExtLd_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ExtLdDX_CopyOutput( SrcOutputData%DX_y, DstOutputData%DX_y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcOutputData%TowerLoad, DstOutputData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOutputData%BladeLoad)) THEN + i1_l = LBOUND(SrcOutputData%BladeLoad,1) + i1_u = UBOUND(SrcOutputData%BladeLoad,1) + IF (.NOT. ALLOCATED(DstOutputData%BladeLoad)) THEN + ALLOCATE(DstOutputData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLoad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%BladeLoad,1), UBOUND(SrcOutputData%BladeLoad,1) + CALL MeshCopy( SrcOutputData%BladeLoad(i1), DstOutputData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MeshCopy( SrcOutputData%TowerLoadAD, DstOutputData%TowerLoadAD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOutputData%BladeLoadAD)) THEN + i1_l = LBOUND(SrcOutputData%BladeLoadAD,1) + i1_u = UBOUND(SrcOutputData%BladeLoadAD,1) + IF (.NOT. ALLOCATED(DstOutputData%BladeLoadAD)) THEN + ALLOCATE(DstOutputData%BladeLoadAD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLoadAD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%BladeLoadAD,1), UBOUND(SrcOutputData%BladeLoadAD,1) + CALL MeshCopy( SrcOutputData%BladeLoadAD(i1), DstOutputData%BladeLoadAD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE ExtLd_CopyOutput + + SUBROUTINE ExtLd_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLd_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL ExtLdDX_DestroyOutput( OutputData%DX_y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( OutputData%TowerLoad, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(OutputData%BladeLoad)) THEN +DO i1 = LBOUND(OutputData%BladeLoad,1), UBOUND(OutputData%BladeLoad,1) + CALL MeshDestroy( OutputData%BladeLoad(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OutputData%BladeLoad) +ENDIF + CALL MeshDestroy( OutputData%TowerLoadAD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(OutputData%BladeLoadAD)) THEN +DO i1 = LBOUND(OutputData%BladeLoadAD,1), UBOUND(OutputData%BladeLoadAD,1) + CALL MeshDestroy( OutputData%BladeLoadAD(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OutputData%BladeLoadAD) +ENDIF + END SUBROUTINE ExtLd_DestroyOutput + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! DX_y: size of buffers for each call to pack subtype + CALL ExtLdDX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DX_y, ErrStat2, ErrMsg2, .TRUE. ) ! DX_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! DX_y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! DX_y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! DX_y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! TowerLoad: size of buffers for each call to pack subtype + CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TowerLoad + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TowerLoad + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TowerLoad + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BladeLoad allocated yes/no + IF ( ALLOCATED(InData%BladeLoad) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeLoad upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) + Int_BufSz = Int_BufSz + 3 ! BladeLoad: size of buffers for each call to pack subtype + CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeLoad + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeLoad + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeLoad + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! TowerLoadAD: size of buffers for each call to pack subtype + CALL MeshPack( InData%TowerLoadAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLoadAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TowerLoadAD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TowerLoadAD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TowerLoadAD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BladeLoadAD allocated yes/no + IF ( ALLOCATED(InData%BladeLoadAD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BladeLoadAD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BladeLoadAD,1), UBOUND(InData%BladeLoadAD,1) + Int_BufSz = Int_BufSz + 3 ! BladeLoadAD: size of buffers for each call to pack subtype + CALL MeshPack( InData%BladeLoadAD(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLoadAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BladeLoadAD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BladeLoadAD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BladeLoadAD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL ExtLdDX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DX_y, ErrStat2, ErrMsg2, OnlySize ) ! DX_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BladeLoad) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLoad,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLoad,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) + CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MeshPack( InData%TowerLoadAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLoadAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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%BladeLoadAD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLoadAD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLoadAD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BladeLoadAD,1), UBOUND(InData%BladeLoadAD,1) + CALL MeshPack( InData%BladeLoadAD(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLoadAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 ExtLd_PackOutput + + SUBROUTINE ExtLd_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(ExtLd_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 = 'ExtLd_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtLdDX_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DX_y, ErrStat2, ErrMsg2 ) ! DX_y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeLoad not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeLoad)) DEALLOCATE(OutData%BladeLoad) + ALLOCATE(OutData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeLoad,1), UBOUND(OutData%BladeLoad,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%TowerLoadAD, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLoadAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (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 ! BladeLoadAD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BladeLoadAD)) DEALLOCATE(OutData%BladeLoadAD) + ALLOCATE(OutData%BladeLoadAD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoadAD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BladeLoadAD,1), UBOUND(OutData%BladeLoadAD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%BladeLoadAD(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLoadAD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(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 ExtLd_UnPackOutput + + + SUBROUTINE ExtLd_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(ExtLd_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(ExtLd_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .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 ExtLd_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL ExtLd_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 ExtLd_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 ExtLd_Input_ExtrapInterp + + + SUBROUTINE ExtLd_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(ExtLd_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ExtLd_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtLd_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL ExtLdDX_Input_ExtrapInterp1( u1%DX_u, u2%DX_u, tin, u_out%DX_u, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + b = -(u1%az - u2%az) + u_out%az = u1%az + b * ScaleFactor + CALL MeshExtrapInterp1(u1%TowerMotion, u2%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%NacelleMotion, u2%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN + DO i1 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN + DO i1 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) + CALL MeshExtrapInterp1(u1%BladeMotion(i1), u2%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated + END SUBROUTINE ExtLd_Input_ExtrapInterp1 + + + SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(ExtLd_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtLd_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ExtLd_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtLd_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: 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 = 'ExtLd_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + CALL ExtLdDX_Input_ExtrapInterp2( u1%DX_u, u2%DX_u, u3%DX_u, tin, u_out%DX_u, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + b = (t(3)**2*(u1%az - u2%az) + t(2)**2*(-u1%az + u3%az))* scaleFactor + c = ( (t(2)-t(3))*u1%az + t(3)*u2%az - t(2)*u3%az ) * scaleFactor + u_out%az = u1%az + b + c * t_out + CALL MeshExtrapInterp2(u1%TowerMotion, u2%TowerMotion, u3%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%NacelleMotion, u2%NacelleMotion, u3%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN + DO i1 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), u3%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated +IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN + DO i1 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) + CALL MeshExtrapInterp2(u1%BladeMotion(i1), u2%BladeMotion(i1), u3%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated + END SUBROUTINE ExtLd_Input_ExtrapInterp2 + + + SUBROUTINE ExtLd_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .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 ExtLd_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL ExtLd_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 ExtLd_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 ExtLd_Output_ExtrapInterp + + + SUBROUTINE ExtLd_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLd_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL ExtLdDX_Output_ExtrapInterp1( y1%DX_y, y2%DX_y, tin, y_out%DX_y, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerLoad, y2%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN + DO i1 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) + CALL MeshExtrapInterp1(y1%BladeLoad(i1), y2%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated + CALL MeshExtrapInterp1(y1%TowerLoadAD, y2%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN + DO i1 = LBOUND(y_out%BladeLoadAD,1),UBOUND(y_out%BladeLoadAD,1) + CALL MeshExtrapInterp1(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated + END SUBROUTINE ExtLd_Output_ExtrapInterp1 + + + SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: 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 = 'ExtLd_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + CALL ExtLdDX_Output_ExtrapInterp2( y1%DX_y, y2%DX_y, y3%DX_y, tin, y_out%DX_y, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerLoad, y2%TowerLoad, y3%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN + DO i1 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) + CALL MeshExtrapInterp2(y1%BladeLoad(i1), y2%BladeLoad(i1), y3%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated + CALL MeshExtrapInterp2(y1%TowerLoadAD, y2%TowerLoadAD, y3%TowerLoadAD, tin, y_out%TowerLoadAD, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%BladeLoadAD) .AND. ALLOCATED(y1%BladeLoadAD)) THEN + DO i1 = LBOUND(y_out%BladeLoadAD,1),UBOUND(y_out%BladeLoadAD,1) + CALL MeshExtrapInterp2(y1%BladeLoadAD(i1), y2%BladeLoadAD(i1), y3%BladeLoadAD(i1), tin, y_out%BladeLoadAD(i1), tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated + END SUBROUTINE ExtLd_Output_ExtrapInterp2 + +END MODULE ExtLoads_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index a1d2570ca3..4a3fb947ad 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -120,6 +120,7 @@ MODULE NWTC_IO MODULE PROCEDURE AllIPAry1 MODULE PROCEDURE AllIPAry2 MODULE PROCEDURE AllFPAry1 + MODULE PROCEDURE AllDPAry1 MODULE PROCEDURE AllRPAry2 MODULE PROCEDURE AllR4PAry3 MODULE PROCEDURE AllR8PAry3 @@ -666,6 +667,39 @@ SUBROUTINE AllFPAry1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) RETURN END SUBROUTINE AllFPAry1 !======================================================================= +!> \copydoc nwtc_io::allipary1 + SUBROUTINE AllDPAry1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) + + ! This routine allocates a 1-D REAL array. + ! Argument declarations. + + REAL(C_DOUBLE), POINTER :: Ary (:) ! Array to be allocated + INTEGER, INTENT(IN) :: AryDim1 ! The size of the first dimension of the array. + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message corresponding to ErrStat + CHARACTER(*), INTENT(IN) :: Descr ! Brief array description. + + + IF ( ASSOCIATED(Ary) ) THEN + DEALLOCATE(Ary) + !ErrStat = ErrID_Warn + !ErrMsg = " AllRPAry2: Ary already allocated." + END IF + + ALLOCATE ( Ary(AryDim1) , STAT=ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_REAL))//& + ' bytes of memory for the '//TRIM( Descr )//' array.' + ELSE + ErrStat = ErrID_None + ErrMsg = '' + END IF + + Ary = 0 + RETURN + END SUBROUTINE AllDPAry1 +!======================================================================= !> \copydoc nwtc_io::allipary1 SUBROUTINE AllRPAry2 ( Ary, AryDim1, AryDim2, Descr, ErrStat, ErrMsg ) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index 86d77b47ea..7b7144cb5b 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -45,6 +45,7 @@ target_link_libraries(openfast_prelib versioninfolib aerodyn14lib aerodynlib + extloadslib beamdynlib elastodynlib extptfm_mckflib diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index e253a1a44d..9977338aa0 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -506,63 +506,170 @@ subroutine FAST_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, d #endif end subroutine FAST_Restart + !================================================================================================================================== -subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, InitSCOutputsGlob, InitSCOutputsTurbine, NumActForcePtsBlade, NumActForcePtsTower, TurbPosn, AbortErrLev_c, dt_c, NumBl_c, NumBlElem_c, NodeClusterType_c, & - ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Init') +subroutine FAST_BR_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, NumBl_c, & + az_blend_mean_c, az_blend_delta_c, vel_mean_c, wind_dir_c, z_ref_c, shear_exp_c, & + ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_BR_CFD_Init') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_BR_CFD_Init IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Init +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Init #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - REAL(C_DOUBLE), INTENT(IN ) :: TMax - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) - INTEGER(C_INT), INTENT(IN ) :: TurbID ! Need not be same as iTurb - INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs - INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs - INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs - REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs - REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsTurbine (*) ! Initial Supercontroller turbine specific outputs = controller inputs - INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade - INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower - INTEGER(C_INT), INTENT(IN ):: NodeClusterType_c - REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: NumBl_c - INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c - TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes - TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + REAL(C_DOUBLE), INTENT(IN ) :: TMax + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: TurbID ! Need not be same as iTurb + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutFileRoot_c(IntfStrLen) + REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) + REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c + REAL(C_DOUBLE), INTENT(IN ) :: az_blend_mean_c + REAL(C_DOUBLE), INTENT(IN ) :: az_blend_delta_c + REAL(C_DOUBLE), INTENT(IN ) :: vel_mean_c + REAL(C_DOUBLE), INTENT(IN ) :: wind_dir_c + REAL(C_DOUBLE), INTENT(IN ) :: z_ref_c + REAL(C_DOUBLE), INTENT(IN ) :: shear_exp_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: NumBl_c + TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST + TYPE(ExtLdDX_OutputType_C),INTENT( OUT) :: ExtLd_Output_to_FAST TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: InputFileName - INTEGER(C_INT) :: i + CHARACTER(IntfStrLen) :: InputFileName + INTEGER(C_INT) :: i TYPE(FAST_ExternInitType) :: ExternInitData - - ! transfer the character array from C to a Fortran string: + INTEGER(IntKi) :: CompLoadsType + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_BR_CFD_Init' + + ! transfer the character array from C to a Fortran string: InputFileName = TRANSFER( InputFileName_c, InputFileName ) I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it - - ! initialize variables: - n_t_global = 0 + + ! initialize variables: + n_t_global = 0 ErrStat = ErrID_None ErrMsg = "" - + + ExternInitData%TMax = TMax + ExternInitData%TurbineID = TurbID + ExternInitData%TurbinePos = TurbPosn + ExternInitData%SensorType = SensorType_None + ExternInitData%NumSC2CtrlGlob = 0 + ExternInitData%NumCtrl2SC = 0 + ExternInitData%NumSC2Ctrl = 0 + ExternInitData%DTdriver = dtDriver_c + ExternInitData%az_blend_mean = az_blend_mean_c + ExternInitData%az_blend_delta = az_blend_delta_c + ExternInitData%vel_mean = vel_mean_c + ExternInitData%wind_dir = wind_dir_c + ExternInitData%z_ref = z_ref_c + ExternInitData%shear_exp = shear_exp_c + + CALL FAST_InitializeAll_T( t_initial, 1_IntKi, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) + + write(*,*) 'ErrMsg = ', ErrMsg + ! set values for return to ExternalInflow + if (ErrStat .ne. ErrID_None) then + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + dt_c = DBLE(Turbine(iTurb)%p_FAST%DT) + + NumBl_c = Turbine(iTurb)%ED%p%NumBl + + CompLoadsType = Turbine(iTurb)%p_FAST%CompAero + + if ( (CompLoadsType .ne. Module_ExtLd) ) then + CALL SetErrStat(ErrID_Fatal, "CompAero is not set to 3 for use of the External Loads module. Use a different C++ initialization call for this turbine.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST) + + OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) + + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + +end subroutine FAST_BR_CFD_Init + +!================================================================================================================================== +subroutine FAST_AL_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, InitSCOutputsGlob, InitSCOutputsTurbine, & + NumActForcePtsBlade, NumActForcePtsTower, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, InflowType, NumBl_c, NumBlElem_c, NumTwrElem_c, & + ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_AL_CFD_Init') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_Init + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Init +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Init +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + REAL(C_DOUBLE), INTENT(IN ) :: TMax + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: TurbID ! Need not be same as iTurb + INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutFileRoot_c(IntfStrLen) ! Root of output and restart file name + INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs + INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs + REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs + REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsTurbine (*) ! Initial Supercontroller turbine specific outputs = controller inputs + INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade + INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower + REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) + REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: InflowType ! inflow type - 1 = From Inflow module, 2 = External + INTEGER(C_INT), INTENT( OUT) :: NumBl_c + INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c + INTEGER(C_INT), INTENT( OUT) :: NumTwrElem_c + TYPE(ExtInfw_InputType_C), INTENT( OUT) :: ExtInfw_Input_from_FAST + TYPE(ExtInfw_OutputType_C),INTENT( OUT) :: ExtInfw_Output_to_FAST + TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST + TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + ! local + CHARACTER(IntfStrLen) :: InputFileName + INTEGER(C_INT) :: i + TYPE(FAST_ExternInitType) :: ExternInitData + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CFD_Init' + + ! transfer the character array from C to a Fortran string: + InputFileName = TRANSFER( InputFileName_c, InputFileName ) + I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it + + ! initialize variables: + n_t_global = 0 + ErrStat = ErrID_None + ErrMsg = "" + NumBl_c = 0 ! initialize here in case of error NumBlElem_c = 0 ! initialize here in case of error - + ExternInitData%TMax = TMax ExternInitData%TurbineID = TurbID ExternInitData%TurbinePos = TurbPosn ExternInitData%SensorType = SensorType_None ExternInitData%NumCtrl2SC = NumCtrl2SC ExternInitData%NumSC2CtrlGlob = NumSC2CtrlGlob - + if ( NumSC2CtrlGlob > 0 ) then CALL AllocAry( ExternInitData%fromSCGlob, NumSC2CtrlGlob, 'ExternInitData%fromSCGlob', ErrStat, ErrMsg) IF (FAILED()) RETURN @@ -571,7 +678,7 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, NumSC2CtrlGlo ExternInitData%fromSCGlob(i) = InitScOutputsGlob(i) end do end if - + ExternInitData%NumSC2Ctrl = NumSC2Ctrl if ( NumSC2Ctrl > 0 ) then CALL AllocAry( ExternInitData%fromSC, NumSC2Ctrl, 'ExternInitData%fromSC', ErrStat, ErrMsg) @@ -581,167 +688,340 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, NumSC2CtrlGlo ExternInitData%fromSC(i) = InitScOutputsTurbine(i) end do end if - + ExternInitData%NumActForcePtsBlade = NumActForcePtsBlade ExternInitData%NumActForcePtsTower = NumActForcePtsTower + ExternInitData%DTdriver = dtDriver_c - ExternInitData%NodeClusterType = NodeClusterType_c - - CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) + CALL FAST_InitializeAll_T( t_initial, 1_IntKi, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) ! set values for return to ExternalInflow - 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_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - RETURN - END IF - + if (ErrStat .ne. ErrID_None) then + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + dt_c = Turbine(iTurb)%p_FAST%dt + + InflowType = Turbine(iTurb)%p_FAST%CompInflow + + if ( (InflowType == 3) .and. (NumActForcePtsBlade .eq. 0) .and. (NumActForcePtsTower .eq. 0) ) then + CALL SetErrStat(ErrID_Warn, "Number of actuator points is zero when inflow type is 2. Mapping of loads may not work. ", ErrStat, ErrMsg, RoutineName ) + end if + + if ( (InflowType .ne. 3) .and. ((NumActForcePtsBlade .ne. 0) .or. (NumActForcePtsTower .ne. 0)) ) then + !!FAST reassigns CompInflow after reading it to a module number based on an internal list in the FAST_Registry. So 2 in input file becomes 3 inside the code. + CALL SetErrStat(ErrID_Fatal, "Number of requested actuator points is non-zero when inflow type is not 2. Please set number of actuator points to zero when induction is turned on.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) - - ! 7-Sep-2015: Sang wants these integers for the ExternalInflow mapping, which is tied to the AeroDyn nodes. FAST doesn't restrict the number of nodes on each - ! blade mesh to be the same, so if this DOES ever change, we'll need to make ExternalInflow less tied to the AeroDyn mapping. - IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN + + ! 7-Sep-2015: OpenFAST doesn't restrict the number of nodes on each blade mesh to be the same, so if this DOES ever change, + ! we'll need to make ExternalInflow less tied to the AeroDyn mapping. + IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN NumBl_c = SIZE(Turbine(iTurb)%AD14%Input(1)%InputMarkers) NumBlElem_c = Turbine(iTurb)%AD14%Input(1)%InputMarkers(1)%Nnodes + NumTwrElem_c = 0 ! Don't care about Aerodyn14 anymore ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN - IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors)) THEN - IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion)) THEN - NumBl_c = SIZE(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion) - END IF - END IF - IF (NumBl_c > 0) THEN - NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes - END IF + NumBl_c = SIZE(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion) + NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes + NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes + ELSE + NumBl_c = 0 + NumBlElem_c = 0 + NumTwrElem_c = 0 END IF - -contains + + OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) + + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + + contains LOGICAL FUNCTION FAILED() - - FAILED = ErrStat >= AbortErrLev - - IF (ErrStat > 0) THEN - CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - - IF ( FAILED ) THEN - - AbortErrLev_c = AbortErrLev - ErrStat_c = ErrStat - ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR - ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - - !IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) - ! bjj: if there is an error, the driver should call FAST_DeallocateTurbines() instead of putting this deallocate statement here - END IF - END IF - - + + FAILED = ErrStat >= AbortErrLev + + IF (ErrStat > 0) THEN + CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) + + IF ( FAILED ) THEN + + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + + !IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) + ! bjj: if there is an error, the driver should call FAST_DeallocateTurbines() instead of putting this deallocate statement here + END IF + END IF + + END FUNCTION FAILED -end subroutine + +end subroutine FAST_AL_CFD_Init !================================================================================================================================== -subroutine FAST_ExtInfw_Solution0(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Solution0') +subroutine FAST_CFD_Solution0(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Solution0') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Solution0 -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Solution0 +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Solution0 +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Solution0 #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - call FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CFD_Solution0' + + call FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) ! if(Turbine(iTurb)%SC_DX%p%useSC) then ! CALL SC_SetInputs(Turbine(iTurb)%p_FAST, Turbine(iTurb)%SrvD%y, Turbine(iTurb)%SC_DX, ErrStat, ErrMsg) ! end if - + + ! set values for return to ExternalInflow + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg, ErrMsg_c ) + +end subroutine FAST_CFD_Solution0 +!================================================================================================================================== +subroutine FAST_CFD_InitIOarrays_SS(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_InitIOarrays_SS') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_InitIOarrays_SS + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_InitIOarrays_SS +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + call FAST_InitIOarrays_SS_T(t_initial, Turbine(iTurb), ErrStat, ErrMsg ) + ! set values for return to ExternalInflow ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - - -end subroutine FAST_ExtInfw_Solution0 + +end subroutine FAST_CFD_InitIOarrays_SS !================================================================================================================================== -subroutine FAST_ExtInfw_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, numElementsPerBlade_c, n_t_global_c, & - ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Restart') +subroutine FAST_AL_CFD_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, InflowType, numblades_c, & + numElementsPerBlade_c, numElementsTower_c, n_t_global_c, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, & + SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_AL_CFD_Restart') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_AL_CFD_Restart IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_AL_CFD_Restart +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_AL_CFD_Restart #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: numblades_c - INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: n_t_global_c - TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes - TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: numblades_c + INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c + INTEGER(C_INT), INTENT( OUT) :: numElementsTower_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: InflowType + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + TYPE(ExtInfw_InputType_C), INTENT( OUT) :: ExtInfw_Input_from_FAST + TYPE(ExtInfw_OutputType_C),INTENT( OUT) :: ExtInfw_Output_to_FAST TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local variables - INTEGER(C_INT) :: NumOuts_c - CHARACTER(IntfStrLen) :: CheckpointRootName + INTEGER(C_INT) :: NumOuts_c + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit REAL(DbKi) :: t_initial_out INTEGER(IntKi) :: NumTurbines_out - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + CALL NWTC_Init() - ! transfer the character array from C to a Fortran string: + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + Unit = -1 CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - + ! check that these are valid: IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) - - ! transfer Fortran variables to C: + + ! transfer Fortran variables to C: n_t_global_c = n_t_global - AbortErrLev_c = AbortErrLev - NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time + AbortErrLev_c = AbortErrLev + NumOuts_c = min(MAXOUTPUTS, 1 + SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time + if (allocated(Turbine(iTurb)%ad%p%rotors)) then ! this might not be allocated if we had an error earlier numBlades_c = Turbine(iTurb)%ad%p%rotors(1)%numblades numElementsPerBlade_c = Turbine(iTurb)%ad%p%rotors(1)%numblnds ! I'm not sure if FASTv8 can handle different number of blade nodes for each blade. + numElementsTower_c = Turbine(iTurb)%ad%y%rotors(1)%TowerLoad%Nnodes else numBlades_c = 0 numElementsPerBlade_c = 0 + numElementsTower_c = 0 end if - - dt_c = Turbine(iTurb)%p_FAST%dt - + + dt_c = Turbine(iTurb)%p_FAST%dt + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE - if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif +#ifdef CONSOLE_FILE + if (ErrStat .ne. ErrID_None) call wrscr1(trim(ErrMsg)) +#endif if (ErrStat >= AbortErrLev) return - + + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) + + InflowType = Turbine(iTurb)%p_FAST%CompInflow + + if (ErrStat .ne. ErrID_None) then + call wrscr1(trim(ErrMsg)) + return + end if + + if (dt_c == Turbine(iTurb)%p_FAST%dt) then + CALL SetErrStat(ErrID_Fatal, "Time step specified in C++ API does not match with time step specified in OpenFAST input file.", ErrStat, ErrMsg, RoutineName ) + return + end if + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) -end subroutine FAST_ExtInfw_Restart +end subroutine FAST_AL_CFD_Restart + +!================================================================================================================================== +subroutine FAST_BR_CFD_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, & + n_t_global_c, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, & + SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_BR_CFD_Restart') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_BR_CFD_Restart + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Restart +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Restart +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: numblades_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST + TYPE(ExtLdDX_OutputType_C),INTENT( OUT) :: ExtLd_Output_to_FAST + TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST + TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + ! local variables + INTEGER(C_INT) :: NumOuts_c + CHARACTER(IntfStrLen) :: CheckpointRootName + INTEGER(IntKi) :: I + INTEGER(IntKi) :: Unit + REAL(DbKi) :: t_initial_out + INTEGER(IntKi) :: NumTurbines_out + INTEGER(IntKi) :: CompLoadsType + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + + CALL NWTC_Init() + ! transfer the character array from C to a Fortran string: + CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) + I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... + IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it + + Unit = -1 + CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) + + if (ErrStat .ne. ErrID_None) then + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + ! check that these are valid: + IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) + IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) + + ! transfer Fortran variables to C: + n_t_global_c = n_t_global + AbortErrLev_c = AbortErrLev + NumOuts_c = min(MAXOUTPUTS, 1 + SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time + numblades_c = Turbine(iTurb)%ED%p%NumBl + dt_c = Turbine(iTurb)%p_FAST%dt + +#ifdef CONSOLE_FILE + if (ErrStat .ne. ErrID_None) call wrscr1(trim(ErrMsg)) +#endif + + CompLoadsType = Turbine(iTurb)%p_FAST%CompAero + + if ( (CompLoadsType .ne. Module_ExtLd) ) then + CALL SetErrStat(ErrID_Fatal, "CompAero is not set to 3 for use of the External Loads module. Use a different initialization call for this turbine.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + + write(*,*) 'Finished restoring OpenFAST from checkpoint' + call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST) + + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + +end subroutine FAST_BR_CFD_Restart +!================================================================================================================================== +subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_oToOF) + + IMPLICIT NONE + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + TYPE(ExtLdDX_InputType_C), INTENT(INOUT) :: ExtLd_iFromOF + TYPE(ExtLdDX_OutputType_C),INTENT(INOUT) :: ExtLd_oToOF + + ExtLd_iFromOF%bldPitch_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch_Len; ExtLd_iFromOF%bldPitch = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch + ExtLd_iFromOF%twrHloc_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrHloc_Len; ExtLd_iFromOF%twrHloc = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrHloc + ExtLd_iFromOF%twrDia_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDia_Len; ExtLd_iFromOF%twrDia = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDia + ExtLd_iFromOF%twrRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrRefPos_Len; ExtLd_iFromOF%twrRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrRefPos + ExtLd_iFromOF%twrDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef_Len; ExtLd_iFromOF%twrDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef + ExtLd_iFromOF%bldRloc_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRloc_Len; ExtLd_iFromOF%bldRloc = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRloc + ExtLd_iFromOF%bldChord_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldChord_Len; ExtLd_iFromOF%bldChord = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldChord + ExtLd_iFromOF%bldRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRefPos_Len; ExtLd_iFromOF%bldRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRefPos + ExtLd_iFromOF%bldRootRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootRefPos_Len; ExtLd_iFromOF%bldRootRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootRefPos + ExtLd_iFromOF%bldDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef_Len; ExtLd_iFromOF%bldDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef + ExtLd_iFromOF%nBlades_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBlades_Len; ExtLd_iFromOF%nBlades = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBlades + ExtLd_iFromOF%nBladeNodes_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBladeNodes_Len; ExtLd_iFromOF%nBladeNodes = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBladeNodes + ExtLd_iFromOF%nTowerNodes_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nTowerNodes_Len; ExtLd_iFromOF%nTowerNodes = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nTowerNodes + + ExtLd_iFromOF%bldRootDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef_Len; ExtLd_iFromOF%bldRootDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef + + ExtLd_iFromOF%hubRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubRefPos_Len; ExtLd_iFromOF%hubRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubRefPos + ExtLd_iFromOF%hubDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef_Len; ExtLd_iFromOF%hubDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef + + ExtLd_iFromOF%nacRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacRefPos_Len; ExtLd_iFromOF%nacRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacRefPos + ExtLd_iFromOF%nacDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef_Len; ExtLd_iFromOF%nacDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef + + ExtLd_oToOF%twrLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd_Len; ExtLd_oToOF%twrLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd + ExtLd_oToOF%bldLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd_Len; ExtLd_oToOF%bldLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd + + end subroutine SetExtLoads_pointers + !================================================================================================================================== subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) IMPLICIT NONE - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST @@ -750,12 +1030,15 @@ subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Ou ExtInfw_Input_from_FAST%pxVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxVel_Len; ExtInfw_Input_from_FAST%pxVel = Turbine(iTurb)%ExtInfw%u%c_obj%pxVel ExtInfw_Input_from_FAST%pyVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyVel_Len; ExtInfw_Input_from_FAST%pyVel = Turbine(iTurb)%ExtInfw%u%c_obj%pyVel ExtInfw_Input_from_FAST%pzVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzVel_Len; ExtInfw_Input_from_FAST%pzVel = Turbine(iTurb)%ExtInfw%u%c_obj%pzVel + ExtInfw_Input_from_FAST%pxDotVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotVel_Len; ExtInfw_Input_from_FAST%pxDotVel = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotVel + ExtInfw_Input_from_FAST%pyDotVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotVel_Len; ExtInfw_Input_from_FAST%pyDotVel = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotVel + ExtInfw_Input_from_FAST%pzDotVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotVel_Len; ExtInfw_Input_from_FAST%pzDotVel = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotVel ExtInfw_Input_from_FAST%pxForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxForce_Len; ExtInfw_Input_from_FAST%pxForce = Turbine(iTurb)%ExtInfw%u%c_obj%pxForce ExtInfw_Input_from_FAST%pyForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyForce_Len; ExtInfw_Input_from_FAST%pyForce = Turbine(iTurb)%ExtInfw%u%c_obj%pyForce ExtInfw_Input_from_FAST%pzForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzForce_Len; ExtInfw_Input_from_FAST%pzForce = Turbine(iTurb)%ExtInfw%u%c_obj%pzForce - ExtInfw_Input_from_FAST%xdotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%xdotForce_Len; ExtInfw_Input_from_FAST%xdotForce = Turbine(iTurb)%ExtInfw%u%c_obj%xdotForce - ExtInfw_Input_from_FAST%ydotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%ydotForce_Len; ExtInfw_Input_from_FAST%ydotForce = Turbine(iTurb)%ExtInfw%u%c_obj%ydotForce - ExtInfw_Input_from_FAST%zdotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%zdotForce_Len; ExtInfw_Input_from_FAST%zdotForce = Turbine(iTurb)%ExtInfw%u%c_obj%zdotForce + ExtInfw_Input_from_FAST%pxDotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotForce_Len; ExtInfw_Input_from_FAST%pxDotForce = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotForce + ExtInfw_Input_from_FAST%pyDotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotForce_Len; ExtInfw_Input_from_FAST%pyDotForce = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotForce + ExtInfw_Input_from_FAST%pzDotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotForce_Len; ExtInfw_Input_from_FAST%pzDotForce = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotForce ExtInfw_Input_from_FAST%pOrientation_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pOrientation_Len; ExtInfw_Input_from_FAST%pOrientation = Turbine(iTurb)%ExtInfw%u%c_obj%pOrientation ExtInfw_Input_from_FAST%fx_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fx_Len; ExtInfw_Input_from_FAST%fx = Turbine(iTurb)%ExtInfw%u%c_obj%fx ExtInfw_Input_from_FAST%fy_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fy_Len; ExtInfw_Input_from_FAST%fy = Turbine(iTurb)%ExtInfw%u%c_obj%fy @@ -764,6 +1047,7 @@ subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Ou ExtInfw_Input_from_FAST%momenty_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momenty_Len; ExtInfw_Input_from_FAST%momenty = Turbine(iTurb)%ExtInfw%u%c_obj%momenty ExtInfw_Input_from_FAST%momentz_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momentz_Len; ExtInfw_Input_from_FAST%momentz = Turbine(iTurb)%ExtInfw%u%c_obj%momentz ExtInfw_Input_from_FAST%forceNodesChord_Len = Turbine(iTurb)%ExtInfw%u%c_obj%forceNodesChord_Len; ExtInfw_Input_from_FAST%forceNodesChord = Turbine(iTurb)%ExtInfw%u%c_obj%forceNodesChord + ExtInfw_Input_from_FAST%forceRHloc_Len = Turbine(iTurb)%ExtInfw%u%c_obj%forceRHloc_Len; ExtInfw_Input_from_FAST%forceRHloc = Turbine(iTurb)%ExtInfw%u%c_obj%forceRHloc if (Turbine(iTurb)%p_FAST%UseSC) then SC_DX_Input_from_FAST%toSC_Len = Turbine(iTurb)%SC_DX%u%c_obj%toSC_Len @@ -781,47 +1065,236 @@ subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Ou end subroutine SetExternalInflow_pointers !================================================================================================================================== -subroutine FAST_ExtInfw_Step(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Step') +subroutine FAST_CFD_Prework(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Prework') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_Prework IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Step -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Step +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Prework #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - - - IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish - + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation - + if (iTurb .eq. (NumTurbines-1) ) then IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved n_t_global = n_t_global + 1 ErrStat_c = ErrID_None ErrMsg = C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - ELSE + ELSE ErrStat_c = ErrID_Info ErrMsg = "Simulation completed."//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF end if - + ELSE - CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + ! if(Turbine(iTurb)%SC%p%scOn) then + ! CALL SC_SetOutputs(Turbine(iTurb)%p_FAST, Turbine(iTurb)%SrvD%Input(1), Turbine(iTurb)%SC, ErrStat, ErrMsg) + ! end if + + CALL FAST_Prework_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + +end subroutine FAST_CFD_Prework +!================================================================================================================================== +subroutine FAST_CFD_UpdateStates(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_UpdateStates') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_UpdateStates + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_UpdateStates +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation + + if (iTurb .eq. (NumTurbines-1) ) then + IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved + n_t_global = n_t_global + 1 + ErrStat_c = ErrID_None + ErrMsg = C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + ELSE + ErrStat_c = ErrID_Info + ErrMsg = "Simulation completed."//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + end if + + ELSE + + CALL FAST_UpdateStates_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + +end subroutine FAST_CFD_UpdateStates +!================================================================================================================================== +subroutine FAST_CFD_AdvanceToNextTimeStep(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_AdvanceToNextTimeStep') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_AdvanceToNextTimeStep + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_AdvanceToNextTimeStep +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation + + if (iTurb .eq. (NumTurbines-1) ) then + IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved + n_t_global = n_t_global + 1 + ErrStat_c = ErrID_None + ErrMsg = C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + ELSE + ErrStat_c = ErrID_Info + ErrMsg = "Simulation completed."//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + end if + + ELSE + + CALL FAST_AdvanceToNextTimeStep_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ! if(Turbine(iTurb)%SC%p%scOn) then + ! CALL SC_SetInputs(Turbine(iTurb)%p_FAST, Turbine(iTurb)%SrvD%y, Turbine(iTurb)%SC, ErrStat, ErrMsg) + ! end if + if (iTurb .eq. (NumTurbines-1) ) then n_t_global = n_t_global + 1 end if - + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF - - -end subroutine FAST_ExtInfw_Step -!================================================================================================================================== + + +end subroutine FAST_CFD_AdvanceToNextTimeStep +!================================================================================================================================== +subroutine FAST_CFD_WriteOutput(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_WriteOutput') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_WriteOutput + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_WriteOutput +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + CALL FAST_WriteOutput_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + +end subroutine FAST_CFD_WriteOutput +!================================================================================================================================== +subroutine FAST_CFD_Step(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Step') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Step +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Step +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation + + if (iTurb .eq. (NumTurbines-1) ) then + IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved + n_t_global = n_t_global + 1 + ErrStat_c = ErrID_None + ErrMsg = C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + ELSE + ErrStat_c = ErrID_Info + ErrMsg = "Simulation completed."//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + end if + + ELSE + + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + if (iTurb .eq. (NumTurbines-1) ) then + n_t_global = n_t_global + 1 + end if + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + END IF + + +end subroutine FAST_CFD_Step +!================================================================================================================================== +subroutine FAST_CFD_Reset_SS(iTurb, n_timesteps, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Reset_SS') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT + !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SS + !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SS +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: n_timesteps ! Number of time steps to go back + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + CALL FAST_Reset_SS_T(t_initial, n_t_global-n_timesteps, n_timesteps, Turbine(iTurb), ErrStat, ErrMsg ) + + if (iTurb .eq. (NumTurbines-1) ) then + n_t_global = n_t_global - n_timesteps + end if + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + + +end subroutine FAST_CFD_Reset_SS +!================================================================================================================================== +subroutine FAST_CFD_Store_SS(iTurb, n_t_global, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Store_SS') + IMPLICIT NONE +#ifndef IMPLICIT_DLLEXPORT + !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SS + !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SS +#endif + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + + CALL FAST_Store_SS_T(t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + + +end subroutine FAST_CFD_Store_SS +!================================================================================================================================== END MODULE FAST_Data diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 779aba9456..aa8ccb6005 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -3,6 +3,7 @@ // routines in FAST_Library_$(PlatformName).dll #include "ExternalInflow_Types.h" +#include "ExtLoadsDX_Types.h" #include "SCDataEx_Types.h" #include "stdio.h" @@ -15,13 +16,33 @@ EXTERNAL_ROUTINE void FAST_AllocateTurbines(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_DeallocateTurbines(int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_ExtInfw_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * NumBlElem, int * n_t_global, - ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_ExtInfw_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, int * NumSC2CtrlGlob, int * NumSC2Ctrl, int * NumCtrl2SC, float * initSCInputsGlob, float * initSCInputsTurbine, int * NumActForcePtsBlade, int * NumActForcePtsTower, float * TurbinePosition, - int *AbortErrLev, double * dt, int * NumBl, int * NumBlElem, int * NodeClusterType, ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, - int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_ExtInfw_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_ExtInfw_Step(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_AL_CFD_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, + double * dt, int * InflowType, int * NumBl, int * NumBlElem, int * NumTwrElem, int * n_t_global, + ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, + SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, + int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_AL_CFD_Init(int * iTurb, double *TMax, const char *InputFileName, + int * TurbineID, char *OutFileRoot, + int * NumSC2CtrlGlob, int * NumSC2Ctrl, int * NumCtrl2SC, + float * initSCInputsGlob, float * initSCInputsTurbine, + int * NumActForcePtsBlade, int * NumActForcePtsTower, float * TurbinePosition, + int *AbortErrLev, double * dtDriver, double * dt, int * InflowType, + int * NumBl, int * NumBlElem, int * NumTwrElem, + ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, + SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, + int *ErrStat, char *ErrMsg); + +EXTERNAL_ROUTINE void FAST_BR_CFD_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_BR_CFD_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, double * vel_mean, double * wind_dir, double * z_ref, double * shear_exp, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_InitIOarrays_SS(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Prework(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_UpdateStates(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_AdvanceToNextTimeStep(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_WriteOutput(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Step(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Reset_SS(int * iTurb, int * n_timesteps, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Store_SS(int * iTurb, int * n_t_global, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_HubPosition(int * iTurb, float * absolute_position, float * rotation_veocity, double * orientation_dcm, int *ErrStat, char *ErrMsg); diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index e223e39268..fd0fadb776 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -38,6 +38,8 @@ MODULE FAST_ModTypes ! state array indexes INTEGER(IntKi), PARAMETER :: STATE_CURR = 1 !< index for "current" (t_global) states INTEGER(IntKi), PARAMETER :: STATE_PRED = 2 !< index for "predicted" (t_global_next) states + INTEGER(IntKi), PARAMETER :: STATE_SS_CURR = 3 + INTEGER(IntKi), PARAMETER :: STATE_SS_PRED = 4 ! VTK visualization INTEGER(IntKi), PARAMETER :: VTK_Unknown = -1 !< unknown option (will produce error) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c172b99d88..c83136a7e4 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -16,6 +16,7 @@ usefrom Registry_BeamDyn.txt usefrom ServoDyn_Registry.txt usefrom Registry-AD14.txt usefrom AeroDyn_Registry.txt +usefrom ExtLoads_Registry.txt usefrom SubDyn_Registry.txt usefrom SeaState.txt usefrom HydroDyn.txt @@ -39,23 +40,24 @@ param FAST - INTEGER Module_Unknown - -1 - "Unknown" - param ^ - INTEGER Module_None - 0 - "No module selected" - param ^ - INTEGER Module_Glue - 1 - "Glue code" - param ^ - INTEGER Module_IfW - 2 - "InflowWind" - -param ^ - INTEGER Module_ExtInfw - 3 "ExternalInflow" - +param ^ - INTEGER Module_ExtInfw - 3 - "ExternalInflow" - param ^ - INTEGER Module_ED - 4 - "ElastoDyn" - param ^ - INTEGER Module_BD - 5 - "BeamDyn" - param ^ - INTEGER Module_AD14 - 6 - "AeroDyn14" - param ^ - INTEGER Module_AD - 7 - "AeroDyn" - -param ^ - INTEGER Module_SrvD - 8 - "ServoDyn" - -param ^ - INTEGER Module_SeaSt - 9 - "SeaState" - -param ^ - INTEGER Module_HD - 10 - "HydroDyn" - -param ^ - INTEGER Module_SD - 11 - "SubDyn" - -param ^ - INTEGER Module_ExtPtfm - 12 - "External Platform Loading MCKF" - -param ^ - INTEGER Module_MAP - 13 - "MAP (Mooring Analysis Program)" - -param ^ - INTEGER Module_FEAM - 14 - "FEAMooring" - -param ^ - INTEGER Module_MD - 15 - "MoorDyn" - -param ^ - INTEGER Module_Orca - 16 - "OrcaFlex integration (HD/Mooring)" - -param ^ - INTEGER Module_IceF - 17 - "IceFloe" - -param ^ - INTEGER Module_IceD - 18 - "IceDyn" - -param ^ - INTEGER NumModules - 18 - "The number of modules available in FAST" - +param ^ - INTEGER Module_ExtLd - 8 - "AeroDyn" - +param ^ - INTEGER Module_SrvD - 9 - "ServoDyn" - +param ^ - INTEGER Module_SeaSt - 10 - "SeaState" - +param ^ - INTEGER Module_HD - 11 - "HydroDyn" - +param ^ - INTEGER Module_SD - 12 - "SubDyn" - +param ^ - INTEGER Module_ExtPtfm - 13 - "External Platform Loading MCKF" - +param ^ - INTEGER Module_MAP - 14 - "MAP (Mooring Analysis Program)" - +param ^ - INTEGER Module_FEAM - 15 - "FEAMooring" - +param ^ - INTEGER Module_MD - 16 - "MoorDyn" - +param ^ - INTEGER Module_Orca - 17 - "OrcaFlex integration (HD/Mooring)" - +param ^ - INTEGER Module_IceF - 18 - "IceFloe" - +param ^ - INTEGER Module_IceD - 19 - "IceDyn" - +param ^ - INTEGER NumModules - 20 - "The number of modules available in FAST" - # Other Constants param ^ - INTEGER MaxNBlades - 3 - "Maximum number of blades allowed on a turbine" - param ^ - INTEGER IceD_MaxLegs - 4 - "because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number" - @@ -377,7 +379,9 @@ typedef ^ ^ IceD_InputType u {:} - - "System inputs" typedef ^ ^ IceD_OutputType y {:} - - "System outputs" typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ IceD_InputType Input_bak {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:}{:} - - "Backup Array of times associated with Input Array" # ..... BeamDyn data ....................................................................................................... # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] @@ -393,54 +397,64 @@ typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ BD_InputType Input_bak {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:}{:} - - "Backup Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... -typedef FAST ElastoDyn_Data ED_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ED_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ElastoDyn_Data ED_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ ED_OutputType Output_bak {:} - - "Backup Array of outputs associated with InputTimes" typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ ED_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... ServoDyn data ....................................................................................................... -typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SrvD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SrvD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SrvD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" typedef ^ ^ SrvD_MiscVarType m - - - "Misc (optimization) variables not associated with time" +typedef ^ ^ SrvD_MiscVarType m_bak - - - "Backup Misc (optimization) variables not associated with time" typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SrvD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn14 data ....................................................................................................... -typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ AD14_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ AD14_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ AD14_OtherStateType OtherSt {2} - - "Other states" +typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ AD14_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ AD14_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ AD14_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ AD14_ParameterType p - - - "Parameters" typedef ^ ^ AD14_InputType u - - - "System inputs" typedef ^ ^ AD14_OutputType y - - - "System outputs" typedef ^ ^ AD14_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD14_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ AD14_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... -typedef FAST AeroDyn_Data AD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST AeroDyn_Data AD_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" @@ -448,13 +462,26 @@ typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ AD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" + +# ..... ExtLoads data ....................................................................................................... +typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {2} - - "Continuous states" +typedef ^ ^ ExtLd_DiscreteStateType xd {2} - - "Discrete states" +typedef ^ ^ ExtLd_ConstraintStateType z {2} - - "Constraint states" +typedef ^ ^ ExtLd_OtherStateType OtherSt {2} - - "Other states" +typedef ^ ^ ExtLd_ParameterType p - - - "Parameters" +typedef ^ ^ ExtLd_InputType u - - - "System inputs" +typedef ^ ^ ExtLd_OutputType y - - - "System outputs" +typedef ^ ^ ExtLd_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... -typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt {2} - - "Other states" +typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" @@ -462,7 +489,9 @@ typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ InflowWind_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... ExternalInflow integration data ....................................................................................................... typedef FAST ExternalInflow_Data ExtInfw_InputType u - - - "System inputs" @@ -476,50 +505,56 @@ typedef ^ ^ SC_DX_OutputType y - - - "System outputs" typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... -typedef FAST SubDyn_Data SD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST SubDyn_Data SD_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ SD_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ SD_ParameterType p - - - "Parameters" typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... -typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ExtPtfm_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ExtPtfm_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ExtPtfm_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ ExtPtfm_ParameterType p - - - "Parameters" typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ ExtPtfm_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... SeaState data ....................................................................................................... -typedef FAST SeaState_Data SeaSt_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherSt {2} - - "Other states" +typedef FAST SeaState_Data SeaSt_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... -typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ HydroDyn_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ HydroDyn_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ HydroDyn_OtherStateType OtherSt {2} - - "Other states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ HydroDyn_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" @@ -527,24 +562,28 @@ typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ HydroDyn_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... -typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ IceFloe_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ IceFloe_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ IceFloe_OtherStateType OtherSt {2} - - "Other states" +typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ IceFloe_ParameterType p - - - "Parameters" typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ IceFloe_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... MAP data ....................................................................................................... -typedef FAST MAP_Data MAP_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ MAP_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ MAP_ConstraintStateType z {2} - - "Constraint states" +typedef FAST MAP_Data MAP_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z {4} - - "Constraint states" typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" @@ -553,25 +592,29 @@ typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (cop typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ MAP_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... -typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ FEAM_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ FEAM_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ FEAM_OtherStateType OtherSt {2} - - "Other states" +typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ FEAM_ParameterType p - - - "Parameters" typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ FEAM_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... -typedef FAST MoorDyn_Data MD_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ MD_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ MD_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ MD_OtherStateType OtherSt {2} - - "Other states" +typedef FAST MoorDyn_Data MD_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" @@ -579,19 +622,23 @@ typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ MD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... -typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ Orca_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ Orca_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ Orca_OtherStateType OtherSt {2} - - "Other states" +typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {4} - - "Continuous states" +typedef ^ ^ Orca_DiscreteStateType xd {4} - - "Discrete states" +typedef ^ ^ Orca_ConstraintStateType z {4} - - "Constraint states" +typedef ^ ^ Orca_OtherStateType OtherSt {4} - - "Other states" typedef ^ ^ Orca_ParameterType p - - - "Parameters" typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ Orca_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" # ..... FAST_ModuleMapType data ....................................................................................................... # ! Data structures for mapping and coupling the various modules together @@ -626,7 +673,7 @@ typedef ^ FAST_ModuleMapType MeshMapType SubStructure_2_SStC_P_P {:} - - "Map Su # ED --> SrvD -- PlatformPtMesh motion to SrvD%PtfmMotionMesh for passing to DLL typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_SrvD_P_P - - - "Map ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller" # ED/BD <-> AD (blades) -typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_AD_L_B {:} - - "Map ElastoDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes" +typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_AD_L_B {:} - - "Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes" typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_BDED_B {:} - - "Map AeroDyn14 InputMarkers or AeroDyn BladeLoad line2 meshes to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes" typedef ^ FAST_ModuleMapType MeshMapType BD_L_2_BD_L {:} - - "Map BeamDyn BldMotion output meshes to locations on the BD input DistrLoad mesh stored in MeshMapType%y_BD_BldMotion_4Loads (BD input and output meshes are not siblings and in fact have nodes at different locations" # ED <-> AD (nacelle, tower, hub, blade root, tailfin) @@ -639,6 +686,16 @@ typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_ED_P_T - - - "Map AeroDyn14 Twr_ typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_AD_P_R {:} - - "Map ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes" typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_AD_P_H - - - "Map ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh" typedef ^ FAST_ModuleMapType MeshMapType AD_P_2_ED_P_H - - - "Map AeroDyn HubLoad point mesh to ElastoDyn HubPtLoad point mesh" +# ED/BD <-> ExtLd (blades) +typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_ExtLd_P_B {:} - - "Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to ExtLoads point meshes" +typedef ^ FAST_ModuleMapType MeshMapType ExtLd_P_2_BDED_B {:} - - "Map ExtLoads at points to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes" +# ED <-> ExtLd (tower, hub, blade root) +typedef ^ FAST_ModuleMapType MeshMapType ED_L_2_ExtLd_P_T - - - "Map ElastoDyn TowerLn2Mesh line2 mesh to ExtLoads point mesh" +typedef ^ FAST_ModuleMapType MeshMapType ExtLd_P_2_ED_P_T - - - "Map ExtLoads TowerLoad point mesh to ElastoDyn TowerPtLoads point mesh" +typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_ExtLd_P_R {:} - - "Map ElastoDyn BladeRootMotion point meshes to ExtLoads BladeRootMotion point meshes" +typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_ExtLd_P_H - - - "Map ElastoDyn HubPtMotion point mesh to ExtLoads HubMotion point mesh" +typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_ExtLd_B {:} - - "Map AeroDyn line loads on blades to ExtLoads point loads" +typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_ExtLd_T - - - "Map AeroDyn line loads on tower to ExtKoads point loads" # IceF <-> SD typedef ^ FAST_ModuleMapType MeshMapType IceF_P_2_SD_P - - - "Map IceFloe point mesh to SubDyn LMesh point mesh" typedef ^ FAST_ModuleMapType MeshMapType SDy3_P_2_IceF_P - - - "Map SubDyn y3Mesh point mesh to IceFloe point mesh" @@ -709,6 +766,8 @@ typedef ^ FAST_InitData AD14_InitInputType InData_AD14 - - 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 ExtLd_InitInputType InData_ExtLd - - - "ExtLd Initialization input data" +typedef ^ FAST_InitData ExtLd_InitOutputType OutData_ExtLd - - - "ExtLd Initialization output data" typedef ^ FAST_InitData InflowWind_InitInputType InData_IfW - - - "IfW Initialization input data" typedef ^ FAST_InitData InflowWind_InitOutputType OutData_IfW - - - "IfW Initialization output data" typedef ^ FAST_InitData ExtInfw_InitInputType InData_ExtInfw - - - "ExtInfw Initialization input data" @@ -754,7 +813,15 @@ typedef ^ FAST_ExternInitType ReKi windGrid_pZero 3 - - "fixed position of the X typedef ^ FAST_ExternInitType CHARACTER(1024) RootName - - - "Root name of FAST output files (overrides normal operation)" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsTower - - - "number of actuator line force points in tower" - -typedef ^ FAST_ExternInitType IntKi NodeClusterType - - - "Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip)" - +typedef ^ FAST_ExternInitType IntKi NodeClusterType - - - "Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip)" - +typedef ^ FAST_ExternInitType DbKi DTdriver - -1 - "External driver time step" s +typedef ^ FAST_ExternInitType Logical TwrAero - .false. - "Is Tower aerodynamics enabled for ExtLoads module?" +typedef ^ FAST_ExternInitType ReKi az_blend_mean - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ FAST_ExternInitType ReKi az_blend_delta - - - "Mean azimuth at which to blend the external and aerodyn loads" - +typedef ^ FAST_ExternInitType ReKi vel_mean - - - "Mean velocity at reference height" m/s +typedef ^ FAST_ExternInitType ReKi wind_dir - - - "Wind direction in compass angle" degrees +typedef ^ FAST_ExternInitType ReKi z_ref - - - "Reference height for velocity profile" m +typedef ^ FAST_ExternInitType ReKi shear_exp - - - "Shear exponent" - # ..... FAST Turbine Data (one realization) ....................................................................................................... typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - @@ -767,6 +834,7 @@ typedef ^ FAST_TurbineType BeamDyn_Data BD - - - "Data for the BeamDyn module" - typedef ^ FAST_TurbineType ServoDyn_Data SrvD - - - "Data for the ServoDyn module" - typedef ^ FAST_TurbineType AeroDyn_Data AD - - - "Data for the AeroDyn module" - typedef ^ FAST_TurbineType AeroDyn14_Data AD14 - - - "Data for the AeroDyn14 module" - +typedef ^ FAST_TurbineType ExtLoads_Data ExtLd - - - "Data for the External loads module" - typedef ^ FAST_TurbineType InflowWind_Data IfW - - - "Data for InflowWind module" - typedef ^ FAST_TurbineType ExternalInflow_Data ExtInfw - - - "Data for ExternalInflow integration module" - typedef ^ FAST_TurbineType SCDataEx_Data SC_DX - - - "Data for SuperController integration module" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index c72e340a72..b12715f653 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -29,6 +29,7 @@ MODULE FAST_Solver USE AeroDyn USE AeroDyn14 + USE ExtLoads USE InflowWind USE ElastoDyn USE BeamDyn @@ -52,13 +53,17 @@ MODULE FAST_Solver !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for BD--using the Option 2 solve method; currently the only inputs solved in this routine !! are the blade distributed loads from AD15; other inputs are solved in option 1. -SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, y_SrvD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, m_ExtLd, y_ExtLd, u_ExtLd, p_ExtLd, y_ED, y_SrvD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-BD load transfer) + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: m_ExtLd !< External Misc Var + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_ExtLd !< External Load outputs + TYPE(ExtLd_InputType), INTENT(IN ) :: u_ExtLd !< External Load inputs (for ExtL-BD load transfer) + TYPE(ExtLd_ParameterType), INTENT(IN ) :: p_ExtLd !< External Load parameters TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< ServoDyn outputs TYPE(SrvD_InputType), INTENT(IN ) :: u_SrvD !< ServoDyn Inputs (for SrvD-BD load transfer) @@ -112,7 +117,41 @@ SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, y_SrvD, u_SrvD, MeshMapD END DO end if - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + !Get the aerodyn loads first + do K = 1,p_FAST%nBeams ! Loop through all blades + call Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), y_ExtLd%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), u_ExtLd%BladeMotion(k) ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + + !Blend the aerodyn loads with the external loads + call ExtLd_ConvertOpDataForOpenFAST(y_ExtLd, u_ExtLd, m_ExtLd, p_ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (p_FAST%BD_OutputSibling) then + + DO K = 1,p_FAST%nBeams ! Loop through all blades + + CALL Transfer_Point_to_Line2( y_ExtLd%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(k), ErrStat2, ErrMsg2, u_ExtLd%BladeMotion(k), BD%y(k)%BldMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END DO + + else + DO K = 1,p_FAST%nBeams ! Loop through all blades + + ! need to transfer the BD output blade motions to nodes on a sibling of the BD blade motion mesh: + CALL Transfer_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Transfer_Point_to_Line2( y_ExtLd%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(k), ErrStat2, ErrMsg2, u_ExtLd%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + END DO + end if + ELSE DO K = 1,p_FAST%nBeams ! Loop through all blades @@ -178,7 +217,7 @@ END SUBROUTINE BD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ED--using the Option 2 solve method. Currently the only inputs not solved in this routine !! are the fields on PlatformPtMesh, which are solved in Option 1. The fields on HubPtLoad are solved in both Option 2 and Option 1. -SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD, u_SrvD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD, y_ExtLd, m_ExtLd, u_ExtLd, p_ExtLd, u_SrvD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters @@ -188,6 +227,10 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD TYPE(AD14_OutputType), INTENT(IN ) :: y_AD14 !< AeroDyn14 outputs TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-ED load transfer) + TYPE(ExtLd_OutputType), INTENT(INOUT) :: y_ExtLd !< ExtLoads outputs + TYPE(ExtLd_MiscVarType), INTENT(INOUT) :: m_ExtLd !< ExtLoads misc var + TYPE(ExtLd_InputType), INTENT(IN ) :: u_ExtLd !< ExtLoads inputs (for ExtLoads-ED load transfer) + TYPE(ExtLd_ParameterType), INTENT(IN ) :: p_ExtLd !< ExtLoads parameters (for ExtLoads-ED load transfer) TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< ServoDyn outputs TYPE(SrvD_InputType), INTENT(IN ) :: u_SrvD !< ServoDyn inputs @@ -235,7 +278,23 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END DO - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + CALL Transfer_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), y_ExtLd%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), u_ExtLd%BladeMotion(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + + call ExtLd_ConvertOpDataForOpenFAST(y_ExtLd, u_ExtLd, m_ExtLd, p_ExtLd, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) + ! NOTE - not only is BladeLn2Mesh not a Sbiling of BladePtLoads, it is a line 2 mesh with different number of nodes + CALL Transfer_Point_to_Point( y_ExtLd%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%ExtLd_P_2_BDED_B(k), ErrStat2, ErrMsg2, u_ExtLd%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END DO + ELSE !p_FAST%CompAero = Module_None DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) @@ -275,7 +334,20 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD CALL Transfer_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + IF ( y_ExtLd%TowerLoad%Committed ) THEN ! NOTE - not only is TowerLn2Mesh not a Sbiling of TowerPtLoads, it is a line 2 mesh with different number of nodes + call Transfer_Line2_to_point( y_AD%rotors(1)%TowerLoad, y_ExtLd%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, u_ExtLd%TowerMotion ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call ExtLd_ConvertOpDataForOpenFAST(y_ExtLd, u_ExtLd, m_ExtLd, p_ExtLd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + CALL Transfer_Point_to_Point( y_ExtLd%TowerLoad, u_ED%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2, u_ExtLd%TowerMotion, y_ED%TowerLn2Mesh ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + ELSE u_ED%TowerPtLoads%Force = 0.0_ReKi u_ED%TowerPtLoads%Moment = 0.0_ReKi @@ -582,6 +654,55 @@ SUBROUTINE AD_InputSolve_IfW( p_FAST, u_AD, y_IfW, y_ExtInfw, ErrStat, ErrMsg ) END SUBROUTINE AD_InputSolve_IfW !---------------------------------------------------------------------------------------------------------------------------------- + +SUBROUTINE AD_InputSolve_IfW_ExtLoads( p_FAST, u_AD, p_ExtLd, ErrStat, ErrMsg ) + + type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameter data + type(AD_InputType), intent(inout) :: u_AD !< The inputs to AeroDyn + type(ExtLd_ParameterType), intent(in) :: p_ExtLd !< Parameters of ExtLoads + integer(IntKi) :: ErrStat !< Error status of the operation + character(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + !local variables + real(ReKi) :: z !< Local 'z' coordinate + real(ReKi) :: mean_vel !< Local mean velocity + real(ReKi) :: pi !< Our favorite number + integer(IntKi) :: j,k !< Local counter variables + integer(IntKi) :: NumBl !< Number of blades + integer(IntKi) :: Nnodes !< Number of nodes + + ErrStat = ErrID_None + ErrMsg = '' + + pi = acos(-1.0) + NumBl = size(u_AD%rotors(1)%InflowOnBlade,3) + Nnodes = size(u_AD%rotors(1)%InflowOnBlade,2) + + do k=1,NumBl + do j=1,Nnodes + !Get position first + z = u_AD%rotors(1)%BladeMotion(k)%Position(3,j) + u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) + mean_vel = p_ExtLd%vel_mean * ( (z/p_ExtLd%z_ref) ** p_ExtLd%shear_exp) + u_AD%rotors(1)%InflowOnBlade(1,j,k) = -mean_vel * sin(p_ExtLd%wind_dir * pi / 180.0) + u_AD%rotors(1)%InflowOnBlade(2,j,k) = -mean_vel * cos(p_ExtLd%wind_dir * pi / 180.0) + u_AD%rotors(1)%InflowOnBlade(3,j,k) = 0.0 + end do + end do + + if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then + Nnodes = size(u_AD%rotors(1)%InflowOnTower,2) + do j=1,Nnodes + !Get position first + z = u_AD%rotors(1)%TowerMotion%Position(3,j) + u_AD%rotors(1)%TowerMotion%TranslationDisp(3,j) + mean_vel = p_ExtLd%vel_mean * ( (z/p_ExtLd%z_ref) ** p_ExtLd%shear_exp) + u_AD%rotors(1)%InflowOnTower(1,j) = -mean_vel * sin(p_ExtLd%wind_dir * pi / 180.0) + u_AD%rotors(1)%InflowOnTower(2,j) = -mean_vel * cos(p_ExtLd%wind_dir * pi / 180.0) + u_AD%rotors(1)%InflowOnTower(3,j) = 0.0 + end do + end if + +END SUBROUTINE AD_InputSolve_IfW_ExtLoads +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets all the AeroDyn inputs, except for the wind inflow values. SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) @@ -866,10 +987,75 @@ SUBROUTINE AD14_InputSolve_NoIfW( p_FAST, u_AD14, y_ED, MeshMapData, ErrStat, Er ! u_AD14%MulTabLoc(IElements,IBlades) = ??? END SUBROUTINE AD14_InputSolve_NoIfW +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets all the ExtLoads inputs, except for the wind inflow values. +SUBROUTINE ExtLd_InputSolve_NoIfW( p_FAST, u_ExtLd, p_ExtLd, y_ED, BD, MeshMapData, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(ExtLd_InputType), INTENT(INOUT) :: u_ExtLd !< The inputs to ExtLoads + TYPE(ExtLd_ParameterType), INTENT(IN) :: p_ExtLd !< The parameters of ExtLoads + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(BeamDyn_Data), INTENT(IN) :: BD !< The data from BeamDyn (want the outputs only, but it's in an array) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: K ! Loops through blades + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_InputSolve_NoIfW' + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------------------------------------------------------------------------------- + ! Set the inputs from ElastoDyn and/or BeamDyn: + !------------------------------------------------------------------------------------------------- + + ! tower + IF (u_ExtLd%TowerMotion%Committed) THEN + CALL Transfer_Line2_to_Point( y_ED%TowerLn2Mesh, u_ExtLd%TowerMotion, MeshMapData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%TowerMotion' ) + END IF + + ! hub + CALL Transfer_Point_to_Point( y_ED%HubPtMotion, u_ExtLd%HubMotion, MeshMapData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%HubMotion' ) + + ! blade root + DO k=1,size(y_ED%BladeRootMotion) + CALL Transfer_Point_to_Point( y_ED%BladeRootMotion(k), u_ExtLd%BladeRootMotion(k), MeshMapData%ED_P_2_ExtLd_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%BladeRootMotion('//trim(num2lstr(k))//')' ) + END DO + + ! blades + IF (p_FAST%CompElast == Module_ED ) THEN + + DO k=1,size(y_ED%BladeLn2Mesh) + CALL Transfer_Line2_to_Point( y_ED%BladeLn2Mesh(k), u_ExtLd%BladeMotion(k), MeshMapData%BDED_L_2_ExtLd_P_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + ELSEIF (p_FAST%CompElast == Module_BD ) THEN ! get them from BeamDyn + + DO k=1,size(u_ExtLd%BladeMotion) + CALL Transfer_Line2_to_Point( BD%y(k)%BldMotion, u_ExtLd%BladeMotion(k), MeshMapData%BDED_L_2_ExtLd_P_B(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_ExtLd%BladeMotion('//trim(num2lstr(k))//')' ) + END DO + + END IF + + u_ExtLd%az = y_ED%LSSTipPxa + u_ExtLd%DX_u%bldPitch(:) = y_ED%BlPitch + + call ExtLd_ConvertInpDataForExtProg(u_ExtLd, p_ExtLd, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + +END SUBROUTINE ExtLd_InputSolve_NoIfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ServoDyn -SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_ExtInfw, y_BD, y_SD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_ExtInfw, p_ExtLd, y_BD, y_SD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters @@ -878,6 +1064,7 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_ExtInfw, y_BD TYPE(ED_OutputType),TARGET, INTENT(IN) :: y_ED !< ElastoDyn outputs TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< InflowWind outputs TYPE(ExtInfw_OutputType), INTENT(IN) :: y_ExtInfw !< ExternalInflow outputs + TYPE(ExtLd_ParameterType), INTENT(in) :: p_ExtLd !< Parameters of ExtLoads TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BD Outputs TYPE(SD_OutputType),TARGET, INTENT(IN) :: y_SD !< SD Outputs TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -888,6 +1075,11 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_ExtInfw, y_BD INTEGER(IntKi) :: k ! blade loop counter INTEGER(IntKi) :: j ! StC instance counter TYPE(MeshType), POINTER :: SubStructureMotion + real(ReKi) :: z !< Local 'z' coordinate + real(ReKi) :: u !< Local u velocity + real(ReKi) :: v !< Local v velocity + real(ReKi) :: mean_vel !< Local mean velocity + real(ReKi) :: pi !< Our favorite number INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -923,6 +1115,20 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_ExtInfw, y_BD if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + pi = acos(-1.0) + z = y_ED%HubPtMotion%Position(3,1) + mean_vel = p_ExtLd%vel_mean * ( (z/p_ExtLd%z_ref) ** p_ExtLd%shear_exp) + u = -mean_vel * sin(p_ExtLd%wind_dir * pi / 180.0) + v = -mean_vel * cos(p_ExtLd%wind_dir * pi / 180.0) + u_SrvD%HorWindV = mean_vel + u_SrvD%WindDir = atan2( v, u) + if (allocated(u_SrvD%LidSpeed )) u_SrvD%LidSpeed = 0.0 + if (allocated(u_SrvD%MsrPositionsX)) u_SrvD%MsrPositionsX = 0.0 + if (allocated(u_SrvD%MsrPositionsY)) u_SrvD%MsrPositionsY = 0.0 + if (allocated(u_SrvD%MsrPositionsz)) u_SrvD%MsrPositionsz = 0.0 + ELSE ! No wind inflow u_SrvD%WindDir = 0.0 @@ -3851,7 +4057,7 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u END SUBROUTINE Perturb_u_FullOpt1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine resets the remap flags on all of the meshes -SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) +SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................... TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -3861,6 +4067,7 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data @@ -3928,7 +4135,8 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp AD14%Input(1)%Twr_InputMarkers%RemapFlag = .FALSE. AD14%y%Twr_OutputLoads%RemapFlag = .FALSE. END IF - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + + ELSEIF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd ) ) THEN IF (AD%Input(1)%rotors(1)%HubMotion%Committed) THEN AD%Input(1)%rotors(1)%HubMotion%RemapFlag = .FALSE. @@ -3960,7 +4168,26 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp END DO END IF - + + IF (p_FAST%CompAero == Module_ExtLd ) THEN + + ExtLd%u%HubMotion%RemapFlag = .FALSE. + + IF ( ExtLd%u%TowerMotion%Committed ) THEN + ExtLd%u%TowerMotion%RemapFlag = .FALSE. + + IF ( ExtLd%y%TowerLoad%Committed ) THEN + ExtLd%y%TowerLoad%RemapFlag = .FALSE. + END IF + END IF + + DO k=1,SIZE( ExtLd%u%BladeMotion ) + ExtLd%u%BladeRootMotion(k)%RemapFlag = .FALSE. + ExtLd%u%BladeMotion( k)%RemapFlag = .FALSE. + ExtLd%y%BladeLoad( k)%RemapFlag = .FALSE. + END DO + + END IF ! ServoDyn -- StrucCtrl meshes IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -4070,16 +4297,16 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp END SUBROUTINE ResetRemapFlags !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes all of the mapping data structures needed between the various modules. -SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(ElastoDyn_Data),TARGET,INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), TARGET, INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data @@ -4345,7 +4572,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M IF (ErrStat >= AbortErrLev ) RETURN - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN ! ED-AD and/or BD-AD + ELSEIF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN ! ED-AD and/or BD-AD ! allocate per-blade space for mapping to structural module @@ -4485,7 +4712,119 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF ! AeroDyn/AeroDyn14 to structural code - + IF ( p_FAST%CompAero == Module_ExtLd ) THEN ! ED-ExtLd and/or BD-ExtLd + + NumBl = SIZE(ExtLd%u%BladeRootMotion) ! Get number of blades + + ! Allocate memory for mapping between ED and ExtLoad blade root meshes + ALLOCATE( MeshMapData%ED_P_2_ExtLd_P_R(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%ED_P_2_ExtLd_P_R.', ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Create the the mesh mapping for mapping between ED and ExtLoad blade root meshes + DO K=1,NumBl + CALL MeshMapCreate( ED%y%BladeRootMotion(K), ExtLd%u%BladeRootMotion(K), MeshMapData%ED_P_2_ExtLd_P_R(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_ExtLd_P_R('//TRIM(Num2LStr(K))//')' ) + END DO + + ! Hub point mesh + CALL MeshMapCreate( ED%y%HubPtMotion, ExtLd%u%HubMotion, MeshMapData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_ExtLd_P_H' ) + + ! Blade meshes: (allocate two mapping data structures to number of blades, then allocate data inside the structures) + ALLOCATE( MeshMapData%BDED_L_2_ExtLd_P_B(NumBl), MeshMapData%ExtLd_P_2_BDED_B(NumBl), MeshMapData%AD_L_2_ExtLd_B(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BDED_L_2_ExtLd_P_B and MeshMapData%ExtLd_P_2_BDED_B.', & + ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + + ! Create mapping for AD line mesh to ExtLoads point mesh + do k=1,NumBl + call MeshMapCreate( AD%y%rotors(1)%BladeLoad(k), ExtLd%y%BladeLoadAD(k), MeshMapData%AD_L_2_ExtLd_B(k), ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_L_2_ExtLd_B('//TRIM(Num2LStr(K))//')' ) + end do + + IF ( p_FAST%CompElast == Module_ED ) then + + DO K=1,NumBl + ! Create mapping for ElastoDyn BldMotion line2 meshes to ExtLoads point mesh + CALL MeshMapCreate( ED%y%BladeLn2Mesh(K), ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BDED_L_2_ExtLd_P_B('//TRIM(Num2LStr(K))//')' ) + ! Create mapping for ExtLoads point mesh to ElastoDyn BldMotion line2 mesh + CALL MeshMapCreate( ExtLd%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ExtLd_P_2_BDED_B('//TRIM(Num2LStr(K))//')' ) + END DO + + ELSEIF ( p_FAST%CompElast == Module_BD ) then + + ! connect ExtLoads mesh with BeamDyn + DO K=1,NumBl + ! Create mapping for BeamDyn BldMotion line2 meshes to ExtLoads point mesh + CALL MeshMapCreate( BD%y(k)%BldMotion, ExtLd%u%BladeMotion(K), MeshMapData%BDED_L_2_ExtLd_P_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BDED_L_2_ExtLd_P_B('//TRIM(Num2LStr(K))//')' ) + ! Create mapping for ExtLoads point mesh to BeamDyn BldMotion line2 mesh + CALL MeshMapCreate( ExtLd%y%BladeLoad(K), BD%Input(1,k)%DistrLoad, MeshMapData%ExtLd_P_2_BDED_B(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ExtLd_P_2_BDED_B('//TRIM(Num2LStr(K))//')' ) + END DO + + IF (.not. p_FAST%BD_OutputSibling) then + + ! Blade meshes for load transfer: (allocate meshes at BD input locations for motions transferred from BD output locations) + ALLOCATE( MeshMapData%BD_L_2_BD_L(NumBl), MeshMapData%y_BD_BldMotion_4Loads(NumBl), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error allocating MeshMapData%BD_L_2_BD_L and MeshMapData%y_BD_BldMotion_4Loads.', & + ErrStat, ErrMsg, RoutineName ) + RETURN + END IF ! ( ErrStat2 /= 0 ) + + DO K=1,NumBl + ! create the new mesh: + CALL MeshCopy ( SrcMesh = BD%Input(1,k)%DistrLoad & + , DestMesh = MeshMapData%y_BD_BldMotion_4Loads(k) & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , TranslationDisp = .TRUE. & + , Orientation = .TRUE. & + , RotationVel = .TRUE. & + , TranslationVel = .TRUE. & + , RotationAcc = .TRUE. & + , TranslationAcc = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + ! create the mapping: + CALL MeshMapCreate( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(K), ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BD_L_2_BD_L('//TRIM(Num2LStr(K))//')' ) + END DO + + END IF !.not. p_FAST%BD_OutputSibling + + ENDIF ! ( p_FAST%CompElast == Module_BD ) + + ! Tower mesh: + IF ( ExtLd%u%TowerMotion%Committed ) THEN + CALL MeshMapCreate( ED%y%TowerLn2Mesh, ExtLd%u%TowerMotion, MeshMapData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_L_2_ExtLd_P_T' ) + + IF ( ExtLd%y%TowerLoad%Committed ) THEN + CALL MeshMapCreate( ExtLd%y%TowerLoad, ED%Input(1)%TowerPtLoads, MeshMapData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ExtLd_P_2_ED_P_T' ) + + IF ( ( AD%Input(1)%rotors(1)%TowerMotion%Committed ) .and. ( AD%y%rotors(1)%TowerLoad%Committed ) ) THEN + !Aerodyn to External loads + CALL MeshMapCreate( AD%y%rotors(1)%TowerLoad, ExtLd%y%TowerLoadAD, MeshMapData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_L_2_ExLd_T' ) + END IF + + END IF ! ( ExtLd%y%TowerLoad%Committed ) + END IF ! ( ExtLd%u%TowerMotion%Committed ) + + END IF ! ( p_FAST%CompAero == Module_ExtLd ) IF ( p_FAST%CompHydro == Module_HD ) THEN ! HydroDyn-{ElastoDyn or SubDyn} @@ -4659,7 +4998,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! reset the remap flags (do this before making the copies else the copies will always have remap = true) !............................................................................................................................ - CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) + CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................ ! initialize the temporary input meshes (for input-output solves in Solve Option 1): @@ -4768,7 +5107,7 @@ END SUBROUTINE InitModuleMappings !! *** Note that modules that do not have direct feedthrough should be called first. *** SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, & p_FAST, m_FAST, WriteThisStep, ED, BD, & - SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) INTEGER(IntKi) , intent(in ) :: n_t_global !< current time step (used only for SrvD hack) @@ -4784,6 +5123,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data @@ -4845,7 +5185,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !> Solve option 2 (modules without direct feedthrough): - CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) + CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) #ifdef OUTPUT_MASS_MATRIX @@ -4900,6 +5240,20 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca CALL AD_InputSolve_IfW( p_FAST, AD%Input(1), IfW%y, ExtInfw%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_InputSolve_IfW_ExtLoads( p_FAST, AD%Input(1), ExtLd%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtLd_InputSolve_NoIfW( p_FAST, ExtLd%u, ExtLd%p, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF ( p_FAST%CompInflow == MODULE_IfW .OR. p_FAST%CompInflow == MODULE_ExtInfw ) THEN + CALL SetErrStat(ErrID_Fatal,'p_FAST%CompInflow option not setup to work with ExtLoads module.',ErrStat,ErrMsg,RoutineName) + ENDIF END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN @@ -4915,7 +5269,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, ExtInfw%y, BD%y, SD%y, MeshmapData, ErrStat2, ErrMsg2 ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, ExtInfw%y, ExtLd%p, BD%y, SD%y, MeshmapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4929,7 +5283,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... - CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) END SUBROUTINE CalcOutputs_And_SolveForInputs @@ -5228,7 +5582,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, 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 + ELSE IF ( ( p_FAST%CompAero == Module_AD ) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN ! note that this uses BD outputs, which are from the previous step (and need to be initialized) CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) @@ -5252,7 +5606,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, END SUBROUTINE SolveOption2b_Inp2IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn and ServoDyn. -SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, WriteThisStep) +SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -5265,6 +5619,7 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLD !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5316,13 +5671,18 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, CALL AD_InputSolve_IfW( p_FAST, AD%Input(1), IfW%y, ExtInfw%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + CALL AD_InputSolve_IfW_ExtLoads( p_FAST, AD%Input(1), ExtLd%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, ExtInfw%y, BD%y, SD%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, ExtInfw%y, ExtLd%p, BD%y, SD%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -5331,7 +5691,7 @@ END SUBROUTINE SolveOption2c_Inp2AD_SrvD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 2" solve for all inputs without direct links to HD, SD, MAP, or the ED platform reference !! point. -SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) +SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) !............................................................................................................................... LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) @@ -5346,6 +5706,7 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLD !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data @@ -5379,7 +5740,7 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! call IfW's CalcOutput; transfer wind-inflow inputs to AD; compute all of SrvD inputs: - CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! ELSE ! these subroutines are called in the AdvanceStates routine before BD, IfW, AD, and SrvD states are updated. This gives a more accurate solution that would otherwise require a correction step. END IF @@ -5392,9 +5753,30 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ELSE IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_InputSolve_IfW( p_FAST, AD%Input(1), IfW%y, ExtInfw%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + IF ( p_FAST%CompInflow == MODULE_IfW .OR. p_FAST%CompInflow == MODULE_ExtInfw ) THEN + CALL SetErrStat(ErrID_Fatal,'p_FAST%CompInflow option not setup to work with ExtLoads module.',ErrStat,ErrMsg,RoutineName) + ENDIF + + CALL AD_InputSolve_IfW_ExtLoads( p_FAST, AD%Input(1), ExtLd%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & + AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtLd_CalcOutput( this_time, ExtLd%u, ExtLd%p, ExtLd%x(this_state), ExtLd%xd(this_state), ExtLd%z(this_state), & + ExtLd%OtherSt(this_state), ExtLd%y, ExtLd%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF @@ -5420,16 +5802,16 @@ 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%y, 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), ExtLd%y, ExtLd%m, ExtLd%u, ExtLd%p, SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ED%y, SrvD%y, SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ExtLd%m, ExtLd%y, ExtLd%u, ExtLd%p, ED%y, SrvD%y, SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module -SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & +SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) @@ -5442,6 +5824,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data @@ -5565,7 +5948,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated inflow outputs here - CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, ExtLd, SD, SrvD, IfW, ExtInfw, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! AeroDyn: get predicted states @@ -5587,7 +5970,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr AD14%xd(STATE_PRED), AD14%z(STATE_PRED), AD14%OtherSt(STATE_PRED), AD14%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO !j_ss - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5607,6 +5990,9 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr END DO !j_ss END IF + IF (p_FAST%CompAero == Module_ExtLd ) THEN + ! DO WE HAVE TO DO SOMETHING HERE? + END IF ! ServoDyn: get predicted states IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -5823,7 +6209,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr END SUBROUTINE FAST_AdvanceStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine extrapolates inputs to modules to give predicted values at t+dt. -SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) @@ -5835,6 +6221,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data @@ -5926,7 +6313,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) AD14%InputTimes(1) = t_global_next - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( (p_FAST%CompAero == Module_AD ) .or. (p_FAST%CompAero == Module_ExtLd ) ) THEN CALL AD_Input_ExtrapInterp(AD%Input, AD%InputTimes, AD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) @@ -5945,7 +6332,10 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A END IF ! CompAero - + IF (p_FAST%CompAero == Module_ExtLd ) THEN + ! Don't need to do anything here. ExtLoads does not have inputs at different times + END IF + ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 945a5926de..f2a0dc864d 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -49,18 +49,18 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In IF (PRESENT(InFile)) THEN IF (PRESENT(ExternInitData)) THEN CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile ) END IF ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END IF @@ -69,7 +69,7 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In END SUBROUTINE FAST_InitializeAll_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to call Init routine for each module. This routine sets all of the init input data for each module. -SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 @@ -84,6 +84,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< SuperController exchange data @@ -205,7 +206,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ExternInitData%FarmIntegration) then ! we're integrating with FAST.Farm CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) else - CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%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, DTdriver=ExternInitData%DTdriver ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) end if else @@ -236,6 +237,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( ED%Input_bak( p_FAST%InterpOrder+1 ), ED%InputTimes_bak( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_bak, ED%Output_bak, and ED%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + Init%InData_ED%Linearize = p_FAST%Linearize Init%InData_ED%CompAeroMaps = .FALSE. Init%InData_ED%RotSpeed = 0.0 ! will set this in a future commit that includes the OpenFAST AeroMap/Steady-State solver @@ -314,10 +322,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( BD%x( p_FAST%nBeams,2), & - BD%xd( p_FAST%nBeams,2), & - BD%z( p_FAST%nBeams,2), & - BD%OtherSt( p_FAST%nBeams,2), & + ALLOCATE( BD%Input_bak( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes_bak( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input_bak and BD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( BD%x( p_FAST%nBeams,4), & + BD%xd( p_FAST%nBeams,4), & + BD%z( p_FAST%nBeams,4), & + BD%OtherSt( p_FAST%nBeams,4), & BD%p( p_FAST%nBeams ), & BD%u( p_FAST%nBeams ), & BD%y( p_FAST%nBeams ), & @@ -421,6 +436,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( AD14%Input_bak( p_FAST%InterpOrder+1 ), AD14%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input_bak and AD14%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) @@ -428,6 +450,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( AD%Input_bak( p_FAST%InterpOrder+1 ), AD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF IF ( p_FAST%CompAero == Module_AD14 ) THEN @@ -449,7 +477,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN allocate(Init%InData_AD%rotors(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then @@ -535,6 +563,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AirDens = 0.0_ReKi END IF ! CompAero + IF ( p_FAST%CompAero == Module_ExtLd ) THEN + + IF ( PRESENT(ExternInitData) ) THEN + + ! set initialization data for ExtLoads + CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) + CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. + CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + AirDens = Init%OutData_ExtLd%AirDens + + END IF + + END IF ! ........................ ! initialize InflowWind @@ -546,6 +597,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( IfW%Input_bak( p_FAST%InterpOrder+1 ), IfW%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_bak and IfW%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompInflow == Module_IfW ) THEN Init%InData_IfW%Linearize = p_FAST%Linearize @@ -760,6 +818,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( SeaSt%Input_bak( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_bak and SeaSt%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + if ( p_FAST%CompSeaSt == Module_SeaSt ) then Init%InData_SeaSt%Gravity = p_FAST%Gravity @@ -849,6 +914,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( HD%Input_bak( p_FAST%InterpOrder+1 ), HD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input_bak and HD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompHydro == Module_HD ) THEN Init%InData_HD%Gravity = p_FAST%Gravity @@ -903,6 +975,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( SD%Input_bak( p_FAST%InterpOrder+1 ), SD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input_bak and SD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ALLOCATE( ExtPtfm%Input( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input and ExtPtfm%InputTimes.",ErrStat,ErrMsg,RoutineName) @@ -910,6 +989,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( ExtPtfm%Input_bak( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input_bak and ExtPtfm%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompSub == Module_SD ) THEN IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -1001,24 +1087,48 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF + ALLOCATE( MAPp%Input_bak( p_FAST%InterpOrder+1 ), MAPp%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input_bak and MAPp%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ALLOCATE( MD%Input( p_FAST%InterpOrder+1 ), MD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + ALLOCATE( MD%Input_bak( p_FAST%InterpOrder+1 ), MD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input_bak and MD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ALLOCATE( FEAM%Input( p_FAST%InterpOrder+1 ), FEAM%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input and FEAM%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + ALLOCATE( FEAM%Input_bak( p_FAST%InterpOrder+1 ), FEAM%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input_bak and FEAM%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ALLOCATE( Orca%Input( p_FAST%InterpOrder+1 ), Orca%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input and Orca%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF + ALLOCATE( Orca%Input_bak( p_FAST%InterpOrder+1 ), Orca%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input_bak and Orca%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF ! ........................ ! initialize MAP @@ -1176,6 +1286,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( IceF%Input_bak( p_FAST%InterpOrder+1 ), IceF%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input_bak and IceF%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + ! We need this to be allocated (else we have issues passing nonallocated arrays and using the first index of Input(), ! but we don't need the space of IceD_MaxLegs if we're not using it. IF ( p_FAST%CompIce /= Module_IceD ) THEN @@ -1193,10 +1310,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( IceD%x( IceDim,2), & - IceD%xd( IceDim,2), & - IceD%z( IceDim,2), & - IceD%OtherSt( IceDim,2), & + ALLOCATE( IceD%Input_bak( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes_bak( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input_bak and IceD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( IceD%x( IceDim,4), & + IceD%xd( IceDim,4), & + IceD%z( IceDim,4), & + IceD%OtherSt( IceDim,4), & IceD%p( IceDim ), & IceD%u( IceDim ), & IceD%y( IceDim ), & @@ -1295,6 +1419,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + ALLOCATE( SrvD%Input_bak( p_FAST%InterpOrder+1 ), SrvD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_bak and SrvD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + IF ( p_FAST%CompServo == Module_SrvD ) THEN Init%InData_SrvD%InputFile = p_FAST%ServoFile Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) @@ -1459,7 +1590,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize mesh-mapping data ! ------------------------------------------------------------------------- - CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, ExtLd, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -1716,7 +1847,7 @@ END SUBROUTINE GetInputFileName !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine checks for command-line arguments, gets the root name of the input files !! (including full path name), and creates the names of the output files. -SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) +SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName, DTdriver ) IMPLICIT NONE @@ -1733,6 +1864,8 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, INTEGER(IntKi), INTENT(IN), OPTIONAL :: TurbID !< an ID for naming the tubine output file LOGICAL, INTENT(IN), OPTIONAL :: OverrideAbortLev !< whether or not we should override the abort error level (e.g., FAST.Farm) CHARACTER(*), INTENT(IN), OPTIONAL :: RootName !< A CHARACTER string containing the root name of FAST output files, overriding normal naming convention + REAL(DbKi), INTENT(IN), OPTIONAL :: DTdriver !< Driver program time step + ! Local variables INTEGER :: i ! loop counter @@ -1793,6 +1926,7 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Ver( Module_BD )%Name = 'BeamDyn' y_FAST%Module_Ver( Module_AD14 )%Name = 'AeroDyn14' y_FAST%Module_Ver( Module_AD )%Name = 'AeroDyn' + y_FAST%Module_Ver( Module_ExtLd )%Name = 'ExtLoads' y_FAST%Module_Ver( Module_SrvD )%Name = 'ServoDyn' y_FAST%Module_Ver( Module_SeaSt )%Name = 'SeaState' y_FAST%Module_Ver( Module_HD )%Name = 'HydroDyn' @@ -1812,6 +1946,7 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Abrev( Module_BD ) = 'BD' y_FAST%Module_Abrev( Module_AD14 ) = 'AD' y_FAST%Module_Abrev( Module_AD ) = 'AD' + y_FAST%Module_Abrev( Module_ExtLd ) = 'ExtLd' y_FAST%Module_Abrev( Module_SrvD ) = 'SrvD' y_FAST%Module_Abrev( Module_SeaSt ) = 'SEA' y_FAST%Module_Abrev( Module_HD ) = 'HD' @@ -1845,6 +1980,15 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, !p%TMax = MAX( TMax, p%TMax ) END IF + IF (PRESENT(DTdriver)) THEN + IF ( ABS( NINT(DTdriver/p%DT) * p%DT - DTdriver ) .lt. 0.001 ) THEN + p%DT_Out = NINT(DTdriver/p%DT) * p%DT + p%n_DT_Out = NINT(DTdriver/p%DT) + ELSE + CALL SetErrStat( ErrID_Fatal, 'DTdriver specified '//TRIM ( Num2LStr( DTdriver ) )//' is not an integral multiple of FAST time step '//TRIM ( Num2LStr( p%DT ) ), ErrStat, ErrMsg, RoutineName ) + END IF + END IF + IF ( ErrStat >= AbortErrLev ) RETURN @@ -1937,7 +2081,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF ( p%KMax < 1_IntKi ) CALL SetErrStat( ErrID_Fatal, 'KMax must be greater than 0.', ErrStat, ErrMsg, RoutineName ) IF (p%CompElast == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompElast must be 1 (ElastoDyn) or 2 (BeamDyn).', ErrStat, ErrMsg, RoutineName ) - IF (p%CompAero == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompAero must be 0 (None), 1 (AeroDyn14), or 2 (AeroDyn).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompAero == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompAero must be 0 (None), 1 (AeroDyn14), 2 (AeroDyn), or 3 (ExtLoads).', ErrStat, ErrMsg, RoutineName ) IF (p%CompServo == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompServo must be 0 (None) or 1 (ServoDyn).', ErrStat, ErrMsg, RoutineName ) IF (p%CompSeaSt == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSeaSt must be 0 (None) or 1 (SeaState).', ErrStat, ErrMsg, RoutineName ) IF (p%CompHydro == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompHydro must be 0 (None) or 1 (HydroDyn).', ErrStat, ErrMsg, RoutineName ) @@ -1976,6 +2120,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompElast == Module_BD .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) if (p%CompInflow == MODULE_ExtInfw .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when ExternalInflow is used. Change CompAero or CompInflow in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + if ((p%CompAero == Module_ExtLd) .and. (p%CompInflow /= Module_NONE) ) call SetErrStat(ErrID_Fatal, 'Inflow module cannot be used when ExtLoads is used. Change CompAero or CompInflow in the OpenFAST input file.', ErrStat, ErrMsg, RoutineName) IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) @@ -2129,7 +2274,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF ( p_FAST%CompAero == Module_AD14 ) THEN y_FAST%Module_Ver( Module_AD14 ) = Init%OutData_AD14%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD14 ) )) - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN y_FAST%Module_Ver( Module_AD ) = Init%OutData_AD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD ) )) END IF @@ -2227,12 +2372,6 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) indxNext = y_FAST%numOuts(Module_Glue) + 1 - - DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind - y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) - y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) - indxNext = indxNext + 1 - END DO DO i=1,y_FAST%numOuts(Module_ExtInfw) !ExternalInflow y_FAST%ChannelNames(indxNext) = Init%OutData_ExtInfw%WriteOutputHdr(i) @@ -2240,6 +2379,12 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) indxNext = indxNext + 1 END DO + 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 + 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) @@ -2700,7 +2845,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS END IF ! CompAero - Compute aerodynamic loads (switch) {0=None; 1=AeroDyn}: - CALL ReadVar( UnIn, InputFile, p%CompAero, "CompAero", "Compute aerodynamic loads (switch) {0=None; 1=AeroDyn14; 2=AeroDyn}", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, p%CompAero, "CompAero", "Compute aerodynamic loads (switch) {0=None; 1=AeroDyn14; 2=AeroDyn; 3=ExtLoads}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2714,6 +2859,8 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS p%CompAero = Module_AD14 ELSEIF ( p%CompAero == 2 ) THEN p%CompAero = Module_AD + ELSEIF ( p%CompAero == 3 ) THEN + p%CompAero = Module_ExtLd ELSE p%CompAero = Module_Unknown END IF @@ -3865,6 +4012,284 @@ SUBROUTINE WrVTK_Ground ( RefPoint, HalfLengths, FileRootName, ErrStat, ErrMsg ) END SUBROUTINE WrVTK_Ground !---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets up the information needed to initialize ExtLoads +SUBROUTINE ExtLd_SetInitInput(InitInData_ExtLd, InitOutData_ED, y_ED, InitOutData_BD, y_BD, InitOutData_AD, p_FAST, ExternInitData, ErrStat, ErrMsg) + ! Passed variables: + TYPE(ExtLd_InitInputType), INTENT(INOUT) :: InitInData_ExtLd !< The initialization input to ExtLoads + TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< The initialization output from structural dynamics module + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (meshes with position/RefOrientation set) + TYPE(BD_InitOutputType), INTENT(IN) :: InitOutData_BD(:) !< The initialization output from structural dynamics module + TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< The outputs of the structural dynamics module (meshes with position/RefOrientation set) + TYPE(AD_InitOutputType), INTENT(IN) :: InitOutData_AD !< The initialization output from AeroDyn + TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< The parameters of the glue code + TYPE(FAST_ExternInitType), INTENT(IN) :: ExternInitData !< Initialization input data from an external source + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables + INTEGER :: i,j,k,jLower,tmp + integer :: nNodesBladeProps, nNodesTowerProps + real(ReKi) :: rInterp + INTEGER :: nTotBldNds + INTEGER :: nMaxBldNds + REAL(ReKi) :: tmp_eta + + REAL(ReKi), ALLOCATABLE :: AD_etaNodes(:) ! Non-dimensional co-ordinates eta at which the blade and tower chord are defined + + ErrStat = ErrID_None + ErrMsg = "" + + InitInData_ExtLd%NumBlades = InitOutData_ED%NumBl + IF (.NOT. ALLOCATED( InitInData_ExtLd%NumBldNodes) ) THEN + ALLOCATE( InitInData_ExtLd%NumBldNodes(InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%NumBldNodes.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + ! Blade node positions and orientations + nTotBldNds = 0 + nMaxBldNds = 0 + IF (p_FAST%CompElast == Module_ED ) THEN + nMaxBldNds = SIZE(y_ED%BladeLn2Mesh(1)%position(1,:)) + nTotBldNds = nMaxBldNds * InitInData_ExtLd%NumBlades + InitInData_ExtLd%NumBldNodes(:) = nMaxBldNds + ELSE IF (p_FAST%CompElast == Module_BD ) THEN + do k=1,InitInData_ExtLd%NumBlades + tmp = SIZE(y_BD(k)%BldMotion%position(1,:)) + nMaxBldNds = max(nMaxBldNds, tmp) + nTotBldNds = nTotBldNds + tmp + InitInData_ExtLd%NumBldNodes(k) = tmp + end do + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldRootPos) ) THEN + ALLOCATE( InitInData_ExtLd%BldRootPos( 3, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRootPos.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldRootOrient) ) THEN + ALLOCATE( InitInData_ExtLd%BldRootOrient( 3, 3, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRootOrient.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldPos) ) THEN + ALLOCATE( InitInData_ExtLd%BldPos( 3, nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldPos.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldOrient) ) THEN + ALLOCATE( InitInData_ExtLd%BldOrient( 3, 3, nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldOrient.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + IF (p_FAST%CompElast == Module_ED ) THEN + DO k=1,InitInData_ExtLd%NumBlades + InitInData_ExtLd%BldRootPos(:,k) = y_ED%BladeRootMotion(k)%position(:,1) + InitInData_ExtLd%BldRootOrient(:,:,k) = y_ED%BladeRootMotion(k)%RefOrientation(:,:,1) + !Deal with the weird node ordering in ElastoDyn where the blade root is the last node + InitInData_ExtLd%BldPos(:,1,k) = y_ED%BladeLn2Mesh(k)%position(:,nMaxBldNds) + InitInData_ExtLd%BldOrient(:,:,1,k) = y_ED%BladeLn2Mesh(k)%RefOrientation(:,:,nMaxBldNds) + !Now fill in the rest of the nodes + InitInData_ExtLd%BldPos(:,2:nMaxBldNds,k) = y_ED%BladeLn2Mesh(k)%position(:,1:nMaxBldNds-1) + InitInData_ExtLd%BldOrient(:,:,2:nMaxBldNds,k) = y_ED%BladeLn2Mesh(k)%RefOrientation(:,:,1:nMaxBldNds-1) + END DO + ELSE IF (p_FAST%CompElast == Module_BD ) THEN + DO k=1,InitInData_ExtLd%NumBlades + InitInData_ExtLd%BldRootPos(:,k) = y_ED%BladeRootMotion(k)%position(:,1) + InitInData_ExtLd%BldRootOrient(:,:,k) = y_ED%BladeRootMotion(k)%RefOrientation(:,:,1) + InitInData_ExtLd%BldPos(:,:,k) = y_BD(k)%BldMotion%position(:,:) + InitInData_ExtLd%BldOrient(:,:,:,k) = y_BD(k)%BldMotion%RefOrientation(:,:,:) + END DO + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldRloc) ) THEN + ALLOCATE( InitInData_ExtLd%BldRloc( nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRloc.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + do k=1,InitInData_ExtLd%NumBlades + InitInData_ExtLd%BldRloc(1,k) = 0.0 + do j = 2, InitInData_ExtLd%NumBldNodes(k) + InitInData_ExtLd%BldRloc(j,k) = InitInData_ExtLd%BldRloc(j-1,k) + norm2(InitInData_ExtLd%BldPos(:,j,k) - InitInData_ExtLd%BldPos(:,j-1,k)) + end do + end do + + ! Tower mesh + InitInData_ExtLd%TwrAero = .true. + if (InitInData_ExtLd%TwrAero) then + InitInData_ExtLd%NumTwrNds = y_ED%TowerLn2Mesh%NNodes + IF ( InitInData_ExtLd%NumTwrNds > 0 ) THEN + + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrPos ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrPos( 3, InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrNodeLocs.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrOrient ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrOrient( 3, 3, InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrOrient.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + ! For some reason, ElastoDyn keeps the last point as the blade/tower root + InitInData_ExtLd%TwrPos(:,1) = y_ED%TowerLn2Mesh%Position(:,InitInData_ExtLd%NumTwrNds) + InitInData_ExtLd%TwrOrient(:,:,1) = y_ED%TowerLn2Mesh%RefOrientation(:,:,InitInData_ExtLd%NumTwrNds) + ! Now fill in rest of the nodes + InitInData_ExtLd%TwrPos(:,2:InitInData_ExtLd%NumTwrNds) = y_ED%TowerLn2Mesh%Position(:,1:InitInData_ExtLd%NumTwrNds-1) + InitInData_ExtLd%TwrOrient(:,:,2:InitInData_ExtLd%NumTwrNds) = y_ED%TowerLn2Mesh%RefOrientation(:,:,1:InitInData_ExtLd%NumTwrNds-1) + + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrDia ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrDia( InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrDia.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + IF (.NOT. ALLOCATED( InitInData_ExtLd%TwrHloc ) ) THEN + ALLOCATE( InitInData_ExtLd%TwrHloc( InitInData_ExtLd%NumTwrNds ), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_AD%TwrHloc.' + RETURN + ELSE + ErrStat = ErrID_None + END IF + END IF + + InitInData_ExtLd%TwrHloc(1) = 0.0 + do j = 2, InitInData_ExtLd%NumTwrNds + InitInData_ExtLd%TwrHloc(j) = InitInData_ExtLd%TwrHloc(j-1) + norm2(InitInData_ExtLd%TwrPos(:,j) - InitInData_ExtLd%TwrPos(:,j-1)) + end do + END IF + + else + + InitInData_ExtLd%NumTwrNds = 0 + + end if + + InitInData_ExtLd%HubPos = y_ED%HubPtMotion%Position(:,1) + InitInData_ExtLd%HubOrient = y_ED%HubPtMotion%RefOrientation(:,:,1) + + InitInData_ExtLd%NacellePos = y_ED%NacelleMotion%Position(:,1) + InitInData_ExtLd%NacelleOrient = y_ED%NacelleMotion%RefOrientation(:,:,1) + + InitInData_ExtLd%az_blend_mean = ExternInitData%az_blend_mean + InitInData_ExtLd%az_blend_delta = ExternInitData%az_blend_delta + InitInData_ExtLd%vel_mean = ExternInitData%vel_mean + InitInData_ExtLd%wind_dir = ExternInitData%wind_dir + InitInData_ExtLd%z_ref = ExternInitData%z_ref + InitInData_ExtLd%shear_exp = ExternInitData%shear_exp + + !Interpolate chord from AeroDyn to nodes of the ExtLoads module + IF (.NOT. ALLOCATED( InitInData_ExtLd%BldChord) ) THEN + ALLOCATE( InitInData_ExtLd%BldChord(nMaxBldNds, InitInData_ExtLd%NumBlades), STAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error allocating space for InitInData_ExtLd%BldRootPos.' + RETURN + ELSE + ErrStat = ErrID_None !reset to ErrID_None, just in case ErrID_None /= 0 + END IF + END IF + + ! The blades first + do k = 1, InitInData_ExtLd%NumBlades + ! Calculate the chord at the force nodes based on interpolation + nNodesBladeProps = SIZE(InitOutData_AD%rotors(1)%BladeProps(k)%BlChord) + allocate(AD_etaNodes(nNodesBladeProps)) + AD_etaNodes = InitOutData_AD%rotors(1)%BladeProps(k)%BlSpn(:)/InitOutData_AD%rotors(1)%BladeProps(k)%BlSpn(nNodesBladeProps) + do i=1,InitInData_ExtLd%NumBldNodes(k) + jLower=1 + tmp_eta = InitInData_ExtLd%BldRloc(i,k)/InitInData_ExtLd%BldRloc(InitInData_ExtLd%NumBldNodes(k),k) + do while ( ( (AD_etaNodes(jLower) - tmp_eta)*(AD_etaNodes(jLower+1) - tmp_eta) .gt. 0 ) .and. (jLower .lt. nNodesBladeProps) )!Determine the closest two nodes at which the blade properties are specified + jLower = jLower + 1 + end do + if (jLower .lt. nNodesBladeProps) then + rInterp = (tmp_eta - AD_etaNodes(jLower))/(AD_etaNodes(jLower+1)-AD_etaNodes(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + InitInData_ExtLd%BldChord(i,k) = InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(jLower) + rInterp * (InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(jLower+1) - InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(jLower)) + else + InitInData_ExtLd%BldChord(i,k) = InitOutData_AD%rotors(1)%BladeProps(k)%BlChord(nNodesBladeProps) !Work around for when the last node of the actuator mesh is slightly outside of the Aerodyn blade properties. Surprisingly this is not an issue with the tower. + end if + end do + deallocate(AD_etaNodes) + end do + + ! The tower now + if ( InitInData_ExtLd%NumTwrNds > 0 ) then + nNodesTowerProps = SIZE(InitOutData_AD%rotors(1)%TwrElev) + allocate(AD_etaNodes(nNodesTowerProps)) + ! Calculate the chord at the force nodes based on interpolation + AD_etaNodes = InitOutData_AD%rotors(1)%TwrElev(:)/InitOutData_AD%rotors(1)%TwrElev(nNodesTowerProps) ! Non-dimensionalize the tower elevation array + do i=1,InitInData_ExtLd%NumTwrNds + tmp_eta = InitInData_ExtLd%TwrHloc(i)/InitInData_ExtLd%TwrHloc(InitInData_ExtLd%NumTwrNds) + do jLower = 1, nNodesTowerProps - 1 + if ((AD_etaNodes(jLower) - tmp_eta)*(AD_etaNodes(jLower+1) - tmp_eta) <= 0) exit + end do + if (jLower .lt. nNodesTowerProps) then + rInterp = (tmp_eta - AD_etaNodes(jLower))/(AD_etaNodes(jLower+1)-AD_etaNodes(jLower)) ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + InitInData_ExtLd%TwrDia(i) = InitOutData_AD%rotors(1)%TwrDiam(jLower) + rInterp * (InitOutData_AD%rotors(1)%TwrDiam(jLower+1) - InitOutData_AD%rotors(1)%TwrDiam(jLower)) + else + InitInData_ExtLd%TwrDia(i) = InitOutData_AD%rotors(1)%TwrDiam(nNodesTowerProps) !Work around for when the last node of the actuator mesh is slightly outside of the Aerodyn tower properties. + end if + end do + deallocate(AD_etaNodes) + end if + + RETURN + +END SUBROUTINE ExtLd_SetInitInput +!---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the information needed to initialize AeroDyn, then initializes AeroDyn SUBROUTINE AD_SetInitInput(InitInData_AD14, InitOutData_ED, y_ED, p_FAST, ErrStat, ErrMsg) @@ -4176,14 +4601,14 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. -SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -4195,6 +4620,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, E TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller exchange data @@ -4250,7 +4676,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, E end if CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4442,7 +4868,7 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 @@ -4745,6 +5171,2334 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A END SUBROUTINE FAST_InitIOarrays !---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_InitIOarrays_SS for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_InitIOarrays_SS_T(t_initial, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SS_T' + + CALL FAST_InitIOarrays_SS(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE FAST_InitIOarrays_SS_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the input and output arrays stored for extrapolation when used in a sub-timestepping mode with an external driver program. They are initialized after the first input-output solve so that the first +!! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to +!! be stored for the predictor-corrector loop. +SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn v14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(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 !< 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 + + 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 ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SS' + + + ErrStat = ErrID_None + ErrMsg = "" + + ! We fill ED%InputTimes with negative times, but the ED%Input values are identical for each of those times; this allows + ! us to use, e.g., quadratic interpolation that effectively acts as a zeroth-order extrapolation and first-order extrapolation + ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as + ! order = SIZE(ED%Input) + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !ED_OutputTimes(p_FAST%InterpOrder + 1 + j) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input(1), ED%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_NEWCOPY, Errstat2, ErrMsg2) !BJJ: THIS IS REALLY ONLY NECESSARY FOR ED-HD COUPLING AT THE MOMENT + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (p_FAST%CompElast == Module_BD ) THEN + + DO k = 1,p_FAST%nBeams + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes_bak(j,k) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input(1,k), BD%Input_bak(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! nBeams + + END IF ! CompElast + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_PRED), SrvD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompServo + + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD14%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD14_CopyInput (AD14%Input(1), AD14%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState( AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input(1), AD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL AD_CopyContState(AD%x(STATE_PRED), AD%x(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState(AD%xd(STATE_PRED), AD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState(AD%z(STATE_PRED), AD%z(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState(AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !IfW%OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_PRED), IfW%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !HD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !SD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input(1), SD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState( SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !MAP_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN + CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! Initialize predicted states for j_pc loop: + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN + CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !MD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input(1), MD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState( MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_PRED), FEAM%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input(1), Orca%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_PRED), Orca%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + !IceF_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes_bak(j,i) = t_initial - (j - 1) * p_FAST%dt + !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_bak(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + ! Initialize predicted states for j_pc loop: + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Initialize predicted states for j_pc loop: + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_PRED), IceD%OtherSt(i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + +END SUBROUTINE FAST_InitIOarrays_SS +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Reset_SS for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Reset_SS_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Reset_SS(t_initial, n_t_global, n_timesteps, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Reset_SS_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 +SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + INTEGER(IntKi), INTENT(IN ) :: n_timesteps !< number of time steps to go back + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + + INTEGER(IntKi) :: i, j, k ! generic loop counters + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + + + ErrStat = ErrID_None + ErrMsg = "" + + + t_global = t_initial + n_t_global * p_FAST%DT + + !---------------------------------------------------------------------------------------- + !! copy the stored states and inputs from n_t_global the current states and inputs + !---------------------------------------------------------------------------------------- + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !ED_OutputTimes(j) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input_bak(j), ED%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ED_CopyOutput (ED%Output_bak(1), ED%y, MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_SS_PRED), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_SS_PRED), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_SS_PRED), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_SS_PRED), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyContState (ED%x( STATE_SS_CURR), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_SS_CURR), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_SS_CURR), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_SS_CURR), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + IF (p_FAST%CompElast == Module_BD ) THEN + + DO k = 1,p_FAST%nBeams + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes(j,k) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input_bak(j,k), BD%Input(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL BD_CopyContState (BD%x( k,STATE_SS_PRED), BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_SS_PRED), BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_SS_PRED), BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SS_PRED), BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyContState (BD%x( k,STATE_SS_CURR), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_SS_CURR), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_SS_CURR), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SS_CURR), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + ! A hack to restore Bladed-style DLL data + if (SrvD%p%UseBladedInterface) then + if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) + SrvD%m%dll_data%avrSWAP( 1) = -10 + CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! put values back: + SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + end if + end if + + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input_bak(j), SrvD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SrvD_CopyContState (SrvD%x( STATE_SS_PRED), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_SS_PRED), SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_SS_PRED), SrvD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SS_PRED), SrvD%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyContState (SrvD%x( STATE_SS_CURR), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_SS_CURR), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_SS_CURR), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SS_CURR), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyMisc( SrvD%m_bak, SrvD%m, MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD14%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD14_CopyInput (AD14%Input_bak(j), AD14%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL AD14_CopyContState (AD14%x( STATE_SS_PRED), AD14%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_SS_PRED), AD14%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_SS_PRED), AD14%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_SS_PRED), AD14%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD14_CopyContState (AD14%x( STATE_SS_CURR), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_SS_CURR), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_SS_CURR), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_SS_CURR), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input_bak(j), AD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL AD_CopyContState (AD%x( STATE_SS_PRED), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_SS_PRED), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_SS_PRED), AD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_SS_PRED), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyContState (AD%x( STATE_SS_CURR), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_SS_CURR), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_SS_CURR), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_SS_CURR), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !IfW%OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input_bak(j), IfW%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL InflowWind_CopyContState (IfW%x( STATE_SS_PRED), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_SS_PRED), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_SS_PRED), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SS_PRED), IfW%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyContState (IfW%x( STATE_SS_CURR), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_SS_CURR), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_SS_CURR), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SS_CURR), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !HD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input_bak(j), HD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL HydroDyn_CopyContState (HD%x( STATE_SS_PRED), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_SS_PRED), HD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_SS_PRED), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SS_PRED), HD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyContState (HD%x( STATE_SS_CURR), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_SS_CURR), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_SS_CURR), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SS_CURR), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !SD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input_bak(j), SD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SD_CopyContState (SD%x( STATE_SS_PRED), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_SS_PRED), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_SS_PRED), SD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_SS_PRED), SD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyContState (SD%x( STATE_SS_CURR), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_SS_CURR), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_SS_CURR), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_SS_CURR), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input_bak(j), ExtPtfm%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SS_PRED), ExtPtfm%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SS_PRED), ExtPtfm%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SS_PRED), ExtPtfm%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SS_PRED), ExtPtfm%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SS_CURR), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SS_CURR), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SS_CURR), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SS_CURR), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !MAP_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input_bak(j), MAPp%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MAP_CopyContState (MAPp%x( STATE_SS_PRED), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_SS_PRED), MAPp%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_SS_PRED), MAPp%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SS_PRED), MAPp%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyContState (MAPp%x( STATE_SS_CURR), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_SS_CURR), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_SS_CURR), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SS_CURR), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !MD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input_bak(j), MD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MD_CopyContState (MD%x( STATE_SS_PRED), MD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_SS_PRED), MD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_SS_PRED), MD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_SS_PRED), MD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyContState (MD%x( STATE_SS_CURR), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_SS_CURR), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_SS_CURR), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_SS_CURR), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !FEAM_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input_bak(j), FEAM%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL FEAM_CopyContState (FEAM%x( STATE_SS_PRED), FEAM%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_SS_PRED), FEAM%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_SS_PRED), FEAM%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SS_PRED), FEAM%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyContState (FEAM%x( STATE_SS_CURR), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_SS_CURR), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_SS_CURR), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SS_CURR), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input_bak(j), Orca%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL Orca_CopyContState (Orca%x( STATE_SS_PRED), Orca%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_SS_PRED), Orca%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_SS_PRED), Orca%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SS_PRED), Orca%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL Orca_CopyContState (Orca%x( STATE_SS_CURR), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_SS_CURR), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_SS_CURR), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SS_CURR), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes(j) = t_global - (j - 1) * p_FAST%dt + !IceF_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input_bak(j), IceF%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceFloe_CopyContState (IceF%x( STATE_SS_PRED), IceF%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_SS_PRED), IceF%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_SS_PRED), IceF%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SS_PRED), IceF%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyContState (IceF%x( STATE_SS_CURR), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_SS_CURR), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_SS_CURR), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SS_CURR), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes(j,i) = t_global - (j - 1) * p_FAST%dt + !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input_bak(j,i), IceD%Input(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceD_CopyContState (IceD%x( i,STATE_SS_PRED), IceD%x( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_SS_PRED), IceD%xd(i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_SS_PRED), IceD%z( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SS_PRED), IceD%OtherSt( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyContState (IceD%x( i,STATE_SS_CURR), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_SS_CURR), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_SS_CURR), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SS_CURR), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! We've moved everything back to the initial time step: + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! update the global time + + m_FAST%t_global = t_global +! y_FAST%n_Out = y_FAST%n_Out - n_timesteps + +END SUBROUTINE FAST_Reset_SS +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Store_SS for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Store_SS_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Store_SS(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Store_SS_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 +SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + + INTEGER(IntKi) :: i, j, k ! generic loop counters + REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset + INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + + + ErrStat = ErrID_None + ErrMsg = "" + + + t_global = t_initial + n_t_global * p_FAST%DT + + !---------------------------------------------------------------------------------------- + !! copy the stored states and inputs from n_t_global the current states and inputs + !---------------------------------------------------------------------------------------- + + DO j = 1, p_FAST%InterpOrder + 1 + ED%InputTimes_bak(j) = ED%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ED_CopyInput (ED%Input(j), ED%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (p_FAST%CompElast == Module_BD ) THEN + + DO k = 1,p_FAST%nBeams + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + BD%InputTimes_bak(j,k) = BD%InputTimes(j,k) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL BD_CopyInput (BD%Input(j,k), BD%Input_bak(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + END IF + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ! Initialize Input-Output arrays for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + SrvD%InputTimes_bak(j) = SrvD%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), SrvD%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + IF ( p_FAST%CompAero == Module_AD14 ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD14%InputTimes_bak(j) = AD14%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD14_CopyInput (AD14%Input(j), AD14%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + AD%InputTimes_bak(j) = AD%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL AD_CopyInput (AD%Input(j), AD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompAero == Module_AD + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + IfW%InputTimes_bak(j) = IfW%InputTimes(j) + !IfW%OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_CURR), IfW%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompInflow == Module_IfW + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + HD%InputTimes_bak(j) = HD%InputTimes(j) + !HD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF !CompHydro + + + IF (p_FAST%CompSub == Module_SD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SD%InputTimes_bak(j) = SD%InputTimes(j) + !SD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL SD_CopyInput (SD%Input(j), SD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + ExtPtfm%InputTimes_bak(j) = ExtPtfm%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompSub + + + IF (p_FAST%CompMooring == Module_MAP) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MAPp%InputTimes_bak(j) = MAPp%InputTimes(j) + !MAP_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), MAPp%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + MD%InputTimes_bak(j) = MD%InputTimes(j) + !MD_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL MD_CopyInput (MD%Input(j), MD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + FEAM%InputTimes_bak(j) = FEAM%InputTimes(j) + !FEAM_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), FEAM%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + ! Copy values for interpolation/extrapolation: + + DO j = 1, p_FAST%InterpOrder + 1 + Orca%InputTimes_bak(j) = Orca%InputTimes(j) + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL Orca_CopyInput (Orca%Input(j), Orca%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_CURR), Orca%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! CompMooring + + + IF (p_FAST%CompIce == Module_IceF ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceF%InputTimes_bak(j) = IceF%InputTimes(j) + !IceF_OutputTimes(i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSEIF (p_FAST%CompIce == Module_IceD ) THEN + + DO i = 1,p_FAST%numIceLegs + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + IceD%InputTimes_bak(j,i) = IceD%InputTimes(j,i) + !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt + END DO + + DO j = 1, p_FAST%InterpOrder + 1 + CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_bak(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_CURR), IceD%OtherSt( i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO ! numIceLegs + + END IF ! CompIce + + ! A hack to store Bladed-style DLL data + if (SrvD%p%UseBladedInterface) then + if (SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE + ! store value to be overwritten + old_avrSwap1 = SrvD%m%dll_data%avrSWAP( 1) + SrvD%m%dll_data%avrSWAP( 1) = -11 + CALL CallBladedDLL(SrvD%Input(1), SrvD%p, SrvD%m%dll_data, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! put values back: + SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + end if + end if + +END SUBROUTINE FAST_Store_SS +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Prework(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Prework_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine does the prep work to advance the time step from n_t_global to n_t_global + 1 +SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, & + ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + + INTEGER(IntKi) :: I, k ! generic loop counters + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' + + + ErrStat = ErrID_None + ErrMsg = "" + + t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + !! determine if the Jacobian should be calculated this time + IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian + + if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then + m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) + else + m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac + end if + + END IF + + ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from + ! the previous step before we extrapolate these inputs: + IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: Extrapolate Inputs + !! + !! gives predicted values at t+dt + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + +END SUBROUTINE FAST_Prework +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_PredictStates for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_UpdateStates(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_UpdateStates_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine takes data from n_t_global and predicts the states and output at n_t_global+1 +SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, & + ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + 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 + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' + + + ErrStat = ErrID_None + ErrMsg = "" + + t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + n_t_global_next = n_t_global+1 + + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + + ! set number of corrections to be used for this time step: + IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps + if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder + NumCorrections = p_FAST%NumCrctn + elseif (n_t_global == 0) then + NumCorrections = max(p_FAST%NumCrctn,16) + else + NumCorrections = max(p_FAST%NumCrctn,1) + end if + ELSE + NumCorrections = p_FAST%NumCrctn + END IF + + !! predictor-corrector loop: + DO j_pc = 0, NumCorrections + WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) + !! + !! STATE_CURR values of x, xd, z, and OtherSt contain values at m_FAST%t_global; + !! STATE_PRED values contain values at t_global_next. + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.c: Input-Output Solve + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 2: Correct (continue in loop) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + enddo ! j_pc + +END SUBROUTINE FAST_UpdateStates + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_AdvanceToNextTimeStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_AdvanceToNextTimeStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_AdvanceToNextTimeStep_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data +SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(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(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + + INTEGER(IntKi) :: I, k ! generic loop counters + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' + + + ErrStat = ErrID_None + ErrMsg = "" + + t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 3: Save all final variables (advance to next time) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !---------------------------------------------------------------------------------------- + !! copy the final predicted states from step t_global_next to actual states for that step + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy final predictions to actual states + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! BeamDyn: copy final predictions to actual states + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_CURR), 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 + CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN + CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! InflowWind: copy final predictions to actual states; copy current outputs to next + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! ServoDyn: copy final predictions to actual states; copy current outputs to next + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy final predictions to actual states + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_CURR), 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 (SD%x( STATE_PRED), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP: copy final predictions to actual states + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! IceFloe: copy final predictions to actual states + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO i=1,p_FAST%numIceLegs + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! We've advanced everything to the next time step: + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + !! update the global time + + m_FAST%t_global = t_global_next + +END SUBROUTINE FAST_AdvanceToNextTimeStep +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_WriteOutput for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_WriteOutput(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_WriteOutput_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data +SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(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(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: I, k ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' + + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------------------- + !! Check to see if we should output data this time step: + !---------------------------------------------------------------------------------------- + + CALL WriteOutputToFile(n_t_global, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !---------------------------------------------------------------------------------------- + !! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------------------- + + IF (p_FAST%WrSttsTime) then + IF ( MOD( n_t_global + 1, p_FAST%n_SttsTime ) == 0 ) THEN + + if (.not. Cmpl4SFun) then + CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + end if + + ENDIF + ENDIF + +END SUBROUTINE FAST_WriteOutput +!---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) @@ -4756,14 +7510,14 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -4778,6 +7532,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data @@ -4863,7 +7618,7 @@ 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, 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, ExtLd, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4880,7 +7635,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! STATE_PRED values contain values at t_global_next. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -4894,7 +7649,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !END IF CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -4975,7 +7730,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN + ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6399,7 +9154,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) end if CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & - Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & + Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -7386,7 +10141,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, E end if CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & - Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%ExtInfw, & + Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%ExtLd, Turbine(i_turb)%IfW, Turbine(i_turb)%ExtInfw, & Turbine(i_turb)%SeaSt, Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7397,7 +10152,7 @@ END SUBROUTINE FAST_RestoreForVTKModeShape_Tary !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the motions generated by mode shapes and outputs VTK data for it -SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -7411,6 +10166,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data @@ -7515,7 +10271,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, 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, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -7547,7 +10303,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, 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, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 7e2ec05633..d99d8021ec 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -37,6 +37,7 @@ MODULE FAST_Types USE InflowWind_Types USE AeroDyn14_Types USE AeroDyn_Types +USE ExtLoads_Types USE SubDyn_Types USE HydroDyn_Types USE IceFloe_Types @@ -54,23 +55,24 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_None = 0 ! No module selected [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Glue = 1 ! Glue code [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IfW = 2 ! InflowWind [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtInfw = 3 ! ExternalInflow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ED = 4 ! ElastoDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD14 = 6 ! AeroDyn14 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 8 ! ServoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 9 ! SeaState [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 10 ! HydroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 11 ! SubDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 12 ! External Platform Loading MCKF [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 13 ! MAP (Mooring Analysis Program) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 14 ! FEAMooring [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 15 ! MoorDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 16 ! OrcaFlex integration (HD/Mooring) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 17 ! IceFloe [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 18 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 18 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! AeroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SD = 12 ! SubDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtPtfm = 13 ! External Platform Loading MCKF [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MAP = 14 ! MAP (Mooring Analysis Program) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_FEAM = 15 ! FEAMooring [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_MD = 16 ! MoorDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 20 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] ! ========= FAST_VTK_BLSurfaceType ======= @@ -375,7 +377,9 @@ MODULE FAST_Types TYPE(IceD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(IceD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE IceDyn_Data ! ======================= ! ========= BeamDyn_Data ======= @@ -391,61 +395,71 @@ MODULE FAST_Types TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE BeamDyn_Data ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ED_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output_bak !< Backup Array of outputs associated with InputTimes [-] TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE ElastoDyn_Data ! ======================= ! ========= ServoDyn_Data ======= TYPE, PUBLIC :: ServoDyn_Data - TYPE(SrvD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SrvD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SrvD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SrvD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(SrvD_ParameterType) :: p !< Parameters [-] TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] TYPE(SrvD_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] + TYPE(SrvD_MiscVarType) :: m_bak !< Backup Misc (optimization) variables not associated with time [-] TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE ServoDyn_Data ! ======================= ! ========= AeroDyn14_Data ======= TYPE, PUBLIC :: AeroDyn14_Data - TYPE(AD14_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(AD14_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(AD14_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(AD14_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(AD14_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(AD14_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(AD14_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(AD14_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(AD14_ParameterType) :: p !< Parameters [-] TYPE(AD14_InputType) :: u !< System inputs [-] TYPE(AD14_OutputType) :: y !< System outputs [-] TYPE(AD14_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn14_Data ! ======================= ! ========= AeroDyn_Data ======= TYPE, PUBLIC :: AeroDyn_Data - TYPE(AD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(AD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(AD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(AD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(AD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(AD_ParameterType) :: p !< Parameters [-] TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] @@ -453,15 +467,30 @@ MODULE FAST_Types TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn_Data ! ======================= +! ========= ExtLoads_Data ======= + TYPE, PUBLIC :: ExtLoads_Data + TYPE(ExtLd_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(ExtLd_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(ExtLd_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(ExtLd_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ExtLd_ParameterType) :: p !< Parameters [-] + TYPE(ExtLd_InputType) :: u !< System inputs [-] + TYPE(ExtLd_OutputType) :: y !< System outputs [-] + TYPE(ExtLd_MiscVarType) :: m !< Misc/optimization variables [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + END TYPE ExtLoads_Data +! ======================= ! ========= InflowWind_Data ======= TYPE, PUBLIC :: InflowWind_Data - TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(InflowWind_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(InflowWind_ParameterType) :: p !< Parameters [-] TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] @@ -469,7 +498,9 @@ MODULE FAST_Types TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE InflowWind_Data ! ======================= ! ========= ExternalInflow_Data ======= @@ -489,56 +520,62 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= ! ========= ExtPtfm_Data ======= TYPE, PUBLIC :: ExtPtfm_Data - TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(ExtPtfm_ParameterType) :: p !< Parameters [-] TYPE(ExtPtfm_InputType) :: u !< System inputs [-] TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] TYPE(ExtPtfm_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE ExtPtfm_Data ! ======================= ! ========= SeaState_Data ======= TYPE, PUBLIC :: SeaState_Data - TYPE(SeaSt_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(SeaSt_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SeaSt_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(SeaSt_ParameterType) :: p !< Parameters [-] TYPE(SeaSt_InputType) :: u !< System inputs [-] TYPE(SeaSt_OutputType) :: y !< System outputs [-] TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE SeaState_Data ! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] @@ -546,28 +583,32 @@ MODULE FAST_Types TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE HydroDyn_Data ! ======================= ! ========= IceFloe_Data ======= TYPE, PUBLIC :: IceFloe_Data - TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(IceFloe_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(IceFloe_ParameterType) :: p !< Parameters [-] TYPE(IceFloe_InputType) :: u !< System inputs [-] TYPE(IceFloe_OutputType) :: y !< System outputs [-] TYPE(IceFloe_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE IceFloe_Data ! ======================= ! ========= MAP_Data ======= TYPE, PUBLIC :: MAP_Data - TYPE(MAP_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(MAP_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(MAP_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] TYPE(MAP_OtherStateType) :: OtherSt !< Other/optimization states [-] TYPE(MAP_ParameterType) :: p !< Parameters [-] TYPE(MAP_InputType) :: u !< System inputs [-] @@ -576,29 +617,33 @@ MODULE FAST_Types TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE MAP_Data ! ======================= ! ========= FEAMooring_Data ======= TYPE, PUBLIC :: FEAMooring_Data - TYPE(FEAM_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(FEAM_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(FEAM_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(FEAM_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(FEAM_ParameterType) :: p !< Parameters [-] TYPE(FEAM_InputType) :: u !< System inputs [-] TYPE(FEAM_OutputType) :: y !< System outputs [-] TYPE(FEAM_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE FEAMooring_Data ! ======================= ! ========= MoorDyn_Data ======= TYPE, PUBLIC :: MoorDyn_Data - TYPE(MD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(MD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(MD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(MD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(MD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(MD_ParameterType) :: p !< Parameters [-] TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] @@ -606,21 +651,25 @@ MODULE FAST_Types TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE MoorDyn_Data ! ======================= ! ========= OrcaFlex_Data ======= TYPE, PUBLIC :: OrcaFlex_Data - TYPE(Orca_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(Orca_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(Orca_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(Orca_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(Orca_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] + TYPE(Orca_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] + TYPE(Orca_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(Orca_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] TYPE(Orca_ParameterType) :: p !< Parameters [-] TYPE(Orca_InputType) :: u !< System inputs [-] TYPE(Orca_OutputType) :: y !< System outputs [-] TYPE(Orca_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] END TYPE OrcaFlex_Data ! ======================= ! ========= FAST_ModuleMapType ======= @@ -648,7 +697,7 @@ MODULE FAST_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_P_P_2_SubStructure !< Map ServoDyn/SStC platform point mesh load to SubDyn/ElastoDyn point load mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SubStructure_2_SStC_P_P !< Map SubDyn y3mesh or ED platform mesh motion to ServoDyn/SStC point mesh [-] TYPE(MeshMapType) :: ED_P_2_SrvD_P_P !< Map ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_AD_L_B !< Map ElastoDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_AD_L_B !< Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_L_2_BDED_B !< Map AeroDyn14 InputMarkers or AeroDyn BladeLoad line2 meshes to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BD_L_2_BD_L !< Map BeamDyn BldMotion output meshes to locations on the BD input DistrLoad mesh stored in MeshMapType%y_BD_BldMotion_4Loads (BD input and output meshes are not siblings and in fact have nodes at different locations [-] TYPE(MeshMapType) :: ED_P_2_AD_P_N !< Map ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh [-] @@ -660,6 +709,14 @@ MODULE FAST_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_AD_P_R !< Map ElastoDyn BladeRootMotion point meshes to AeroDyn BladeRootMotion point meshes [-] TYPE(MeshMapType) :: ED_P_2_AD_P_H !< Map ElastoDyn HubPtMotion point mesh to AeroDyn HubMotion point mesh [-] TYPE(MeshMapType) :: AD_P_2_ED_P_H !< Map AeroDyn HubLoad point mesh to ElastoDyn HubPtLoad point mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_ExtLd_P_B !< Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to ExtLoads point meshes [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ExtLd_P_2_BDED_B !< Map ExtLoads at points to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes [-] + TYPE(MeshMapType) :: ED_L_2_ExtLd_P_T !< Map ElastoDyn TowerLn2Mesh line2 mesh to ExtLoads point mesh [-] + TYPE(MeshMapType) :: ExtLd_P_2_ED_P_T !< Map ExtLoads TowerLoad point mesh to ElastoDyn TowerPtLoads point mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: ED_P_2_ExtLd_P_R !< Map ElastoDyn BladeRootMotion point meshes to ExtLoads BladeRootMotion point meshes [-] + TYPE(MeshMapType) :: ED_P_2_ExtLd_P_H !< Map ElastoDyn HubPtMotion point mesh to ExtLoads HubMotion point mesh [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_L_2_ExtLd_B !< Map AeroDyn line loads on blades to ExtLoads point loads [-] + TYPE(MeshMapType) :: AD_L_2_ExtLd_T !< Map AeroDyn line loads on tower to ExtKoads point loads [-] TYPE(MeshMapType) :: IceF_P_2_SD_P !< Map IceFloe point mesh to SubDyn LMesh point mesh [-] TYPE(MeshMapType) :: SDy3_P_2_IceF_P !< Map SubDyn y3Mesh point mesh to IceFloe point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: IceD_P_2_SD_P !< Map IceDyn point mesh to SubDyn LMesh point mesh [-] @@ -728,6 +785,8 @@ MODULE FAST_Types 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(ExtLd_InitInputType) :: InData_ExtLd !< ExtLd Initialization input data [-] + TYPE(ExtLd_InitOutputType) :: OutData_ExtLd !< ExtLd Initialization output data [-] TYPE(InflowWind_InitInputType) :: InData_IfW !< IfW Initialization input data [-] TYPE(InflowWind_InitOutputType) :: OutData_IfW !< IfW Initialization output data [-] TYPE(ExtInfw_InitInputType) :: InData_ExtInfw !< ExtInfw Initialization input data [-] @@ -775,6 +834,14 @@ MODULE FAST_Types INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] INTEGER(IntKi) :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + REAL(DbKi) :: DTdriver = -1 !< External driver time step [s] + LOGICAL :: TwrAero = .false. !< Is Tower aerodynamics enabled for ExtLoads module? [-] + REAL(ReKi) :: az_blend_mean !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: az_blend_delta !< Mean azimuth at which to blend the external and aerodyn loads [-] + REAL(ReKi) :: vel_mean !< Mean velocity at reference height [m/s] + REAL(ReKi) :: wind_dir !< Wind direction in compass angle [degrees] + REAL(ReKi) :: z_ref !< Reference height for velocity profile [m] + REAL(ReKi) :: shear_exp !< Shear exponent [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= @@ -789,6 +856,7 @@ MODULE FAST_Types TYPE(ServoDyn_Data) :: SrvD !< Data for the ServoDyn module [-] TYPE(AeroDyn_Data) :: AD !< Data for the AeroDyn module [-] TYPE(AeroDyn14_Data) :: AD14 !< Data for the AeroDyn14 module [-] + TYPE(ExtLoads_Data) :: ExtLd !< Data for the External loads module [-] TYPE(InflowWind_Data) :: IfW !< Data for InflowWind module [-] TYPE(ExternalInflow_Data) :: ExtInfw !< Data for ExternalInflow integration module [-] TYPE(SCDataEx_Data) :: SC_DX !< Data for SuperController integration module [-] @@ -16394,6 +16462,26 @@ SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCod ENDDO ENDDO ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcIceDyn_DataData%Input_bak,1) + i2_l = LBOUND(SrcIceDyn_DataData%Input_bak,2) + i2_u = UBOUND(SrcIceDyn_DataData%Input_bak,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input_bak)) THEN + ALLOCATE(DstIceDyn_DataData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%Input_bak,2), UBOUND(SrcIceDyn_DataData%Input_bak,2) + DO i1 = LBOUND(SrcIceDyn_DataData%Input_bak,1), UBOUND(SrcIceDyn_DataData%Input_bak,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%Input_bak(i1,i2), DstIceDyn_DataData%Input_bak(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) @@ -16407,6 +16495,20 @@ SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCod END IF END IF DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcIceDyn_DataData%InputTimes_bak,1) + i2_l = LBOUND(SrcIceDyn_DataData%InputTimes_bak,2) + i2_u = UBOUND(SrcIceDyn_DataData%InputTimes_bak,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstIceDyn_DataData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstIceDyn_DataData%InputTimes_bak = SrcIceDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyIceDyn_Data @@ -16504,8 +16606,20 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ENDDO DEALLOCATE(IceDyn_DataData%Input) ENDIF +IF (ALLOCATED(IceDyn_DataData%Input_bak)) THEN +DO i2 = LBOUND(IceDyn_DataData%Input_bak,2), UBOUND(IceDyn_DataData%Input_bak,2) +DO i1 = LBOUND(IceDyn_DataData%Input_bak,1), UBOUND(IceDyn_DataData%Input_bak,1) + CALL IceD_DestroyInput( IceDyn_DataData%Input_bak(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN DEALLOCATE(IceDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(IceDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(IceDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyIceDyn_Data @@ -16762,11 +16876,41 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Input_bak upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + 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 + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -17188,6 +17332,52 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_bak,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -17208,6 +17398,26 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_bak,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%InputTimes_bak,2), UBOUND(InData%InputTimes_bak,2) + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE FAST_PackIceDyn_Data SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -17767,6 +17977,67 @@ SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Input_bak,2), UBOUND(OutData%Input_bak,2) + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1,i2), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + 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 @@ -17790,6 +18061,29 @@ SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%InputTimes_bak,2), UBOUND(OutData%InputTimes_bak,2) + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE FAST_UnPackIceDyn_Data SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -18008,6 +18302,26 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl ENDDO ENDDO ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Input_bak,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Input_bak,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Input_bak,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input_bak)) THEN + ALLOCATE(DstBeamDyn_DataData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%Input_bak,2), UBOUND(SrcBeamDyn_DataData%Input_bak,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Input_bak,1), UBOUND(SrcBeamDyn_DataData%Input_bak,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%Input_bak(i1,i2), DstBeamDyn_DataData%Input_bak(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) @@ -18021,6 +18335,20 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl END IF END IF DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes_bak,1) + i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes_bak,2) + i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes_bak,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstBeamDyn_DataData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBeamDyn_DataData%InputTimes_bak = SrcBeamDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyBeamDyn_Data @@ -18134,8 +18462,20 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(BeamDyn_DataData%Input) ENDIF +IF (ALLOCATED(BeamDyn_DataData%Input_bak)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Input_bak,2), UBOUND(BeamDyn_DataData%Input_bak,2) +DO i1 = LBOUND(BeamDyn_DataData%Input_bak,1), UBOUND(BeamDyn_DataData%Input_bak,1) + CALL BD_DestroyInput( BeamDyn_DataData%Input_bak(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN DEALLOCATE(BeamDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(BeamDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyBeamDyn_Data @@ -18440,11 +18780,41 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Input_bak upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + 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 + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -18953,6 +19323,52 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_bak,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18973,6 +19389,26 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_bak,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%InputTimes_bak,2), UBOUND(InData%InputTimes_bak,2) + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE FAST_PackBeamDyn_Data SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -19649,6 +20085,67 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Input_bak,2), UBOUND(OutData%Input_bak,2) + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1,i2), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + 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 @@ -19672,6 +20169,29 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%InputTimes_bak,2), UBOUND(OutData%InputTimes_bak,2) + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -19736,6 +20256,22 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO +ENDIF +IF (ALLOCATED(SrcElastoDyn_DataData%Output_bak)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Output_bak,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Output_bak,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output_bak)) THEN + ALLOCATE(DstElastoDyn_DataData%Output_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcElastoDyn_DataData%Output_bak,1), UBOUND(SrcElastoDyn_DataData%Output_bak,1) + CALL ED_CopyOutput( SrcElastoDyn_DataData%Output_bak(i1), DstElastoDyn_DataData%Output_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -19756,6 +20292,22 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcElastoDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input_bak)) THEN + ALLOCATE(DstElastoDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcElastoDyn_DataData%Input_bak,1), UBOUND(SrcElastoDyn_DataData%Input_bak,1) + CALL ED_CopyInput( SrcElastoDyn_DataData%Input_bak(i1), DstElastoDyn_DataData%Input_bak(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) @@ -19767,6 +20319,18 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData END IF END IF DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstElastoDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstElastoDyn_DataData%InputTimes_bak = SrcElastoDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyElastoDyn_Data @@ -19821,6 +20385,13 @@ SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg, DEAL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(ElastoDyn_DataData%Output) +ENDIF +IF (ALLOCATED(ElastoDyn_DataData%Output_bak)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Output_bak,1), UBOUND(ElastoDyn_DataData%Output_bak,1) + CALL ED_DestroyOutput( ElastoDyn_DataData%Output_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Output_bak) ENDIF CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -19831,8 +20402,18 @@ SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg, DEAL ENDDO DEALLOCATE(ElastoDyn_DataData%Input) ENDIF +IF (ALLOCATED(ElastoDyn_DataData%Input_bak)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Input_bak,1), UBOUND(ElastoDyn_DataData%Input_bak,1) + CALL ED_DestroyInput( ElastoDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN DEALLOCATE(ElastoDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(ElastoDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(ElastoDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyElastoDyn_Data @@ -20038,6 +20619,29 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Output_bak allocated yes/no + IF ( ALLOCATED(InData%Output_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output_bak,1), UBOUND(InData%Output_bak,1) + Int_BufSz = Int_BufSz + 3 ! Output_bak: size of buffers for each call to pack subtype + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output_bak + 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 @@ -20079,11 +20683,39 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -20384,6 +21016,47 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Output_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output_bak,1), UBOUND(InData%Output_bak,1) + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_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 @@ -20453,6 +21126,47 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -20468,6 +21182,21 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_PackElastoDyn_Data SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -20889,6 +21618,62 @@ 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 ! Output_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Output_bak) + ALLOCATE(OutData%Output_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output_bak,1), UBOUND(OutData%Output_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Output_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(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 @@ -20985,6 +21770,62 @@ 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_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -21003,6 +21844,24 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackElastoDyn_Data SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -21052,6 +21911,9 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyMisc( SrcServoDyn_DataData%m_bak, DstServoDyn_DataData%m_bak, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN i1_l = LBOUND(SrcServoDyn_DataData%Output,1) i1_u = UBOUND(SrcServoDyn_DataData%Output,1) @@ -21087,6 +21949,22 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcServoDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcServoDyn_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input_bak)) THEN + ALLOCATE(DstServoDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcServoDyn_DataData%Input_bak,1), UBOUND(SrcServoDyn_DataData%Input_bak,1) + CALL SrvD_CopyInput( SrcServoDyn_DataData%Input_bak(i1), DstServoDyn_DataData%Input_bak(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) @@ -21098,6 +21976,18 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C END IF END IF DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcServoDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcServoDyn_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstServoDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstServoDyn_DataData%InputTimes_bak = SrcServoDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyServoDyn_Data @@ -21146,6 +22036,8 @@ SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg, DEALLO CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SrvD_DestroyMisc( ServoDyn_DataData%m_bak, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ServoDyn_DataData%Output)) THEN DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) @@ -21162,8 +22054,18 @@ SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(ServoDyn_DataData%Input) ENDIF +IF (ALLOCATED(ServoDyn_DataData%Input_bak)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Input_bak,1), UBOUND(ServoDyn_DataData%Input_bak,1) + CALL SrvD_DestroyInput( ServoDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ServoDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN DEALLOCATE(ServoDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(ServoDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(ServoDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyServoDyn_Data @@ -21347,6 +22249,23 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! m_bak: size of buffers for each call to pack subtype + CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_bak, ErrStat2, ErrMsg2, .TRUE. ) ! m_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m_bak + 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 @@ -21410,11 +22329,39 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -21674,6 +22621,34 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_bak, ErrStat2, ErrMsg2, OnlySize ) ! m_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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 @@ -21784,6 +22759,47 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -21799,6 +22815,21 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_PackServoDyn_Data SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -22164,6 +23195,46 @@ SUBROUTINE FAST_UnPackServoDyn_Data( 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) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_bak, ErrStat2, ErrMsg2 ) ! m_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (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 @@ -22316,6 +23387,62 @@ 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 ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -22334,6 +23461,24 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackServoDyn_Data SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -22399,6 +23544,22 @@ SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcAeroDyn14_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%Input_bak,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input_bak)) THEN + ALLOCATE(DstAeroDyn14_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcAeroDyn14_DataData%Input_bak,1), UBOUND(SrcAeroDyn14_DataData%Input_bak,1) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input_bak(i1), DstAeroDyn14_DataData%Input_bak(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) @@ -22410,6 +23571,18 @@ SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData END IF END IF DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes_bak)) THEN + ALLOCATE(DstAeroDyn14_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstAeroDyn14_DataData%InputTimes_bak = SrcAeroDyn14_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyAeroDyn14_Data @@ -22465,8 +23638,18 @@ SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg, DEAL ENDDO DEALLOCATE(AeroDyn14_DataData%Input) ENDIF +IF (ALLOCATED(AeroDyn14_DataData%Input_bak)) THEN +DO i1 = LBOUND(AeroDyn14_DataData%Input_bak,1), UBOUND(AeroDyn14_DataData%Input_bak,1) + CALL AD14_DestroyInput( AeroDyn14_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(AeroDyn14_DataData%Input_bak) +ENDIF IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN DEALLOCATE(AeroDyn14_DataData%InputTimes) +ENDIF +IF (ALLOCATED(AeroDyn14_DataData%InputTimes_bak)) THEN + DEALLOCATE(AeroDyn14_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyAeroDyn14_Data @@ -22673,11 +23856,39 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -22978,6 +24189,47 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -22993,6 +24245,21 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_PackAeroDyn14_Data SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -23414,6 +24681,62 @@ 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 ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -23432,6 +24755,24 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackAeroDyn14_Data SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -23516,6 +24857,22 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcAeroDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input_bak)) THEN + ALLOCATE(DstAeroDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcAeroDyn_DataData%Input_bak,1), UBOUND(SrcAeroDyn_DataData%Input_bak,1) + CALL AD_CopyInput( SrcAeroDyn_DataData%Input_bak(i1), DstAeroDyn_DataData%Input_bak(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) @@ -23527,6 +24884,18 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl END IF END IF DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstAeroDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstAeroDyn_DataData%InputTimes_bak = SrcAeroDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyAeroDyn_Data @@ -23591,8 +24960,18 @@ SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(AeroDyn_DataData%Input) ENDIF +IF (ALLOCATED(AeroDyn_DataData%Input_bak)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Input_bak,1), UBOUND(AeroDyn_DataData%Input_bak,1) + CALL AD_DestroyInput( AeroDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(AeroDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN DEALLOCATE(AeroDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(AeroDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(AeroDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyAeroDyn_Data @@ -23839,11 +25218,39 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -24213,6 +25620,47 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -24228,6 +25676,21 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_PackAeroDyn_Data SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -24745,6 +26208,62 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -24763,11 +26282,29 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackAeroDyn_Data - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData + SUBROUTINE FAST_CopyExtLoads_Data( SrcExtLoads_DataData, DstExtLoads_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLoads_Data), INTENT(INOUT) :: SrcExtLoads_DataData + TYPE(ExtLoads_Data), INTENT(INOUT) :: DstExtLoads_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -24776,93 +26313,58 @@ SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_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_CopyInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtLoads_Data' ! 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 ) + DO i1 = LBOUND(SrcExtLoads_DataData%x,1), UBOUND(SrcExtLoads_DataData%x,1) + CALL ExtLd_CopyContState( SrcExtLoads_DataData%x(i1), DstExtLoads_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN 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 ) + DO i1 = LBOUND(SrcExtLoads_DataData%xd,1), UBOUND(SrcExtLoads_DataData%xd,1) + CALL ExtLd_CopyDiscState( SrcExtLoads_DataData%xd(i1), DstExtLoads_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN 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 ) + DO i1 = LBOUND(SrcExtLoads_DataData%z,1), UBOUND(SrcExtLoads_DataData%z,1) + CALL ExtLd_CopyConstrState( SrcExtLoads_DataData%z(i1), DstExtLoads_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN 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 ) + DO i1 = LBOUND(SrcExtLoads_DataData%OtherSt,1), UBOUND(SrcExtLoads_DataData%OtherSt,1) + CALL ExtLd_CopyOtherState( SrcExtLoads_DataData%OtherSt(i1), DstExtLoads_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN 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 ExtLd_CopyParam( SrcExtLoads_DataData%p, DstExtLoads_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Output,1) - i1_u = UBOUND(SrcInflowWind_DataData%Output,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN - ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL ExtLd_CopyInput( SrcExtLoads_DataData%u, DstExtLoads_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ExtLd_CopyOutput( SrcExtLoads_DataData%y, DstExtLoads_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL ExtLd_CopyMisc( SrcExtLoads_DataData%m, DstExtLoads_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcExtLoads_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcExtLoads_DataData%InputTimes,1) + i1_u = UBOUND(SrcExtLoads_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstExtLoads_DataData%InputTimes)) THEN + ALLOCATE(DstExtLoads_DataData%InputTimes(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 DstExtLoads_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes + DstExtLoads_DataData%InputTimes = SrcExtLoads_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data + END SUBROUTINE FAST_CopyExtLoads_Data - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData + SUBROUTINE FAST_DestroyExtLoads_Data( ExtLoads_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLoads_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers @@ -24871,7 +26373,7 @@ SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DE LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtLoads_Data' ErrStat = ErrID_None ErrMsg = "" @@ -24882,56 +26384,40 @@ SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DE DEALLOCATEpointers_local = .true. END IF -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +DO i1 = LBOUND(ExtLoads_DataData%x,1), UBOUND(ExtLoads_DataData%x,1) + CALL ExtLd_DestroyContState( ExtLoads_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +DO i1 = LBOUND(ExtLoads_DataData%xd,1), UBOUND(ExtLoads_DataData%xd,1) + CALL ExtLd_DestroyDiscState( ExtLoads_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +DO i1 = LBOUND(ExtLoads_DataData%z,1), UBOUND(ExtLoads_DataData%z,1) + CALL ExtLd_DestroyConstrState( ExtLoads_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +DO i1 = LBOUND(ExtLoads_DataData%OtherSt,1), UBOUND(ExtLoads_DataData%OtherSt,1) + CALL ExtLd_DestroyOtherState( ExtLoads_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtLd_DestroyParam( ExtLoads_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Output)) THEN -DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) - CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtLd_DestroyInput( ExtLoads_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Output) -ENDIF - CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtLd_DestroyOutput( ExtLoads_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Input)) THEN -DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL ExtLd_DestroyMisc( ExtLoads_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) -ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) +IF (ALLOCATED(ExtLoads_DataData%InputTimes)) THEN + DEALLOCATE(ExtLoads_DataData%InputTimes) ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data + END SUBROUTINE FAST_DestroyExtLoads_Data - SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackExtLoads_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(IN) :: InData + TYPE(ExtLoads_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -24946,7 +26432,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_PackExtLoads_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -24965,7 +26451,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL ExtLd_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 @@ -24984,7 +26470,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL ExtLd_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 @@ -25003,7 +26489,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL ExtLd_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 @@ -25022,7 +26508,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL ExtLd_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 @@ -25040,7 +26526,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL ExtLd_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25057,7 +26543,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL ExtLd_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25074,7 +26560,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL ExtLd_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25091,7 +26577,7 @@ SUBROUTINE FAST_PackInflowWind_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 InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL ExtLd_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25107,69 +26593,6 @@ SUBROUTINE FAST_PackInflowWind_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 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 @@ -25198,6 +26621,1141 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END 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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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%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_PackExtLoads_Data + + SUBROUTINE FAST_UnPackExtLoads_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(ExtLoads_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_UnPackExtLoads_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ExtLd_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 ! 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_UnPackExtLoads_Data + + SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData + TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) + CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) + CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) + CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) + CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Output,1) + i1_u = UBOUND(SrcInflowWind_DataData%Output,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN + ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Input,1) + i1_u = UBOUND(SrcInflowWind_DataData%Input,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN + ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcInflowWind_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Input_bak,1) + i1_u = UBOUND(SrcInflowWind_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input_bak)) THEN + ALLOCATE(DstInflowWind_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInflowWind_DataData%Input_bak,1), UBOUND(SrcInflowWind_DataData%Input_bak,1) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input_bak(i1), DstInflowWind_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) + i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN + ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcInflowWind_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcInflowWind_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes_bak)) THEN + ALLOCATE(DstInflowWind_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInflowWind_DataData%InputTimes_bak = SrcInflowWind_DataData%InputTimes_bak +ENDIF + END SUBROUTINE FAST_CopyInflowWind_Data + + SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) + CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) + CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) + CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) + CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InflowWind_DataData%Output)) THEN +DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) + CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InflowWind_DataData%Output) +ENDIF + CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InflowWind_DataData%Input)) THEN +DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InflowWind_DataData%Input) +ENDIF +IF (ALLOCATED(InflowWind_DataData%Input_bak)) THEN +DO i1 = LBOUND(InflowWind_DataData%Input_bak,1), UBOUND(InflowWind_DataData%Input_bak,1) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InflowWind_DataData%Input_bak) +ENDIF +IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN + DEALLOCATE(InflowWind_DataData%InputTimes) +ENDIF +IF (ALLOCATED(InflowWind_DataData%InputTimes_bak)) THEN + DEALLOCATE(InflowWind_DataData%InputTimes_bak) +ENDIF + END SUBROUTINE FAST_DestroyInflowWind_Data + + SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(InflowWind_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInflowWind_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 @@ -25544,6 +28102,47 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -25559,6 +28158,21 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -25971,15 +28585,69 @@ SUBROUTINE FAST_UnPackInflowWind_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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + 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) - 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 + 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 @@ -26013,27 +28681,29 @@ SUBROUTINE FAST_UnPackInflowWind_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 InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated Int_Xferred = Int_Xferred + 1 ELSE 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%Input_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(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%Input_bak.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26067,7 +28737,7 @@ SUBROUTINE FAST_UnPackInflowWind_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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26094,6 +28764,24 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackInflowWind_Data SUBROUTINE FAST_CopyExternalInflow_Data( SrcExternalInflow_DataData, DstExternalInflow_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -27053,6 +29741,22 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcSubDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcSubDyn_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input_bak)) THEN + ALLOCATE(DstSubDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcSubDyn_DataData%Input_bak,1), UBOUND(SrcSubDyn_DataData%Input_bak,1) + CALL SD_CopyInput( SrcSubDyn_DataData%Input_bak(i1), DstSubDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN i1_l = LBOUND(SrcSubDyn_DataData%Output,1) i1_u = UBOUND(SrcSubDyn_DataData%Output,1) @@ -27083,6 +29787,18 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod END IF END IF DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcSubDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcSubDyn_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstSubDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSubDyn_DataData%InputTimes_bak = SrcSubDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopySubDyn_Data @@ -27138,6 +29854,13 @@ SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ENDDO DEALLOCATE(SubDyn_DataData%Input) ENDIF +IF (ALLOCATED(SubDyn_DataData%Input_bak)) THEN +DO i1 = LBOUND(SubDyn_DataData%Input_bak,1), UBOUND(SubDyn_DataData%Input_bak,1) + CALL SD_DestroyInput( SubDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(SubDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(SubDyn_DataData%Output)) THEN DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) @@ -27149,6 +29872,9 @@ SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATE CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN DEALLOCATE(SubDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(SubDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(SubDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroySubDyn_Data @@ -27355,6 +30081,29 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no IF ( ALLOCATED(InData%Output) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension @@ -27400,6 +30149,11 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -27700,6 +30454,47 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -27784,6 +30579,21 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -28205,6 +31015,62 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -28319,6 +31185,24 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -28384,6 +31268,22 @@ SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcExtPtfm_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%Input_bak,1) + i1_u = UBOUND(SrcExtPtfm_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input_bak)) THEN + ALLOCATE(DstExtPtfm_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcExtPtfm_DataData%Input_bak,1), UBOUND(SrcExtPtfm_DataData%Input_bak,1) + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input_bak(i1), DstExtPtfm_DataData%Input_bak(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) @@ -28395,6 +31295,18 @@ SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, Ctrl END IF END IF DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes_bak)) THEN + ALLOCATE(DstExtPtfm_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstExtPtfm_DataData%InputTimes_bak = SrcExtPtfm_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyExtPtfm_Data @@ -28450,8 +31362,18 @@ SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(ExtPtfm_DataData%Input) ENDIF +IF (ALLOCATED(ExtPtfm_DataData%Input_bak)) THEN +DO i1 = LBOUND(ExtPtfm_DataData%Input_bak,1), UBOUND(ExtPtfm_DataData%Input_bak,1) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ExtPtfm_DataData%Input_bak) +ENDIF IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN DEALLOCATE(ExtPtfm_DataData%InputTimes) +ENDIF +IF (ALLOCATED(ExtPtfm_DataData%InputTimes_bak)) THEN + DEALLOCATE(ExtPtfm_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyExtPtfm_Data @@ -28658,11 +31580,39 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -28866,35 +31816,74 @@ 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 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + 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 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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 + 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 @@ -28922,18 +31911,20 @@ 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 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN 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%Input_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,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 + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28978,6 +31969,21 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -29399,6 +32405,62 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -29417,6 +32479,24 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackExtPtfm_Data SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -29482,6 +32562,22 @@ SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcSeaState_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcSeaState_DataData%Input_bak,1) + i1_u = UBOUND(SrcSeaState_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%Input_bak)) THEN + ALLOCATE(DstSeaState_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcSeaState_DataData%Input_bak,1), UBOUND(SrcSeaState_DataData%Input_bak,1) + CALL SeaSt_CopyInput( SrcSeaState_DataData%Input_bak(i1), DstSeaState_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF IF (ALLOCATED(SrcSeaState_DataData%Output)) THEN i1_l = LBOUND(SrcSeaState_DataData%Output,1) i1_u = UBOUND(SrcSeaState_DataData%Output,1) @@ -29512,6 +32608,18 @@ SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, C END IF END IF DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcSeaState_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcSeaState_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcSeaState_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes_bak)) THEN + ALLOCATE(DstSeaState_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSeaState_DataData%InputTimes_bak = SrcSeaState_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopySeaState_Data @@ -29567,6 +32675,13 @@ SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(SeaState_DataData%Input) ENDIF +IF (ALLOCATED(SeaState_DataData%Input_bak)) THEN +DO i1 = LBOUND(SeaState_DataData%Input_bak,1), UBOUND(SeaState_DataData%Input_bak,1) + CALL SeaSt_DestroyInput( SeaState_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(SeaState_DataData%Input_bak) +ENDIF IF (ALLOCATED(SeaState_DataData%Output)) THEN DO i1 = LBOUND(SeaState_DataData%Output,1), UBOUND(SeaState_DataData%Output,1) CALL SeaSt_DestroyOutput( SeaState_DataData%Output(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) @@ -29578,6 +32693,9 @@ SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg, DEALLO CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(SeaState_DataData%InputTimes)) THEN DEALLOCATE(SeaState_DataData%InputTimes) +ENDIF +IF (ALLOCATED(SeaState_DataData%InputTimes_bak)) THEN + DEALLOCATE(SeaState_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroySeaState_Data @@ -29784,6 +32902,29 @@ SUBROUTINE FAST_PackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no IF ( ALLOCATED(InData%Output) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension @@ -29829,6 +32970,11 @@ SUBROUTINE FAST_PackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -30127,89 +33273,145 @@ SUBROUTINE FAST_PackSeaState_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%Output) ) THEN + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL SeaSt_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 SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,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%Output,1), UBOUND(InData%Output,1) - CALL SeaSt_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 + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN 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%InputTimes_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -30634,6 +33836,62 @@ SUBROUTINE FAST_UnPackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SeaSt_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -30748,6 +34006,24 @@ SUBROUTINE FAST_UnPackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackSeaState_Data SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -30832,6 +34108,22 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcHydroDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input_bak)) THEN + ALLOCATE(DstHydroDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcHydroDyn_DataData%Input_bak,1), UBOUND(SrcHydroDyn_DataData%Input_bak,1) + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input_bak(i1), DstHydroDyn_DataData%Input_bak(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) @@ -30843,6 +34135,18 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C END IF END IF DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstHydroDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstHydroDyn_DataData%InputTimes_bak = SrcHydroDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyHydroDyn_Data @@ -30907,8 +34211,18 @@ SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(HydroDyn_DataData%Input) ENDIF +IF (ALLOCATED(HydroDyn_DataData%Input_bak)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Input_bak,1), UBOUND(HydroDyn_DataData%Input_bak,1) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(HydroDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN DEALLOCATE(HydroDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(HydroDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(HydroDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyHydroDyn_Data @@ -31155,11 +34469,39 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -31529,6 +34871,47 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -31544,6 +34927,21 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -31956,15 +35354,69 @@ 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%Output(i1), ErrStat2, ErrMsg2 ) ! Output + 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) - 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 + 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 @@ -31998,27 +35450,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_interp, ErrStat2, ErrMsg2 ) ! y_interp + 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated Int_Xferred = Int_Xferred + 1 ELSE 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%Input_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(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%Input_bak.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -32052,7 +35506,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 HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -32079,6 +35533,24 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -32144,6 +35616,22 @@ SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcIceFloe_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%Input_bak,1) + i1_u = UBOUND(SrcIceFloe_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input_bak)) THEN + ALLOCATE(DstIceFloe_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceFloe_DataData%Input_bak,1), UBOUND(SrcIceFloe_DataData%Input_bak,1) + CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input_bak(i1), DstIceFloe_DataData%Input_bak(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) @@ -32155,6 +35643,18 @@ SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, Ctrl END IF END IF DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcIceFloe_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcIceFloe_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes_bak)) THEN + ALLOCATE(DstIceFloe_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstIceFloe_DataData%InputTimes_bak = SrcIceFloe_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyIceFloe_Data @@ -32210,8 +35710,18 @@ SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(IceFloe_DataData%Input) ENDIF +IF (ALLOCATED(IceFloe_DataData%Input_bak)) THEN +DO i1 = LBOUND(IceFloe_DataData%Input_bak,1), UBOUND(IceFloe_DataData%Input_bak,1) + CALL IceFloe_DestroyInput( IceFloe_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(IceFloe_DataData%Input_bak) +ENDIF IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN DEALLOCATE(IceFloe_DataData%InputTimes) +ENDIF +IF (ALLOCATED(IceFloe_DataData%InputTimes_bak)) THEN + DEALLOCATE(IceFloe_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyIceFloe_Data @@ -32418,11 +35928,39 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -32723,6 +36261,47 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -32738,6 +36317,21 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -33159,6 +36753,62 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -33177,6 +36827,24 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -33259,6 +36927,22 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcMAP_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcMAP_DataData%Input_bak,1) + i1_u = UBOUND(SrcMAP_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Input_bak)) THEN + ALLOCATE(DstMAP_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMAP_DataData%Input_bak,1), UBOUND(SrcMAP_DataData%Input_bak,1) + CALL MAP_CopyInput( SrcMAP_DataData%Input_bak(i1), DstMAP_DataData%Input_bak(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) @@ -33270,6 +36954,18 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta END IF END IF DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcMAP_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcMAP_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcMAP_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes_bak)) THEN + ALLOCATE(DstMAP_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMAP_DataData%InputTimes_bak = SrcMAP_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyMAP_Data @@ -33332,8 +37028,18 @@ SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg, DEALLOCATEpointe ENDDO DEALLOCATE(MAP_DataData%Input) ENDIF +IF (ALLOCATED(MAP_DataData%Input_bak)) THEN +DO i1 = LBOUND(MAP_DataData%Input_bak,1), UBOUND(MAP_DataData%Input_bak,1) + CALL MAP_DestroyInput( MAP_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MAP_DataData%Input_bak) +ENDIF IF (ALLOCATED(MAP_DataData%InputTimes)) THEN DEALLOCATE(MAP_DataData%InputTimes) +ENDIF +IF (ALLOCATED(MAP_DataData%InputTimes_bak)) THEN + DEALLOCATE(MAP_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyMAP_Data @@ -33578,11 +37284,39 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -33699,8 +37433,64 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 + 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 @@ -33728,7 +37518,7 @@ 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 + 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 @@ -33756,7 +37546,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 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 @@ -33784,7 +37574,18 @@ 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 + 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 @@ -33812,7 +37613,9 @@ 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 + 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 @@ -33840,18 +37643,18 @@ 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%Output) ) THEN + 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%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,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%Output,1), UBOUND(InData%Output,1) - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + 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 @@ -33881,46 +37684,18 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN 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%Input_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,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%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -33965,6 +37740,21 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -34478,6 +38268,62 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -34496,6 +38342,24 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -34561,6 +38425,22 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcFEAMooring_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%Input_bak,1) + i1_u = UBOUND(SrcFEAMooring_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input_bak)) THEN + ALLOCATE(DstFEAMooring_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcFEAMooring_DataData%Input_bak,1), UBOUND(SrcFEAMooring_DataData%Input_bak,1) + CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input_bak(i1), DstFEAMooring_DataData%Input_bak(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) @@ -34572,6 +38452,18 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD END IF END IF DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes_bak)) THEN + ALLOCATE(DstFEAMooring_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstFEAMooring_DataData%InputTimes_bak = SrcFEAMooring_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyFEAMooring_Data @@ -34627,8 +38519,18 @@ SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg, DE ENDDO DEALLOCATE(FEAMooring_DataData%Input) ENDIF +IF (ALLOCATED(FEAMooring_DataData%Input_bak)) THEN +DO i1 = LBOUND(FEAMooring_DataData%Input_bak,1), UBOUND(FEAMooring_DataData%Input_bak,1) + CALL FEAM_DestroyInput( FEAMooring_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(FEAMooring_DataData%Input_bak) +ENDIF IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN DEALLOCATE(FEAMooring_DataData%InputTimes) +ENDIF +IF (ALLOCATED(FEAMooring_DataData%InputTimes_bak)) THEN + DEALLOCATE(FEAMooring_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyFEAMooring_Data @@ -34835,11 +38737,39 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -35140,6 +39070,47 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -35155,6 +39126,21 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -35433,7 +39419,47 @@ 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 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 @@ -35473,13 +39499,27 @@ 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 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 @@ -35513,27 +39553,29 @@ 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 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated Int_Xferred = Int_Xferred + 1 ELSE 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%Input_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(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%Input_bak.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -35567,7 +39609,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 FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -35594,6 +39636,24 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -35678,6 +39738,22 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcMoorDyn_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Input_bak,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input_bak)) THEN + ALLOCATE(DstMoorDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMoorDyn_DataData%Input_bak,1), UBOUND(SrcMoorDyn_DataData%Input_bak,1) + CALL MD_CopyInput( SrcMoorDyn_DataData%Input_bak(i1), DstMoorDyn_DataData%Input_bak(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) @@ -35689,6 +39765,18 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl END IF END IF DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes_bak)) THEN + ALLOCATE(DstMoorDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMoorDyn_DataData%InputTimes_bak = SrcMoorDyn_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyMoorDyn_Data @@ -35753,8 +39841,18 @@ SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(MoorDyn_DataData%Input) ENDIF +IF (ALLOCATED(MoorDyn_DataData%Input_bak)) THEN +DO i1 = LBOUND(MoorDyn_DataData%Input_bak,1), UBOUND(MoorDyn_DataData%Input_bak,1) + CALL MD_DestroyInput( MoorDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MoorDyn_DataData%Input_bak) +ENDIF IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN DEALLOCATE(MoorDyn_DataData%InputTimes) +ENDIF +IF (ALLOCATED(MoorDyn_DataData%InputTimes_bak)) THEN + DEALLOCATE(MoorDyn_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyMoorDyn_Data @@ -36001,11 +40099,39 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -36375,6 +40501,47 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -36390,6 +40557,21 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -36907,6 +41089,62 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -36925,6 +41163,24 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -36990,6 +41246,22 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF +IF (ALLOCATED(SrcOrcaFlex_DataData%Input_bak)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%Input_bak,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%Input_bak,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input_bak)) THEN + ALLOCATE(DstOrcaFlex_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOrcaFlex_DataData%Input_bak,1), UBOUND(SrcOrcaFlex_DataData%Input_bak,1) + CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input_bak(i1), DstOrcaFlex_DataData%Input_bak(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) @@ -37001,6 +41273,18 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C END IF END IF DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes +ENDIF +IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes_bak)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes_bak,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes_bak,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes_bak)) THEN + ALLOCATE(DstOrcaFlex_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOrcaFlex_DataData%InputTimes_bak = SrcOrcaFlex_DataData%InputTimes_bak ENDIF END SUBROUTINE FAST_CopyOrcaFlex_Data @@ -37056,8 +41340,18 @@ SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(OrcaFlex_DataData%Input) ENDIF +IF (ALLOCATED(OrcaFlex_DataData%Input_bak)) THEN +DO i1 = LBOUND(OrcaFlex_DataData%Input_bak,1), UBOUND(OrcaFlex_DataData%Input_bak,1) + CALL Orca_DestroyInput( OrcaFlex_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OrcaFlex_DataData%Input_bak) +ENDIF IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN DEALLOCATE(OrcaFlex_DataData%InputTimes) +ENDIF +IF (ALLOCATED(OrcaFlex_DataData%InputTimes_bak)) THEN + DEALLOCATE(OrcaFlex_DataData%InputTimes_bak) ENDIF END SUBROUTINE FAST_DestroyOrcaFlex_Data @@ -37264,11 +41558,39 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no + IF ( ALLOCATED(InData%Input_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no + IF ( ALLOCATED(InData%InputTimes_bak) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -37569,6 +41891,47 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(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 @@ -37584,6 +41947,21 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + 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_bak,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_bak(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 ) @@ -38005,6 +42383,62 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%Input_bak) + ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + 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 @@ -38023,6 +42457,24 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + 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_bak)) DEALLOCATE(OutData%InputTimes_bak) + ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) + OutData%InputTimes_bak(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 ) @@ -38383,6 +42835,82 @@ SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B)) THEN + ALLOCATE(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_ExtLd_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), DstModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%ExtLd_P_2_BDED_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ExtLd_P_2_BDED_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%ExtLd_P_2_BDED_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ExtLd_P_2_BDED_B)) THEN + ALLOCATE(DstModuleMapTypeData%ExtLd_P_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ExtLd_P_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ExtLd_P_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%ExtLd_P_2_BDED_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ExtLd_P_2_BDED_B(i1), DstModuleMapTypeData%ExtLd_P_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_ExtLd_P_T, DstModuleMapTypeData%ED_L_2_ExtLd_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ExtLd_P_2_ED_P_T, DstModuleMapTypeData%ExtLd_P_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_ExtLd_P_R)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_ExtLd_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_ExtLd_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), DstModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_ExtLd_P_H, DstModuleMapTypeData%ED_P_2_ExtLd_P_H, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_ExtLd_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_ExtLd_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_ExtLd_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_ExtLd_B)) THEN + ALLOCATE(DstModuleMapTypeData%AD_L_2_ExtLd_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_ExtLd_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_ExtLd_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_ExtLd_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ExtLd_B(i1), DstModuleMapTypeData%AD_L_2_ExtLd_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ExtLd_T, DstModuleMapTypeData%AD_L_2_ExtLd_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -38753,6 +43281,42 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg, DEALLO CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_ExtLd_P_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_ExtLd_P_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_ExtLd_P_B,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%ExtLd_P_2_BDED_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ExtLd_P_2_BDED_B,1), UBOUND(ModuleMapTypeData%ExtLd_P_2_BDED_B,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ExtLd_P_2_BDED_B) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_ExtLd_P_R)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_ExtLd_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_ExtLd_P_R,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_ExtLd_P_R) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%AD_L_2_ExtLd_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_ExtLd_B,1), UBOUND(ModuleMapTypeData%AD_L_2_ExtLd_B,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%AD_L_2_ExtLd_B) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) @@ -39437,145 +44001,305 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_N + Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_N: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_N + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_N + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_N + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_TF: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_TF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_TF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_TF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_TF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_H: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_H + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_H + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_H + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BDED_L_2_ExtLd_P_B allocated yes/no + IF ( ALLOCATED(InData%BDED_L_2_ExtLd_P_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_ExtLd_P_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BDED_L_2_ExtLd_P_B,1), UBOUND(InData%BDED_L_2_ExtLd_P_B,1) + Int_BufSz = Int_BufSz + 3 ! BDED_L_2_ExtLd_P_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_ExtLd_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_N + IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_ExtLd_P_B Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_N + IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_ExtLd_P_B Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_N + IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_ExtLd_P_B Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! ExtLd_P_2_BDED_B allocated yes/no + IF ( ALLOCATED(InData%ExtLd_P_2_BDED_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ExtLd_P_2_BDED_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ExtLd_P_2_BDED_B,1), UBOUND(InData%ExtLd_P_2_BDED_B,1) + Int_BufSz = Int_BufSz + 3 ! ExtLd_P_2_BDED_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ExtLd_P_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF + IF(ALLOCATED(Re_Buf)) THEN ! ExtLd_P_2_BDED_B Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF + IF(ALLOCATED(Db_Buf)) THEN ! ExtLd_P_2_BDED_B Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF + IF(ALLOCATED(Int_Buf)) THEN ! ExtLd_P_2_BDED_B Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_TF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_L_2_ExtLd_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_ExtLd_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_ExtLd_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_TF + IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_ExtLd_P_T Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_TF + IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_ExtLd_P_T Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_TF + IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_ExtLd_P_T Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + Int_BufSz = Int_BufSz + 3 ! ExtLd_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%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ExtLd_P_2_ED_P_T 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 ! ExtLd_P_2_ED_P_T 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 ! ExtLd_P_2_ED_P_T 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 ! ExtLd_P_2_ED_P_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 + Int_BufSz = Int_BufSz + 1 ! ED_P_2_ExtLd_P_R allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_ExtLd_P_R) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_ExtLd_P_R upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_ExtLd_P_R,1), UBOUND(InData%ED_P_2_ExtLd_P_R,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_ExtLd_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_ExtLd_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_ExtLd_P_R 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 ! ED_P_2_ExtLd_P_R 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 ! ED_P_2_ExtLd_P_R 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 ! ED_P_2_ExtLd_P_R 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 + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_ExtLd_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_ExtLd_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_ExtLd_P_H 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 ! ED_P_2_ExtLd_P_H 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 ! ED_P_2_ExtLd_P_H 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 ! ED_P_2_ExtLd_P_H 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 + Int_BufSz = Int_BufSz + 1 ! AD_L_2_ExtLd_B allocated yes/no + IF ( ALLOCATED(InData%AD_L_2_ExtLd_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_ExtLd_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%AD_L_2_ExtLd_B,1), UBOUND(InData%AD_L_2_ExtLd_B,1) + Int_BufSz = Int_BufSz + 3 ! AD_L_2_ExtLd_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ExtLd_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ExtLd_B Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ExtLd_B Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ExtLd_B Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_H + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! AD_L_2_ExtLd_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ExtLd_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_H + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ExtLd_T Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_H + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ExtLd_T Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_H + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ExtLd_T Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -40488,18 +45212,476 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%ED_L_2_TStC_P_T) ) THEN + IF ( .NOT. ALLOCATED(InData%ED_L_2_TStC_P_T) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_TStC_P_T,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_TStC_P_T,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_TStC_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TStC_P_2_ED_P_T) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC_P_2_ED_P_T,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_P_2_ED_P_T,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_P_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ED_L_2_BStC_P_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) + DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_BStC_P_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BStC_P_2_ED_P_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) + DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_ED_P_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BD_L_2_BStC_P_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) + DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BStC_P_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BStC_P_2_BD_P_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) + DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_BD_P_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SStC_P_P_2_SubStructure) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC_P_P_2_SubStructure,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_P_P_2_SubStructure,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SStC_P_P_2_SubStructure,1), UBOUND(InData%SStC_P_P_2_SubStructure,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_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 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SubStructure_2_SStC_P_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SubStructure_2_SStC_P_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SubStructure_2_SStC_P_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SubStructure_2_SStC_P_P,1), UBOUND(InData%SubStructure_2_SStC_P_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_SStC_P_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_AD_L_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_TStC_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_TStC_P_T,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%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_TStC_P_T + 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 @@ -40529,18 +45711,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%TStC_P_2_ED_P_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC_P_2_ED_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_P_2_ED_P_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_P_2_ED_P_T + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40568,24 +45739,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%ED_L_2_BStC_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_BStC_P_B + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40613,25 +45767,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_ED_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_ED_P_B + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40659,25 +45795,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BStC_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BStC_P_B + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40705,25 +45823,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_BD_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_BD_P_B + CALL 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 @@ -40751,21 +45851,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC_P_P_2_SubStructure) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC_P_P_2_SubStructure,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_P_P_2_SubStructure,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC_P_P_2_SubStructure,1), UBOUND(InData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_SubStructure + 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 @@ -40793,20 +45879,18 @@ 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%SubStructure_2_SStC_P_P) ) THEN + 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%SubStructure_2_SStC_P_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SubStructure_2_SStC_P_P,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%SubStructure_2_SStC_P_P,1), UBOUND(InData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_SStC_P_P + 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 @@ -40836,7 +45920,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_P + CALL 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 @@ -40864,18 +45948,7 @@ 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 - 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 NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40903,20 +45976,18 @@ 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%AD_L_2_BDED_B) ) THEN + IF ( .NOT. ALLOCATED(InData%BDED_L_2_ExtLd_P_B) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_ExtLd_P_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_ExtLd_P_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 + DO i1 = LBOUND(InData%BDED_L_2_ExtLd_P_B,1), UBOUND(InData%BDED_L_2_ExtLd_P_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_ExtLd_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40946,18 +46017,18 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN + IF ( .NOT. ALLOCATED(InData%ExtLd_P_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%BD_L_2_BD_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%ExtLd_P_2_BDED_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExtLd_P_2_BDED_B,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 + DO i1 = LBOUND(InData%ExtLd_P_2_BDED_B,1), UBOUND(InData%ExtLd_P_2_BDED_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! ExtLd_P_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40987,7 +46058,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_ExtLd_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41015,7 +46086,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_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_N + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ExtLd_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41043,63 +46114,18 @@ 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_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%ED_P_2_ExtLd_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_ExtLd_P_R,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_ExtLd_P_R,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 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 + DO i1 = LBOUND(InData%ED_P_2_ExtLd_P_R,1), UBOUND(InData%ED_P_2_ExtLd_P_R,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_ExtLd_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_ExtLd_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41127,7 +46153,9 @@ 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 + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_ExtLd_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41155,18 +46183,18 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + IF ( .NOT. ALLOCATED(InData%AD_L_2_ExtLd_B) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_ExtLd_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_ExtLd_B,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 + DO i1 = LBOUND(InData%AD_L_2_ExtLd_B,1), UBOUND(InData%AD_L_2_ExtLd_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ExtLd_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41196,35 +46224,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_H + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ExtLd_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42190,7 +47190,423 @@ 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_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_PRP_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) ! SubStructure_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_SubStructure, ErrStat2, ErrMsg2 ) ! HD_W_P_2_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SubStructure_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_SubStructure, ErrStat2, ErrMsg2 ) ! HD_M_P_2_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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) ! Structure_2_Mooring + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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_2_Structure, ErrStat2, ErrMsg2 ) ! Mooring_2_Structure + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_NStC_P_N not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_NStC_P_N)) DEALLOCATE(OutData%ED_P_2_NStC_P_N) + ALLOCATE(OutData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_NStC_P_N,1), UBOUND(OutData%ED_P_2_NStC_P_N,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_NStC_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42199,6 +47615,20 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC_P_2_ED_P_N not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NStC_P_2_ED_P_N)) DEALLOCATE(OutData%NStC_P_2_ED_P_N) + ALLOCATE(OutData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NStC_P_2_ED_P_N,1), UBOUND(OutData%NStC_P_2_ED_P_N,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42232,53 +47662,29 @@ 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_HD_PRP_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_W_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) ! NStC_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_L_2_TStC_P_T not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_L_2_TStC_P_T)) DEALLOCATE(OutData%ED_L_2_TStC_P_T) + ALLOCATE(OutData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_L_2_TStC_P_T,1), UBOUND(OutData%ED_L_2_TStC_P_T,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42312,13 +47718,29 @@ 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_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_W_P_2_SubStructure + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) ! ED_L_2_TStC_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC_P_2_ED_P_T not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TStC_P_2_ED_P_T)) DEALLOCATE(OutData%TStC_P_2_ED_P_T) + ALLOCATE(OutData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TStC_P_2_ED_P_T,1), UBOUND(OutData%TStC_P_2_ED_P_T,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42352,13 +47774,33 @@ 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%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_M_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) ! TStC_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_L_2_BStC_P_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_L_2_BStC_P_B)) DEALLOCATE(OutData%ED_L_2_BStC_P_B) + ALLOCATE(OutData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%ED_L_2_BStC_P_B,2), UBOUND(OutData%ED_L_2_BStC_P_B,2) + DO i1 = LBOUND(OutData%ED_L_2_BStC_P_B,1), UBOUND(OutData%ED_L_2_BStC_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42392,13 +47834,34 @@ 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_SubStructure, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SubStructure + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! ED_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_ED_P_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BStC_P_2_ED_P_B)) DEALLOCATE(OutData%BStC_P_2_ED_P_B) + ALLOCATE(OutData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BStC_P_2_ED_P_B,2), UBOUND(OutData%BStC_P_2_ED_P_B,2) + DO i1 = LBOUND(OutData%BStC_P_2_ED_P_B,1), UBOUND(OutData%BStC_P_2_ED_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42432,13 +47895,34 @@ 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%Structure_2_Mooring, ErrStat2, ErrMsg2 ) ! Structure_2_Mooring + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_ED_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BStC_P_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BD_L_2_BStC_P_B)) DEALLOCATE(OutData%BD_L_2_BStC_P_B) + ALLOCATE(OutData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BD_L_2_BStC_P_B,2), UBOUND(OutData%BD_L_2_BStC_P_B,2) + DO i1 = LBOUND(OutData%BD_L_2_BStC_P_B,1), UBOUND(OutData%BD_L_2_BStC_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42472,13 +47956,34 @@ 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%Mooring_2_Structure, ErrStat2, ErrMsg2 ) ! Mooring_2_Structure + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BD_L_2_BStC_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_BD_P_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BStC_P_2_BD_P_B)) DEALLOCATE(OutData%BStC_P_2_BD_P_B) + ALLOCATE(OutData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BStC_P_2_BD_P_B,2), UBOUND(OutData%BStC_P_2_BD_P_B,2) + DO i1 = LBOUND(OutData%BStC_P_2_BD_P_B,1), UBOUND(OutData%BStC_P_2_BD_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42512,13 +48017,30 @@ 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_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_BD_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC_P_P_2_SubStructure not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SStC_P_P_2_SubStructure)) DEALLOCATE(OutData%SStC_P_P_2_SubStructure) + ALLOCATE(OutData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SStC_P_P_2_SubStructure,1), UBOUND(OutData%SStC_P_P_2_SubStructure,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42552,27 +48074,29 @@ 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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_NStC_P_N not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SubStructure_2_SStC_P_P not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_NStC_P_N)) DEALLOCATE(OutData%ED_P_2_NStC_P_N) - ALLOCATE(OutData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%SubStructure_2_SStC_P_P)) DEALLOCATE(OutData%SubStructure_2_SStC_P_P) + ALLOCATE(OutData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ED_P_2_NStC_P_N,1), UBOUND(OutData%ED_P_2_NStC_P_N,1) + DO i1 = LBOUND(OutData%SubStructure_2_SStC_P_P,1), UBOUND(OutData%SubStructure_2_SStC_P_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42606,7 +48130,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_NStC_P_N(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_NStC_P_N + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! SubStructure_2_SStC_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42615,20 +48139,6 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC_P_2_ED_P_N not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC_P_2_ED_P_N)) DEALLOCATE(OutData%NStC_P_2_ED_P_N) - ALLOCATE(OutData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC_P_2_ED_P_N,1), UBOUND(OutData%NStC_P_2_ED_P_N,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42662,29 +48172,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%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) ! NStC_P_2_ED_P_N + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_L_2_TStC_P_T not allocated + 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%ED_L_2_TStC_P_T)) DEALLOCATE(OutData%ED_L_2_TStC_P_T) - ALLOCATE(OutData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) + IF (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%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ED_L_2_TStC_P_T,1), UBOUND(OutData%ED_L_2_TStC_P_T,1) + 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 @@ -42718,7 +48226,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_TStC_P_T(i1), ErrStat2, ErrMsg2 ) ! ED_L_2_TStC_P_T + 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 @@ -42727,20 +48235,20 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC_P_2_ED_P_T not allocated + 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%TStC_P_2_ED_P_T)) DEALLOCATE(OutData%TStC_P_2_ED_P_T) - ALLOCATE(OutData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) + IF (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%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%TStC_P_2_ED_P_T,1), UBOUND(OutData%TStC_P_2_ED_P_T,1) + 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 @@ -42774,7 +48282,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%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) ! TStC_P_2_ED_P_T + 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 @@ -42783,24 +48291,20 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_L_2_BStC_P_B not allocated + 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_L_2_BStC_P_B)) DEALLOCATE(OutData%ED_L_2_BStC_P_B) - ALLOCATE(OutData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (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%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%ED_L_2_BStC_P_B,2), UBOUND(OutData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%ED_L_2_BStC_P_B,1), UBOUND(OutData%ED_L_2_BStC_P_B,1) + 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 @@ -42834,7 +48338,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_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! ED_L_2_BStC_P_B + 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 @@ -42842,26 +48346,7 @@ SUBROUTINE FAST_UnPackModuleMapType( 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 ! BStC_P_2_ED_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_P_2_ED_P_B)) DEALLOCATE(OutData%BStC_P_2_ED_P_B) - ALLOCATE(OutData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_P_2_ED_P_B,2), UBOUND(OutData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_ED_P_B,1), UBOUND(OutData%BStC_P_2_ED_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42895,34 +48380,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%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_ED_P_B + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BStC_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BStC_P_B)) DEALLOCATE(OutData%BD_L_2_BStC_P_B) - ALLOCATE(OutData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BD_L_2_BStC_P_B,2), UBOUND(OutData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%BD_L_2_BStC_P_B,1), UBOUND(OutData%BD_L_2_BStC_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42956,34 +48420,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_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BD_L_2_BStC_P_B + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_N CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_BD_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_P_2_BD_P_B)) DEALLOCATE(OutData%BStC_P_2_BD_P_B) - ALLOCATE(OutData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_P_2_BD_P_B,2), UBOUND(OutData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_BD_P_B,1), UBOUND(OutData%BStC_P_2_BD_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43017,30 +48460,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%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_BD_P_B + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC_P_P_2_SubStructure not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC_P_P_2_SubStructure)) DEALLOCATE(OutData%SStC_P_P_2_SubStructure) - ALLOCATE(OutData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_P_P_2_SubStructure,1), UBOUND(OutData%SStC_P_P_2_SubStructure,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43074,29 +48500,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%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_SubStructure + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_TF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SubStructure_2_SStC_P_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SubStructure_2_SStC_P_P)) DEALLOCATE(OutData%SubStructure_2_SStC_P_P) - ALLOCATE(OutData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SubStructure_2_SStC_P_P,1), UBOUND(OutData%SubStructure_2_SStC_P_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43130,15 +48540,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%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! SubStructure_2_SStC_P_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43172,27 +48580,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%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_P + 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 ! BDED_L_2_AD_L_B not allocated + 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%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 (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%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', 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) + 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 @@ -43226,7 +48634,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%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + 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 @@ -43235,20 +48643,6 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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 @@ -43282,29 +48676,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 NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - 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 @@ -43338,15 +48716,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%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_ExtLd_P_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BDED_L_2_ExtLd_P_B)) DEALLOCATE(OutData%BDED_L_2_ExtLd_P_B) + ALLOCATE(OutData%BDED_L_2_ExtLd_P_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_ExtLd_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BDED_L_2_ExtLd_P_B,1), UBOUND(OutData%BDED_L_2_ExtLd_P_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43380,13 +48770,29 @@ 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_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_ExtLd_P_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExtLd_P_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%ExtLd_P_2_BDED_B)) DEALLOCATE(OutData%ExtLd_P_2_BDED_B) + ALLOCATE(OutData%ExtLd_P_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExtLd_P_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ExtLd_P_2_BDED_B,1), UBOUND(OutData%ExtLd_P_2_BDED_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43420,13 +48826,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%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_N + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! ExtLd_P_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43460,7 +48868,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_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_ExtLd_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_ExtLd_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43500,13 +48908,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%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_TF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! ExtLd_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_ExtLd_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_ExtLd_P_R)) DEALLOCATE(OutData%ED_P_2_ExtLd_P_R) + ALLOCATE(OutData%ED_P_2_ExtLd_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_ExtLd_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_ExtLd_P_R,1), UBOUND(OutData%ED_P_2_ExtLd_P_R,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43540,13 +48962,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%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_ExtLd_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_ExtLd_P_R CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43580,27 +49004,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%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_ExtLd_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_ExtLd_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%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 (ALLOCATED(OutData%AD_L_2_ExtLd_B)) DEALLOCATE(OutData%AD_L_2_ExtLd_B) + ALLOCATE(OutData%AD_L_2_ExtLd_B(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) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_ExtLd_B.', 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) + DO i1 = LBOUND(OutData%AD_L_2_ExtLd_B,1), UBOUND(OutData%AD_L_2_ExtLd_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -43634,7 +49058,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_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_ExtLd_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -43676,47 +49100,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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_H + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ExtLd_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ExtLd_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -45426,6 +50810,12 @@ SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrSta CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL ExtLd_CopyInitInput( SrcInitDataData%InData_ExtLd, DstInitDataData%InData_ExtLd, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtLd_CopyInitOutput( SrcInitDataData%OutData_ExtLd, DstInitDataData%OutData_ExtLd, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -45546,6 +50936,10 @@ SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg, DEALLOCATEpointe CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ExtLd_DestroyInitInput( InitDataData%InData_ExtLd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ExtLd_DestroyInitOutput( InitDataData%OutData_ExtLd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) @@ -45808,6 +51202,40 @@ SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! InData_ExtLd: size of buffers for each call to pack subtype + CALL ExtLd_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtLd, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtLd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtLd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtLd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_ExtLd: size of buffers for each call to pack subtype + CALL ExtLd_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtLd, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtLd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtLd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtLd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -46512,6 +51940,62 @@ SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtLd_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtLd, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtLd_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtLd, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -47650,6 +53134,86 @@ SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtLd_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtLd, ErrStat2, ErrMsg2 ) ! InData_ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtLd_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtLd, ErrStat2, ErrMsg2 ) ! OutData_ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -48671,6 +54235,14 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType + DstExternInitTypeData%DTdriver = SrcExternInitTypeData%DTdriver + DstExternInitTypeData%TwrAero = SrcExternInitTypeData%TwrAero + DstExternInitTypeData%az_blend_mean = SrcExternInitTypeData%az_blend_mean + DstExternInitTypeData%az_blend_delta = SrcExternInitTypeData%az_blend_delta + DstExternInitTypeData%vel_mean = SrcExternInitTypeData%vel_mean + DstExternInitTypeData%wind_dir = SrcExternInitTypeData%wind_dir + DstExternInitTypeData%z_ref = SrcExternInitTypeData%z_ref + DstExternInitTypeData%shear_exp = SrcExternInitTypeData%shear_exp END SUBROUTINE FAST_CopyExternInitType SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -48764,6 +54336,14 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower Int_BufSz = Int_BufSz + 1 ! NodeClusterType + Db_BufSz = Db_BufSz + 1 ! DTdriver + Int_BufSz = Int_BufSz + 1 ! TwrAero + Re_BufSz = Re_BufSz + 1 ! az_blend_mean + Re_BufSz = Re_BufSz + 1 ! az_blend_delta + Re_BufSz = Re_BufSz + 1 ! vel_mean + Re_BufSz = Re_BufSz + 1 ! wind_dir + Re_BufSz = Re_BufSz + 1 ! z_ref + Re_BufSz = Re_BufSz + 1 ! shear_exp IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -48865,6 +54445,22 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NodeClusterType Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTdriver + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%az_blend_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%az_blend_delta + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%vel_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wind_dir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z_ref + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%shear_exp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FAST_PackExternInitType SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -48982,6 +54578,22 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = Int_Xferred + 1 OutData%NodeClusterType = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%DTdriver = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%az_blend_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%az_blend_delta = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%vel_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wind_dir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z_ref = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%shear_exp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FAST_UnPackExternInitType SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -49026,6 +54638,9 @@ SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCod CALL FAST_Copyaerodyn14_data( SrcTurbineTypeData%AD14, DstTurbineTypeData%AD14, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FAST_Copyextloads_data( SrcTurbineTypeData%ExtLd, DstTurbineTypeData%ExtLd, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL FAST_Copyinflowwind_data( SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -49106,6 +54721,8 @@ SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg, DEALLOCATE CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL FAST_Destroyaerodyn14_data( TurbineTypeData%AD14, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL FAST_Destroyextloads_data( TurbineTypeData%ExtLd, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL FAST_Destroyinflowwind_data( TurbineTypeData%IfW, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL FAST_Destroyexternalinflow_data( TurbineTypeData%ExtInfw, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) @@ -49324,6 +54941,23 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! ExtLd: size of buffers for each call to pack subtype + CALL FAST_Packextloads_data( Re_Buf, Db_Buf, Int_Buf, InData%ExtLd, ErrStat2, ErrMsg2, .TRUE. ) ! ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ExtLd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ExtLd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ExtLd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype CALL FAST_Packinflowwind_data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -49802,6 +55436,34 @@ SUBROUTINE FAST_PackTurbineType( 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 FAST_Packextloads_data( Re_Buf, Db_Buf, Int_Buf, InData%ExtLd, ErrStat2, ErrMsg2, OnlySize ) ! ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -50577,6 +56239,46 @@ SUBROUTINE FAST_UnPackTurbineType( 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 FAST_Unpackextloads_data( Re_Buf, Db_Buf, Int_Buf, OutData%ExtLd, ErrStat2, ErrMsg2 ) ! ExtLd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) From d34deab4af29ec0cac9e5709eaa1b1e1f24b4c8b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 13 Jul 2023 13:09:57 +0000 Subject: [PATCH 002/232] Install libnetcdf-dev in GH Actions This library is needed by openfastcpplib --- .github/workflows/automated-dev-tests.yml | 30 +++++++++++------------ 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index f8e2b398c0..8324591a0d 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -166,7 +166,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev # gcovr + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev # gcovr - name: Setup workspace run: cmake -E make_directory ${{runner.workspace}}/openfast/build - name: Configure build @@ -216,7 +216,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Build OpenFAST C-Interfaces working-directory: ${{runner.workspace}}/openfast/build run: | @@ -247,7 +247,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Build OpenFAST glue-code working-directory: ${{runner.workspace}}/openfast/build run: | @@ -278,7 +278,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Build FAST.Farm working-directory: ${{runner.workspace}}/openfast/build run: | @@ -370,7 +370,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Run AeroDyn tests uses: ./.github/actions/tests-module-aerodyn with: @@ -419,7 +419,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -478,7 +478,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" vtk sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Run Interface / API tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -517,7 +517,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -564,7 +564,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -608,7 +608,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -652,7 +652,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -696,7 +696,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -740,7 +740,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -784,7 +784,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | @@ -828,7 +828,7 @@ jobs: python -m pip install --upgrade pip pip install numpy "Bokeh>=2.4,!=3.0.0,!=3.0.1,!=3.0.2,!=3.0.3" sudo apt-get update -y - sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev + sudo apt-get install -y libhdf5-dev libnetcdf-dev libopenmpi-dev libyaml-cpp-dev - name: Configure Tests working-directory: ${{runner.workspace}}/openfast/build run: | From b4ac67a953e1a785feaa0df50260f0f051127349 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 13 Jul 2023 16:25:03 +0000 Subject: [PATCH 003/232] Disable C++ regression test until it is updated --- reg_tests/CTestList.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 428b149b41..6267db9b3c 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -294,7 +294,7 @@ of_regression("MHK_RM1_Floating" "openfast;elastodyn;aerod # OpenFAST C++ API test if(BUILD_OPENFAST_CPP_API) - of_cpp_interface_regression("5MW_Land_DLL_WTurb_cpp" "openfast;fastlib;cpp") + # of_cpp_interface_regression("5MW_Land_DLL_WTurb_cpp" "openfast;fastlib;cpp") endif() # OpenFAST C++ Driver test for OpenFAST Library From eed049168e17dcd1827c5ff94de929350d6b331f Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 14 Jul 2023 16:56:50 -0600 Subject: [PATCH 004/232] Fix FAST_Library.f90 after rebasing onto the update ExtInflow (from dev) --- modules/openfast-library/src/FAST_Library.f90 | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 9977338aa0..38b93fa258 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -728,8 +728,15 @@ subroutine FAST_AL_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, NumBlElem_c = Turbine(iTurb)%AD14%Input(1)%InputMarkers(1)%Nnodes NumTwrElem_c = 0 ! Don't care about Aerodyn14 anymore ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN - NumBl_c = SIZE(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion) - NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes + IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors)) THEN + IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion)) THEN + NumBl_c = SIZE(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion) + END IF + END IF + IF (NumBl_c > 0) THEN + NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes + END IF +!FIXME: need some checks on this. If the Tower mesh is not initialized, this will be garbage NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes ELSE NumBl_c = 0 @@ -1030,15 +1037,12 @@ subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Ou ExtInfw_Input_from_FAST%pxVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxVel_Len; ExtInfw_Input_from_FAST%pxVel = Turbine(iTurb)%ExtInfw%u%c_obj%pxVel ExtInfw_Input_from_FAST%pyVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyVel_Len; ExtInfw_Input_from_FAST%pyVel = Turbine(iTurb)%ExtInfw%u%c_obj%pyVel ExtInfw_Input_from_FAST%pzVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzVel_Len; ExtInfw_Input_from_FAST%pzVel = Turbine(iTurb)%ExtInfw%u%c_obj%pzVel - ExtInfw_Input_from_FAST%pxDotVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotVel_Len; ExtInfw_Input_from_FAST%pxDotVel = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotVel - ExtInfw_Input_from_FAST%pyDotVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotVel_Len; ExtInfw_Input_from_FAST%pyDotVel = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotVel - ExtInfw_Input_from_FAST%pzDotVel_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotVel_Len; ExtInfw_Input_from_FAST%pzDotVel = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotVel ExtInfw_Input_from_FAST%pxForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxForce_Len; ExtInfw_Input_from_FAST%pxForce = Turbine(iTurb)%ExtInfw%u%c_obj%pxForce ExtInfw_Input_from_FAST%pyForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyForce_Len; ExtInfw_Input_from_FAST%pyForce = Turbine(iTurb)%ExtInfw%u%c_obj%pyForce ExtInfw_Input_from_FAST%pzForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzForce_Len; ExtInfw_Input_from_FAST%pzForce = Turbine(iTurb)%ExtInfw%u%c_obj%pzForce - ExtInfw_Input_from_FAST%pxDotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotForce_Len; ExtInfw_Input_from_FAST%pxDotForce = Turbine(iTurb)%ExtInfw%u%c_obj%pxDotForce - ExtInfw_Input_from_FAST%pyDotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotForce_Len; ExtInfw_Input_from_FAST%pyDotForce = Turbine(iTurb)%ExtInfw%u%c_obj%pyDotForce - ExtInfw_Input_from_FAST%pzDotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotForce_Len; ExtInfw_Input_from_FAST%pzDotForce = Turbine(iTurb)%ExtInfw%u%c_obj%pzDotForce + ExtInfw_Input_from_FAST%xdotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%xdotForce_Len; ExtInfw_Input_from_FAST%xdotForce = Turbine(iTurb)%ExtInfw%u%c_obj%xdotForce + ExtInfw_Input_from_FAST%ydotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%ydotForce_Len; ExtInfw_Input_from_FAST%ydotForce = Turbine(iTurb)%ExtInfw%u%c_obj%ydotForce + ExtInfw_Input_from_FAST%zdotForce_Len = Turbine(iTurb)%ExtInfw%u%c_obj%zdotForce_Len; ExtInfw_Input_from_FAST%zdotForce = Turbine(iTurb)%ExtInfw%u%c_obj%zdotForce ExtInfw_Input_from_FAST%pOrientation_Len = Turbine(iTurb)%ExtInfw%u%c_obj%pOrientation_Len; ExtInfw_Input_from_FAST%pOrientation = Turbine(iTurb)%ExtInfw%u%c_obj%pOrientation ExtInfw_Input_from_FAST%fx_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fx_Len; ExtInfw_Input_from_FAST%fx = Turbine(iTurb)%ExtInfw%u%c_obj%fx ExtInfw_Input_from_FAST%fy_Len = Turbine(iTurb)%ExtInfw%u%c_obj%fy_Len; ExtInfw_Input_from_FAST%fy = Turbine(iTurb)%ExtInfw%u%c_obj%fy @@ -1047,7 +1051,6 @@ subroutine SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Ou ExtInfw_Input_from_FAST%momenty_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momenty_Len; ExtInfw_Input_from_FAST%momenty = Turbine(iTurb)%ExtInfw%u%c_obj%momenty ExtInfw_Input_from_FAST%momentz_Len = Turbine(iTurb)%ExtInfw%u%c_obj%momentz_Len; ExtInfw_Input_from_FAST%momentz = Turbine(iTurb)%ExtInfw%u%c_obj%momentz ExtInfw_Input_from_FAST%forceNodesChord_Len = Turbine(iTurb)%ExtInfw%u%c_obj%forceNodesChord_Len; ExtInfw_Input_from_FAST%forceNodesChord = Turbine(iTurb)%ExtInfw%u%c_obj%forceNodesChord - ExtInfw_Input_from_FAST%forceRHloc_Len = Turbine(iTurb)%ExtInfw%u%c_obj%forceRHloc_Len; ExtInfw_Input_from_FAST%forceRHloc = Turbine(iTurb)%ExtInfw%u%c_obj%forceRHloc if (Turbine(iTurb)%p_FAST%UseSC) then SC_DX_Input_from_FAST%toSC_Len = Turbine(iTurb)%SC_DX%u%c_obj%toSC_Len From b46e9bdab2253397b1e5ad0609b941cb92841401 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 30 Oct 2023 11:58:37 -0600 Subject: [PATCH 005/232] Cleanup HD InitInputs and some VS build projects - removed PointsToSeaState (still need to fix some more pointers, though) - removed InitInp PtfmLocationX and Y from HD since it's used in SeaState - cleaned up some VS projects related to SeaSt/HD --- modules/hydrodyn/src/HydroDyn.f90 | 3 -- modules/hydrodyn/src/HydroDyn.txt | 47 +++++++++---------- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 12 ++--- modules/hydrodyn/src/HydroDyn_Types.f90 | 15 ------ modules/hydrodyn/src/Morison.f90 | 12 ++--- modules/openfast-library/src/FAST_Subs.f90 | 2 - modules/seastate/src/SeaSt_WaveField.f90 | 4 +- .../HydroDyn_c_binding.vfproj | 36 -------------- 8 files changed, 36 insertions(+), 95 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 3aedc321d5..ebcf348611 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -143,7 +143,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ErrStat = ErrID_None ErrMsg = "" p%UnOutFile = -1 !bjj: this was being written to the screen when I had an error in my HD input file, so I'm going to initialize here. - p%PointsToSeaState = .true. ! this should be true unless we are initializing from restart (in a different driver/routine) #ifdef BETA_BUILD CALL DispBetaNotice( "This is a beta version of HydroDyn and is for testing purposes only."//NewLine//"This version includes user waves, WaveMod=6 and the ability to write example user waves." ) @@ -952,8 +951,6 @@ SUBROUTINE HydroDyn_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! Destroy the parameter data: (ignore errors) - ! Need to nullify pointers so that SeaState module data is not deallocated by HD (i.e., use DEALLOCATEpointers=.false. when it points to SeaState data) - ! on restart, the data is a separate copy of the SeaState module data, hence the PointsToSeaState parameter CALL HydroDyn_DestroyParam( p, ErrStat2, ErrMsg2 ) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 7404e94a7e..b31d0de887 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -76,32 +76,30 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi WtrDpth - - - "Water depth from the driver; may be overwritten " "m" typedef ^ ^ ReKi MSL2SWL - - - "Mean sea level to still water level from the driver; may be overwritten" "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" -typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" -typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # -typedef ^ ^ INTEGER NStepWave - 0 - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - -typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - -typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - -typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - -typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) -typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) -typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) -typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ INTEGER NStepWave - 0 - "Total number of frequency components = total number of time steps in the incident wave" - +typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - +typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - +typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - +typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - +typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - +typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) +typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) +typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) +typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) +typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - +typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) +typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # # Define outputs from the initialization routine here: @@ -196,7 +194,6 @@ typedef ^ ^ Integer typedef ^ ^ R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" - typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" - typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType LOGICAL PointsToSeaState - .TRUE. - "Flag that determines if the data contains pointers to SeaState module or if new copies (from restart)" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # # diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 287a45116b..d3eae7b327 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -353,6 +353,12 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, SeaSt%InitInp%defMSL2SWL = REAL(defMSL2SWL_C, ReKi) ! use values from SeaState SeaSt%InitInp%TMax = REAL(TMax_C, DbKi) + ! Platform reference position + ! This is only specified as an (X,Y) position (no Z). + SeaSt%InitInp%PtfmLocationX = REAL(PtfmRefPtPositionX_C, ReKi) + SeaSt%InitInp%PtfmLocationY = REAL(PtfmRefPtPositionY_C, ReKi) + + ! Wave elevation output ! Wave elevations can be exported for a set of points (grid or any other layout). ! This feature is used only in the driver codes for exporting for visualization @@ -428,12 +434,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, if(associated(SeaSt%InitOutData%WaveField )) HD%InitInp%WaveField => SeaSt%InitOutData%WaveField - ! Platform reference position - ! The HD model uses this for building the moddel. This is only specified as an (X,Y) - ! position (no Z). - HD%InitInp%PtfmLocationX = REAL(PtfmRefPtPositionX_C, ReKi) - HD%InitInp%PtfmLocationY = REAL(PtfmRefPtPositionY_C, ReKi) - !------------------------------------------------------------- ! Call the main subroutine HydroDyn_Init diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 8f650ed9a4..44a8dc180a 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -93,8 +93,6 @@ MODULE HydroDyn_Types REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth from the driver; may be overwritten [m] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level from the driver; may be overwritten [m] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] - REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] @@ -215,7 +213,6 @@ MODULE HydroDyn_Types 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 = 0_IntKi !< number of outputs in jacobian matrix [-] - LOGICAL :: PointsToSeaState = .TRUE. !< Flag that determines if the data contains pointers to SeaState module or if new copies (from restart) [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE HydroDyn_ParameterType ! ======================= @@ -906,8 +903,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL DstInitInputData%TMax = SrcInitInputData%TMax - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 @@ -991,8 +986,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, InData%TMax) - call RegPack(Buf, InData%PtfmLocationX) - call RegPack(Buf, InData%PtfmLocationY) call RegPack(Buf, InData%VisMeshes) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -1062,10 +1055,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmLocationX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmLocationY) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%VisMeshes) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) @@ -2350,7 +2339,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%dx = SrcParamData%dx end if DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState DstParamData%VisMeshes = SrcParamData%VisMeshes end subroutine @@ -2518,7 +2506,6 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%dx) end if call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%PointsToSeaState) call RegPack(Buf, InData%VisMeshes) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2744,8 +2731,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) end if call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PointsToSeaState) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%VisMeshes) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index cdd6f63966..3a4cf2a82e 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2324,7 +2324,7 @@ subroutine VisMeshSetup(u,p,y,m,InitOut,ErrStat,ErrMsg) Pos1=u%Mesh%Position(:,p%Members(iMem)%NodeIndx(1)) ! start node position of member Pos2=u%Mesh%Position(:,p%Members(iMem)%NodeIndx(size(p%Members(iMem)%NodeIndx))) ! end node position of member Theta(1) = 0.0_R8Ki ! roll (assumed since insufficient info) - Theta(2) = acos(real((Pos2(3)-Pos1(3))/norm2(Pos2-Pos1),R8Ki)) ! pitch + Theta(2) = acos(real((Pos2(3)-Pos1(3))/TwoNorm(Pos2-Pos1),R8Ki)) ! pitch Theta(3) = atan2(real(Pos2(2)-Pos1(2),R8Ki),real(Pos2(1)-Pos1(1),R8Ki)) ! yaw MemberOrient=EulerConstructZYX(Theta) ! yaw-pitch-roll sequence @@ -2867,7 +2867,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/posMid(1),posMid(2),ZetaMid/) ! Reference point on the free surface ELSE - FSPt = (/posMid(1),posMid(2),0.0/) + FSPt = (/posMid(1),posMid(2),0.0_ReKi/) n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat, y_hat, z_hat ) @@ -3485,7 +3485,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos1(1),pos1(2),Zeta1/) ! Reference point on the free surface ELSE - FSPt = (/pos1(1),pos1(2),0.0/) + FSPt = (/pos1(1),pos1(2),0.0_ReKi/) n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat1, y_hat, z_hat ) @@ -3506,7 +3506,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface ELSE - FSPt = (/pos2(1),pos2(2),0.0/) + FSPt = (/pos2(1),pos2(2),0.0_ReKi/) n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat2, y_hat, z_hat ) @@ -3528,7 +3528,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface ELSE - FSPt = (/pos2(1),pos2(2),0.0/) + FSPt = (/pos2(1),pos2(2),0.0_ReKi/) n_hat = (/0.0,0.0,1.0/) END IF CALL GetSectionUnitVectors( k_hat2, y_hat, z_hat ) @@ -3696,7 +3696,7 @@ SUBROUTINE GetSectionUnitVectors( k, y, z ) IF ( ABS(k(3)) > 0.999999_ReKi ) THEN ! k is effectively vertical y = (/0.0,1.0,0.0/) ELSE - y = (/-k(2),k(1),0.0/) + y = (/-k(2),k(1),0.0_ReKi/) y = y / SQRT(Dot_Product(y,y)) ENDIF z = cross_product(k,y) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 8da17998e8..9992169f77 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7757,8 +7757,6 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb ! deal with sibling meshes here: ! (ignoring for now; they are not going to be siblings on restart) - Turbine%HD%p%PointsToSeaState = .false. ! since the pointers aren't pointing to the same data as SeaState after restart, set this to avoid memory leaks and deallocation problems - ! deal with files that were open: IF (Turbine%p_FAST%WrTxtOutFile) THEN CALL OpenFunkFileAppend ( Turbine%y_FAST%UnOu, TRIM(Turbine%p_FAST%OutFileRoot)//'.out', ErrStat2, ErrMsg2) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index c33c053aaf..74b40cbefd 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -85,7 +85,7 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeTotalWaveElev REAL(SiKi) :: Zeta1, Zeta2 - LOGICAL :: FirstWarn_Clamp + !LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeTotalWaveElev' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -118,7 +118,7 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, Time, pos, r, n, ErrStat, Err ErrStat = ErrID_None ErrMsg = "" - r1 = MAX(r,1.0e-6) ! In case r is zero + r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index e7464b083b..7bcec48d49 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -208,42 +208,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - From 1d1a6f060f9ccbdb230f2bec0ecd61b726603d49 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 30 Oct 2023 14:02:02 -0600 Subject: [PATCH 006/232] SeaSt/HD: remove extra copies of `WaveTime` This is already stored in the WaveField type, so doesn't need extra copies. --- modules/hydrodyn/src/HydroDyn.f90 | 14 ++-- modules/hydrodyn/src/HydroDyn.txt | 2 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 65 +++++++++--------- modules/hydrodyn/src/WAMIT.f90 | 7 -- modules/openfast-library/src/FAST_Subs.f90 | 2 +- modules/seastate/src/SeaState.f90 | 14 ++-- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_DriverCode.f90 | 4 +- modules/seastate/src/SeaState_Types.f90 | 70 -------------------- modules/seastate/src/UserWaves.f90 | 2 +- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 35 ---------- modules/seastate/src/Waves_Types.f90 | 35 ---------- 14 files changed, 46 insertions(+), 208 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index ebcf348611..b3baa45f97 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -273,8 +273,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy Waves initialization output into the initialization input type for the WAMIT module !p%NWaveElev = InputFileData%Waves%NWaveElev p%NStepWave = InitInp%NStepWave - - p%WaveTime => InitInp%WaveField%WaveTime + p%WaveField => InitInp%WaveField m%LastIndWave = 1 @@ -370,7 +369,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! CALL MOVE_ALLOC( InitInp%WaveElevC, InputFileData%WAMIT%WaveElevC ) ! Temporarily move arrays to init input for WAMIT (save some space) - InputFileData%WAMIT%WaveTime => InitInp%WaveField%WaveTime + InputFileData%WAMIT%WaveTime => p%WaveField%WaveTime InputFileData%WAMIT%WaveElev0 => InitInp%WaveField%WaveElev0 InputFileData%WAMIT%WaveElevC => InitInp%WaveField%WaveElevC InputFileData%WAMIT%WaveElevC0 => InitInp%WaveField%WaveElevC0 @@ -442,7 +441,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%WAMIT2used = .TRUE. ! init input for WAMIT2 pointers to save space - !InputFileData%WAMIT2%WaveTime => InitInp%WaveTime ! This isn't actually used within WAMIT2 GJH 9/30/2021 InputFileData%WAMIT2%WaveElevC0 => InitInp%WaveField%WaveElevC0 InputFileData%WAMIT2%WaveDirArr => InitInp%WaveField%WaveDirArr @@ -1300,7 +1298,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) if ( ErrStat >= AbortErrLev ) return - call WAMIT_CalcOutput( Time, p%WaveTime, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & + call WAMIT_CalcOutput( Time, p%WaveField%WaveTime, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & z%WAMIT, OtherState%WAMIT(1), y%WAMIT(1), m%WAMIT(1), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) do iBody=1,p%NBody @@ -1321,7 +1319,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, m%u_WAMIT(iBody)%Mesh%TranslationAcc (:,1) = u%WAMITMesh%TranslationAcc (:,iBody) m%u_WAMIT(iBody)%Mesh%RotationAcc (:,1) = u%WAMITMesh%RotationAcc (:,iBody) - call WAMIT_CalcOutput( Time, p%WaveTime, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & + call WAMIT_CalcOutput( Time, p%WaveField%WaveTime, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & z%WAMIT, OtherState%WAMIT(iBody), y%WAMIT(iBody), m%WAMIT(iBody), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT(iBody)%Mesh%Force (:,1) @@ -1342,7 +1340,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, if (p%WAMIT2used) then if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then - call WAMIT2_CalcOutput( Time, p%WaveTime, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) + call WAMIT2_CalcOutput( Time, p%WaveField%WaveTime, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) do iBody=1,p%NBody y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(1)%Mesh%Force (:,iBody) @@ -1353,7 +1351,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, else do iBody=1,p%NBody - call WAMIT2_CalcOutput( Time, p%WaveTime, p%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) + call WAMIT2_CalcOutput( Time, p%WaveField%WaveTime, p%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(iBody)%Mesh%Force (:,1) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT2(iBody)%Mesh%Moment(:,1) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index b31d0de887..4535eff3fb 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -173,7 +173,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER totalStates - - - "Number of excitation and radiation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalExctnStates - - - "Number of excitation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalRdtnStates - - - "Number of radiation states for all WAMIT bodies" - -typedef ^ ^ SiKi WaveTime {*} - - "Array of time samples, (sec)" - typedef ^ ^ INTEGER NStepWave - - - "Number of data points in the wave kinematics arrays" - typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ ReKi AddF0 {:}{:} - - "Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m)" - @@ -195,6 +194,7 @@ typedef ^ ^ R8Ki typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" - typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 44a8dc180a..abb746c2a0 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -192,7 +192,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: totalStates = 0_IntKi !< Number of excitation and radiation states for all WAMIT bodies [-] INTEGER(IntKi) :: totalExctnStates = 0_IntKi !< Number of excitation states for all WAMIT bodies [-] INTEGER(IntKi) :: totalRdtnStates = 0_IntKi !< Number of radiation states for all WAMIT bodies [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of data points in the wave kinematics arrays [-] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] @@ -214,6 +213,7 @@ MODULE HydroDyn_Types REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_ParameterType ! ======================= ! ========= HydroDyn_InputType ======= @@ -2226,7 +2226,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%totalStates = SrcParamData%totalStates DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates - DstParamData%WaveTime => SrcParamData%WaveTime DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%WtrDpth = SrcParamData%WtrDpth if (allocated(SrcParamData%AddF0)) then @@ -2340,6 +2339,7 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%VisMeshes = SrcParamData%VisMeshes + DstParamData%WaveField => SrcParamData%WaveField end subroutine subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -2373,7 +2373,6 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) end if call Morison_DestroyParam(ParamData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(ParamData%WaveTime) if (allocated(ParamData%AddF0)) then deallocate(ParamData%AddF0) end if @@ -2404,6 +2403,7 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%dx)) then deallocate(ParamData%dx) end if + nullify(ParamData%WaveField) end subroutine subroutine HydroDyn_PackParam(Buf, Indata) @@ -2442,14 +2442,6 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%totalStates) call RegPack(Buf, InData%totalExctnStates) call RegPack(Buf, InData%totalRdtnStates) - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) - end if - end if call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, allocated(InData%AddF0)) @@ -2507,6 +2499,13 @@ subroutine HydroDyn_PackParam(Buf, Indata) end if call RegPack(Buf, InData%Jac_ny) call RegPack(Buf, InData%VisMeshes) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2570,30 +2569,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%totalRdtnStates) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime - else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveTime => null() - end if call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) @@ -2733,6 +2708,26 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%VisMeshes) if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if end subroutine subroutine HydroDyn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 5a636df0af..839c5c7137 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -931,13 +931,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS IF (ASSOCIATED(InitInp%WaveElev1)) SS_Exctn_InitInp%WaveElev1 => InitInp%WaveElev1 !TODO: Verify what happens within SS_Exctn when we have no waves. - ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation - !ALLOCATE ( SS_Exctn_InitInp%WaveTime (0:InitInp%NStepWave) , STAT=ErrStat2 ) - !IF ( ErrStat2 /= 0 ) THEN - ! CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the SS_Exctn_InitInp%WaveTime array.', ErrStat, ErrMsg, RoutineName) - ! 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, & diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 9992169f77..659813d586 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -6525,7 +6525,7 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, SeaSt) ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value t = REAL(t_global,SiKi) - call GetWaveElevIndx( t, SeaSt%p%WaveTime, y_FAST%VTK_LastWaveIndx ) + call GetWaveElevIndx( t, SeaSt%p%WaveField%WaveTime, y_FAST%VTK_LastWaveIndx ) n = 1 do ix=1,p_FAST%VTK_surface%NWaveElevPts(1) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 827e828c76..c150f3fa71 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -222,7 +222,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below ! Copy Waves_InitOut pointer information before calling cleanup (to avoid memory problems): - p%WaveTime => p%WaveField%WaveTime p%WaveElev1 => p%WaveField%WaveElev1 p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc @@ -295,7 +294,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! assign pointer arrays to init input for Waves2 (save some space) - InputFileData%Waves2%WaveTime => p%WaveTime InputFileData%Waves2%WaveElevC0 => Waves_InitOut%WaveElevC0 InputFileData%Waves2%WaveDirArr => Waves_InitOut%WaveDirArr @@ -519,7 +517,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison InitOut%WaveAccMCF => p%WaveField%WaveAccMCF ! For Morison (MacCamy-Fuchs) - InitOut%WaveTime => p%WaveField%WaveTime ! For Morison, and WAMIT for use in SS_Excitation InitOut%WaveElevC0 => p%WaveField%WaveElevC0 ! For WAMIT and WAMIT2, FIT InitOut%WaveDirArr => p%WaveField%WaveDirArr ! For WAMIT and WAMIT2 InitOut%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) @@ -555,7 +552,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%MSL2SWL = InitOut%MSL2SWL p%WaveField%EffWtrDpth = p%EffWtrDpth ! Effective water depth measured from the SWL p%WaveField%WaveStMod = p%WaveStMod - ! p%WaveField%WaveTime => Waves_InitOut%WaveTime ! p%WaveField%WaveElev1 => Waves_InitOut%WaveElev ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc @@ -584,7 +580,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%NStepWave, & p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & - InitOut%WaveTime, ErrStat, ErrMsg ) + p%WaveField%WaveTime, ErrStat, ErrMsg ) end if end if @@ -601,17 +597,17 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init RETURN end if - do it = 1,size(p%WaveTime) + do it = 1,size(p%WaveField%WaveTime) do i = 1, size(InitOut%WaveElevSeries,DIM=2) - InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do end do if (associated(p%WaveElev2)) then - do it = 1,size(p%WaveTime) + do it = 1,size(p%WaveField%WaveTime) do i = 1, size(InitOut%WaveElevSeries,DIM=2) - TmpElev = SeaSt_Interp_3D( real(p%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) InitOut%WaveElevSeries(it,i) = InitOut%WaveElevSeries(it,i) + TmpElev end do diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 8e06548d2c..3f14a10df5 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -95,7 +95,6 @@ typedef ^ ^ SiKi PWaveVel0 typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) -typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined" (sec) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - @@ -144,7 +143,6 @@ typedef ^ ^ SeaSt_Interp_MiscVarType # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # typedef ^ ParameterType Waves2_ParameterType Waves2 - - - "Parameter data for the Waves2 module" - -typedef ^ ^ SiKi WaveTime {*} - - "Array of time samples, (sec)" - typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index ae6bad8550..a762314b39 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -654,7 +654,7 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## It is arranged as blocks of X,Y,Elevation at each timestep' write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## Each block is separated by two blank lines for use in gnuplot' write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' - write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# WaveTMax = '//TRIM(Num2LStr(SeaState_p%WaveTime(SeaState_P%NStepWave))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# WaveTMax = '//TRIM(Num2LStr(SeaState_p%WaveField%WaveTime(SeaState_P%NStepWave))) write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# NStepWave = '//TRIM(Num2LStr(SeaState_p%NStepWave)) write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridXPoints = '//TRIM(Num2LStr(SeaState_p%NGrid(1))) write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridYPoints = '//TRIM(Num2LStr(SeaState_p%NGrid(2))) @@ -667,7 +667,7 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S ! Timestep looping do i = 0,SeaState_p%NStepWave write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) NewLine - write (WaveElevFileUn,'(A8,F10.3)', IOSTAT=ErrStatTmp ) '# Time: ',SeaState_p%WaveTime(I) + write (WaveElevFileUn,'(A8,F10.3)', IOSTAT=ErrStatTmp ) '# Time: ',SeaState_p%WaveField%WaveTime(I) ! Now output the X,Y, Elev info for this timestep do j=1,SeaState_p%NGrid(1) xpos = -SeaState_p%deltaGrid(1)*(SeaState_p%NGrid(1)-1)/2.0 + (J-1)*SeaState_p%deltaGrid(1) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index e2f7db7d23..d65259da53 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -116,7 +116,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] @@ -167,7 +166,6 @@ MODULE SeaState_Types ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType TYPE(Waves2_ParameterType) :: Waves2 !< Parameter data for the Waves2 module [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] @@ -761,7 +759,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 - DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 @@ -825,7 +822,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveElev1) nullify(InitOutputData%WaveElev2) nullify(InitOutputData%WaveElev0) - nullify(InitOutputData%WaveTime) call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WaveElevSeries)) then @@ -972,14 +968,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElev0) end if end if - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) - end if - end if call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -1403,30 +1391,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElev0 => null() end if - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime - else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveTime => null() - end if call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) @@ -1722,7 +1686,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call Waves2_CopyParam(SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstParamData%WaveTime => SrcParamData%WaveTime DstParamData%WaveDT = SrcParamData%WaveDT DstParamData%NGridPts = SrcParamData%NGridPts DstParamData%NGrid = SrcParamData%NGrid @@ -1862,7 +1825,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) ErrMsg = '' call Waves2_DestroyParam(ParamData%Waves2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(ParamData%WaveTime) if (allocated(ParamData%WaveElevxi)) then deallocate(ParamData%WaveElevxi) end if @@ -1918,14 +1880,6 @@ subroutine SeaSt_PackParam(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call Waves2_PackParam(Buf, InData%Waves2) - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) - end if - end if call RegPack(Buf, InData%WaveDT) call RegPack(Buf, InData%NGridPts) call RegPack(Buf, InData%NGrid) @@ -2100,30 +2054,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call Waves2_UnpackParam(Buf, OutData%Waves2) ! Waves2 - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime - else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveTime => null() - end if call RegUnpack(Buf, OutData%WaveDT) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NGridPts) diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 122dde24af..b5c193d982 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -40,7 +40,7 @@ MODULE UserWaves !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ErrMsg) TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Initialization output data - TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Initialization input data REAL(DbKi), INTENT(IN ) :: WaveDT ! Value of wave dt, used for filling WaveTime INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 4c8f94d42f..d5818d19ea 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -84,7 +84,6 @@ typedef ^ ^ SiKi PWaveAccMCF 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) -typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined" (sec) typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 74899068d3..7869fd47e2 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -31,7 +31,6 @@ typedef ^ ^ INTEGER WaveStMod typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveTime {*} - - "Simulation times at which the instantaneous second order loads associated with the incident waves are determined" sec typedef ^ ^ integer nGrid 3 - - "Grid dimensions" typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations can be output" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 2bdcf55998..38bd761d8f 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -45,7 +45,6 @@ MODULE Waves2_Types LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] @@ -100,7 +99,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveTime => SrcInitInputData%WaveTime DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid @@ -157,7 +155,6 @@ subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' nullify(InitInputData%WaveDirArr) nullify(InitInputData%WaveElevC0) - nullify(InitInputData%WaveTime) if (allocated(InitInputData%WaveKinGridxi)) then deallocate(InitInputData%WaveKinGridxi) end if @@ -199,14 +196,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) - end if - end if call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%NWaveElevGrid) call RegPack(Buf, InData%NWaveKinGrid) @@ -308,30 +297,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) else OutData%WaveElevC0 => null() end if - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime - else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveTime => null() - end if call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElevGrid) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index ba7d81ef96..9ccefd8051 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -102,7 +102,6 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< 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 = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -541,7 +540,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 end if - DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave @@ -572,7 +570,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveElev0)) then deallocate(InitOutputData%WaveElev0) end if - nullify(InitOutputData%WaveTime) end subroutine subroutine Waves_PackInitOutput(Buf, Indata) @@ -683,14 +680,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) - end if - end if call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) @@ -1008,30 +997,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev0) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime - else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveTime => null() - end if call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RhoXg) From 9a1c41b72115b2b2deee7818f7dd3d5ad347d574 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 30 Oct 2023 14:38:59 -0600 Subject: [PATCH 007/232] SeaSt: remove extra copies of `WaveElevC0` --- modules/seastate/src/SeaState.f90 | 3 -- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.f90 | 2 +- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 39 +------------- modules/seastate/src/Waves_Types.f90 | 35 ------------- 8 files changed, 3 insertions(+), 150 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index c150f3fa71..ef98d7ffd5 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -230,7 +230,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 p%WaveAccMCF => p%WaveField%WaveAccMCF - p%WaveElevC0 => p%WaveField%WaveElevC0 p%WaveDirArr => p%WaveField%WaveDirArr p%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 @@ -294,7 +293,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! assign pointer arrays to init input for Waves2 (save some space) - InputFileData%Waves2%WaveElevC0 => Waves_InitOut%WaveElevC0 InputFileData%Waves2%WaveDirArr => Waves_InitOut%WaveDirArr CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) @@ -517,7 +515,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison InitOut%WaveAccMCF => p%WaveField%WaveAccMCF ! For Morison (MacCamy-Fuchs) - InitOut%WaveElevC0 => p%WaveField%WaveElevC0 ! For WAMIT and WAMIT2, FIT InitOut%WaveDirArr => p%WaveField%WaveDirArr ! For WAMIT and WAMIT2 InitOut%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 3f14a10df5..99716e4b00 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -76,7 +76,6 @@ typedef ^ ^ ReKi Wtr typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi EffWtrDpth - - - "Effective water depth equal to the sum of input WtrDpth and MSL2SWL" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (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 WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) @@ -166,7 +165,6 @@ typedef ^ ^ SiKi Wav #### vvvvvvvvvvvvvvvvvvvvvvvvv #### The following 3 parameters aren't used in SeaState after initialization, but are stored as parameters so that we can deallocate the arrays and nullify the pointers in a consistent way (in one module) typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) -typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) #### ^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index d65259da53..693a35df1e 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -97,7 +97,6 @@ MODULE SeaState_Types REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Effective water depth equal to the sum of input WtrDpth and MSL2SWL [(m)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] @@ -187,7 +186,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -740,7 +738,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%EffWtrDpth = SrcInitOutputData%EffWtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL - DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin @@ -808,7 +805,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(InitOutputData%WaveElevC0) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveDirArr) nullify(InitOutputData%WaveDynP) @@ -851,14 +847,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%EffWtrDpth) call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, associated(InData%WaveElevC0)) - if (associated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC0) - end if - end if call RegPack(Buf, associated(InData%WaveElevC)) if (associated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -1045,30 +1033,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) - OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 - else - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC0 => null() - end if if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1729,7 +1693,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF DstParamData%WaveDirArr => SrcParamData%WaveDirArr - DstParamData%WaveElevC0 => SrcParamData%WaveElevC0 DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then @@ -1841,7 +1804,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%PWaveVel0) nullify(ParamData%WaveAccMCF) nullify(ParamData%WaveDirArr) - nullify(ParamData%WaveElevC0) nullify(ParamData%PWaveAccMCF0) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) @@ -1979,14 +1941,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - call RegPack(Buf, associated(InData%WaveElevC0)) - if (associated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC0) - end if - end if call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -2340,30 +2294,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveDirArr => null() end if - if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) - OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 - else - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC0 => null() - end if if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 4bc80285c3..2aba6b7cde 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -2358,7 +2358,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS END SUBROUTINE Get_1Spsd_and_WaveElevC0 !------------------------------------------------------------------------------------------------------------------------ -!> update InitOut%WaveElevC0; call InitFFT before calling this routine! +!> update WaveField%WaveElevC0; call InitFFT before calling this routine! SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStat, ErrMsg) TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index d5818d19ea..204aad49e3 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -67,7 +67,6 @@ typedef ^ ^ ReKi PtfmLocatio # Define outputs from the initialization routine here: # -typedef ^ InitOutputType SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) typedef ^ InitOutputType SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 7869fd47e2..28cbca79e8 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -30,7 +30,6 @@ typedef ^ ^ INTEGER WaveStMod typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) -typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) typedef ^ ^ integer nGrid 3 - - "Grid dimensions" typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations can be output" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 38bd761d8f..573031edcc 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -44,7 +44,6 @@ MODULE Waves2_Types INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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)] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] @@ -84,7 +83,7 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' ErrStat = ErrID_None @@ -98,7 +97,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid @@ -154,7 +152,6 @@ subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' nullify(InitInputData%WaveDirArr) - nullify(InitInputData%WaveElevC0) if (allocated(InitInputData%WaveKinGridxi)) then deallocate(InitInputData%WaveKinGridxi) end if @@ -188,14 +185,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - call RegPack(Buf, associated(InData%WaveElevC0)) - if (associated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC0) - end if - end if call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%NWaveElevGrid) call RegPack(Buf, InData%NWaveKinGrid) @@ -227,7 +216,7 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Waves2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -273,30 +262,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) else OutData%WaveDirArr => null() end if - if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) - OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 - else - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC0 => null() - end if call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElevGrid) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 9ccefd8051..d4f7a698ee 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -85,7 +85,6 @@ MODULE Waves_Types ! ======================= ! ========= Waves_InitOutputType ======= TYPE, PUBLIC :: Waves_InitOutputType - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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 :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] @@ -501,7 +500,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' - DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 if (allocated(SrcInitOutputData%WaveElevC)) then LB(1:3) = lbound(SrcInitOutputData%WaveElevC) UB(1:3) = ubound(SrcInitOutputData%WaveElevC) @@ -553,7 +551,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Waves_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' - nullify(InitOutputData%WaveElevC0) if (allocated(InitOutputData%WaveElevC)) then deallocate(InitOutputData%WaveElevC) end if @@ -578,14 +575,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, associated(InData%WaveElevC0)) - if (associated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC0) - end if - end if call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -697,30 +686,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) - OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 - else - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC0 => null() - end if if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 02b049b28f7ba6c53b39db1605c2cac60269cb8b Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 30 Oct 2023 14:48:19 -0600 Subject: [PATCH 008/232] SeaSt: remove extra copies of `WaveDirArr` --- modules/seastate/src/SeaState.f90 | 11 +--- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 38 -------------- modules/seastate/src/Waves_Types.f90 | 35 ------------- 7 files changed, 1 insertion(+), 157 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index ef98d7ffd5..3cd3b9dde4 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -230,7 +230,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 p%WaveAccMCF => p%WaveField%WaveAccMCF - p%WaveDirArr => p%WaveField%WaveDirArr p%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! check error (must be done AFTER moving pointers to parameters) @@ -288,15 +287,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves2%NStepWave2 = Waves_InitOut%NStepWave2 InputFileData%Waves2%WaveDOmega = Waves_InitOut%WaveDOmega - ! Copy the WaveElevXY data in from the SeaState InputFileData - ! IF (ALLOCATED(tmpWaveElevXY)) CALL MOVE_ALLOC(tmpWaveElevXY, InputFileData%Waves2%WaveElevXY) - - ! assign pointer arrays to init input for Waves2 (save some space) - - InputFileData%Waves2%WaveDirArr => Waves_InitOut%WaveDirArr - CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) - p%WaveElev2 => p%WaveField%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly + p%WaveElev2 => p%WaveField%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN @@ -515,7 +507,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison InitOut%WaveAccMCF => p%WaveField%WaveAccMCF ! For Morison (MacCamy-Fuchs) - InitOut%WaveDirArr => p%WaveField%WaveDirArr ! For WAMIT and WAMIT2 InitOut%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 99716e4b00..c2e104891f 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -77,7 +77,6 @@ typedef ^ ^ ReKi Wtr typedef ^ ^ ReKi EffWtrDpth - - - "Effective water depth equal to the sum of input WtrDpth and MSL2SWL" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (m) typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) @@ -164,7 +163,6 @@ typedef ^ ^ SiKi PWa typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) #### vvvvvvvvvvvvvvvvvvvvvvvvv #### The following 3 parameters aren't used in SeaState after initialization, but are stored as parameters so that we can deallocate the arrays and nullify the pointers in a consistent way (in one module) -typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) #### ^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 693a35df1e..cb414aa92c 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -98,7 +98,6 @@ MODULE SeaState_Types REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Effective water depth equal to the sum of input WtrDpth and MSL2SWL [(m)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] @@ -185,7 +184,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -739,7 +737,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%EffWtrDpth = SrcInitOutputData%EffWtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC - DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir @@ -806,7 +803,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) - nullify(InitOutputData%WaveDirArr) nullify(InitOutputData%WaveDynP) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveAccMCF) @@ -855,14 +851,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElevC) end if end if - call RegPack(Buf, associated(InData%WaveDirArr)) - if (associated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) - call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDirArr) - end if - end if call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveDir) @@ -1057,30 +1045,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElevC => null() end if - if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) - OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr - else - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDirArr => null() - end if call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMax) @@ -1692,7 +1656,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF - DstParamData%WaveDirArr => SrcParamData%WaveDirArr DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then @@ -1803,7 +1766,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveVel) nullify(ParamData%PWaveVel0) nullify(ParamData%WaveAccMCF) - nullify(ParamData%WaveDirArr) nullify(ParamData%PWaveAccMCF0) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) @@ -1933,14 +1895,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveAccMCF) end if end if - call RegPack(Buf, associated(InData%WaveDirArr)) - if (associated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) - call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDirArr) - end if - end if call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -2270,30 +2224,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveAccMCF => null() end if - if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) - OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr - else - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDirArr => null() - end if if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 204aad49e3..f7a96cb9ad 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -68,7 +68,6 @@ typedef ^ ^ ReKi PtfmLocatio # Define outputs from the initialization routine here: # typedef ^ InitOutputType SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 28cbca79e8..cd8e296ebd 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -29,7 +29,6 @@ typedef ^ ^ SiKi WaveDOmega typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) typedef ^ ^ integer nGrid 3 - - "Grid dimensions" typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations can be output" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 573031edcc..3d39170214 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -43,7 +43,6 @@ MODULE Waves2_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] @@ -96,7 +95,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid @@ -151,7 +149,6 @@ subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Waves2_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' - nullify(InitInputData%WaveDirArr) if (allocated(InitInputData%WaveKinGridxi)) then deallocate(InitInputData%WaveKinGridxi) end if @@ -167,7 +164,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Waves2_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves2_PackInitInput' - logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDens) @@ -177,14 +173,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WaveMultiDir) - call RegPack(Buf, associated(InData%WaveDirArr)) - if (associated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) - call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDirArr) - end if - end if call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%NWaveElevGrid) call RegPack(Buf, InData%NWaveKinGrid) @@ -219,8 +207,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx - type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return @@ -238,30 +224,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) - OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr - else - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDirArr => null() - end if call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElevGrid) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index d4f7a698ee..f52ce2c477 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -86,7 +86,6 @@ MODULE Waves_Types ! ========= Waves_InitOutputType ======= TYPE, PUBLIC :: Waves_InitOutputType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] @@ -512,7 +511,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC end if - DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir @@ -554,7 +552,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveElevC)) then deallocate(InitOutputData%WaveElevC) end if - nullify(InitOutputData%WaveDirArr) nullify(InitOutputData%WaveDynP) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveAccMCF) @@ -580,14 +577,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if - call RegPack(Buf, associated(InData%WaveDirArr)) - if (associated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) - call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDirArr) - end if - end if call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) @@ -700,30 +689,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevC) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) - OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr - else - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDirArr => null() - end if call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMax) From e3a00f74906647d99c831ea33ab37c0d6c7c0988 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 30 Oct 2023 15:03:45 -0600 Subject: [PATCH 009/232] HD: replace pointers to individual arrays with pointer to WaveField --- modules/hydrodyn/src/HydroDyn.f90 | 10 +-- modules/hydrodyn/src/WAMIT.f90 | 12 +-- modules/hydrodyn/src/WAMIT.txt | 8 +- modules/hydrodyn/src/WAMIT2.f90 | 44 +++++----- modules/hydrodyn/src/WAMIT2.txt | 4 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 94 +++++++------------- modules/hydrodyn/src/WAMIT_Types.f90 | 120 +++++--------------------- 7 files changed, 89 insertions(+), 203 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index b3baa45f97..05622f5fe2 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -369,11 +369,9 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! CALL MOVE_ALLOC( InitInp%WaveElevC, InputFileData%WAMIT%WaveElevC ) ! Temporarily move arrays to init input for WAMIT (save some space) - InputFileData%WAMIT%WaveTime => p%WaveField%WaveTime InputFileData%WAMIT%WaveElev0 => InitInp%WaveField%WaveElev0 InputFileData%WAMIT%WaveElevC => InitInp%WaveField%WaveElevC - InputFileData%WAMIT%WaveElevC0 => InitInp%WaveField%WaveElevC0 - InputFileData%WAMIT%WaveDirArr => InitInp%WaveField%WaveDirArr + InputFileData%WAMIT%WaveField => InitInp%WaveField ! InputFileData%WAMIT%seast_interp_p = InitInp%WaveField%seast_interp_p CALL SeaSt_Interp_CopyParam(InitInp%WaveField%seast_interp_p, InputFileData%WAMIT%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -440,11 +438,9 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Flag required for indicating when to try using arrays that are allocated p%WAMIT2used = .TRUE. - ! init input for WAMIT2 pointers to save space - InputFileData%WAMIT2%WaveElevC0 => InitInp%WaveField%WaveElevC0 - InputFileData%WAMIT2%WaveDirArr => InitInp%WaveField%WaveDirArr - ! Copy Waves initialization output into the initialization input type for the WAMIT module + InputFileData%WAMIT2%WaveField => InitInp%WaveField + InputFileData%WAMIT2%RhoXg = InitInp%RhoXg InputFileData%WAMIT2%NStepWave = InitInp%NStepWave InputFileData%WAMIT2%NStepWave2 = InitInp%NStepWave2 diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 839c5c7137..9e26125ec3 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -931,7 +931,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS IF (ASSOCIATED(InitInp%WaveElev1)) SS_Exctn_InitInp%WaveElev1 => InitInp%WaveElev1 !TODO: Verify what happens within SS_Exctn when we have no waves. - SS_Exctn_InitInp%WaveTime => InitInp%WaveTime + SS_Exctn_InitInp%WaveTime => InitInp%WaveField%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) @@ -1079,14 +1079,14 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments TmpCoord(1) = Omega - TmpCoord(2) = InitInp%WaveDirArr(I) + TmpCoord(2) = InitInp%WaveField%WaveDirArr(I) CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN END IF - WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I)) + WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveField%WaveElevC0(1,I), InitInp%WaveField%WaveElevC0(2,I)) END DO ! J - All wave excitation forces and moments @@ -1133,7 +1133,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments TmpCoord(1) = Omega - TmpCoord(2) = InitInp%WaveDirArr(I) + TmpCoord(2) = InitInp%WaveField%WaveDirArr(I) CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN @@ -1253,7 +1253,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS TmpIm = -sin(tmpAngle) Fxy = CMPLX( TmpRe, TmpIm ) - tmpComplexArr(I) = Fxy*CMPLX(InitInp%WaveElevC0(1,I), InitInp%WaveElevC0(2,I)) + tmpComplexArr(I) = Fxy*CMPLX(InitInp%WaveField%WaveElevC0(1,I), InitInp%WaveField%WaveElevC0(2,I)) end do @@ -1299,7 +1299,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! CALL Cleanup() ! RETURN !END IF - SS_Exctn_InitInp%WaveTime => InitInp%WaveTime + SS_Exctn_InitInp%WaveTime => InitInp%WaveField%WaveTime diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 9a9d912e56..070ebb872e 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -17,6 +17,7 @@ usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt usefrom SeaState_Interp.txt +usefrom SeaSt_WaveField.txt typedef WAMIT/WAMIT InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - @@ -45,15 +46,14 @@ typedef ^ ^ INTEGER typedef ^ ^ ReKi WaveDOmega - - - "" - typedef ^ ^ SiKi WaveElev0 {*} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -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 (points to SeaState module data)" (meters) typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveTime {*} - - "(points to SeaState module data)" - typedef ^ ^ INTEGER WaveMod - - - "" - typedef ^ ^ ReKi WtrDens - - - "" - -typedef ^ ^ SiKi WaveDirArr {*} - - "Array of wave directions (one per frequency) from the Waves module (points to SeaState module data)" - typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" + # # # Define outputs from the initialization routine here: diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index cf28edda86..57a0e574ff 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -1143,7 +1143,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! need to account for any offset in the location of the WAMIT body (this term vanishes). ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. - aWaveElevC = CMPLX( InitInp%WaveElevC0(1,J), InitInp%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 + aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 ! Calculate the frequency Omega1 = J * InitInp%WaveDOmega @@ -1161,7 +1161,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS IF ( MnDriftData%DataIs3D ) THEN ! Set the (omega1,beta1,beta2) point we are looking for. (angles in degrees here) - Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord3(2) = Coord3(2) - RotateZdegOffset @@ -1175,7 +1175,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ELSE ! Set the (omega1,omega2,beta1,beta2) point we are looking for. (angles in degrees here) - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord4(3) = Coord4(3) - RotateZdegOffset @@ -1713,7 +1713,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! First get the wave amplitude -- must be reconstructed from the WaveElevC array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 so that the wave amplitude is of the same form as the paper. - aWaveElevC = CMPLX( InitInp%WaveElevC0(1,J), InitInp%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 + aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 ! Calculate the frequency Omega1 = J * InitInp%WaveDOmega @@ -1726,7 +1726,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg IF ( NewmanAppData%DataIs3D ) THEN ! Set the (omega1,beta1,beta2) point we are looking for. - Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord3 = (/ REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord3(2) = Coord3(2) - RotateZdegOffset @@ -1739,7 +1739,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ELSE ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord4(3) = Coord4(3) - RotateZdegOffset @@ -1828,7 +1828,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! direction associated with it through the equal energy approach used in multidirectional waves. WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J)*D2R) ) + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J)*D2R) ) PhaseShiftXY = CMPLX( cos(TmpReal1), -sin(TmpReal1) ) ! Apply the phase shift @@ -2266,11 +2266,11 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS Omega2 = K * InitInp%WaveDOmega ! the nth frequency ! Find the Wave amplitudes 1 and 2 - aWaveElevC1 = CMPLX( InitInp%WaveElevC0(1,J+K), InitInp%WaveElevC0(2,J+K), SiKi) / InitInp%NStepWave2 - aWaveElevC2 = CMPLX( InitInp%WaveElevC0(1,K), InitInp%WaveElevC0(2,K), SiKi) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J+K), InitInp%WaveField%WaveElevC0(2,J+K), SiKi) / InitInp%NStepWave2 + aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,K), InitInp%WaveField%WaveElevC0(2,K), SiKi) / InitInp%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveDirArr(J+K), InitInp%WaveDirArr(K) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveField%WaveDirArr(J+K), InitInp%WaveField%WaveDirArr(K) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord4(3) = Coord4(3) - RotateZdegOffset @@ -2298,8 +2298,8 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J+K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J+K)*D2R) ) - TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(K)*D2R) ) + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J+K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J+K)*D2R) ) + TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(K)*D2R) ) ! Set the phase shift for the set of difference frequencies PhaseShiftXY = CMPLX( cos(TmpReal1 - TmpReal2), -sin(TmpReal1 - TmpReal2) ) @@ -2760,10 +2760,10 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Find the wave amplitude at frequency omega - aWaveElevC1 = CMPLX( InitInp%WaveElevC0(1,J), InitInp%WaveElevC0(2,J), SiKi ) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi ) / InitInp%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveDirArr(J), InitInp%WaveDirArr(J) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord4(3) = Coord4(3) - RotateZdegOffset @@ -2791,7 +2791,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! direction associated with it through the equal energy approach used in multidirectional waves. WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J)*D2R) ) + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J)*D2R) ) ! Set the phase shift for the set of sum frequencies PhaseShiftXY = CMPLX( cos(TmpReal1 + TmpReal1), -sin(TmpReal1 + TmpReal1) ) @@ -2873,11 +2873,11 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat Omega2 = (J-K) * InitInp%WaveDOmega ! Find the wave amplitude at frequency omega. Remove the NStepWave2 normalization built into WaveElevC0 from Waves module - aWaveElevC1 = CMPLX( InitInp%WaveElevC0(1, K), InitInp%WaveElevC0(2, K), SiKi ) / InitInp%NStepWave2 - aWaveElevC2 = CMPLX( InitInp%WaveElevC0(1,J-K), InitInp%WaveElevC0(2,J-K), SiKi ) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1, K), InitInp%WaveField%WaveElevC0(2, K), SiKi ) / InitInp%NStepWave2 + aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,J-K), InitInp%WaveField%WaveElevC0(2,J-K), SiKi ) / InitInp%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. - Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveDirArr(K), InitInp%WaveDirArr(J-K) /) + Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveField%WaveDirArr(K), InitInp%WaveField%WaveDirArr(J-K) /) ! Apply local Z rotation to heading angle (degrees) to put wave direction into the local (rotated) body frame Coord4(3) = Coord4(3) - RotateZdegOffset @@ -2905,8 +2905,8 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(K)*D2R) ) - TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveDirArr(J-K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveDirArr(J-K)*D2R) ) + TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(K)*D2R) ) + TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J-K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J-K)*D2R) ) ! Set the phase shift for the set of sum frequencies PhaseShiftXY = CMPLX( cos(TmpReal1 + TmpReal2), -sin(TmpReal1 + TmpReal2) ) @@ -3319,11 +3319,11 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, !> 1. Check that WaveElevC0 is a 2x(NStepWave2+1) sized array (0 index start) - IF ( SIZE( InitInp%WaveElevC0, 2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( InitInp%WaveField%WaveElevC0, 2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to WAMIT2_Init:'//NewLine// & ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%NStepWave2 + 1))// & ' (2x(NStepWave2+1)), but instead received array of size '// & - TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveElevC0,2)))//'.', ErrStat, ErrMsg, RoutineName) + TRIM(Num2LStr(SIZE(InitInp%WaveField%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveField%WaveElevC0,2)))//'.', ErrStat, ErrMsg, RoutineName) RETURN END IF diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 79ff8a8b33..f66ec23fe2 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -13,6 +13,7 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt +usefrom SeaSt_WaveField.txt param WAMIT2/WAMIT2 unused INTEGER MaxWAMIT2Outputs - 6 - "" - @@ -35,14 +36,13 @@ typedef ^ ^ ReKi WtrDens typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" (m) -typedef ^ ^ SiKi WaveElevC0 {*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data)" (meters) typedef ^ ^ SiKi WaveDir - - - "Mean incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDirArr {*} - - "Wave direction assigned to each frequency (points to SeaState module data)" (degrees) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - typedef ^ ^ INTEGER WaveMod - - - "The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here." - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" #[note: only one of MnDriff / NewmanApp / DiffQTF can be non-zero typedef ^ ^ INTEGER MnDrift - - - "Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use}" - diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index b29c74410f..849a048034 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE WAMIT2_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] @@ -52,13 +53,12 @@ MODULE WAMIT2_Types REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(m)] - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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 (points to SeaState module data) [(meters)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction assigned to each frequency (points to SeaState module data) [(degrees)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: DiffQTF = 0_IntKi !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] @@ -110,8 +110,9 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -175,13 +176,12 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 DstInitInputData%WaveDir = SrcInitInputData%WaveDir DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%MnDrift = SrcInitInputData%MnDrift DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF @@ -202,6 +202,8 @@ subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(WAMIT2_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -217,8 +219,7 @@ subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%PtfmRefztRot)) then deallocate(InitInputData%PtfmRefztRot) end if - nullify(InitInputData%WaveElevC0) - nullify(InitInputData%WaveDirArr) + nullify(InitInputData%WaveField) end subroutine subroutine WAMIT2_PackInitInput(Buf, Indata) @@ -259,27 +260,18 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, associated(InData%WaveElevC0)) - if (associated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC0) - end if - end if call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) - call RegPack(Buf, associated(InData%WaveDirArr)) - if (associated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) - call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDirArr) - end if - end if call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if call RegPack(Buf, InData%MnDrift) call RegPack(Buf, InData%NewmanApp) call RegPack(Buf, InData%DiffQTF) @@ -301,7 +293,7 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -387,64 +379,36 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) - OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 - else - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC0 => null() - end if call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpackPointer(Buf, Ptr, PtrIdx) if (RegCheckErr(Buf, RoutineName)) return if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) - OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + call c_f_pointer(Ptr, OutData%WaveField) else - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField end if else - OutData%WaveDirArr => null() + OutData%WaveField => null() end if - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MnDrift) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NewmanApp) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index f09135bcc5..e630d66343 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -34,6 +34,7 @@ MODULE WAMIT_Types USE Conv_Radiation_Types USE SS_Radiation_Types USE SS_Excitation_Types +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE ! ========= WAMIT_InitInputType ======= @@ -65,15 +66,13 @@ MODULE WAMIT_Types REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin (needed for SS_Excitation module) [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< 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 (points to SeaState module data) [(meters)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< (points to SeaState module data) [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Array of wave directions (one per frequency) from the Waves module (points to SeaState module data) [-] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE WAMIT_InitInputType ! ======================= ! ========= WAMIT_ContinuousStateType ======= @@ -276,17 +275,15 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC - DstInitInputData%WaveTime => SrcInitInputData%WaveTime DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -323,12 +320,10 @@ subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitInputData%WaveElev0) nullify(InitInputData%WaveElev1) - nullify(InitInputData%WaveElevC0) nullify(InitInputData%WaveElevC) - nullify(InitInputData%WaveTime) - nullify(InitInputData%WaveDirArr) call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%WaveField) end subroutine subroutine WAMIT_PackInitInput(Buf, Indata) @@ -406,14 +401,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElev1) end if end if - call RegPack(Buf, associated(InData%WaveElevC0)) - if (associated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC0) - end if - end if call RegPack(Buf, associated(InData%WaveElevC)) if (associated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -422,27 +409,18 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElevC) end if end if - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) - end if - end if call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, associated(InData%WaveDirArr)) - if (associated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) - call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDirArr) - end if - end if call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -637,30 +615,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveElev1 => null() end if - if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) - OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 - else - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC0 => null() - end if if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -685,63 +639,35 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveElevC => null() end if - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime - else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveTime => null() - end if call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpackPointer(Buf, Ptr, PtrIdx) if (RegCheckErr(Buf, RoutineName)) return if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) - OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + call c_f_pointer(Ptr, OutData%WaveField) else - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField end if else - OutData%WaveDirArr => null() + OutData%WaveField => null() end if - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine subroutine WAMIT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) From 24c4c8ec542a135fcee7034418697c9b56a15d13 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 30 Oct 2023 15:06:25 -0600 Subject: [PATCH 010/232] HD: removed commented-out subroutines --- modules/hydrodyn/src/Morison.f90 | 77 -------------------------------- 1 file changed, 77 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 3a4cf2a82e..5ce3e56bb5 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2500,83 +2500,6 @@ SUBROUTINE AllocateNodeLoadVariables(InitInp, p, m, NNodes, errStat, errMsg ) m%V_rel_n_HiPass = 0.0_ReKi END SUBROUTINE AllocateNodeLoadVariables - -! !---------------------------------------------------------------------------------------------------------------------------------- -! !> This routine is similar to InterpWrappedStpReal, except it returns only the slope for the interpolation. -! !! By returning the slope based on Time, we don't have to calculate this for every variable (Yary) we want to interpolate. -! !! NOTE: p%WaveTime (and most arrays here) start with index of 0 instead of 1, so we will subtract 1 from "normal" interpolation -! !! schemes. -! FUNCTION GetInterpolationSlope(Time, p, m, IntWrapIndx) RESULT( InterpSlope ) -! REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds -! TYPE(Morison_ParameterType), INTENT(IN ) :: p !< Parameters -! TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables -! INTEGER, OPTIONAL, INTENT( OUT) :: IntWrapIndx -! -! REAL(SiKi) :: Time_SiKi -! REAL(SiKi) :: TimeMod -! REAL(ReKi) :: InterpSlope -! -! Time_SiKi = REAL(Time, SiKi) -! TimeMod = MOD(Time_SiKi, p%WaveTime(p%NStepWave)) !p%WaveTime starts at index 0, so it has p%NStepWave+1 elements -! IF ( TimeMod <= p%WaveTime(1) ) THEN !second element -! m%LastIndWave = 0 -! END IF -! -! IF ( TimeMod <= p%WaveTime(0) ) THEN -! m%LastIndWave = 0 -! InterpSlope = 0.0_ReKi ! returns values at m%LastIndWave -! IF(PRESENT(IntWrapIndx)) IntWrapIndx = 0 -! ELSE IF ( TimeMod >= p%WaveTime(p%NStepWave) ) THEN -! m%LastIndWave = p%NStepWave-1 -! InterpSlope = 1.0_ReKi ! returns values at p%NStepWave -! IF(PRESENT(IntWrapIndx)) IntWrapIndx = p%NStepWave -! ELSE -! m%LastIndWave = MAX( MIN( m%LastIndWave, p%NStepWave-1 ), 0 ) -! -! DO -! -! IF ( TimeMod < p%WaveTime(m%LastIndWave) ) THEN -! -! m%LastIndWave = m%LastIndWave - 1 -! -! ELSE IF ( TimeMod >= p%WaveTime(m%LastIndWave+1) ) THEN -! -! m%LastIndWave = m%LastIndWave + 1 -! -! ELSE -! IF(PRESENT(IntWrapIndx)) IntWrapIndx = m%LastIndWave -! -! InterpSlope = ( TimeMod - p%WaveTime(m%LastIndWave) )/( p%WaveTime(m%LastIndWave+1) - p%WaveTime(m%LastIndWave) ) -! RETURN ! stop checking DO loop -! END IF -! -! END DO -! -! END IF -! -! END FUNCTION GetInterpolationSlope -! !---------------------------------------------------------------------------------------------------------------------------------- -! !> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. -! FUNCTION InterpolateWithSlope(InterpSlope, Ind, YAry) -! REAL(ReKi), INTENT(IN) :: InterpSlope -! INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables -! REAL(SiKi), INTENT(IN) :: YAry(0:) -! REAL(ReKi) :: InterpolateWithSlope -! -! InterpolateWithSlope = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) -! -! END FUNCTION InterpolateWithSlope -! !---------------------------------------------------------------------------------------------------------------------------------- -! !> Use in conjunction with GetInterpolationSlope, to replace InterpWrappedStpReal here. -! FUNCTION InterpolateWithSlopeR(InterpSlope, Ind, YAry) -! REAL(ReKi), INTENT(IN) :: InterpSlope -! INTEGER(IntKi), INTENT(IN ) :: Ind !< Misc/optimization variables -! REAL(ReKi), INTENT(IN) :: YAry(0:) -! REAL(ReKi) :: InterpolateWithSlopeR -! -! InterpolateWithSlopeR = ( YAry(Ind+1) - YAry(Ind) )*InterpSlope + YAry(Ind) -! -! END FUNCTION InterpolateWithSlopeR !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) From ca755c2072a4cdfbe279c5648caff9f1dc3441fb Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:04:04 -0600 Subject: [PATCH 011/232] SeaSt: remove extra `WaveDynP` pointers also added subroutines to add 1st and 2nd order arrays without copying all the error checks --- modules/seastate/src/SeaState.f90 | 198 ++++++++++------------- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Output.f90 | 8 +- modules/seastate/src/SeaState_Types.f90 | 70 -------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ---- 6 files changed, 90 insertions(+), 224 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 3cd3b9dde4..2b863f07a0 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -225,7 +225,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveElev1 => p%WaveField%WaveElev1 p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc - p%WaveDynP => p%WaveField%WaveDynP p%PWaveVel0 => p%WaveField%PWaveVel0 p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 @@ -313,64 +312,18 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Difference frequency results IF ( p%Waves2%WvDiffQTFF ) THEN - ! Dynamic pressure -- difference frequency terms - IF ( SIZE(p%WaveDynP,DIM=1) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=1) .OR. & - SIZE(p%WaveDynP,DIM=2) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=2).OR. & - SIZE(p%WaveDynP,DIM=3) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=3).OR. & - SIZE(p%WaveDynP,DIM=4) /= SIZE(Waves2_InitOut%WaveDynP2D,DIM=4)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveDynP arrays for first and second order wave elevations are of different sizes. '//NewLine// & - 'Waves: '// TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=4)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=4))), & - ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveDynP = p%WaveField%WaveDynP + Waves2_InitOut%WaveDynP2D - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2D0 - ENDIF + ! Dynamic pressure -- difference frequency terms + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle velocity -- difference frequency terms - IF ( SIZE(p%WaveVel,DIM=1) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=1) .OR. & - SIZE(p%WaveVel,DIM=2) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=2) .OR. & - SIZE(p%WaveVel,DIM=3) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=3) .OR. & - SIZE(p%WaveVel,DIM=4) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=4) .OR. & - SIZE(p%WaveVel,DIM=5) /= SIZE(Waves2_InitOut%WaveVel2D,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveVel arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveVel = p%WaveField%WaveVel + Waves2_InitOut%WaveVel2D - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2D0 - ENDIF - + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2D + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle acceleration -- difference frequency terms - IF ( SIZE(p%WaveAcc,DIM=1) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=1) .OR. & - SIZE(p%WaveAcc,DIM=2) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=2) .OR. & - SIZE(p%WaveAcc,DIM=3) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=3) .OR. & - SIZE(p%WaveAcc,DIM=4) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=4) .OR. & - SIZE(p%WaveAcc,DIM=5) /= SIZE(Waves2_InitOut%WaveAcc2D,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveAcc arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveAcc = p%WaveField%WaveAcc + Waves2_InitOut%WaveAcc2D - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveAcc0 = WaveAcc0 + WaveAcc2D0 - ! MacCamy-Fuchs scaled acceleration should not contain second-order contributions - !IF (InputFileData%Waves%MCFD > 0) THEN - ! p%WaveAccMCF = p%WaveAccMCF + Waves2_InitOut%WaveAcc2D - !END IF - - ENDIF + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2D + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ENDIF ! second order wave kinematics difference frequency results @@ -378,63 +331,20 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF ( p%Waves2%WvSumQTFF ) THEN ! Dynamic pressure -- sum frequency terms - IF ( SIZE(p%WaveDynP,DIM=1) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=1) .OR. & - SIZE(p%WaveDynP,DIM=2) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=2) .OR. & - SIZE(p%WaveDynP,DIM=3) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=3) .OR. & - SIZE(p%WaveDynP,DIM=4) /= SIZE(Waves2_InitOut%WaveDynP2S,DIM=4)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveDynP arrays for first and second order wave elevations are of different sizes. '//NewLine// & - 'Waves: '// TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(p%WaveDynP,DIM=4)))//NewLine// & - 'Waves2: '// TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=1)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=2)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=3)))//'x'// & - TRIM(Num2LStr(SIZE(Waves2_InitOut%WaveDynP2D,DIM=4))), & - ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveDynP = p%WaveField%WaveDynP + Waves2_InitOut%WaveDynP2S - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveDynP0 = WaveDynP0 + WaveDynP2S0 - ENDIF + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle velocity -- sum frequency terms - IF ( SIZE(p%WaveVel,DIM=1) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=1) .OR. & - SIZE(p%WaveVel,DIM=2) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=2) .OR. & - SIZE(p%WaveVel,DIM=3) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=3) .OR. & - SIZE(p%WaveVel,DIM=4) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=4) .OR. & - SIZE(p%WaveVel,DIM=5) /= SIZE(Waves2_InitOut%WaveVel2S,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveVel arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveVel = p%WaveField%WaveVel + Waves2_InitOut%WaveVel2S - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveVel0 = WaveVel0 + WaveVel2S0 - ENDIF + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2S + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! Particle velocity -- sum frequency terms - IF ( SIZE(p%WaveAcc,DIM=1) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=1) .OR. & - SIZE(p%WaveAcc,DIM=2) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=2) .OR. & - SIZE(p%WaveAcc,DIM=3) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=3) .OR. & - SIZE(p%WaveAcc,DIM=4) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=4) .OR. & - SIZE(p%WaveAcc,DIM=5) /= SIZE(Waves2_InitOut%WaveAcc2S,DIM=5)) THEN - CALL SetErrStat(ErrID_Fatal, & - ' WaveAcc arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - p%WaveField%WaveAcc = p%WaveField%WaveAcc + Waves2_InitOut%WaveAcc2S - !IF (InputFileData%Waves%WaveStMod > 0 ) WaveAcc0 = WaveAcc0 + WaveAcc2S0 - ! MacCamy-Fuchs scaled accleration should not contain second-order contributions - !IF (InputFileData%Waves%MCFD > 0) THEN - ! p%WaveAccMCF = p%WaveAccMCF + Waves2_InitOut%WaveAcc2S - !END IF - ENDIF + ! Particle acceleration -- sum frequency terms + ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2S + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ENDIF ! second order wave kinematics sum frequency results + ELSE ! these need to be set to zero since we don't have a UseWaves2 flag: InputFileData%Waves2%NWaveElevGrid = 0 @@ -500,7 +410,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! ... pointer data: InitOut%WaveElev1 => p%WaveField%WaveElev1 - InitOut%WaveDynP => p%WaveField%WaveDynP ! For Morison InitOut%WaveAcc => p%WaveField%WaveAcc ! For Morison InitOut%WaveVel => p%WaveField%WaveVel ! For Morison InitOut%PWaveDynP0 => p%WaveField%PWaveDynP0 ! For Morison @@ -543,7 +452,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! p%WaveField%WaveElev1 => Waves_InitOut%WaveElev ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc - ! p%WaveField%WaveDynP => Waves_InitOut%WaveDynP ! p%WaveField%PWaveVel0 => Waves_InitOut%PWaveVel0 ! p%WaveField%PWaveAcc0 => Waves_InitOut%PWaveAcc0 ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 @@ -562,13 +470,15 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Write Wave Kinematics? if ( InputFileData%Waves%WaveMod /= 6 ) then if ( InitInp%WrWvKinMod == 2 ) then - call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & + call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & p%Z_Depth, p%deltaGrid, p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & - InitOut%WaveVel, InitOut%WaveAcc, InitOut%WaveDynP, ErrStat, ErrMsg ) + InitOut%WaveVel, InitOut%WaveAcc, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%NStepWave, & p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & - p%WaveField%WaveTime, ErrStat, ErrMsg ) + p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if end if @@ -666,9 +576,73 @@ SUBROUTINE CleanUp() END SUBROUTINE CleanUp !................................ + END SUBROUTINE SeaSt_Init +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) + REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:) + REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:) + CHARACTER(*), INTENT(IN ) :: ArrayName + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & + SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4)) THEN + + ErrStat = ErrID_Fatal + ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & + 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=4)))//NewLine// & + 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=4))) + ELSE + ErrStat = ErrID_None + ErrMsg = "" + Array1 = Array1 + Array2 + ENDIF + +END SUBROUTINE AddArrays_4D +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) + REAL(SiKi), INTENT(INOUT) :: Array1(:,:,:,:,:) + REAL(SiKi), INTENT(IN ) :: Array2(:,:,:,:,:) + CHARACTER(*), INTENT(IN ) :: ArrayName + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & + SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & + SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=4) .OR. & + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=5)) THEN + + ErrStat = ErrID_Fatal + ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & + 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=4)))//'x'// & + TRIM(Num2LStr(SIZE(Array1,DIM=5)))//NewLine// & + 'Waves2: '// TRIM(Num2LStr(SIZE(Array2,DIM=1)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=2)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=4)))//'x'// & + TRIM(Num2LStr(SIZE(Array2,DIM=5))) + ELSE + ErrStat = ErrID_None + ErrMsg = "" + Array1 = Array1 + Array2 + ENDIF + +END SUBROUTINE AddArrays_5D !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index c2e104891f..5196e3c934 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -82,7 +82,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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) @@ -155,7 +154,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 79bc15c467..f845f440b8 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -232,13 +232,14 @@ MODULE SeaState_Output CONTAINS !==================================================================================================== -SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, NStepWave, WaveDT, X_HalfWidth, Y_HalfWidth, & +SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, WaveDT, X_HalfWidth, Y_HalfWidth, & Z_Depth, deltaGrid, NGrid, WaveElev1, WaveElev2, & - WaveVel, WaveAcc, WaveDynP, ErrStat, ErrMsg ) + WaveVel, WaveAcc, ErrStat, ErrMsg ) ! Passed variables CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. TYPE(ProgDesc), INTENT( IN ) :: SeaSt_Prog ! the name/version/date of the SeaState program + TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField !< WaveFieldType INTEGER, INTENT( IN ) :: NStepWave ! Number of time steps for the wave kinematics arrays real(DbKi), intent( in ) :: WaveDT real(ReKi), intent( in ) :: X_HalfWidth @@ -250,7 +251,6 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, NStepWave, WaveDT, X_ REAL(SiKi), pointer, INTENT( IN ) :: WaveElev2 (:,:,: ) ! Instantaneous wave elevations at requested locations - 2nd order REAL(SiKi), pointer, INTENT( IN ) :: WaveVel (:,:,:,:,:) ! The wave velocities (time,node,component) REAL(SiKi), pointer, INTENT( IN ) :: WaveAcc (:,:,:,:,:) ! The wave accelerations (time,node,component) - REAL(SiKi), pointer, INTENT( IN ) :: WaveDynP(:,:,:,:) ! The wave dynamic pressure (time,node) INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -319,7 +319,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, NStepWave, WaveDT, X_ CASE (6) WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (m,i,j,k,3) CASE (7) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveDynP(m,i,j,k ) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveDynP(m,i,j,k ) END SELECT !END IF END DO ! for i diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index cb414aa92c..3699be0fcd 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -103,7 +103,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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)] @@ -178,7 +177,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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)] @@ -742,7 +740,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel @@ -803,7 +800,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) - nullify(InitOutputData%WaveDynP) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveAccMCF) nullify(InitOutputData%WaveVel) @@ -856,14 +852,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveDynP)) - if (associated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) - call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDynP) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -1055,30 +1043,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) - OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP - else - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDynP => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1650,7 +1614,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveElev1 => SrcParamData%WaveElev1 DstParamData%WaveElev2 => SrcParamData%WaveElev2 DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 - DstParamData%WaveDynP => SrcParamData%WaveDynP DstParamData%WaveAcc => SrcParamData%WaveAcc DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 DstParamData%WaveVel => SrcParamData%WaveVel @@ -1760,7 +1723,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveElev1) nullify(ParamData%WaveElev2) nullify(ParamData%PWaveDynP0) - nullify(ParamData%WaveDynP) nullify(ParamData%WaveAcc) nullify(ParamData%PWaveAcc0) nullify(ParamData%WaveVel) @@ -1847,14 +1809,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveDynP0) end if end if - call RegPack(Buf, associated(InData%WaveDynP)) - if (associated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) - call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDynP) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -2080,30 +2034,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveDynP0 => null() end if - if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) - OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP - else - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDynP => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index f7a96cb9ad..0d0de18009 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -72,7 +72,6 @@ typedef ^ ^ SiKi WaveDirMin typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveDynP {*}{*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index f52ce2c477..3de9551954 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -90,7 +90,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] @@ -515,7 +514,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel @@ -552,7 +550,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveElevC)) then deallocate(InitOutputData%WaveElevC) end if - nullify(InitOutputData%WaveDynP) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveAccMCF) nullify(InitOutputData%WaveVel) @@ -581,14 +578,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveDynP)) - if (associated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) - call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveDynP) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -697,30 +686,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) - OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP - else - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveDynP => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From c332e923a51c4c4216777469e0c92e3a07e9fb7e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:12:52 -0600 Subject: [PATCH 012/232] SeaSt: remove extra `PWaveAccMCF0` pointers --- modules/seastate/src/SeaState.f90 | 2 - modules/seastate/src/SeaState.txt | 5 -- modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------- 5 files changed, 113 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 2b863f07a0..535d48d97a 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -229,7 +229,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 p%WaveAccMCF => p%WaveField%WaveAccMCF - p%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -416,7 +415,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison InitOut%WaveAccMCF => p%WaveField%WaveAccMCF ! For Morison (MacCamy-Fuchs) - InitOut%PWaveAccMCF0 => p%WaveField%PWaveAccMCF0 ! For Morison (MacCamy-Fuchs) InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 5196e3c934..4dd0590797 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -87,7 +87,6 @@ typedef ^ ^ SiKi WaveAccMCF 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 (grid) 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 PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) 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 (grid) 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 WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - @@ -159,10 +158,6 @@ typedef ^ ^ SiKi PWa 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 WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -#### vvvvvvvvvvvvvvvvvvvvvvvvv -#### The following 3 parameters aren't used in SeaState after initialization, but are stored as parameters so that we can deallocate the arrays and nullify the pointers in a consistent way (in one module) -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) -#### ^^^^^^^^^^^^^^^^^^^^^^^^^ typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 3699be0fcd..ecfc622a0a 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -108,7 +108,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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 (grid) 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(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] @@ -182,7 +181,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -745,7 +743,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 @@ -805,7 +802,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveVel) nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) - nullify(InitOutputData%PWaveAccMCF0) nullify(InitOutputData%PWaveVel0) nullify(InitOutputData%WaveElev1) nullify(InitOutputData%WaveElev2) @@ -892,14 +888,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - call RegPack(Buf, associated(InData%PWaveAccMCF0)) - if (associated(InData%PWaveAccMCF0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) - call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveAccMCF0) - end if - end if call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -1163,30 +1151,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%PWaveAcc0 => null() end if - if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) - OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 - else - allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) - call RegUnpack(Buf, OutData%PWaveAccMCF0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveAccMCF0 => null() - end if if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1619,7 +1583,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF - DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then LB(1:1) = lbound(SrcParamData%WaveKinxi) @@ -1728,7 +1691,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveVel) nullify(ParamData%PWaveVel0) nullify(ParamData%WaveAccMCF) - nullify(ParamData%PWaveAccMCF0) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) end if @@ -1849,14 +1811,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveAccMCF) end if end if - call RegPack(Buf, associated(InData%PWaveAccMCF0)) - if (associated(InData%PWaveAccMCF0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) - call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveAccMCF0) - end if - end if call RegPack(Buf, InData%NWaveKin) call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then @@ -2154,30 +2108,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveAccMCF => null() end if - if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) - OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 - else - allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) - call RegUnpack(Buf, OutData%PWaveAccMCF0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveAccMCF0 => null() - end if call RegUnpack(Buf, OutData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 0d0de18009..4f21fc9df5 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -77,7 +77,6 @@ typedef ^ ^ SiKi WaveAccMCF 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi PWaveAccMCF0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 3de9551954..e90bc2a215 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -95,7 +95,6 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] @@ -519,7 +518,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev if (allocated(SrcInitOutputData%WaveElev0)) then @@ -555,7 +553,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveVel) nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) - nullify(InitOutputData%PWaveAccMCF0) nullify(InitOutputData%PWaveVel0) nullify(InitOutputData%WaveElev) if (allocated(InitOutputData%WaveElev0)) then @@ -618,14 +615,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - call RegPack(Buf, associated(InData%PWaveAccMCF0)) - if (associated(InData%PWaveAccMCF0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) - call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveAccMCF0) - end if - end if call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -806,30 +795,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%PWaveAcc0 => null() end if - if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) - OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 - else - allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) - call RegUnpack(Buf, OutData%PWaveAccMCF0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveAccMCF0 => null() - end if if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 06c79dd2ab0dac4a66e6f11f789a0012f687ff64 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:18:07 -0600 Subject: [PATCH 013/232] SeaSt: remove extra `WaveAccMCF` pointers --- modules/seastate/src/SeaState.f90 | 3 -- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------- 5 files changed, 111 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 535d48d97a..0e9a7625df 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -228,7 +228,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%PWaveVel0 => p%WaveField%PWaveVel0 p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 - p%WaveAccMCF => p%WaveField%WaveAccMCF ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -414,7 +413,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%PWaveDynP0 => p%WaveField%PWaveDynP0 ! For Morison InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison - InitOut%WaveAccMCF => p%WaveField%WaveAccMCF ! For Morison (MacCamy-Fuchs) InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 @@ -453,7 +451,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! p%WaveField%PWaveVel0 => Waves_InitOut%PWaveVel0 ! p%WaveField%PWaveAcc0 => Waves_InitOut%PWaveAcc0 ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 - ! p%WaveField%WaveAccMCF => Waves_InitOut%WaveAccMCF ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( p%WaveField, InitOut%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 4dd0590797..6e76edbb8c 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -83,7 +83,6 @@ typedef ^ ^ SiKi WaveDir typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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 PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) @@ -157,7 +156,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index ecfc622a0a..cf477d9a37 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -104,7 +104,6 @@ MODULE SeaState_Types LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] @@ -180,7 +179,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -739,7 +737,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc - DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 @@ -798,7 +795,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveAcc) - nullify(InitOutputData%WaveAccMCF) nullify(InitOutputData%WaveVel) nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) @@ -856,14 +852,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveAcc) end if end if - call RegPack(Buf, associated(InData%WaveAccMCF)) - if (associated(InData%WaveAccMCF)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) - call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveAccMCF) - end if - end if call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -1055,30 +1043,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveAcc => null() end if - if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) - OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF - else - allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) - call RegUnpack(Buf, OutData%WaveAccMCF) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveAccMCF => null() - end if if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1582,7 +1546,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 - DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then LB(1:1) = lbound(SrcParamData%WaveKinxi) @@ -1690,7 +1653,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%PWaveAcc0) nullify(ParamData%WaveVel) nullify(ParamData%PWaveVel0) - nullify(ParamData%WaveAccMCF) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) end if @@ -1803,14 +1765,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveVel0) end if end if - call RegPack(Buf, associated(InData%WaveAccMCF)) - if (associated(InData%WaveAccMCF)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) - call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveAccMCF) - end if - end if call RegPack(Buf, InData%NWaveKin) call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then @@ -2084,30 +2038,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveVel0 => null() end if - if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) - OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF - else - allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) - call RegUnpack(Buf, OutData%WaveAccMCF) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveAccMCF => null() - end if call RegUnpack(Buf, OutData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 4f21fc9df5..77bd1599ee 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -73,7 +73,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi WaveAccMCF {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index e90bc2a215..c460d19e8d 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -91,7 +91,6 @@ MODULE Waves_Types INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] @@ -514,7 +513,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc - DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 @@ -549,7 +547,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%WaveElevC) end if nullify(InitOutputData%WaveAcc) - nullify(InitOutputData%WaveAccMCF) nullify(InitOutputData%WaveVel) nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) @@ -583,14 +580,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveAcc) end if end if - call RegPack(Buf, associated(InData%WaveAccMCF)) - if (associated(InData%WaveAccMCF)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) - call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveAccMCF) - end if - end if call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -699,30 +688,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveAcc => null() end if - if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) - OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF - else - allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) - call RegUnpack(Buf, OutData%WaveAccMCF) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveAccMCF => null() - end if if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 9d59f1964969fffcbbed20c1bee825719d6e0e12 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:22:11 -0600 Subject: [PATCH 014/232] SeaSt: remove extra `PWaveVel0` pointers --- modules/seastate/src/SeaState.f90 | 3 -- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.f90 | 1 - modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------- 6 files changed, 112 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0e9a7625df..557d1248c0 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -225,7 +225,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveElev1 => p%WaveField%WaveElev1 p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc - p%PWaveVel0 => p%WaveField%PWaveVel0 p%PWaveAcc0 => p%WaveField%PWaveAcc0 p%PWaveDynP0 => p%WaveField%PWaveDynP0 @@ -412,7 +411,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveVel => p%WaveField%WaveVel ! For Morison InitOut%PWaveDynP0 => p%WaveField%PWaveDynP0 ! For Morison InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison - InitOut%PWaveVel0 => p%WaveField%PWaveVel0 ! For Morison InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 @@ -448,7 +446,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! p%WaveField%WaveElev1 => Waves_InitOut%WaveElev ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc - ! p%WaveField%PWaveVel0 => Waves_InitOut%PWaveVel0 ! p%WaveField%PWaveAcc0 => Waves_InitOut%PWaveAcc0 ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 6e76edbb8c..6c5b936fb5 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -86,7 +86,6 @@ typedef ^ ^ SiKi WaveAcc 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 (grid) 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 PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) -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 (grid) 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 WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) @@ -155,7 +154,6 @@ typedef ^ ^ SiKi PWa typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi PWaveVel0 {*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index cf477d9a37..9d001f2af8 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -107,7 +107,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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 (grid) 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(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] @@ -178,7 +177,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -740,7 +738,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 @@ -798,7 +795,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveVel) nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) - nullify(InitOutputData%PWaveVel0) nullify(InitOutputData%WaveElev1) nullify(InitOutputData%WaveElev2) nullify(InitOutputData%WaveElev0) @@ -876,14 +872,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - call RegPack(Buf, associated(InData%PWaveVel0)) - if (associated(InData%PWaveVel0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) - call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveVel0) - end if - end if call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -1115,30 +1103,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%PWaveAcc0 => null() end if - if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) - OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 - else - allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) - call RegUnpack(Buf, OutData%PWaveVel0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveVel0 => null() - end if if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1545,7 +1509,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveAcc => SrcParamData%WaveAcc DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 DstParamData%WaveVel => SrcParamData%WaveVel - DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then LB(1:1) = lbound(SrcParamData%WaveKinxi) @@ -1652,7 +1615,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveAcc) nullify(ParamData%PWaveAcc0) nullify(ParamData%WaveVel) - nullify(ParamData%PWaveVel0) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) end if @@ -1757,14 +1719,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - call RegPack(Buf, associated(InData%PWaveVel0)) - if (associated(InData%PWaveVel0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) - call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveVel0) - end if - end if call RegPack(Buf, InData%NWaveKin) call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then @@ -2014,30 +1968,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveVel => null() end if - if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) - OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 - else - allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) - call RegUnpack(Buf, OutData%PWaveVel0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveVel0 => null() - end if call RegUnpack(Buf, OutData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 2aba6b7cde..20a02888f2 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -1340,7 +1340,6 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! mean sea level, the wave kinematics are zero: ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 - ! InitOut%PWaveVel0 (:,:,:,:,:) = 0.0 ! InitOut%PWaveAcc0 (:,:,:,:,:) = 0.0 primeCount = 1 diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 77bd1599ee..1297c43e99 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -76,7 +76,6 @@ typedef ^ ^ SiKi WaveAcc 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) -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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index c460d19e8d..df4f056113 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -94,7 +94,6 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveVel0 => NULL() !< 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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] @@ -516,7 +515,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev if (allocated(SrcInitOutputData%WaveElev0)) then LB(1:1) = lbound(SrcInitOutputData%WaveElev0) @@ -550,7 +548,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveVel) nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) - nullify(InitOutputData%PWaveVel0) nullify(InitOutputData%WaveElev) if (allocated(InitOutputData%WaveElev0)) then deallocate(InitOutputData%WaveElev0) @@ -604,14 +601,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - call RegPack(Buf, associated(InData%PWaveVel0)) - if (associated(InData%PWaveVel0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) - call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveVel0) - end if - end if call RegPack(Buf, associated(InData%WaveElev)) if (associated(InData%WaveElev)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) @@ -760,30 +749,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%PWaveAcc0 => null() end if - if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) - OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 - else - allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) - call RegUnpack(Buf, OutData%PWaveVel0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveVel0 => null() - end if if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 1cd33977125adcd46af1dc97b151851650b15b5b Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:27:20 -0600 Subject: [PATCH 015/232] SeaSt: remove extra `PWaveDynP0` pointers --- modules/seastate/src/SeaState.f90 | 2 - modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------- 5 files changed, 110 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 557d1248c0..60f30a1c1b 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -226,7 +226,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc p%PWaveAcc0 => p%WaveField%PWaveAcc0 - p%PWaveDynP0 => p%WaveField%PWaveDynP0 ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -409,7 +408,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveElev1 => p%WaveField%WaveElev1 InitOut%WaveAcc => p%WaveField%WaveAcc ! For Morison InitOut%WaveVel => p%WaveField%WaveVel ! For Morison - InitOut%PWaveDynP0 => p%WaveField%PWaveDynP0 ! For Morison InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 6c5b936fb5..832ecd7bef 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -84,7 +84,6 @@ typedef ^ ^ LOGICAL WaveMultiDir typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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 PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - @@ -150,7 +149,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - -typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 9d001f2af8..acdda19489 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -105,7 +105,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] @@ -173,7 +172,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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)] @@ -736,7 +734,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 @@ -793,7 +790,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) - nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) nullify(InitOutputData%WaveElev1) nullify(InitOutputData%WaveElev2) @@ -856,14 +852,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - call RegPack(Buf, associated(InData%PWaveDynP0)) - if (associated(InData%PWaveDynP0)) then - call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) - call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveDynP0) - end if - end if call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -1055,30 +1043,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) - OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 - else - allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) - call RegUnpack(Buf, OutData%PWaveDynP0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveDynP0 => null() - end if if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1505,7 +1469,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveElev1 => SrcParamData%WaveElev1 DstParamData%WaveElev2 => SrcParamData%WaveElev2 - DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 DstParamData%WaveAcc => SrcParamData%WaveAcc DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 DstParamData%WaveVel => SrcParamData%WaveVel @@ -1611,7 +1574,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) end if nullify(ParamData%WaveElev1) nullify(ParamData%WaveElev2) - nullify(ParamData%PWaveDynP0) nullify(ParamData%WaveAcc) nullify(ParamData%PWaveAcc0) nullify(ParamData%WaveVel) @@ -1687,14 +1649,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveElev2) end if end if - call RegPack(Buf, associated(InData%PWaveDynP0)) - if (associated(InData%PWaveDynP0)) then - call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) - call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveDynP0) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -1872,30 +1826,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveElev2 => null() end if - if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) - OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 - else - allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) - call RegUnpack(Buf, OutData%PWaveDynP0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveDynP0 => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 1297c43e99..d5aca9e9af 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -74,7 +74,6 @@ typedef ^ ^ INTEGER WaveNDir typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi PWaveDynP0 {*}{*}{*} - - "Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index df4f056113..a8f769160a 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -92,7 +92,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: PWaveDynP0 => NULL() !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] @@ -513,7 +512,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev if (allocated(SrcInitOutputData%WaveElev0)) then @@ -546,7 +544,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) - nullify(InitOutputData%PWaveDynP0) nullify(InitOutputData%PWaveAcc0) nullify(InitOutputData%WaveElev) if (allocated(InitOutputData%WaveElev0)) then @@ -585,14 +582,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - call RegPack(Buf, associated(InData%PWaveDynP0)) - if (associated(InData%PWaveDynP0)) then - call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) - call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveDynP0) - end if - end if call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -701,30 +690,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) - OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 - else - allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) - call RegUnpack(Buf, OutData%PWaveDynP0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveDynP0 => null() - end if if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 36b5b959bb053d415e5d228256abc9130a8bb304 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:35:01 -0600 Subject: [PATCH 016/232] SeaSt: remove extra `PWaveAcc0` pointers --- modules/seastate/src/SeaState.f90 | 3 -- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.f90 | 1 - modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------- 6 files changed, 112 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 60f30a1c1b..3d2ffcb83a 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -225,7 +225,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveElev1 => p%WaveField%WaveElev1 p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc - p%PWaveAcc0 => p%WaveField%PWaveAcc0 ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -408,7 +407,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveElev1 => p%WaveField%WaveElev1 InitOut%WaveAcc => p%WaveField%WaveAcc ! For Morison InitOut%WaveVel => p%WaveField%WaveVel ! For Morison - InitOut%PWaveAcc0 => p%WaveField%PWaveAcc0 ! For Morison InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 @@ -444,7 +442,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! p%WaveField%WaveElev1 => Waves_InitOut%WaveElev ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc - ! p%WaveField%PWaveAcc0 => Waves_InitOut%PWaveAcc0 ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 832ecd7bef..7ffc89cc44 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -84,7 +84,6 @@ typedef ^ ^ LOGICAL WaveMultiDir typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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 PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) @@ -150,7 +149,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) -typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index acdda19489..347c239ef2 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -105,7 +105,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] @@ -173,7 +172,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -734,7 +732,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 @@ -790,7 +787,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) - nullify(InitOutputData%PWaveAcc0) nullify(InitOutputData%WaveElev1) nullify(InitOutputData%WaveElev2) nullify(InitOutputData%WaveElev0) @@ -852,14 +848,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - call RegPack(Buf, associated(InData%PWaveAcc0)) - if (associated(InData%PWaveAcc0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) - call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveAcc0) - end if - end if call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -1043,30 +1031,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) - OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 - else - allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) - call RegUnpack(Buf, OutData%PWaveAcc0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveAcc0 => null() - end if if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1470,7 +1434,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveElev1 => SrcParamData%WaveElev1 DstParamData%WaveElev2 => SrcParamData%WaveElev2 DstParamData%WaveAcc => SrcParamData%WaveAcc - DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then @@ -1575,7 +1538,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveElev1) nullify(ParamData%WaveElev2) nullify(ParamData%WaveAcc) - nullify(ParamData%PWaveAcc0) nullify(ParamData%WaveVel) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) @@ -1657,14 +1619,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveAcc) end if end if - call RegPack(Buf, associated(InData%PWaveAcc0)) - if (associated(InData%PWaveAcc0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) - call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveAcc0) - end if - end if call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -1850,30 +1804,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveAcc => null() end if - if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) - OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 - else - allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) - call RegUnpack(Buf, OutData%PWaveAcc0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveAcc0 => null() - end if if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 20a02888f2..c9234f9f1f 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -1340,7 +1340,6 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! mean sea level, the wave kinematics are zero: ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 - ! InitOut%PWaveAcc0 (:,:,:,:,:) = 0.0 primeCount = 1 count = 1 diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index d5aca9e9af..a9c4863bac 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -74,7 +74,6 @@ typedef ^ ^ INTEGER WaveNDir typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ ^ SiKi PWaveAcc0 {*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index a8f769160a..f63c8fc603 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -92,7 +92,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAcc0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] @@ -512,7 +511,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev if (allocated(SrcInitOutputData%WaveElev0)) then LB(1:1) = lbound(SrcInitOutputData%WaveElev0) @@ -544,7 +542,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) - nullify(InitOutputData%PWaveAcc0) nullify(InitOutputData%WaveElev) if (allocated(InitOutputData%WaveElev0)) then deallocate(InitOutputData%WaveElev0) @@ -582,14 +579,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - call RegPack(Buf, associated(InData%PWaveAcc0)) - if (associated(InData%PWaveAcc0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) - call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%PWaveAcc0) - end if - end if call RegPack(Buf, associated(InData%WaveElev)) if (associated(InData%WaveElev)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) @@ -690,30 +679,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) - OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 - else - allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) - call RegUnpack(Buf, OutData%PWaveAcc0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%PWaveAcc0 => null() - end if if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 73ef85624327e1f212b343281df22c8e891e6d05 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 11:42:57 -0600 Subject: [PATCH 017/232] SeaSt: remove extra `WaveElev1` and `WaveElev2` pointers --- modules/seastate/src/SeaState.f90 | 45 ++---- modules/seastate/src/SeaState.txt | 4 - modules/seastate/src/SeaState_DriverCode.f90 | 18 ++- modules/seastate/src/SeaState_Output.f90 | 25 ++-- modules/seastate/src/SeaState_Types.f90 | 140 ------------------- modules/seastate/src/Waves2.f90 | 4 +- modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 38 ----- 8 files changed, 32 insertions(+), 243 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 3d2ffcb83a..f500f4dbfa 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -222,7 +222,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below ! Copy Waves_InitOut pointer information before calling cleanup (to avoid memory problems): - p%WaveElev1 => p%WaveField%WaveElev1 p%WaveVel => p%WaveField%WaveVel p%WaveAcc => p%WaveField%WaveAcc @@ -282,41 +281,26 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves2%WaveDOmega = Waves_InitOut%WaveDOmega CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) - p%WaveElev2 => p%WaveField%WaveElev2 ! do this before calling cleanup() so that pointers get deallocated properly - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - ! If we calculated wave elevations, it is now stored in p%WaveElev. So we need to add the corrections. - IF (InputFileData%Waves2%NWaveElevGrid > 0 ) THEN - ! Make sure the sizes of the two resulting arrays are identical... - IF ( SIZE(p%WaveElev1,DIM=1) /= SIZE(p%WaveElev2,DIM=1) .OR. & - SIZE(p%WaveElev1,DIM=2) /= SIZE(p%WaveElev2,DIM=2)) THEN - CALL SetErrStat(ErrID_Fatal,' WaveElev(NWaveElev) arrays for first and second order wave elevations are of different sizes.',ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - ELSE - InitOut%WaveElev2 => p%WaveElev2 - ENDIF - ENDIF - ! The acceleration, velocity, and dynamic pressures will get added to the parts passed to the morrison module later... ! Difference frequency results IF ( p%Waves2%WvDiffQTFF ) THEN ! Dynamic pressure -- difference frequency terms - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle velocity -- difference frequency terms - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2D + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel_D', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2D CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle acceleration -- difference frequency terms - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2D + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc_D', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2D CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -326,16 +310,16 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF ( p%Waves2%WvSumQTFF ) THEN ! Dynamic pressure -- sum frequency terms - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle velocity -- sum frequency terms - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2S + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel_S', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2S CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Particle acceleration -- sum frequency terms ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2S + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc_S', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2S CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ENDIF ! second order wave kinematics sum frequency results @@ -404,7 +388,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! ... pointer data: - InitOut%WaveElev1 => p%WaveField%WaveElev1 InitOut%WaveAcc => p%WaveField%WaveAcc ! For Morison InitOut%WaveVel => p%WaveField%WaveVel ! For Morison InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT @@ -439,7 +422,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%MSL2SWL = InitOut%MSL2SWL p%WaveField%EffWtrDpth = p%EffWtrDpth ! Effective water depth measured from the SWL p%WaveField%WaveStMod = p%WaveStMod - ! p%WaveField%WaveElev1 => Waves_InitOut%WaveElev ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 @@ -458,12 +440,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init if ( InputFileData%Waves%WaveMod /= 6 ) then if ( InitInp%WrWvKinMod == 2 ) then call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & - p%Z_Depth, p%deltaGrid, p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & - InitOut%WaveVel, InitOut%WaveAcc, ErrStat2, ErrMsg2 ) + p%Z_Depth, p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%NStepWave, & - p%NGrid, InitOut%WaveElev1, InitOut%WaveElev2, & + p%NGrid, p%WaveField%WaveElev1, p%WaveField%WaveElev2, & p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if @@ -484,15 +465,15 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init do it = 1,size(p%WaveField%WaveTime) do i = 1, size(InitOut%WaveElevSeries,DIM=2) - InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do end do - if (associated(p%WaveElev2)) then + if (allocated(p%WaveField%WaveElev2)) then do it = 1,size(p%WaveField%WaveTime) do i = 1, size(InitOut%WaveElevSeries,DIM=2) - TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) InitOut%WaveElevSeries(it,i) = InitOut%WaveElevSeries(it,i) + TmpElev end do @@ -573,6 +554,8 @@ SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ErrStat = ErrID_None + ErrMsg = "" IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & @@ -590,8 +573,6 @@ SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) TRIM(Num2LStr(SIZE(Array2,DIM=3)))//'x'// & TRIM(Num2LStr(SIZE(Array2,DIM=4))) ELSE - ErrStat = ErrID_None - ErrMsg = "" Array1 = Array1 + Array2 ENDIF diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 7ffc89cc44..69ae2317f0 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -84,8 +84,6 @@ typedef ^ ^ LOGICAL WaveMultiDir typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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 WaveElev1 {*}{*}{*} - - "First order wave elevation" - -typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - @@ -146,8 +144,6 @@ typedef ^ ^ INTEGER NSt typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation" - -typedef ^ ^ SiKi WaveElev2 {*}{*}{*} - - "Second order wave elevation" - typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi 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 ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index a762314b39..8821f86522 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -624,8 +624,6 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S ErrMsg = "" ErrStat = ErrID_None - ErrMsgTmp = "" - ErrStatTmp = ErrID_None ! If we calculated the wave elevation at a set of coordinates for use with making movies, put it into an output file @@ -637,12 +635,12 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S if ( ErrStat >= AbortErrLev ) return end if - if (associated(SeaState_p%WaveElev2)) then - maxWaveVal = MAXVAL(SeaState_p%WaveElev1+SeaState_p%WaveElev2) - minWaveVal = MINVAL(SeaState_p%WaveElev1+SeaState_p%WaveElev2) + if (allocated(SeaState_p%WaveField%WaveElev2)) then + maxWaveVal = MAXVAL(SeaState_p%WaveField%WaveElev1 + SeaState_p%WaveField%WaveElev2) + minWaveVal = MINVAL(SeaState_p%WaveField%WaveElev1 + SeaState_p%WaveField%WaveElev2) else - maxWaveVal = MAXVAL(SeaState_p%WaveElev1) - minWaveVal = MINVAL(SeaState_p%WaveElev1) + maxWaveVal = MAXVAL(SeaState_p%WaveField%WaveElev1) + minWaveVal = MINVAL(SeaState_p%WaveField%WaveElev1) end if ! Write some useful header information @@ -673,10 +671,10 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S xpos = -SeaState_p%deltaGrid(1)*(SeaState_p%NGrid(1)-1)/2.0 + (J-1)*SeaState_p%deltaGrid(1) do k=1, SeaState_p%NGrid(2) ypos = -SeaState_p%deltaGrid(2)*(SeaState_p%NGrid(2)-1)/2.0 + (K-1)*SeaState_p%deltaGrid(2) - if (associated(SeaState_p%WaveElev2)) then - WaveElev = SeaState_p%WaveElev1(I,J,K) + SeaState_p%WaveElev2(I,J,K) + if (allocated(SeaState_p%WaveField%WaveElev2)) then + WaveElev = SeaState_p%WaveField%WaveElev1(I,J,K) + SeaState_p%WaveField%WaveElev2(I,J,K) else - WaveElev = SeaState_p%WaveElev1(I,J,K) + WaveElev = SeaState_p%WaveField%WaveElev1(I,J,K) end if write (WaveElevFileUn,WaveElevFmt, IOSTAT=ErrStatTmp ) xpos, ypos, WaveElev end do diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index f845f440b8..e7ddeb3854 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -233,8 +233,7 @@ MODULE SeaState_Output !==================================================================================================== SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, WaveDT, X_HalfWidth, Y_HalfWidth, & - Z_Depth, deltaGrid, NGrid, WaveElev1, WaveElev2, & - WaveVel, WaveAcc, ErrStat, ErrMsg ) + Z_Depth, deltaGrid, NGrid, ErrStat, ErrMsg ) ! Passed variables CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. @@ -247,10 +246,6 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, real(ReKi), intent( in ) :: Z_Depth real(ReKi), intent( in ) :: deltaGrid(3) INTEGER, INTENT( IN ) :: NGrid(3) ! Number of grid points for the wave kinematics arrays - REAL(SiKi), pointer, INTENT( IN ) :: WaveElev1 (:,:,: ) ! Instantaneous wave elevations at requested locations - 1st order - REAL(SiKi), pointer, INTENT( IN ) :: WaveElev2 (:,:,: ) ! Instantaneous wave elevations at requested locations - 2nd order - REAL(SiKi), pointer, INTENT( IN ) :: WaveVel (:,:,:,:,:) ! The wave velocities (time,node,component) - REAL(SiKi), pointer, INTENT( IN ) :: WaveAcc (:,:,:,:,:) ! The wave accelerations (time,node,component) INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -307,17 +302,17 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, SELECT CASE (iFile) CASE (1) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveVel (m,i,j,k,1) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveVel (m,i,j,k,1) CASE (2) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveVel (m,i,j,k,2) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveVel (m,i,j,k,2) CASE (3) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveVel (m,i,j,k,3) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveVel (m,i,j,k,3) CASE (4) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (m,i,j,k,1) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveAcc (m,i,j,k,1) CASE (5) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (m,i,j,k,2) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveAcc (m,i,j,k,2) CASE (6) - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveAcc (m,i,j,k,3) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveAcc (m,i,j,k,3) CASE (7) WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveDynP(m,i,j,k ) END SELECT @@ -352,10 +347,10 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, DO m= 0,NStepWave do j = 1, NGrid(2) do i = 1, NGrid(1) - if ( associated(WaveElev2) ) then - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveElev1(m,i,j) + WaveElev2(m,i,j) + if ( allocated(WaveField%WaveElev2) ) then + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveElev1(m,i,j) + WaveField%WaveElev2(m,i,j) else - WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveElev1(m,i,j) + WRITE(UnWv,Frmt,ADVANCE='no') Delim, WaveField%WaveElev1(m,i,j) end if end do WRITE (UnWv,'()', IOSTAT=ErrStat) ! write the line return diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 347c239ef2..829db30356 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -105,8 +105,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -169,8 +167,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] @@ -732,8 +728,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 - DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave @@ -787,8 +781,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) - nullify(InitOutputData%WaveElev1) - nullify(InitOutputData%WaveElev2) nullify(InitOutputData%WaveElev0) call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -848,22 +840,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - call RegPack(Buf, associated(InData%WaveElev1)) - if (associated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) - call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev1) - end if - end if - call RegPack(Buf, associated(InData%WaveElev2)) - if (associated(InData%WaveElev2)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) - call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev2) - end if - end if call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -1031,54 +1007,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) - OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 - else - allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev1 => null() - end if - if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) - OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 - else - allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) - call RegUnpack(Buf, OutData%WaveElev2) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev2 => null() - end if if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1431,8 +1359,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveElevyi = SrcParamData%WaveElevyi end if - DstParamData%WaveElev1 => SrcParamData%WaveElev1 - DstParamData%WaveElev2 => SrcParamData%WaveElev2 DstParamData%WaveAcc => SrcParamData%WaveAcc DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%NWaveKin = SrcParamData%NWaveKin @@ -1535,8 +1461,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%WaveElevyi)) then deallocate(ParamData%WaveElevyi) end if - nullify(ParamData%WaveElev1) - nullify(ParamData%WaveElev2) nullify(ParamData%WaveAcc) nullify(ParamData%WaveVel) if (allocated(ParamData%WaveKinxi)) then @@ -1595,22 +1519,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if - call RegPack(Buf, associated(InData%WaveElev1)) - if (associated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) - call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev1) - end if - end if - call RegPack(Buf, associated(InData%WaveElev2)) - if (associated(InData%WaveElev2)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) - call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev2) - end if - end if call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -1732,54 +1640,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevyi) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) - OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 - else - allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev1 => null() - end if - if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) - OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 - else - allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) - call RegUnpack(Buf, OutData%WaveElev2) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev2 => null() - end if if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index 9b84aa2138..cd11aedac7 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -411,10 +411,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) RETURN END IF - !InitOut%WaveElev2 => WaveField%WaveElev2 - !Initialize the output arrays to zero. We will only fill it in for the points we calculate. - WaveField%WaveElev2 = 0.0_SiKi + WaveField%WaveElev2 = 0.0_SiKi InitOut%WaveVel2D = 0.0_SiKi InitOut%WaveAcc2D = 0.0_SiKi InitOut%WaveDynP2D = 0.0_SiKi diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index cd8e296ebd..09a56e003e 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -54,7 +54,6 @@ typedef ^ ^ SiKi WaveAcc2S typedef ^ ^ SiKi WaveDynP2S {:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (N/m^2) typedef ^ ^ SiKi WaveVel2D {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveVel2S {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) -typedef ^ InitOutputType SiKi WaveElev2 {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the NWaveElevGrid points where the incident wave elevations can be output" (meters) diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 3d39170214..4b4a13f967 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -65,7 +65,6 @@ MODULE Waves2_Types REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveDynP2S !< Instantaneous 2nd-order sum frequency correction for the dynamic pressure of incident waves , at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2D !< Instantaneous 2nd-order difference frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2S !< Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Instantaneous elevation time-series of incident waves at each of the NWaveElevGrid points where the incident wave elevations can be output [(meters)] END TYPE Waves2_InitOutputType ! ======================= ! ========= Waves2_ParameterType ======= @@ -369,7 +368,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S end if - DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 end subroutine subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -397,14 +395,12 @@ subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveVel2S)) then deallocate(InitOutputData%WaveVel2S) end if - nullify(InitOutputData%WaveElev2) end subroutine subroutine Waves2_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Waves2_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' - logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WaveAcc2D)) if (allocated(InData%WaveAcc2D)) then @@ -436,14 +432,6 @@ subroutine Waves2_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S), ubound(InData%WaveVel2S)) call RegPack(Buf, InData%WaveVel2S) end if - call RegPack(Buf, associated(InData%WaveElev2)) - if (associated(InData%WaveElev2)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) - call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev2) - end if - end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -454,8 +442,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) integer(IntKi) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx - type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WaveAcc2D)) deallocate(OutData%WaveAcc2D) call RegUnpack(Buf, IsAllocAssoc) @@ -541,30 +527,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveVel2S) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) - OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 - else - allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) - call RegUnpack(Buf, OutData%WaveElev2) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev2 => null() - end if end subroutine subroutine Waves2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) From 82aa4dc9721c561e90af394c9b80da626a5e5689 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 13:40:48 -0600 Subject: [PATCH 018/232] SeaSt: fix bug in ca755c20 --- modules/seastate/src/SeaState.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index f500f4dbfa..32375083d9 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -589,8 +589,8 @@ SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & - SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=4) .OR. & - SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=5)) THEN + SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4) .OR. & + SIZE(Array1,DIM=5) /= SIZE(Array2,DIM=5)) THEN ErrStat = ErrID_Fatal ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & From 0d14ff3c043ead268f29bf4918023e4af21f5e27 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 13:48:53 -0600 Subject: [PATCH 019/232] SeaSt: remove extra `WaveAcc` pointers --- modules/seastate/src/SeaState.f90 | 3 -- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 70 ------------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------- 5 files changed, 111 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 32375083d9..167a248808 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -223,7 +223,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves_InitOut pointer information before calling cleanup (to avoid memory problems): p%WaveVel => p%WaveField%WaveVel - p%WaveAcc => p%WaveField%WaveAcc ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -388,7 +387,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! ... pointer data: - InitOut%WaveAcc => p%WaveField%WaveAcc ! For Morison InitOut%WaveVel => p%WaveField%WaveVel ! For Morison InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 @@ -423,7 +421,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%EffWtrDpth = p%EffWtrDpth ! Effective water depth measured from the SWL p%WaveField%WaveStMod = p%WaveStMod ! p%WaveField%WaveVel => Waves_InitOut%WaveVel - ! p%WaveField%WaveAcc => Waves_InitOut%WaveAcc ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 69ae2317f0..d066b3d1bb 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -82,7 +82,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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 WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - @@ -144,7 +143,6 @@ typedef ^ ^ INTEGER NSt typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi 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 ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 829db30356..022934587d 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -103,7 +103,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] @@ -167,7 +166,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -726,7 +724,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg @@ -779,7 +776,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) - nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) nullify(InitOutputData%WaveElev0) call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) @@ -824,14 +820,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveAcc)) - if (associated(InData%WaveAcc)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) - call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveAcc) - end if - end if call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -959,30 +947,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) - OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc - else - allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) - call RegUnpack(Buf, OutData%WaveAcc) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveAcc => null() - end if if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1359,7 +1323,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveElevyi = SrcParamData%WaveElevyi end if - DstParamData%WaveAcc => SrcParamData%WaveAcc DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then @@ -1461,7 +1424,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%WaveElevyi)) then deallocate(ParamData%WaveElevyi) end if - nullify(ParamData%WaveAcc) nullify(ParamData%WaveVel) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) @@ -1519,14 +1481,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if - call RegPack(Buf, associated(InData%WaveAcc)) - if (associated(InData%WaveAcc)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) - call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveAcc) - end if - end if call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -1640,30 +1594,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevyi) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) - OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc - else - allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) - call RegUnpack(Buf, OutData%WaveAcc) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveAcc => null() - end if if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index a9c4863bac..dfab2c2b1b 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -72,7 +72,6 @@ typedef ^ ^ SiKi WaveDirMin typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveAcc {*}{*}{*}{*}{*} - - "Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed" (m/s^2) typedef ^ ^ SiKi WaveVel {*}{*}{*}{*}{*} - - "Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index f63c8fc603..1c18ac473d 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -90,7 +90,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] @@ -509,7 +508,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev if (allocated(SrcInitOutputData%WaveElev0)) then @@ -540,7 +538,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveElevC)) then deallocate(InitOutputData%WaveElevC) end if - nullify(InitOutputData%WaveAcc) nullify(InitOutputData%WaveVel) nullify(InitOutputData%WaveElev) if (allocated(InitOutputData%WaveElev0)) then @@ -563,14 +560,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveAcc)) - if (associated(InData%WaveAcc)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) - call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveAcc) - end if - end if call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -631,30 +620,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) - OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc - else - allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) - call RegUnpack(Buf, OutData%WaveAcc) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveAcc => null() - end if if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From b8c70010151e2fe1444a4be6ebd4a1c6233723e1 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 13:51:58 -0600 Subject: [PATCH 020/232] SeaSt: remove extra `WaveVel` pointers --- modules/seastate/src/SeaState.f90 | 4 -- modules/seastate/src/SeaState.txt | 2 - modules/seastate/src/SeaState_Types.f90 | 90 +++---------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 39 +---------- 5 files changed, 12 insertions(+), 124 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 167a248808..aa79c07cc4 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -221,8 +221,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below - ! Copy Waves_InitOut pointer information before calling cleanup (to avoid memory problems): - p%WaveVel => p%WaveField%WaveVel ! check error (must be done AFTER moving pointers to parameters) IF ( ErrStat >= AbortErrLev ) THEN @@ -387,7 +385,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! ... pointer data: - InitOut%WaveVel => p%WaveField%WaveVel ! For Morison InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT InitOut%WaveElev0 => p%WaveField%WaveElev0 @@ -420,7 +417,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%MSL2SWL = InitOut%MSL2SWL p%WaveField%EffWtrDpth = p%EffWtrDpth ! Effective water depth measured from the SWL p%WaveField%WaveStMod = p%WaveStMod - ! p%WaveField%WaveVel => Waves_InitOut%WaveVel ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index d066b3d1bb..e21d7032eb 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -82,7 +82,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi 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 (grid) 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 WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - @@ -143,7 +142,6 @@ typedef ^ ^ INTEGER NSt typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ 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 ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics can be output" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 022934587d..30dae38914 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -103,7 +103,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) 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(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -166,7 +165,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< 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)] INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] @@ -681,7 +679,7 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' @@ -724,7 +722,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave @@ -776,7 +773,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) - nullify(InitOutputData%WaveVel) nullify(InitOutputData%WaveElev0) call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -820,14 +816,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveVel)) - if (associated(InData%WaveVel)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) - call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveVel) - end if - end if call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -870,7 +858,7 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -947,30 +935,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) - OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel - else - allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) - call RegUnpack(Buf, OutData%WaveVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveVel => null() - end if if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1280,8 +1244,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyParam' @@ -1323,7 +1287,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveElevyi = SrcParamData%WaveElevyi end if - DstParamData%WaveVel => SrcParamData%WaveVel DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then LB(1:1) = lbound(SrcParamData%WaveKinxi) @@ -1409,8 +1372,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) type(SeaSt_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' @@ -1424,7 +1387,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%WaveElevyi)) then deallocate(ParamData%WaveElevyi) end if - nullify(ParamData%WaveVel) if (allocated(ParamData%WaveKinxi)) then deallocate(ParamData%WaveKinxi) end if @@ -1457,8 +1419,8 @@ subroutine SeaSt_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackParam' - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call Waves2_PackParam(Buf, InData%Waves2) @@ -1481,14 +1443,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if - call RegPack(Buf, associated(InData%WaveVel)) - if (associated(InData%WaveVel)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) - call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveVel) - end if - end if call RegPack(Buf, InData%NWaveKin) call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then @@ -1540,8 +1494,8 @@ subroutine SeaSt_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -1594,30 +1548,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevyi) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) - OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel - else - allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) - call RegUnpack(Buf, OutData%WaveVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveVel => null() - end if call RegUnpack(Buf, OutData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index dfab2c2b1b..c3f7935101 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -72,7 +72,6 @@ typedef ^ ^ SiKi WaveDirMin typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -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 NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 1c18ac473d..023a32cf49 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -90,7 +90,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveVel => NULL() !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] @@ -487,7 +486,7 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' ErrStat = ErrID_None @@ -508,7 +507,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev if (allocated(SrcInitOutputData%WaveElev0)) then LB(1:1) = lbound(SrcInitOutputData%WaveElev0) @@ -538,7 +536,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WaveElevC)) then deallocate(InitOutputData%WaveElevC) end if - nullify(InitOutputData%WaveVel) nullify(InitOutputData%WaveElev) if (allocated(InitOutputData%WaveElev0)) then deallocate(InitOutputData%WaveElev0) @@ -560,14 +557,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveVel)) - if (associated(InData%WaveVel)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) - call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveVel) - end if - end if call RegPack(Buf, associated(InData%WaveElev)) if (associated(InData%WaveElev)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) @@ -592,7 +581,7 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Waves_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitOutput' - integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -620,30 +609,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) - OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel - else - allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) - call RegUnpack(Buf, OutData%WaveVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveVel => null() - end if if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 59239948227ad0c0314ce349394689121dcdf431 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 14:02:19 -0600 Subject: [PATCH 021/232] SeaSt: remove extra `WaveElev0` pointers --- modules/hydrodyn/src/HydroDyn.f90 | 1 - modules/hydrodyn/src/SS_Excitation.f90 | 14 ---------- modules/seastate/src/SeaState.f90 | 1 - modules/seastate/src/SeaState.txt | 1 - modules/seastate/src/SeaState_Types.f90 | 35 ------------------------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 35 ------------------------- 7 files changed, 88 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 05622f5fe2..a9dd5df529 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -365,7 +365,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Init inputs for the SS_Excitation model (set this just in case it will be used) InputFileData%WAMIT%WaveDir = InitInp%WaveDir - ! CALL MOVE_ALLOC( InitInp%WaveElev0, InputFileData%WAMIT%WaveElev0 ) ! CALL MOVE_ALLOC( InitInp%WaveElevC, InputFileData%WAMIT%WaveElevC ) ! Temporarily move arrays to init input for WAMIT (save some space) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 145cdb37e5..835e642220 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -275,25 +275,11 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Allocate Wave-elevation related arrays p%NStepWave = InitInp%NStepWave - !allocate ( p%WaveElev0(0:p%NStepWave) , STAT=ErrStat2 ) - !IF (ErrStat2 /= 0) THEN - ! CALL SetErrStat(ErrID_Fatal,'Error allocating p%WaveElev0 array',ErrStat,ErrMsg,'SS_Exc_Init') - !end if - !allocate ( p%WaveTime (0:p%NStepWave) , STAT=ErrStat2 ) - !IF (ErrStat2 /= 0) THEN - ! CALL SetErrStat(ErrID_Fatal,'Error allocating p%WaveTime array',ErrStat,ErrMsg,'SS_Exc_Init') - !end if - ! - !IF (ErrStat >= AbortErrLev) THEN - ! CALL CleanUp() - ! RETURN - !END IF p%SeaSt_Interp_p = InitInp%SeaSt_Interp_p p%ExctnDisp = InitInp%ExctnDisp p%WaveTime => InitInp%WaveTime p%ExctnDisp = InitInp%ExctnDisp if (p%ExctnDisp == 0) then - ! call MOVE_ALLOC(InitInp%WaveElev0, p%WaveElev0) p%WaveElev0 => InitInp%WaveElev0 else p%WaveElev1 => InitInp%WaveElev1 diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index aa79c07cc4..f9dfa5dd40 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -386,7 +386,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! ... pointer data: InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT - InitOut%WaveElev0 => p%WaveField%WaveElev0 ! non-pointer data: InitOut%WaveDirMin = Waves_InitOut%WaveDirMin ! For WAMIT and WAMIT2 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index e21d7032eb..e91eae56b1 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -82,7 +82,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveElev0 {*} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 30dae38914..e707b4a38b 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -103,7 +103,6 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] @@ -722,7 +721,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 @@ -773,7 +771,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC) - nullify(InitOutputData%WaveElev0) call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WaveElevSeries)) then @@ -816,14 +813,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveElev0)) - if (associated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) - call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev0) - end if - end if call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -935,30 +924,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) - OutData%WaveElev0(LB(1):) => OutData%WaveElev0 - else - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev0 => null() - end if call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index c3f7935101..7fd6deec06 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -73,7 +73,6 @@ typedef ^ ^ SiKi WaveDirMax typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 023a32cf49..f53803ba4a 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -91,7 +91,6 @@ MODULE Waves_Types INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -508,18 +507,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev - if (allocated(SrcInitOutputData%WaveElev0)) then - LB(1:1) = lbound(SrcInitOutputData%WaveElev0) - UB(1:1) = ubound(SrcInitOutputData%WaveElev0) - if (.not. allocated(DstInitOutputData%WaveElev0)) then - allocate(DstInitOutputData%WaveElev0(LB(1):UB(1)), 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 - end if DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave @@ -537,9 +524,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%WaveElevC) end if nullify(InitOutputData%WaveElev) - if (allocated(InitOutputData%WaveElev0)) then - deallocate(InitOutputData%WaveElev0) - end if end subroutine subroutine Waves_PackInitOutput(Buf, Indata) @@ -565,11 +549,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElev) end if end if - call RegPack(Buf, allocated(InData%WaveElev0)) - if (allocated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) - call RegPack(Buf, InData%WaveElev0) - end if call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) @@ -633,20 +612,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveElev => null() end if - if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RhoXg) From a72a35d277067ca4aabc734a583dc4aa323cbb73 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 14:08:04 -0600 Subject: [PATCH 022/232] SeaSt: remove extra `WaveElevC` pointers --- modules/hydrodyn/src/HydroDyn.f90 | 5 +--- modules/seastate/src/SeaState.f90 | 4 +-- modules/seastate/src/SeaState.txt | 1 - modules/seastate/src/SeaState_Types.f90 | 39 ++----------------------- modules/seastate/src/Waves.txt | 19 ++++++------ modules/seastate/src/Waves_Types.f90 | 35 ---------------------- 6 files changed, 13 insertions(+), 90 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index a9dd5df529..b76a892a2d 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -364,10 +364,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%WaveDOmega = InitInp%WaveDOmega ! Init inputs for the SS_Excitation model (set this just in case it will be used) - InputFileData%WAMIT%WaveDir = InitInp%WaveDir - ! CALL MOVE_ALLOC( InitInp%WaveElevC, InputFileData%WAMIT%WaveElevC ) - ! Temporarily move arrays to init input for WAMIT (save some space) - + InputFileData%WAMIT%WaveDir = InitInp%WaveDir InputFileData%WAMIT%WaveElev0 => InitInp%WaveField%WaveElev0 InputFileData%WAMIT%WaveElevC => InitInp%WaveField%WaveElevC InputFileData%WAMIT%WaveField => InitInp%WaveField diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index f9dfa5dd40..7577c527b0 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -384,9 +384,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END IF ! Copy Waves InitOut data to SeaState InitOut - ! ... pointer data: - InitOut%WaveElevC => p%WaveField%WaveElevC ! For WAMIT - + ! non-pointer data: InitOut%WaveDirMin = Waves_InitOut%WaveDirMin ! For WAMIT and WAMIT2 InitOut%WaveDirMax = Waves_InitOut%WaveDirMax ! For WAMIT and WAMIT2 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index e91eae56b1..3de8301d38 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -76,7 +76,6 @@ typedef ^ ^ ReKi Wtr typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi EffWtrDpth - - - "Effective water depth equal to the sum of input WtrDpth and MSL2SWL" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (m) -typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index e707b4a38b..e011ea78df 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -97,7 +97,6 @@ MODULE SeaState_Types REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Effective water depth equal to the sum of input WtrDpth and MSL2SWL [(m)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] @@ -678,7 +677,7 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' @@ -715,7 +714,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%EffWtrDpth = SrcInitOutputData%EffWtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL - DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir @@ -770,7 +768,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(InitOutputData%WaveElevC) call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WaveElevSeries)) then @@ -800,14 +797,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%EffWtrDpth) call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, associated(InData%WaveElevC)) - if (associated(InData%WaveElevC)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC) - end if - end if call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveDir) @@ -847,7 +836,7 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -890,30 +879,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC, UB(1:3)-LB(1:3)) - OutData%WaveElevC(LB(1):,LB(2):,LB(3):) => OutData%WaveElevC - else - allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC) - call RegUnpack(Buf, OutData%WaveElevC) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC => null() - end if call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMax) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 7fd6deec06..c74d77ba50 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -67,14 +67,13 @@ typedef ^ ^ ReKi PtfmLocatio # Define outputs from the initialization routine here: # -typedef ^ InitOutputType SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) -typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) -typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) -typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - +typedef ^ InitOutputType SiKi WaveDirMin - - - "Minimum wave direction." (degrees) +typedef ^ InitOutputType SiKi WaveDirMax - - - "Maximum wave direction." (degrees) +typedef ^ InitOutputType INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) +typedef ^ InitOutputType SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) +typedef ^ InitOutputType SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) +typedef ^ InitOutputType DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) +typedef ^ InitOutputType SiKi RhoXg - - - "= WtrDens*Gravity" - +typedef ^ InitOutputType INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - +typedef ^ InitOutputType INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index f53803ba4a..f2814d3396 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -85,7 +85,6 @@ MODULE Waves_Types ! ======================= ! ========= Waves_InitOutputType ======= TYPE, PUBLIC :: Waves_InitOutputType - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] @@ -490,18 +489,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcInitOutputData%WaveElevC)) then - LB(1:3) = lbound(SrcInitOutputData%WaveElevC) - UB(1:3) = ubound(SrcInitOutputData%WaveElevC) - if (.not. allocated(DstInitOutputData%WaveElevC)) then - allocate(DstInitOutputData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC - end if DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir @@ -520,9 +507,6 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Waves_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InitOutputData%WaveElevC)) then - deallocate(InitOutputData%WaveElevC) - end if nullify(InitOutputData%WaveElev) end subroutine @@ -532,11 +516,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WaveElevC)) - if (allocated(InData%WaveElevC)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) - call RegPack(Buf, InData%WaveElevC) - end if call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) @@ -566,20 +545,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevC) - if (RegCheckErr(Buf, RoutineName)) return - end if call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMax) From e0e9fea445614d9e1494bdad28eb9759291bc283 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 14:27:48 -0600 Subject: [PATCH 023/232] SeaSt: remove extra copies of `EffWtrDpth` --- modules/seastate/src/SeaState.f90 | 5 ++--- modules/seastate/src/SeaState.txt | 2 -- modules/seastate/src/SeaState_Types.f90 | 10 ---------- 3 files changed, 2 insertions(+), 15 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 7577c527b0..5d92e1c624 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -345,11 +345,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: InitOut%WtrDens = InputFileData%Waves%WtrDens InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL - InitOut%EffWtrDpth = InputFileData%Waves%WtrDpth + p%WaveField%EffWtrDpth = InputFileData%Waves%WtrDpth ! Effective water depth measured from the SWL ! bjj: does WtrDpth change later? Because otherwise EffWtrDpth is the same as WtrDpth + InitOut%MSL2SWL = InputFileData%MSL2SWL p%WaveStMod = InputFileData%Waves%WaveStMod p%WtrDpth = InitOut%WtrDpth - p%EffWtrDpth = InitOut%EffWtrDpth InitOut%WaveMultiDir = InputFileData%Waves%WaveMultiDir InitOut%MCFD = InputFileData%Waves%MCFD @@ -412,7 +412,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Build WaveField p%WaveField%MSL2SWL = InitOut%MSL2SWL - p%WaveField%EffWtrDpth = p%EffWtrDpth ! Effective water depth measured from the SWL p%WaveField%WaveStMod = p%WaveStMod ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 3de8301d38..816a994811 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -74,7 +74,6 @@ typedef ^ ^ CHARACTER(ChanLen) Wri typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) -typedef ^ ^ ReKi EffWtrDpth - - - "Effective water depth equal to the sum of input WtrDpth and MSL2SWL" (m) typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (m) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) @@ -145,7 +144,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) -typedef ^ ^ ReKi EffWtrDpth - - - "Effective water depth equal to the sum of input WtrDpth and MSL2SWL" (m) typedef ^ ^ DbKi DT - - - "Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states" - typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" - typedef ^ ^ OutParmType OutParam {:} - - "" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index e011ea78df..b4bca056fb 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -95,7 +95,6 @@ MODULE SeaState_Types TYPE(ProgDesc) :: Ver !< Version of SeaState [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] - REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Effective water depth equal to the sum of input WtrDpth and MSL2SWL [(m)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] @@ -168,7 +167,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] - REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Effective water depth equal to the sum of input WtrDpth and MSL2SWL [(m)] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] @@ -712,7 +710,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%EffWtrDpth = SrcInitOutputData%EffWtrDpth DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax @@ -795,7 +792,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%EffWtrDpth) call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) @@ -875,8 +871,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EffWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMin) @@ -1255,7 +1249,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinzi = SrcParamData%WaveKinzi end if DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%EffWtrDpth = SrcParamData%EffWtrDpth DstParamData%DT = SrcParamData%DT DstParamData%WaveStMod = SrcParamData%WaveStMod if (allocated(SrcParamData%OutParam)) then @@ -1390,7 +1383,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveKinzi) end if call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%EffWtrDpth) call RegPack(Buf, InData%DT) call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, allocated(InData%OutParam)) @@ -1524,8 +1516,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) end if call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EffWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveStMod) From 7d6022711d6a8afaff3deaf195b119fa5e2e3ad4 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 14:49:31 -0600 Subject: [PATCH 024/232] HD/SeaSt: remove extra copies of `MSL2SWL` --- modules/hydrodyn/src/HydroDyn.f90 | 1 - modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 - modules/hydrodyn/src/HydroDyn_Input.f90 | 11 ++------ modules/hydrodyn/src/HydroDyn_Types.f90 | 5 ---- modules/hydrodyn/src/Morison.f90 | 29 ++++++++++---------- modules/hydrodyn/src/Morison.txt | 2 -- modules/hydrodyn/src/Morison_Types.f90 | 10 ------- modules/openfast-library/src/FAST_Subs.f90 | 3 +- modules/seastate/src/SeaState.f90 | 7 +---- modules/seastate/src/SeaState.txt | 1 - modules/seastate/src/SeaState_Types.f90 | 5 ---- 12 files changed, 19 insertions(+), 57 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index b76a892a2d..db61694282 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -189,7 +189,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%Morison%WtrDens = InitInp%WtrDens InputFileData%Morison%WtrDpth = InitInp%WtrDpth - InputFileData%Morison%MSL2SWL = InitInp%MSL2SWL diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 4535eff3fb..21fc8612ed 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -74,7 +74,6 @@ typedef ^ ^ Logical typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" typedef ^ ^ ReKi WtrDens - - - "Water density from the driver; may be overwritten " "(kg/m^3)" typedef ^ ^ ReKi WtrDpth - - - "Water depth from the driver; may be overwritten " "m" -typedef ^ ^ ReKi MSL2SWL - - - "Mean sea level to still water level from the driver; may be overwritten" "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index aa09c9bc97..c83acca2fc 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -324,7 +324,6 @@ subroutine SetHD_InitInputs() ! Data from InitOutData_SeaSt: InitInData_HD%WtrDens = InitOutData_SeaSt%WtrDens InitInData_HD%WtrDpth = InitOutData_SeaSt%WtrDpth - InitInData_HD%MSL2SWL = InitOutData_SeaSt%MSL2SWL InitInData_HD%NStepWave = InitOutData_SeaSt%NStepWave InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 InitInData_HD%RhoXg = InitOutData_SeaSt%RhoXg diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index b7b3117521..457a6f64c5 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1140,7 +1140,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! WtrDpth - Water depth ! First adjust water depth based on MSL2SWL values - InputFileData%Morison%WtrDpth = InputFileData%Morison%WtrDpth + InputFileData%Morison%MSL2SWL + InputFileData%Morison%WtrDpth = InputFileData%Morison%WtrDpth + InitInp%WaveField%MSL2SWL IF ( InputFileData%Morison%WtrDpth <= 0.0 ) THEN CALL SetErrStat( ErrID_Fatal,'WtrDpth must be greater than zero.',ErrStat,ErrMsg,RoutineName) @@ -1151,15 +1151,10 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! MSL2SWL - Mean sea level to still water level - IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InputFileData%Morison%MSL2SWL, 0.0_ReKi) ) THEN + IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InitInp%WaveField%MSL2SWL, 0.0_ReKi) ) THEN CALL SetErrStat( ErrID_Fatal,'SeaState MSL2SWL must be 0 when PotMod = 1 (WAMIT).',ErrStat,ErrMsg,RoutineName) RETURN END IF - IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InputFileData%Morison%MSL2SWL, 0.0_ReKi) ) THEN - CALL SetErrStat( ErrID_Fatal,'HydroDyn MSL2SWL must be 0 when PotMod = 1 (WAMIT).',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ! WaveMod - Wave kinematics model switch. -- Check that actual data was passed in from SeaState. If none exists, then set WaveMod=0 and warn @@ -2437,7 +2432,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS InputFileData%Morison%Gravity = InitInp%Gravity ! Process the input geometry and generate the simulation mesh representation - call Morison_GenerateSimulationNodes( InputFileData%Morison%MSL2SWL, InputFileData%Morison%NJoints, InputFileData%Morison%InpJoints, InputFileData%Morison%NMembers, InputFileData%Morison%InpMembers, InputFileData%Morison%NNodes, InputFileData%Morison%Nodes, errStat2, errMsg2 ) + call Morison_GenerateSimulationNodes( InitInp%WaveField%MSL2SWL, InputFileData%Morison%NJoints, InputFileData%Morison%InpJoints, InputFileData%Morison%NMembers, InputFileData%Morison%InpMembers, InputFileData%Morison%NNodes, InputFileData%Morison%Nodes, errStat2, errMsg2 ) !CALL Morison_ProcessMorisonGeometry( InputFileData%Morison, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDynInput_GetInput' ) IF ( ErrStat >= AbortErrLev ) RETURN diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index abb746c2a0..d0f7e64244 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -91,7 +91,6 @@ MODULE HydroDyn_Types REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density from the driver; may be overwritten [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth from the driver; may be overwritten [m] - REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level from the driver; may be overwritten [m] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -901,7 +900,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL DstInitInputData%TMax = SrcInitInputData%TMax DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%NStepWave = SrcInitInputData%NStepWave @@ -984,7 +982,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, InData%TMax) call RegPack(Buf, InData%VisMeshes) call RegPack(Buf, InData%NStepWave) @@ -1051,8 +1048,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%VisMeshes) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 5ce3e56bb5..923625156e 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1484,7 +1484,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! These are all per node and not done here, yet do i = 1, member%NElements+1 - call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(member%NodeIndx(i)), InitInp%MSL2SWL, member%tMG(i), member%MGDensity(i) ) + call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(member%NodeIndx(i)), MSL2SWL, member%tMG(i), member%MGDensity(i) ) end do member%R( 1) = propSet1%PropD / 2.0 @@ -1545,7 +1545,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%MmbrFilledIDIndx = MmbrFilledIDIndx ! Set this to the parameter version of this member data if ( MmbrFilledIDIndx > 0 ) then member%FillDens = InitInp%FilledGroups(MmbrFilledIDIndx)%FillDens - member%FillFSLoc = InitInp%FilledGroups(MmbrFilledIDIndx)%FillFSLoc - InitInp%MSL2SWL + member%FillFSLoc = InitInp%FilledGroups(MmbrFilledIDIndx)%FillFSLoc - MSL2SWL if (member%FillFSLoc >= Zb) then member%z_overfill = member%FillFSLoc - Zb member%l_fill = member%RefLength @@ -1869,7 +1869,7 @@ subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) prop2Indx = InitInp%InpMembers(I)%MPropSetID2Indx end if ! Now populate the various member data arrays using the HydroDyn input file data - call SetMemberProperties( InitInp%MSL2SWL, InitInp%Gravity, p%Members(i), InitInp%InpMembers(i)%MCoefMod, InitInp%InpMembers(i)%MmbrCoefIDIndx, InitInp%InpMembers(i)%MmbrFilledIDIndx, InitInp%MPropSets(prop1Indx), InitInp%MPropSets(prop2Indx), InitInp, errStat2, errMsg2 ) + call SetMemberProperties( p%WaveField%MSL2SWL, InitInp%Gravity, p%Members(i), InitInp%InpMembers(i)%MCoefMod, InitInp%InpMembers(i)%MmbrCoefIDIndx, InitInp%InpMembers(i)%MmbrFilledIDIndx, InitInp%MPropSets(prop1Indx), InitInp%MPropSets(prop2Indx), InitInp, errStat2, errMsg2 ) call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') if (ErrStat >= AbortErrLev) return end do @@ -1929,7 +1929,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%NStepWave = InitInp%NStepWave p%NumOuts = InitInp%NumOuts p%NMOutputs = InitInp%NMOutputs ! Number of members to output [ >=0 and <10] - p%MSL2SWL = InitInp%MSL2SWL p%WaveDisp = InitInp%WaveDisp p%AMMod = InitInp%AMMod p%WaveStMod = InitInp%WaveStMod @@ -1982,7 +1981,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Redundant work (these are already assigned to the member data arrays, ! but is needed on the joint data because we report the tMG, and MGDensity at each Joint node in the Summary File - call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(i), InitInp%MSL2SWL, InitInp%Nodes(i)%tMG, InitInp%Nodes(i)%MGDensity ) + call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(i), p%WaveField%MSL2SWL, InitInp%Nodes(i)%tMG, InitInp%Nodes(i)%MGDensity ) end do ! allocate and copy in node-based load and hydrodynamic arrays @@ -2014,7 +2013,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In DO I=1,p%NNodes ! This needs to change so that the Position is relative to MSL NOT SWL: pos = InitInp%Nodes(I)%Position - pos(3) = pos(3) + InitInp%MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL ! Create the node on the mesh CALL MeshPositionNode (u%Mesh & , i & @@ -2126,7 +2125,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In tMG = -999.0 An_drag = 0.0 - IF ( (InitInp%InpJoints(i)%Position(3)-p%MSL2SWL) >= -p%WtrDpth ) THEN + IF ( (InitInp%InpJoints(i)%Position(3)-p%WaveField%MSL2SWL) >= -p%WtrDpth ) THEN ! loop through each member attached to the joint, getting the radius of its appropriate end DO J = 1, InitInp%InpJoints(I)%NConnections @@ -2257,7 +2256,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In if ( errStat >= AbortErrLev ) return ! Write Summary information to *HydroDyn* summary file now that everything has been initialized. - CALL WriteSummaryFile( InitInp%UnSum, InitInp%MSL2SWL, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & + CALL WriteSummaryFile( InitInp%UnSum, p%WaveField%MSL2SWL, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & p%NumOuts, p%OutParam, p%MOutLst, p%JOutLst, u%Mesh, y%Mesh, p, m, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if ( errStat >= AbortErrLev ) return @@ -2994,13 +2993,13 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) IF ( p%AMMod .EQ. 0_IntKi ) THEN ! Compute added-mass force up to the SWL - z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%MSL2SWL ! Undisplaced z-position of the current node + z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the current node IF ( z1 > 0.0_ReKi ) THEN ! Node is above SWL undisplaced; zero added-mass force f_hydro = 0.0_ReKi CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) ELSE ! Need to compute deltal_AM and h_c_AM based on the formulation without wave stretching. - z2 = u%Mesh%Position(3, mem%NodeIndx(i+1)) - p%MSL2SWL ! Undisplaced z-position of the next node + z2 = u%Mesh%Position(3, mem%NodeIndx(i+1)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the next node IF ( z2 > 0.0_ReKi ) THEN ! Element i crosses the SWL h = -z1 / mem%cosPhi_ref ! Length of Element i between SWL and node i, h>=0 deltal_AM = mem%dl/2.0 + h @@ -3270,7 +3269,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, Am = mem%Ca(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) IF ( p%AMMod .EQ. 0_IntKi ) THEN ! Always compute added-mass force on nodes below SWL when undisplaced - z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%MSL2SWL ! Undisplaced z-position of the current node + z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the current node IF ( z1 > 0.0_ReKi ) THEN ! Node is above SWL when undisplaced; zero added-mass force f_hydro = 0.0_ReKi CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_A(:, i) ) @@ -3285,7 +3284,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, IF ( i == N+1 ) THEN deltalRight = 0.0_ReKi ELSE - z2 = u%Mesh%Position(3, mem%NodeIndx(i+1)) - p%MSL2SWL + z2 = u%Mesh%Position(3, mem%NodeIndx(i+1)) - p%WaveField%MSL2SWL IF ( z2 > 0.0_ReKi ) THEN ! Element i crosses the SWL deltalRight = -z1 / mem%cosPhi_ref ELSE @@ -3564,7 +3563,7 @@ SUBROUTINE GetDisplacedNodePosition( forceDisplaced, pos ) ! Undisplaced node position pos = u%Mesh%Position - pos(3,:) = pos(3,:) - p%MSL2SWL ! Z position measured from the SWL + pos(3,:) = pos(3,:) - p%WaveField%MSL2SWL ! Z position measured from the SWL IF ( (p%WaveDisp /= 0) .OR. forceDisplaced ) THEN ! Use displaced X and Y position pos(1,:) = pos(1,:) + u%Mesh%TranslationDisp(1,:) @@ -4216,9 +4215,9 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat pos(2) = u%Mesh%TranslationDisp(2,J) + u%Mesh%Position(2,J) END IF IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled - pos(3) = u%Mesh%Position(3,J) + u%Mesh%TranslationDisp(3,J) - p%MSL2SWL ! Use the current Z location. + pos(3) = u%Mesh%Position(3,J) + u%Mesh%TranslationDisp(3,J) - p%WaveField%MSL2SWL ! Use the current Z location. ELSE ! Wave stretching disabled - pos(3) = u%Mesh%Position(3,J) - p%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. + pos(3) = u%Mesh%Position(3,J) - p%WaveField%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. END IF ! Get fluid velocity at the joint diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 38dc16137a..3aa5ca05c2 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -227,7 +227,6 @@ typedef ^ ^ INTEGER typedef ^ InitInputType ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m -typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - @@ -339,7 +338,6 @@ typedef ^ ParameterType DbKi typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m -typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - typedef ^ ^ INTEGER NMembers - - - "number of members" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 4afa3ffc65..21e28067a3 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -290,7 +290,6 @@ MODULE Morison_Types REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] @@ -401,7 +400,6 @@ MODULE Morison_Types REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] INTEGER(IntKi) :: NMembers = 0_IntKi !< number of members [-] @@ -3502,7 +3500,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp DstInitInputData%AMMod = SrcInitInputData%AMMod DstInitInputData%NJoints = SrcInitInputData%NJoints @@ -3857,7 +3854,6 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, InData%WaveDisp) call RegPack(Buf, InData%AMMod) call RegPack(Buf, InData%NJoints) @@ -4025,8 +4021,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%AMMod) @@ -5405,7 +5399,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Gravity = SrcParamData%Gravity DstParamData%WtrDens = SrcParamData%WtrDens DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL DstParamData%WaveDisp = SrcParamData%WaveDisp DstParamData%AMMod = SrcParamData%AMMod DstParamData%NMembers = SrcParamData%NMembers @@ -5696,7 +5689,6 @@ subroutine Morison_PackParam(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, InData%WaveDisp) call RegPack(Buf, InData%AMMod) call RegPack(Buf, InData%NMembers) @@ -5823,8 +5815,6 @@ subroutine Morison_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%AMMod) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 659813d586..a1d7750e02 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -876,7 +876,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%Gravity = p_FAST%Gravity Init%InData_HD%WtrDens = Init%OutData_SeaSt%WtrDens Init%InData_HD%WtrDpth = Init%OutData_SeaSt%WtrDpth - Init%InData_HD%MSL2SWL = Init%OutData_SeaSt%MSL2SWL Init%InData_HD%UseInputFile = .TRUE. Init%InData_HD%InputFile = p_FAST%HydroFile Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) @@ -1240,7 +1239,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_IceF%InputFile = p_FAST%IceFile Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi - Init%InData_IceF%MSL2SWL = Init%OutData_SeaSt%MSL2SWL + Init%InData_IceF%MSL2SWL = Init%OutData_SeaSt%WaveField%MSL2SWL Init%InData_IceF%gravity = p_FAST%Gravity CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 5d92e1c624..6cafea9ec4 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -347,7 +347,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL p%WaveField%EffWtrDpth = InputFileData%Waves%WtrDpth ! Effective water depth measured from the SWL ! bjj: does WtrDpth change later? Because otherwise EffWtrDpth is the same as WtrDpth - InitOut%MSL2SWL = InputFileData%MSL2SWL + p%WaveField%MSL2SWL = InputFileData%MSL2SWL p%WaveStMod = InputFileData%Waves%WaveStMod p%WtrDpth = InitOut%WtrDpth @@ -406,12 +406,10 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveDir = InputFileData%Waves%WaveDir ! For WAMIT for use in SS_Excitation ! InitOut%WtrDens = InputFileData%Waves%WtrDens ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth - ! InitOut%MSL2SWL = InputFileData%MSL2SWL InitOut%SeaSt_Interp_p = p%seast_interp_p ! Build WaveField - p%WaveField%MSL2SWL = InitOut%MSL2SWL p%WaveField%WaveStMod = p%WaveStMod ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 @@ -738,9 +736,6 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er REAL(SiKi) :: zeta REAL(SiKi) :: zeta1 REAL(SiKi) :: zeta2 - REAL(SiKi) :: zp - REAL(ReKi) :: positionXYZp(3) - REAL(ReKi) :: positionXY0(3) INTEGER(IntKi) :: nodeInWater diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 816a994811..d13fe21794 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -74,7 +74,6 @@ typedef ^ ^ CHARACTER(ChanLen) Wri typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) -typedef ^ ^ ReKi MSL2SWL - - - "Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default)" (m) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index b4bca056fb..c0fe530f46 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -95,7 +95,6 @@ MODULE SeaState_Types TYPE(ProgDesc) :: Ver !< Version of SeaState [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] - REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] @@ -710,7 +709,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir @@ -792,7 +790,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveDir) @@ -871,8 +868,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMax) From eb93c94b3bf094b14dadffb745662f120865365a Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 21:47:19 -0600 Subject: [PATCH 025/232] HD/SeaSt: remove extra `WaveStMod` copies --- modules/hydrodyn/src/HydroDyn.f90 | 1 - modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 - modules/hydrodyn/src/HydroDyn_Input.f90 | 8 ++-- modules/hydrodyn/src/HydroDyn_Types.f90 | 5 --- modules/hydrodyn/src/Morison.f90 | 2 +- modules/hydrodyn/src/Morison.txt | 1 - modules/hydrodyn/src/Morison_Types.f90 | 5 --- modules/openfast-library/src/FAST_Subs.f90 | 2 - modules/seastate/src/SeaState.f90 | 24 +++++------ modules/seastate/src/SeaState.txt | 3 +- modules/seastate/src/SeaState_Input.f90 | 42 ++------------------ modules/seastate/src/SeaState_Types.f90 | 15 +++---- modules/seastate/src/Waves.f90 | 10 ++--- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves2.txt | 2 - modules/seastate/src/Waves2_Types.f90 | 5 --- modules/seastate/src/Waves_Types.f90 | 5 --- 18 files changed, 32 insertions(+), 101 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index db61694282..c1eebb2491 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -584,7 +584,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy SeaState initialization output into the initialization input type for the Morison module InputFileData%Morison%NStepWave = InitInp%NStepWave InputFileData%Morison%MCFD = InitInp%MCFD - InputFileData%Morison%WaveStMod = InitInp%WaveStMod InputFileData%Morison%WaveField => InitInp%WaveField ! Were visualization meshes requested? diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 21fc8612ed..3afa527e17 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -81,7 +81,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index c83acca2fc..df7734930e 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -328,7 +328,6 @@ subroutine SetHD_InitInputs() InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 InitInData_HD%RhoXg = InitOutData_SeaSt%RhoXg InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod - InitInData_HD%WaveStMod = InitOutData_SeaSt%WaveStMod InitInData_HD%WaveDirMod = InitOutData_SeaSt%WaveDirMod InitInData_HD%WvLowCOff = InitOutData_SeaSt%WvLowCOff InitInData_HD%WvHiCOff = InitOutData_SeaSt%WvHiCOff diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 457a6f64c5..44253d698c 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1188,15 +1188,15 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. IF ( InitInp%WaveMod /= 0 .AND. InputFileData%Morison%NMembers > 0 ) THEN IF ( InitInp%WaveMod /= 6 ) THEN - IF ( ( InitInp%WaveStMod /= 0 ) .AND. ( InitInp%WaveStMod /= 1 ) .AND. & - ( InitInp%WaveStMod /= 2 ) .AND. ( InitInp%WaveStMod /= 3 ) ) THEN + IF ( ( InitInp%WaveField%WaveStMod /= 0 ) .AND. ( InitInp%WaveField%WaveStMod /= 1 ) .AND. & + ( InitInp%WaveField%WaveStMod /= 2 ) .AND. ( InitInp%WaveField%WaveStMod /= 3 ) ) THEN ErrMsg = ' WaveStMod must be 0, 1, 2, or 3.' ErrStat = ErrID_Fatal RETURN END IF ELSE - IF ( ( InitInp%WaveStMod /= 0 ) .AND. ( InitInp%WaveStMod /= 1 ) .AND. & - ( InitInp%WaveStMod /= 3 ) ) THEN + IF ( ( InitInp%WaveField%WaveStMod /= 0 ) .AND. ( InitInp%WaveField%WaveStMod /= 1 ) .AND. & + ( InitInp%WaveField%WaveStMod /= 3 ) ) THEN ErrMsg = ' WaveStMod must be 0, 1, or 3 when WaveMod = 6.' ErrStat = ErrID_Fatal RETURN diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index d0f7e64244..237728c7eb 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -97,7 +97,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] @@ -906,7 +905,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%RhoXg = SrcInitInputData%RhoXg DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff @@ -988,7 +986,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WvLowCOff) call RegPack(Buf, InData%WvHiCOff) @@ -1060,8 +1057,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvLowCOff) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 923625156e..1b5e7e53c0 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1931,7 +1931,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%NMOutputs = InitInp%NMOutputs ! Number of members to output [ >=0 and <10] p%WaveDisp = InitInp%WaveDisp p%AMMod = InitInp%AMMod - p%WaveStMod = InitInp%WaveStMod + p%WaveStMod = InitInp%WaveField%WaveStMod p%VisMeshes = InitInp%VisMeshes ! visualization mesh for morison elements ! Only compute added-mass force up to the free surface if wave stretching is enabled diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 3aa5ca05c2..4819c8c7a9 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -272,7 +272,6 @@ typedef ^ ^ CHARACTER(C typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER UnSum - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ INTEGER WaveStMod - - - "" - typedef ^ ^ SiKi MCFD - - - "Diameter of the MacCamy-Fuchs member." - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 21e28067a3..9271ef252b 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -335,7 +335,6 @@ MODULE Morison_Types INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] INTEGER(IntKi) :: UnSum = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< [-] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of the MacCamy-Fuchs member. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] @@ -3721,7 +3720,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NumOuts = SrcInitInputData%NumOuts DstInitInputData%UnSum = SrcInitInputData%UnSum DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes @@ -3991,7 +3989,6 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, InData%UnSum) call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%MCFD) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -4266,8 +4263,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index a1d7750e02..26e663665b 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -838,7 +838,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 Init%InData_HD%RhoXg = Init%OutData_SeaSt%RhoXg Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod - Init%InData_HD%WaveStMod = Init%OutData_SeaSt%WaveStMod Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff @@ -856,7 +855,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField - end if end if diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 6cafea9ec4..0bcd859642 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -215,14 +215,23 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY ! Allocate the WaveFieldType to store wave field information - ALLOCATE(p%WaveField) + ALLOCATE(p%WaveField, STAT=ErrStat2) + IF (ErrStat2 /=0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating WaveField.",ErrStat,ErrMsg,RoutineName) + CALL CleanUp() + RETURN + END IF + + p%WaveField%MSL2SWL = InputFileData%MSL2SWL + p%WaveField%WaveStMod = InputFileData%WaveStMod + ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below - ! check error (must be done AFTER moving pointers to parameters) + ! check error IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN @@ -347,8 +356,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL p%WaveField%EffWtrDpth = InputFileData%Waves%WtrDpth ! Effective water depth measured from the SWL ! bjj: does WtrDpth change later? Because otherwise EffWtrDpth is the same as WtrDpth - p%WaveField%MSL2SWL = InputFileData%MSL2SWL - p%WaveStMod = InputFileData%Waves%WaveStMod p%WtrDpth = InitOut%WtrDpth InitOut%WaveMultiDir = InputFileData%Waves%WaveMultiDir @@ -395,7 +402,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT InitOut%WaveMod = InputFileData%Waves%WaveMod - InitOut%WaveStMod = InputFileData%Waves%WaveStMod InitOut%WvLowCOff = InputFileData%Waves%WvLowCOff InitOut%WvHiCOff = InputFileData%Waves%WvHiCOff InitOut%WvLowCOffD = InputFileData%Waves2%WvLowCOffD @@ -407,14 +413,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! InitOut%WtrDens = InputFileData%Waves%WtrDens ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InitOut%SeaSt_Interp_p = p%seast_interp_p - - ! Build WaveField - p%WaveField%WaveStMod = p%WaveStMod - ! p%WaveField%PWaveDynP0 => Waves_InitOut%PWaveDynP0 - ! p%WaveField%PWaveAccMCF0 => Waves_InitOut%PWaveAccMCF0 + InitOut%SeaSt_Interp_p = p%seast_interp_p - ! CALL SeaSt_WaveField_CopySeaSt_WaveFieldType( p%WaveField, InitOut%WaveField, MESH_NEWCOPY, ErrStat2, ErrMsg2) InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index d13fe21794..33d9227398 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -47,6 +47,7 @@ typedef ^ ^ CHARACTER(ChanLen) Out typedef ^ ^ LOGICAL SeaStSum - - - "Generate a SeaState summary file [T/F]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - +typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - @@ -83,7 +84,6 @@ typedef ^ ^ SiKi RhoXg typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) @@ -144,7 +144,6 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ DbKi DT - - - "Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states" - -typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" - typedef ^ ^ OutParmType OutParam {:} - - "" - typedef ^ ^ INTEGER NumOuts - - - "Number of SeaState module-level outputs (not the total number including sub-modules" - typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files]" - diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 46ef2092d0..8c3de32a66 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -153,7 +153,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. - call ParseVar( FileInfo_In, CurLine, 'WaveStMod', InputFileData%Waves%WaveStMod, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WaveStMod', InputFileData%WaveStMod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WaveTMax - Analysis time for incident wave calculations. @@ -650,48 +650,15 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! All three methods of wave stretching tentatively implemented. IF ( InputFileData%Waves%WaveMod /= 0 .AND. InputFileData%Waves%WaveMod /= 6 ) THEN - IF ( (InputFileData%Waves%WaveStMod /= 0) .AND. (InputFileData%Waves%WaveStMod /= 1) .AND. & - (InputFileData%Waves%WaveStMod /= 2) .AND. (InputFileData%Waves%WaveStMod /= 3) ) THEN + IF ( (InputFileData%WaveStMod /= 0) .AND. (InputFileData%WaveStMod /= 1) .AND. & + (InputFileData%WaveStMod /= 2) .AND. (InputFileData%WaveStMod /= 3) ) THEN CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0, 1, 2, or 3.',ErrStat,ErrMsg,RoutineName) RETURN END IF ELSE ! Wave stretching is not supported when WaveMod = 0 or 6. - InputFileData%Waves%WaveStMod = 0_IntKi + InputFileData%WaveStMod = 0_IntKi END IF - !if ( InputFileData%Waves%WaveMod /= 6 .AND. InputFileData%Morison%NMembers > 0 .AND. InputFileData%Waves%WaveMod > 0 ) then - ! - ! if ( ( InputFileData%Waves%WaveStMod /= 0 ) .AND. ( InputFileData%Waves%WaveStMod /= 1 ) .AND. & - ! ( InputFileData%Waves%WaveStMod /= 2 ) ) then ! (TODO: future version will support 3) .AND. ( InputFileData%Waves%WaveStMod /= 3 ) ) then - ! ErrMsg = ' WaveStMod must be 0, 1, or 2.' !, or 3.' - ! ErrStat = ErrID_Fatal - ! - ! return - ! end if - ! - ! !if ( ( InputFileData%Waves%WaveStMod /= 3 ) .AND. ( InputFileData%Waves%WaveMod == 5 ) ) then - ! ! ErrMsg = ' WaveStMod must be set to 3 when WaveMod is set to 5.' - ! ! ErrStat = ErrID_Fatal - ! ! - ! ! return - ! !end if - ! - ! - ! - !else !don't use this one - ! - ! ! NOTE: Do not read in WaveStMod for floating platforms since it is - ! ! inconsistent to use stretching (which is a nonlinear correction) for - ! ! the viscous drag term in Morison's equation while not accounting for - ! ! stretching in the diffraction and radiation problems (according to - ! ! Paul Sclavounos, there are such corrections). Instead, the viscous - ! ! drag term from Morison's equation is computed by integrating up to - ! ! the MSL, regardless of the instantaneous free surface elevation. - ! - ! InputFileData%Waves%WaveStMod = 0 - ! - !end if - ! WaveTMax - Analysis time for incident wave calculations. @@ -1227,7 +1194,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er InputFileData%Waves2%WtrDens = InputFileData%Waves%WtrDens InputFileData%Waves2%Gravity = InitInp%Gravity InputFileData%Waves2%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%Waves2%WaveStMod = InputFileData%Waves%WaveStMod InputFileData%Waves2%NGrid = p%NGrid InputFileData%Waves2%NWaveElevGrid = InputFileData%Waves%NWaveElevGrid diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index c0fe530f46..17d784d85a 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -66,6 +66,7 @@ MODULE SeaState_Types LOGICAL :: SeaStSum = .false. !< Generate a SeaState summary file [T/F] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -104,7 +105,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] @@ -167,7 +167,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] @@ -302,6 +301,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum DstInputFileData%OutFmt = SrcInputFileData%OutFmt DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt + DstInputFileData%WaveStMod = SrcInputFileData%WaveStMod end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -394,6 +394,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%SeaStSum) call RegPack(Buf, InData%OutFmt) call RegPack(Buf, InData%OutSFmt) + call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -526,6 +527,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -718,7 +721,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod - DstInitOutputData%WaveStMod = SrcInitOutputData%WaveStMod DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod DstInitOutputData%WvLowCOff = SrcInitOutputData%WvLowCOff DstInitOutputData%WvHiCOff = SrcInitOutputData%WvHiCOff @@ -799,7 +801,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WvLowCOff) call RegPack(Buf, InData%WvHiCOff) @@ -886,8 +887,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvLowCOff) @@ -1245,7 +1244,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WtrDpth = SrcParamData%WtrDpth DstParamData%DT = SrcParamData%DT - DstParamData%WaveStMod = SrcParamData%WaveStMod if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) UB(1:1) = ubound(SrcParamData%OutParam) @@ -1379,7 +1377,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -1513,8 +1510,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index c9234f9f1f..04ca95837d 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -865,7 +865,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END IF - IF (InitInp%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching ALLOCATE ( PWaveDynPC0BPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynPC0BPz0.', ErrStat,ErrMsg,RoutineName) @@ -1111,7 +1111,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END DO ! J - All points where the incident wave kinematics will be computed without stretching !=================================== - IF (InitInp%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) @@ -1230,7 +1230,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END IF !=================================== - IF (InitInp%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL where z-partial derivatives will be computed for extrapolated stretching ! FFT's of the partial derivatives CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ) @@ -1401,7 +1401,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) end do END IF - IF (InitInp%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching primeCount = 1 DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed @@ -1489,7 +1489,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveField%WaveAccMCF (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) END IF - IF (InitInp%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching WaveField%PWaveDynP0(InitOut%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) WaveField%PWaveVel0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) WaveField%PWaveAcc0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index c74d77ba50..a62644e9e3 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -40,7 +40,6 @@ typedef ^ ^ SiKi WavePhase typedef ^ ^ SiKi WavePkShp - - - "Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz]" - typedef ^ ^ CHARACTER(80) WavePkShpChr - - - "String to temporarially hold value of peak shape parameter input line" - typedef ^ ^ INTEGER WaveSeed {2} - - "Random seeds of incident waves [-2147483648 to 2147483647]" - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 09a56e003e..a286fa751e 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -26,8 +26,6 @@ typedef ^ ^ INTEGER NStepWave typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - - typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ integer nGrid 3 - - "Grid dimensions" diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 4b4a13f967..2990cecbb4 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -41,7 +41,6 @@ MODULE Waves2_Types INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] @@ -92,7 +91,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid @@ -170,7 +168,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%NWaveElevGrid) @@ -219,8 +216,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%nGrid) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index f2814d3396..d0c4c7e1dc 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -57,7 +57,6 @@ MODULE Waves_Types REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] @@ -132,7 +131,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax DstInitInputData%WaveTp = SrcInitInputData%WaveTp DstInitInputData%WtrDens = SrcInitInputData%WtrDens @@ -270,7 +268,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WavePkShp) call RegPack(Buf, InData%WavePkShpChr) call RegPack(Buf, InData%WaveSeed) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%WaveTp) call RegPack(Buf, InData%WtrDens) @@ -369,8 +366,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveSeed) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTp) From 2dd9c0687ad6e96da9adbd999bc55553e848b297 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 31 Oct 2023 21:55:38 -0600 Subject: [PATCH 026/232] HD C bindings: fix HD initializations --- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index d3eae7b327..d0a9ce928b 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -404,9 +404,8 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! Values passed in HD%InitInp%Gravity = REAL(Gravity_C, ReKi) - HD%InitInp%WtrDens = REAL(defWtrDens_C, ReKi) ! use values from SeaState - HD%InitInp%WtrDpth = REAL(defWtrDpth_C, ReKi) ! use values from SeaState - HD%InitInp% MSL2SWL = REAL(defMSL2SWL_C, ReKi) ! use values from SeaState + HD%InitInp%WtrDens = REAL(SeaSt%InitOutData%WtrDens, ReKi) ! use values from SeaState + HD%InitInp%WtrDpth = REAL(SeaSt%InitOutData%WtrDpth, ReKi) ! use values from SeaState HD%InitInp%TMax = REAL(TMax_C, DbKi) ! Transfer data from SeaState @@ -415,7 +414,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 HD%InitInp%RhoXg = SeaSt%InitOutData%RhoXg HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod - HD%InitInp%WaveStMod = SeaSt%InitOutData%WaveStMod HD%InitInp%WaveDirMod = SeaSt%InitOutData%WaveDirMod HD%InitInp%WvLowCOff = SeaSt%InitOutData%WvLowCOff HD%InitInp%WvHiCOff = SeaSt%InitOutData%WvHiCOff From 976e9a76e6560d00ab6092f8af1eaeb61498068a Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 1 Nov 2023 09:14:03 -0600 Subject: [PATCH 027/232] Fix MSL2SWL input to IceDyn --- modules/openfast-library/src/FAST_Subs.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 26e663665b..9c7c63858c 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1259,7 +1259,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, 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_SeaSt%MSL2SWL + Init%InData_IceD%MSL2SWL = Init%OutData_SeaSt%WaveField%MSL2SWL Init%InData_IceD%WtrDens = Init%OutData_SeaSt%WtrDens Init%InData_IceD%gravity = p_FAST%Gravity Init%InData_IceD%TMax = p_FAST%TMax From 3aa16901a0cb356e2dace1c1f8b857ad4edcffcd Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 1 Nov 2023 11:12:02 -0600 Subject: [PATCH 028/232] HD/SeaSt: remove extra `WtrDens` and `RhoXg` copies These are now stored in WaveField data since the modules that need them already access the rest of the WaveField data. Also, all of the SeaSt InitOut data that are sent to HD Init are now done in one place instead of two (originally there was some issue with pointers in the SeaSt InitOut type, but that is not a concern any more). --- modules/hydrodyn/src/HydroDyn.f90 | 19 +++--- modules/hydrodyn/src/HydroDyn.txt | 2 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 2 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 2 - modules/hydrodyn/src/HydroDyn_Input.f90 | 8 +-- modules/hydrodyn/src/HydroDyn_Types.f90 | 10 --- modules/hydrodyn/src/Morison.f90 | 66 +++++++++---------- modules/hydrodyn/src/Morison.txt | 2 - modules/hydrodyn/src/Morison_Types.f90 | 10 --- modules/hydrodyn/src/WAMIT.f90 | 23 ++++--- modules/hydrodyn/src/WAMIT.txt | 2 - modules/hydrodyn/src/WAMIT2.f90 | 12 ++-- modules/hydrodyn/src/WAMIT2.txt | 2 - modules/hydrodyn/src/WAMIT2_Types.f90 | 10 --- modules/hydrodyn/src/WAMIT_Types.f90 | 10 --- modules/openfast-library/src/FAST_Subs.f90 | 60 ++++++++--------- modules/seastate/src/SeaSt_WaveField.txt | 2 + .../seastate/src/SeaSt_WaveField_Types.f90 | 10 +++ modules/seastate/src/SeaState.f90 | 5 +- modules/seastate/src/SeaState.txt | 3 +- modules/seastate/src/SeaState_Input.f90 | 5 +- modules/seastate/src/SeaState_Output.f90 | 2 +- modules/seastate/src/SeaState_Types.f90 | 15 ++--- modules/seastate/src/Waves.f90 | 5 +- modules/seastate/src/Waves.txt | 2 - modules/seastate/src/Waves2.f90 | 6 +- modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 5 -- modules/seastate/src/Waves_Types.f90 | 10 --- 29 files changed, 118 insertions(+), 193 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index c1eebb2491..70883f56df 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -144,6 +144,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ErrMsg = "" p%UnOutFile = -1 !bjj: this was being written to the screen when I had an error in my HD input file, so I'm going to initialize here. + p%WaveField => InitInp%WaveField + #ifdef BETA_BUILD CALL DispBetaNotice( "This is a beta version of HydroDyn and is for testing purposes only."//NewLine//"This version includes user waves, WaveMod=6 and the ability to write example user waves." ) #endif @@ -187,9 +189,12 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - InputFileData%Morison%WtrDens = InitInp%WtrDens InputFileData%Morison%WtrDpth = InitInp%WtrDpth - + + InputFileData%Morison%WaveField => InitInp%WaveField + InputFileData%WAMIT%WaveField => InitInp%WaveField + InputFileData%WAMIT2%WaveField => InitInp%WaveField + ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level @@ -272,7 +277,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy Waves initialization output into the initialization input type for the WAMIT module !p%NWaveElev = InputFileData%Waves%NWaveElev p%NStepWave = InitInp%NStepWave - p%WaveField => InitInp%WaveField m%LastIndWave = 1 @@ -355,7 +359,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy SeaState initialization output into the initialization input type for the WAMIT module - InputFileData%WAMIT%RhoXg = InitInp%RhoXg InputFileData%WAMIT%NStepWave = InitInp%NStepWave InputFileData%WAMIT%NStepWave2 = InitInp%NStepWave2 InputFileData%WAMIT%WaveDirMin = InitInp%WaveDirMin @@ -418,7 +421,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I WRITE( InputFileData%UnSum, '(A81)' ) 'Buoyancy loads from members modelled with WAMIT, summed about ( 0.0, 0.0, 0.0 )' WRITE( InputFileData%UnSum, '(18x,6(2X,A20))' ) ' BuoyFxi ', ' BuoyFyi ', ' BuoyFzi ', ' BuoyMxi ', ' BuoyMyi ', ' BuoyMzi ' WRITE( InputFileData%UnSum, '(18x,6(2X,A20))' ) ' (N) ', ' (N) ', ' (N) ', ' (N-m) ', ' (N-m) ', ' (N-m) ' - WRITE( InputFileData%UnSum, '(A18,6(2X,ES20.6))') ' External: ',0.0,0.0,InputFileData%WAMIT%RhoXg*InputFileData%PtfmVol0(iBody),InputFileData%WAMIT%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOByt(iBody), -InputFileData%WAMIT%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOBxt(iBody), 0.0 ! and the moment about Y due to the COB being offset from the WAMIT reference point + WRITE( InputFileData%UnSum, '(A18,6(2X,ES20.6))') ' External: ',0.0,0.0,p%WaveField%RhoXg*InputFileData%PtfmVol0(iBody),p%WaveField%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOByt(iBody), -p%WaveField%RhoXg*InputFileData%PtfmVol0(iBody)*InputFileData%PtfmCOBxt(iBody), 0.0 ! and the moment about Y due to the COB being offset from the WAMIT reference point end do END IF @@ -434,9 +437,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%WAMIT2used = .TRUE. ! Copy Waves initialization output into the initialization input type for the WAMIT module - InputFileData%WAMIT2%WaveField => InitInp%WaveField - - InputFileData%WAMIT2%RhoXg = InitInp%RhoXg InputFileData%WAMIT2%NStepWave = InitInp%NStepWave InputFileData%WAMIT2%NStepWave2 = InitInp%NStepWave2 InputFileData%WAMIT2%WaveDirMin = InitInp%WaveDirMin @@ -531,7 +531,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! General FITInitData%InputFile = InputFileData%PotFile FITInitData%Gravity = InputFileData%Gravity - FITInitData%Rho = InputFileData%Morison%WtrDens + FITInitData%Rho = p%WaveField%WtrDens FITInitData%time_end = InitInp%TMax FITInitData%dtime = InitInp%WaveDT ! Set the FIT module's timestep equal to the WaveDT timestep, this was checked earlier to make sure it is an integer muliple of the glue-code timestep! ! Waves @@ -584,7 +584,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy SeaState initialization output into the initialization input type for the Morison module InputFileData%Morison%NStepWave = InitInp%NStepWave InputFileData%Morison%MCFD = InitInp%MCFD - InputFileData%Morison%WaveField => InitInp%WaveField ! Were visualization meshes requested? InputFileData%Morison%VisMeshes = p%VisMeshes diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 3afa527e17..f1cf2288d9 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -72,14 +72,12 @@ typedef ^ ^ FileInfoTyp 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 ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" -typedef ^ ^ ReKi WtrDens - - - "Water density from the driver; may be overwritten " "(kg/m^3)" typedef ^ ^ ReKi WtrDpth - - - "Water depth from the driver; may be overwritten " "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # typedef ^ ^ INTEGER NStepWave - 0 - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - -typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index d0a9ce928b..ad07766ab3 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -404,7 +404,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! Values passed in HD%InitInp%Gravity = REAL(Gravity_C, ReKi) - HD%InitInp%WtrDens = REAL(SeaSt%InitOutData%WtrDens, ReKi) ! use values from SeaState HD%InitInp%WtrDpth = REAL(SeaSt%InitOutData%WtrDpth, ReKi) ! use values from SeaState HD%InitInp%TMax = REAL(TMax_C, DbKi) @@ -412,7 +411,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup HD%InitInp%NStepWave = SeaSt%InitOutData%NStepWave HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 - HD%InitInp%RhoXg = SeaSt%InitOutData%RhoXg HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod HD%InitInp%WaveDirMod = SeaSt%InitOutData%WaveDirMod HD%InitInp%WvLowCOff = SeaSt%InitOutData%WvLowCOff diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index df7734930e..3f5f405d78 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -322,11 +322,9 @@ subroutine SetHD_InitInputs() InitInData_HD%Linearize = drvrData%Linearize ! Data from InitOutData_SeaSt: - InitInData_HD%WtrDens = InitOutData_SeaSt%WtrDens InitInData_HD%WtrDpth = InitOutData_SeaSt%WtrDpth InitInData_HD%NStepWave = InitOutData_SeaSt%NStepWave InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 - InitInData_HD%RhoXg = InitOutData_SeaSt%RhoXg InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod InitInData_HD%WaveDirMod = InitOutData_SeaSt%WaveDirMod InitInData_HD%WvLowCOff = InitOutData_SeaSt%WvLowCOff diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 44253d698c..1f010fe12e 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1129,9 +1129,9 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !------------------------------------------------------------------------- - ! WtrDens - Water density. + ! WtrDens - Water density. ! shouldn't this be checked in SeaState instead (and omitted here?) - IF ( InputFileData%Morison%WtrDens < 0.0 ) THEN + IF ( InitInp%WaveField%WtrDens < 0.0 ) THEN CALL SetErrStat( ErrID_Fatal,'WtrDens must not be negative.',ErrStat,ErrMsg,RoutineName) RETURN END IF @@ -2222,7 +2222,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN ELSE - InputFileData%Morison%FilledGroups(I)%FillDens = InputFileData%Morison%WtrDens + InputFileData%Morison%FilledGroups(I)%FillDens = InitInp%WaveField%WtrDens END IF END DO @@ -2420,11 +2420,9 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !---------------------------------------------------------- ! WAMIT - InputFileData%WAMIT%WtrDens = InputFileData%Morison%WtrDens InputFileData%WAMIT%WaveMod = InitInp%WaveMod InputFileData%WAMIT%HasWAMIT = InputFileData%PotMod == 1 ! WAMIT2 - InputFileData%WAMIT2%WtrDens = InputFileData%Morison%WtrDens InputFileData%WAMIT2%WaveMod = InitInp%WaveMod InputFileData%WAMIT2%HasWAMIT = InputFileData%PotMod == 1 ! Morison diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 237728c7eb..fefef6059c 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -89,13 +89,11 @@ MODULE HydroDyn_Types CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density from the driver; may be overwritten [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth from the driver; may be overwritten [m] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] - REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] @@ -897,13 +895,11 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%OutRootName = SrcInitInputData%OutRootName DstInitInputData%Linearize = SrcInitInputData%Linearize DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%TMax = SrcInitInputData%TMax DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%RhoXg = SrcInitInputData%RhoXg DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff @@ -978,13 +974,11 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%OutRootName) call RegPack(Buf, InData%Linearize) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%TMax) call RegPack(Buf, InData%VisMeshes) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WvLowCOff) @@ -1041,8 +1035,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%TMax) @@ -1053,8 +1045,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 1b5e7e53c0..e34fc86430 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1921,7 +1921,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Define parameters here: p%DT = Interval - p%WtrDens = InitInp%WtrDens p%WtrDpth = InitInp%WtrDpth p%Gravity = InitInp%Gravity p%NNodes = InitInp%NNodes @@ -1931,7 +1930,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%NMOutputs = InitInp%NMOutputs ! Number of members to output [ >=0 and <10] p%WaveDisp = InitInp%WaveDisp p%AMMod = InitInp%AMMod - p%WaveStMod = InitInp%WaveField%WaveStMod p%VisMeshes = InitInp%VisMeshes ! visualization mesh for morison elements ! Only compute added-mass force up to the free surface if wave stretching is enabled @@ -2181,7 +2179,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In IF (EqualRealNos(Amag_drag, 0.0_ReKi)) THEN p%DragConst_End(i) = 0.0 ELSE - p%DragConst_End(i) = InitInp%Nodes(i)%JAxCd*p%WtrDens / ( 4.0_ReKi * Amag_drag ) + p%DragConst_End(i) = InitInp%Nodes(i)%JAxCd*p%WaveField%WtrDens / ( 4.0_ReKi * Amag_drag ) END IF ! magnitudes of normal-weighted values Amag = sqrt(Amag) @@ -2191,7 +2189,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Constant part of the external hydrodynamic added mass term if ( Vmag > 0.0 ) then v2D(:,1) = Vn - p%AM_End(:,:,i) = (InitInp%Nodes(I)%JAxCa*InitInp%WtrDens/ Vmag)*matmul(v2D, transpose(v2D)) + p%AM_End(:,:,i) = (InitInp%Nodes(I)%JAxCa*p%WaveField%WtrDens/ Vmag)*matmul(v2D, transpose(v2D)) end if ! Constant part of the external hydrodynamic dynamic pressure force @@ -2978,8 +2976,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !-------------------- hydrodynamic drag loads: sides: Section 7.1.2 ------------------------! vec = matmul( mem%Ak,m%vrel(:,mem%NodeIndx(i)) ) - f_hydro = mem%Cd(i)*p%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & - 0.5*mem%AxCd(i)*p%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) + f_hydro = mem%Cd(i)*p%WaveField%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & + 0.5*mem%AxCd(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(4:6, i) @@ -2989,7 +2987,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, IF ( .NOT. mem%PropPot ) THEN !-------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------! - Am = mem%Ca(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt + Am = mem%Ca(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) IF ( p%AMMod .EQ. 0_IntKi ) THEN ! Compute added-mass force up to the SWL @@ -3023,12 +3021,12 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !--------------------- hydrodynamic inertia loads: sides: Section 7.1.4 --------------------------! IF (mem%PropMCF) THEN - f_hydro= p%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FAMCF(:,mem%NodeIndx(i)) ) + & - 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + f_hydro= p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FAMCF(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k ELSE - f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & - 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i) *p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k END IF @@ -3066,8 +3064,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, RMGFSInt = SubRatio * mem%RMG(FSElem+1) + (1.0-SubRatio) * mem%RMG(FSElem) vec = matmul( mem%Ak,vrelFSInt ) - F_DS = mem%Cd(FSElem)*p%WtrDens*RMGFSInt*TwoNorm(vec)*vec + & - 0.5*mem%AxCd(FSElem)*p%WtrDens*pi*RMGFSInt*dRdl_p * & + F_DS = mem%Cd(FSElem)*p%WaveField%WtrDens*RMGFSInt*TwoNorm(vec)*vec + & + 0.5*mem%AxCd(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*dRdl_p * & abs(dot_product( mem%k, vrelFSInt )) * matmul( mem%kkt, vrelFSInt ) ! Hydrodynamic added mass and inertia loads @@ -3075,8 +3073,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! ------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------ IF (p%AMMod > 0_IntKi) THEN - Am = mem%Ca(FSElem)*p%WtrDens*pi*RMGFSInt*RMGFSInt*mem%Ak + & - 2.0*mem%AxCa(FSElem)*p%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p*mem%kkt + Am = mem%Ca(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*mem%Ak + & + 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p*mem%kkt F_AS = -matmul( Am, & SubRatio * u%Mesh%TranslationAcc(:,mem%NodeIndx(FSElem+1)) + & (1.0-SubRatio) * u%Mesh%TranslationAcc(:,mem%NodeIndx(FSElem )) ) @@ -3084,12 +3082,12 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! ------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ------------------------ IF ( mem%PropMCF) THEN - F_IS= p%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAMCFFSInt ) + & - 2.0*mem%AxCa(FSElem)*p%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & + F_IS= p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAMCFFSInt ) + & + 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & 2.0*mem%AxCp(FSElem) *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k ELSE - F_IS=(mem%Ca(FSElem)+mem%Cp(FSElem))*p%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAFSInt ) + & - 2.0*mem%AxCa(FSElem)*p%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & + F_IS=(mem%Ca(FSElem)+mem%Cp(FSElem))*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt * matmul( mem%Ak, FAFSInt ) + & + 2.0*mem%AxCa(FSElem)*p%WaveField%WtrDens*pi*RMGFSInt*RMGFSInt*dRdl_p * matmul( mem%kkt, FAFSInt ) + & 2.0*mem%AxCp(FSElem) *pi*RMGFSInt *dRdl_pp * FDynPFSInt*mem%k END IF END IF @@ -3258,15 +3256,15 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !--------------------- hydrodynamic drag loads: sides: Section 7.1.2 --------------------------------! vec = matmul( mem%Ak,m%vrel(:,mem%NodeIndx(i)) ) - f_hydro = mem%Cd(i)*p%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & - 0.5*mem%AxCd(i)*p%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) + f_hydro = mem%Cd(i)*p%WaveField%WtrDens*mem%RMG(i)*TwoNorm(vec)*vec + & + 0.5*mem%AxCd(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*dRdl_p * abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) y%Mesh%Moment(:,mem%NodeIndx(i)) = y%Mesh%Moment(:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(4:6, i) IF ( .NOT. mem%PropPot ) THEN !-------------------- hydrodynamic added mass loads: sides: Section 7.1.3 ------------------------! - Am = mem%Ca(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt + Am = mem%Ca(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*mem%Ak + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p*mem%kkt f_hydro = -matmul( Am, u%Mesh%TranslationAcc(:,mem%NodeIndx(i)) ) IF ( p%AMMod .EQ. 0_IntKi ) THEN ! Always compute added-mass force on nodes below SWL when undisplaced z1 = u%Mesh%Position(3, mem%NodeIndx(i)) - p%WaveField%MSL2SWL ! Undisplaced z-position of the current node @@ -3304,12 +3302,12 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !-------------------- hydrodynamic inertia loads: sides: Section 7.1.4 ---------------------------! IF ( mem%PropMCF ) THEN - f_hydro= p%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FAMCF(:,mem%NodeIndx(i)) ) + & - 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + f_hydro= p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FAMCF(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k ELSE - f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & - 2.0*mem%AxCa(i)*p%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & + f_hydro=(mem%Ca(i)+mem%Cp(i))*p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i) * matmul( mem%Ak, m%FA(:,mem%NodeIndx(i)) ) + & + 2.0*mem%AxCa(i) *p%WaveField%WtrDens*pi*mem%RMG(i)*mem%RMG(i)*dRdl_p * matmul( mem%kkt, m%FA(:,mem%NodeIndx(i)) ) + & 2.0*m%FDynP(mem%NodeIndx(i))*mem%AxCp(i)*pi*mem%RMG(i)*dRdl_pp*mem%k END IF CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_I(:, i) ) @@ -3705,7 +3703,7 @@ SUBROUTINE GetSectionHstLds( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, dFdl(1:3) = -R *dRdl*C0*k_hat + R*C1*y_hat + R*C2*z_hat dFdl(4:6) = -R**2*dRdl*C2*y_hat + R**2*dRdl*C1*z_hat + CROSS_PRODUCT((pos0-origin),dFdl(1:3)) - dFdl = dFdl * p%WtrDens * g + dFdl = dFdl * p%WaveField%WtrDens * g END SUBROUTINE GetSectionHstLds @@ -3930,7 +3928,7 @@ SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) ! End plate force in the k_hat direction Fk = -0.5*Z0*(R_2*dTheta-tmp1) + cosPhi/6.0*( 2.0*dy_3 - z1*z2*dy - z1_2*(y2+2.0*y1) + z2_2*(y1+2.0*y2) ) - F(1:3) = p%WtrDens * g * Fk * k_hat + F(1:3) = p%WaveField%WtrDens * g * Fk * k_hat ! End plate moment in the y_hat and z_hat direction My = Z0/6.0*( 2.0*dy_3 + 2.0*dy*tmp2 + 3.0*tmp1*sz ) & ! y_hat component @@ -3948,7 +3946,7 @@ SUBROUTINE GetEndPlateHstLds(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) Mz = -Z0/ 6.0*( tmp1*dz_3 + 3.0*tmp2*dz_2 + 3.0*tmp3*dz ) & -cosPhi/24.0*(3.0*tmp1*dz_4 + 8.0*tmp2*dz_3 + 6.0*tmp3*dz_2) END IF - F(4:6) = p%WtrDens * g * (My*y_hat + Mz*z_hat) + F(4:6) = p%WaveField%WtrDens * g * (My*y_hat + Mz*z_hat) END SUBROUTINE GetEndPlateHstLds @@ -3994,11 +3992,11 @@ SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, ! Hydrostatic force on element FbVec = (/0.0_ReKi,0.0_ReKi,Vs/) - Pi*( r2*r2*z2 - r1*r1*z1) *k_hat - FbVec = p%WtrDens * g * FbVec + FbVec = p%WaveField%WtrDens * g * FbVec ! Hydrostatic moment on element about the lower node MbVec = (Vhc+0.25*Pi*(r2**4-r1**4)) * Cross_Product(k_hat,(/0.0_ReKi,0.0_ReKi,1.0_ReKi/)) - MbVec = p%WtrDens * g * MbVec + MbVec = p%WaveField%WtrDens * g * MbVec ! Distribute element load to nodes alpha = alphaIn*(z2-Zeta2)**pwr/(alphaIn*(z2-Zeta2)**pwr+(1.0_ReKi-alphaIn)*(z1-Zeta1)**pwr) @@ -4022,7 +4020,7 @@ SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, ! Scaled radius of element at point where its centerline crosses the waterplane rh = r1 + h0*dRdl ! Estimate the free-surface normal at the free-surface intersection, n_hat - IF ( p%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute free surface normal + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute free surface normal CALL GetFreeSurfaceNormal( Time, FSInt, rh, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE ! Without wave stretching, use the normal of the SWL @@ -4084,13 +4082,13 @@ SUBROUTINE getElementHstLds_Mod1( Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, ! Hydrostatic force on element FbVec = (/0.0_ReKi,0.0_ReKi,Vs/) - Pi*a0b0*Z0*n_hat + Pi*r1**2*z1*k_hat - FbVec = p%WtrDens * g * FbVec + FbVec = p%WaveField%WtrDens * g * FbVec ! Hydrostatic moment on element about the lower node MbVec = Cross_Product( Vrc*r_hat+Vhc*k_hat, (/0.0_ReKi,0.0_ReKi,1.0_ReKi/) ) & + 0.25*Pi*a0b0* ( ( s_hat(3)*a0*a0 + 4.0*(s0-h0*sinGamma)*Z0 )*t_hat - t_hat(3)*b0*b0*s_hat ) & - 0.25*Pi*r1**4*( r_hat(3) *t_hat - t_hat(3) * r_hat ) - MbVec = p%WtrDens * g * MbVec + MbVec = p%WaveField%WtrDens * g * MbVec IF ( Is1stElement ) THEN ! This is the 1st element of the member ! Assign the element load to the lower (1st) node of the member diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 4819c8c7a9..59cb5b7b8c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -225,7 +225,6 @@ typedef ^ ^ INTEGER # e.g., the name of the input file, the file root name,etc. # typedef ^ InitInputType ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - @@ -335,7 +334,6 @@ typedef ^ ^ MeshMapType # typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" (sec) typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDens - - - "Water density" kg/m^3 typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 9271ef252b..85f196160a 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -288,7 +288,6 @@ MODULE Morison_Types ! ========= Morison_InitInputType ======= TYPE, PUBLIC :: Morison_InitInputType REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] @@ -397,7 +396,6 @@ MODULE Morison_Types TYPE, PUBLIC :: Morison_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [(sec)] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] @@ -3497,7 +3495,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E ErrStat = ErrID_None ErrMsg = '' DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp DstInitInputData%AMMod = SrcInitInputData%AMMod @@ -3850,7 +3847,6 @@ subroutine Morison_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveDisp) call RegPack(Buf, InData%AMMod) @@ -4014,8 +4010,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDisp) @@ -5392,7 +5386,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM ErrMsg = '' DstParamData%DT = SrcParamData%DT DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens DstParamData%WtrDpth = SrcParamData%WtrDpth DstParamData%WaveDisp = SrcParamData%WaveDisp DstParamData%AMMod = SrcParamData%AMMod @@ -5682,7 +5675,6 @@ subroutine Morison_PackParam(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveDisp) call RegPack(Buf, InData%AMMod) @@ -5806,8 +5798,6 @@ subroutine Morison_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDisp) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 9e26125ec3..054cff306b 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -217,7 +217,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ErrMsg = "" ! Copy Output Init data from Waves Module Init call - p%NStepWave = InitInp%NStepWave p%ExctnMod = InitInp%ExctnMod p%ExctnDisp = InitInp%ExctnDisp @@ -244,9 +243,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS do iBody = 1, p%NBody p%F_HS_Moment_Offset(1,iBody) = 0.0_ReKi p%F_HS_Moment_Offset(2,iBody) = 0.0_ReKi - p%F_HS_Moment_Offset(3,iBody) = InitInp%RhoXg*InitInp%PtfmVol0(iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position - p%F_HS_Moment_Offset(4,iBody) = InitInp%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOByt(iBody) - InitInp%PtfmRefyt(iBody) ) ! and the moment about X due to the COB being offset from the local WAMIT reference point - p%F_HS_Moment_Offset(5,iBody) = -InitInp%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOBxt(iBody) - InitInp%PtfmRefxt(iBody) ) ! and the moment about Y due to the COB being offset from the localWAMIT reference point + p%F_HS_Moment_Offset(3,iBody) = InitInp%WaveField%RhoXg*InitInp%PtfmVol0(iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position + p%F_HS_Moment_Offset(4,iBody) = InitInp%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOByt(iBody) - InitInp%PtfmRefyt(iBody) ) ! and the moment about X due to the COB being offset from the local WAMIT reference point + p%F_HS_Moment_Offset(5,iBody) = -InitInp%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOBxt(iBody) - InitInp%PtfmRefxt(iBody) ) ! and the moment about Y due to the COB being offset from the localWAMIT reference point p%F_HS_Moment_Offset(6,iBody) = 0.0_ReKi end do @@ -260,16 +259,16 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! element-by-element multiplication, instead of matrix-by-matrix ! multiplication: - SttcDim(1,1) = InitInp%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - SttcDim(1,4) = InitInp%RhoXg *InitInp%WAMITULEN**3 ! Force-rotation/Moment-translation - Hydrostatic restoring - SttcDim(4,4) = InitInp%RhoXg *InitInp%WAMITULEN**4 ! Moment-rotation + SttcDim(1,1) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation + SttcDim(1,4) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Force-rotation/Moment-translation - Hydrostatic restoring + SttcDim(4,4) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**4 ! Moment-rotation - RdtnDim(1,1) = InitInp%WtrDens*InitInp%WAMITULEN**3 ! Force-translation - RdtnDim(1,4) = InitInp%WtrDens*InitInp%WAMITULEN**4 ! Force-rotation/Moment-translation - Hydrodynamic added mass and damping - RdtnDim(4,4) = InitInp%WtrDens*InitInp%WAMITULEN**5 ! Moment-rotation + RdtnDim(1,1) = InitInp%WaveField%WtrDens*InitInp%WAMITULEN**3 ! Force-translation + RdtnDim(1,4) = InitInp%WaveField%WtrDens*InitInp%WAMITULEN**4 ! Force-rotation/Moment-translation - Hydrodynamic added mass and damping + RdtnDim(4,4) = InitInp%WaveField%WtrDens*InitInp%WAMITULEN**5 ! Moment-rotation - DffrctDim(1) = InitInp%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - Hydrodynamic wave excitation force - DffrctDim(4) = InitInp%RhoXg *InitInp%WAMITULEN**3 ! Moment-rotation + DffrctDim(1) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - Hydrodynamic wave excitation force + DffrctDim(4) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Moment-rotation DO I = 1,3 ! Loop through all force-translation elements (rows) diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 070ebb872e..12847ee71b 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -40,7 +40,6 @@ typedef ^ ^ DbKi typedef ^ ^ ReKi WaveDir - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - -typedef ^ ^ ReKi Rhoxg - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ ReKi WaveDOmega - - - "" - @@ -48,7 +47,6 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ INTEGER WaveMod - - - "" - -typedef ^ ^ ReKi WtrDens - - - "" - typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 57a0e574ff..9e49840140 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -3996,9 +3996,9 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) IF ( Data3D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) ) THEN IF ( .NOT. EqualRealNos(REAL(Data3D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ),SiKi), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,7) ,SiKi)) .AND. & + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,7) ,SiKi)) .AND. & .NOT. EqualRealNos( AIMAG(Data3D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) ), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,8) ,SiKi)) ) THEN + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData3D(I,8) ,SiKi)) ) THEN CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Num2Lstr(NumHeaderLines+I))//' of '//TRIM(Filename3D)// & ' contains different values for the real and imaginary part (columns 7 and 8) than was '// & 'given earlier in the file for the same values of wave frequency and wave direction '// & @@ -4011,7 +4011,7 @@ SUBROUTINE Read_DataFile3D( InitInp, Filename3D, Data3D, ErrStat, Errmsg ) ! Store the data after dimensionalizing Data3D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) = & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData3D(I,7),RawData3D(I,8),SiKi) + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData3D(I,7),RawData3D(I,8),SiKi) ! Set flag indicating that this value has been inserted. Data3D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4) ) = .TRUE. @@ -4760,9 +4760,9 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) IF ( Data4D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) ) THEN IF ( .NOT. EqualRealNos( REAL(Data4D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ),SiKi), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,8) ,SiKi)) .AND. & + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,8) ,SiKi)) .AND. & .NOT. EqualRealNos(AIMAG(Data4D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) )), & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,9) ,SiKi))) THEN + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K * RawData4D(I,9) ,SiKi))) THEN CALL SetErrStat( ErrID_Fatal, ' Line '//TRIM(Num2Lstr(NumHeaderLines+I))//' of '//TRIM(Filename4D)// & ' contains different values for the real and imaginary part (columns 8 and 9) than was '// & 'given earlier in the file for the same values of wave frequency and wave direction '// & @@ -4775,7 +4775,7 @@ SUBROUTINE Read_DataFile4D( InitInp, Filename4D, Data4D, ErrStat, Errmsg ) ! Store the data after dimensionalizing Data4D%DataSet( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) = & - REAL(InitInp%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData4D(I,8),RawData4D(I,9),SiKi) + REAL(InitInp%WaveField%RhoXg * InitInp%WAMITULEN**K,SiKi) * CMPLX(RawData4D(I,8),RawData4D(I,9),SiKi) ! Set flag indicating that this value has been inserted. Data4D%DataMask( TmpCoord(1), TmpCoord(2), TmpCoord(3), TmpCoord(4), TmpCoord(5) ) = .TRUE. diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index f66ec23fe2..5b55f29564 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -28,11 +28,9 @@ typedef ^ ^ ReKi PtfmRefzt typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians typedef ^ ^ ReKi WAMITULEN - - - "WAMIT unit length scale" - -typedef ^ ^ ReKi RhoXg - - - "Density * Gravity -- from the Waves module." - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ ReKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" (m) diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 849a048034..53f60b28b0 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -46,11 +46,9 @@ MODULE WAMIT2_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< WAMIT unit length scale [-] - REAL(ReKi) :: RhoXg = 0.0_ReKi !< Density * Gravity -- from the Waves module. [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< Frequency step for incident wave calculations [(rad/s)] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(m)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] @@ -169,11 +167,9 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN - DstInitInputData%RhoXg = SrcInitInputData%RhoXg DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%WaveDir = SrcInitInputData%WaveDir @@ -253,11 +249,9 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%PtfmRefztRot) end if call RegPack(Buf, InData%WAMITULEN) - call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveDir) @@ -365,16 +359,12 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) end if call RegUnpack(Buf, OutData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index e630d66343..705bf5c7f0 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -60,7 +60,6 @@ MODULE WAMIT_Types REAL(ReKi) :: WaveDir = 0.0_ReKi !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] - REAL(ReKi) :: Rhoxg = 0.0_ReKi !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< [-] @@ -68,7 +67,6 @@ MODULE WAMIT_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< [-] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] @@ -269,7 +267,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err call Conv_Rdtn_CopyInitInput(SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega @@ -277,7 +274,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) @@ -381,7 +377,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WAMITFile) call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) - call RegPack(Buf, InData%Rhoxg) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveDOmega) @@ -410,7 +405,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) @@ -559,8 +553,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - call RegUnpack(Buf, OutData%Rhoxg) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) @@ -641,8 +633,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) end if call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMax) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 9c7c63858c..f1632c5299 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -832,31 +832,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup - if ( p_FAST%CompHydro == Module_HD ) then - Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave - Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 - Init%InData_HD%RhoXg = Init%OutData_SeaSt%RhoXg - Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod - Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod - Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff - Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff - Init%InData_HD%WvLowCOffD = Init%OutData_SeaSt%WvLowCOffD - Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD - Init%InData_HD%WvLowCOffS = Init%OutData_SeaSt%WvLowCOffS - Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS - Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - - Init%InData_HD%WaveDirMin = Init%OutData_SeaSt%WaveDirMin - Init%InData_HD%WaveDirMax = Init%OutData_SeaSt%WaveDirMax - Init%InData_HD%WaveDir = Init%OutData_SeaSt%WaveDir - Init%InData_HD%WaveMultiDir = Init%OutData_SeaSt%WaveMultiDir - Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega - Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD - - Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField - end if - end if ! ........................ @@ -872,14 +847,37 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompHydro == Module_HD ) THEN Init%InData_HD%Gravity = p_FAST%Gravity - Init%InData_HD%WtrDens = Init%OutData_SeaSt%WtrDens - Init%InData_HD%WtrDpth = Init%OutData_SeaSt%WtrDpth Init%InData_HD%UseInputFile = .TRUE. Init%InData_HD%InputFile = p_FAST%HydroFile Init%InData_HD%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_HD)) Init%InData_HD%TMax = p_FAST%TMax Init%InData_HD%Linearize = p_FAST%Linearize if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. + + ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true + Init%InData_HD%WtrDpth = Init%OutData_SeaSt%WtrDpth + Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave + Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 + Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod + Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod + Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff + Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff + Init%InData_HD%WvLowCOffD = Init%OutData_SeaSt%WvLowCOffD + Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD + Init%InData_HD%WvLowCOffS = Init%OutData_SeaSt%WvLowCOffS + Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS + Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn + + Init%InData_HD%WaveDirMin = Init%OutData_SeaSt%WaveDirMin + Init%InData_HD%WaveDirMax = Init%OutData_SeaSt%WaveDirMax + Init%InData_HD%WaveDir = Init%OutData_SeaSt%WaveDir + Init%InData_HD%WaveMultiDir = Init%OutData_SeaSt%WaveMultiDir + Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega + Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD + + Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField + ! end if + CALL HydroDyn_Init( Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), Init%OutData_HD, ErrStat2, ErrMsg2 ) @@ -1050,7 +1048,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_MAP%sea_density = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState + Init%InData_MAP%sea_density = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState Init%InData_MAP%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState ! differences for MAP++ @@ -1103,7 +1101,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn - Init%InData_MD%rhoW = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState + Init%InData_MD%rhoW = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState Init%InData_MD%WtrDepth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) @@ -1148,7 +1146,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, 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 = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState + Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState ! Init%InData_FEAM%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & @@ -1260,7 +1258,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, 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_SeaSt%WaveField%MSL2SWL - Init%InData_IceD%WtrDens = Init%OutData_SeaSt%WtrDens + Init%InData_IceD%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens Init%InData_IceD%gravity = p_FAST%Gravity Init%InData_IceD%TMax = p_FAST%TMax Init%InData_IceD%LegNum = 1 diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index d46f9fb211..7133cad915 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -25,3 +25,5 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) +typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index c0626b5641..0f51e6e554 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -55,6 +55,8 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -257,6 +259,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr end if + DstSeaSt_WaveFieldTypeData%WtrDens = SrcSeaSt_WaveFieldTypeData%WtrDens + DstSeaSt_WaveFieldTypeData%RhoXg = SrcSeaSt_WaveFieldTypeData%RhoXg end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -401,6 +405,8 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) call RegPack(Buf, InData%WaveDirArr) end if + call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -629,6 +635,10 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveDirArr) if (RegCheckErr(Buf, RoutineName)) return end if + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0bcd859642..baaac17099 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -224,6 +224,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%MSL2SWL = InputFileData%MSL2SWL p%WaveField%WaveStMod = InputFileData%WaveStMod + p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp + p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) @@ -352,7 +354,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Define initialization-routine output here: InitOut%Ver = SeaSt_ProgDesc ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: - InitOut%WtrDens = InputFileData%Waves%WtrDens InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL p%WaveField%EffWtrDpth = InputFileData%Waves%WtrDpth ! Effective water depth measured from the SWL ! bjj: does WtrDpth change later? Because otherwise EffWtrDpth is the same as WtrDpth @@ -397,7 +398,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveDirMax = Waves_InitOut%WaveDirMax ! For WAMIT and WAMIT2 InitOut%WaveDOmega = Waves_InitOut%WaveDOmega ! For WAMIT and WAMIT2, FIT - InitOut%RhoXg = Waves_InitOut%RhoXg ! For WAMIT and WAMIT2 InitOut%NStepWave = Waves_InitOut%NStepWave ! For WAMIT, WAMIT2, SS_Excitation, Morison InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT @@ -410,7 +410,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WvHiCOffS = InputFileData%Waves2%WvHiCOffS InitOut%WaveDirMod = InputFileData%Waves%WaveDirMod InitOut%WaveDir = InputFileData%Waves%WaveDir ! For WAMIT for use in SS_Excitation - ! InitOut%WtrDens = InputFileData%Waves%WtrDens ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth InitOut%SeaSt_Interp_p = p%seast_interp_p diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 33d9227398..ba4c1406d9 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -48,6 +48,7 @@ typedef ^ ^ LOGICAL Sea typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - +typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - @@ -73,14 +74,12 @@ typedef ^ ^ Logical Lin typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" -typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 8c3de32a66..5522722dfd 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -95,7 +95,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, CurLine = CurLine + 1 ! WtrDens - Water density. - call ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDens', InputFileData%Waves%WtrDens, defWtrDens, ErrStat2, ErrMsg2, UnEc ) + call ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDens', InputFileData%WtrDens, defWtrDens, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WtrDpth - Water depth @@ -536,7 +536,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WtrDens - Water density. - if ( InputFileData%Waves%WtrDens < 0.0 ) then + if ( InputFileData%WtrDens < 0.0 ) then call SetErrStat( ErrID_Fatal,'WtrDens must not be negative.',ErrStat,ErrMsg,RoutineName) return end if @@ -1191,7 +1191,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! If we are using the Waves module, the node information must be copied over. InputFileData%Waves2%NWaveKinGrid = InputFileData%Waves%NWaveKinGrid ! Number of points where the incident wave kinematics will be computed (-) if ( InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) then - InputFileData%Waves2%WtrDens = InputFileData%Waves%WtrDens InputFileData%Waves2%Gravity = InitInp%Gravity InputFileData%Waves2%WtrDpth = InputFileData%Waves%WtrDpth InputFileData%Waves2%NGrid = p%NGrid diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index e7ddeb3854..fd88ba99dd 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -1031,7 +1031,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS IF (InputFileData%Waves%WaveMod /= 0 .and. InputFileData%Waves%WaveMod /= 6) THEN WRITE( UnSum, '(1X,A61,F8.2,A4/)' ) 'The Mean Sea Level to Still Water Level (MSL2SWL) Offset is :',InputFileData%MSL2SWL,' (m)' - WRITE( UnSum, '(1X,A15,F8.2,A8)' ) 'Water Density: ', InputFileData%Waves%WtrDens, '(kg/m^3)' + WRITE( UnSum, '(1X,A15,F8.2,A8)' ) 'Water Density: ', InputFileData%WtrDens, '(kg/m^3)' WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19)' ) 'Water Depth : ', InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL, '(m) relative to MSL; ', & InputFileData%Waves%WtrDpth, '(m) relative to SWL' WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19/)' ) 'Grid Z_Depth : ', InputFileData%Z_Depth - InputFileData%MSL2SWL, '(m) relative to MSL; ', & diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 17d784d85a..2357627c04 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -67,6 +67,7 @@ MODULE SeaState_Types CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -94,14 +95,12 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] @@ -302,6 +301,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutFmt = SrcInputFileData%OutFmt DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt DstInputFileData%WaveStMod = SrcInputFileData%WaveStMod + DstInputFileData%WtrDens = SrcInputFileData%WtrDens end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -395,6 +395,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%OutFmt) call RegPack(Buf, InData%OutSFmt) call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -529,6 +530,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -710,14 +713,12 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod @@ -790,14 +791,12 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveDirMin) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) @@ -865,8 +864,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMin) @@ -879,8 +876,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 04ca95837d..c4fa75ad7b 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -1090,7 +1090,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & InitInp%WaveKinGridyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) - WaveDynPC0 (I,J) = InitOut%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) + WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) @@ -1116,7 +1116,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) ! Partial derivatives at zi = 0 - PWaveDynPC0BPz0 (I,J) = InitOut%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*InitInp%WtrDpth ) + PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*InitInp%WtrDpth ) PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr @@ -1651,7 +1651,6 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !InitOut%WriteOutputHdr = (/ 'Time', 'Column2' /) !InitOut%WriteOutputUnt = (/ '(s)', '(-)' /) - InitOut%RhoXg = InitInp%WtrDens*InitInp%Gravity diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index a62644e9e3..0ffe71b075 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -42,7 +42,6 @@ typedef ^ ^ CHARACTER(80) WavePkShpCh typedef ^ ^ INTEGER WaveSeed {2} - - "Random seeds of incident waves [-2147483648 to 2147483647]" - typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) -typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth" (meters) typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations are computed (the XY grid point locations)" - typedef ^ ^ INTEGER NWaveKinGrid - - - "Number of grid points where the incident wave kinematics will be computed" - @@ -72,7 +71,6 @@ typedef ^ InitOutputType INTEGER WaveNDir typedef ^ InitOutputType SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ InitOutputType SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ InitOutputType DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) -typedef ^ InitOutputType SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ InitOutputType INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ InitOutputType INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index cd11aedac7..d0f450f46f 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -634,7 +634,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> Dynamic pressure !> * \f$ P_{nm}^- = \rho_\mathrm{w} B_{nm}^- \omega_{\mu^-} \f$ - DynP_nm_minus = REAL(InitInp%WtrDens,SiKi) * B_minus * Omega_minus + DynP_nm_minus = REAL(WaveField%WtrDens,SiKi) * B_minus * Omega_minus @@ -1009,7 +1009,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> Dynamic pressure !> * \f$ P_{nn}^+ = \rho_\mathrm{w} B_{nn}^+ \omega_{\mu^+} \f$ - DynP_nm_plus = REAL(InitInp%WtrDens, SiKi) * B_plus * Omega_plus + DynP_nm_plus = REAL(WaveField%WtrDens, SiKi) * B_plus * Omega_plus @@ -1111,7 +1111,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> Dynamic pressure !> * \f$ P_{nm}^+ = \rho_\mathrm{w} B_{nm}^+ \omega_{\mu^+} \f$ - DynP_nm_plus = REAL(InitInp%WtrDens,SiKi) * B_plus * Omega_plus + DynP_nm_plus = REAL(WaveField%WtrDens,SiKi) * B_plus * Omega_plus diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index a286fa751e..818c9dd4b6 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -19,7 +19,6 @@ include Registry_NWTC_Library.txt # e.g., the name of the input file, the file root name,etc. # typedef Waves2/Waves2 InitInputType ReKi Gravity - - - "Gravitational acceleration" (m/s^2) -typedef ^ ^ ReKi WtrDens - - - "Water density" (kg/m^3) typedef ^ ^ ReKi WtrDpth - - - "Water depth" (meters) typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 2990cecbb4..62928607de 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -36,7 +36,6 @@ MODULE Waves2_Types ! ========= Waves2_InitInputType ======= TYPE, PUBLIC :: Waves2_InitInputType REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] @@ -86,7 +85,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er ErrStat = ErrID_None ErrMsg = '' DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 @@ -163,7 +161,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves2_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -206,8 +203,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index d0c4c7e1dc..a02c7d6c1b 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -59,7 +59,6 @@ MODULE Waves_Types INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] - REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] @@ -90,7 +89,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE Waves_InitOutputType @@ -133,7 +131,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax DstInitInputData%WaveTp = SrcInitInputData%WaveTp - DstInitInputData%WtrDens = SrcInitInputData%WtrDens DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid @@ -270,7 +267,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveSeed) call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%WaveTp) - call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%NWaveElevGrid) call RegPack(Buf, InData%NWaveKinGrid) @@ -370,8 +366,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTp) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElevGrid) @@ -490,7 +484,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 end subroutine @@ -524,7 +517,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if call RegPack(Buf, InData%WaveTMax) - call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return @@ -574,8 +566,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) end if call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) From c4da8850f4d3529d08bd166c8cc1e856d1d03ab9 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 1 Nov 2023 12:30:22 -0600 Subject: [PATCH 029/232] HD/SeaSt: `WaveDir`, `WaveDirMin`, `WaveDirMax`, and `WaveMultiDir` --- modules/hydrodyn/src/HydroDyn.f90 | 7 +- modules/hydrodyn/src/HydroDyn.txt | 4 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 4 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 4 - modules/hydrodyn/src/HydroDyn_Input.f90 | 6 - modules/hydrodyn/src/HydroDyn_Types.f90 | 20 --- modules/hydrodyn/src/WAMIT.f90 | 6 +- modules/hydrodyn/src/WAMIT.txt | 3 - modules/hydrodyn/src/WAMIT2.f90 | 132 +++++++++--------- modules/hydrodyn/src/WAMIT2.txt | 5 - modules/hydrodyn/src/WAMIT2_Types.f90 | 20 --- modules/hydrodyn/src/WAMIT_Types.f90 | 15 -- modules/openfast-library/src/FAST_Subs.f90 | 4 - modules/seastate/src/SeaSt_WaveField.txt | 4 + .../seastate/src/SeaSt_WaveField_Types.f90 | 20 +++ modules/seastate/src/SeaState.f90 | 17 +-- modules/seastate/src/SeaState.txt | 7 +- modules/seastate/src/SeaState_Input.f90 | 22 +-- modules/seastate/src/SeaState_Types.f90 | 30 ++-- modules/seastate/src/UserWaves.f90 | 4 +- modules/seastate/src/Waves.f90 | 19 +-- modules/seastate/src/Waves.txt | 4 - modules/seastate/src/Waves_Types.f90 | 20 --- 23 files changed, 137 insertions(+), 240 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 70883f56df..b5dce4f5f5 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -361,12 +361,9 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%NStepWave = InitInp%NStepWave InputFileData%WAMIT%NStepWave2 = InitInp%NStepWave2 - InputFileData%WAMIT%WaveDirMin = InitInp%WaveDirMin - InputFileData%WAMIT%WaveDirMax = InitInp%WaveDirMax InputFileData%WAMIT%WaveDOmega = InitInp%WaveDOmega ! Init inputs for the SS_Excitation model (set this just in case it will be used) - InputFileData%WAMIT%WaveDir = InitInp%WaveDir InputFileData%WAMIT%WaveElev0 => InitInp%WaveField%WaveElev0 InputFileData%WAMIT%WaveElevC => InitInp%WaveField%WaveElevC InputFileData%WAMIT%WaveField => InitInp%WaveField @@ -439,8 +436,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy Waves initialization output into the initialization input type for the WAMIT module InputFileData%WAMIT2%NStepWave = InitInp%NStepWave InputFileData%WAMIT2%NStepWave2 = InitInp%NStepWave2 - InputFileData%WAMIT2%WaveDirMin = InitInp%WaveDirMin - InputFileData%WAMIT2%WaveDirMax = InitInp%WaveDirMax InputFileData%WAMIT2%WaveDOmega = InitInp%WaveDOmega InputFileData%WAMIT2%Gravity = InitInp%Gravity InputFileData%WAMIT2%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file @@ -538,7 +533,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Need to pre-process the incoming wave data to be compatible with FIT FITInitData%N_omega = InitInp%NStepWave2 - FITInitData%Wave_angle = InitInp%WaveDir + FITInitData%Wave_angle = p%WaveField%WaveDir ! allocate waves data arrays for FIT CALL AllocAry( FITInitData%Wave_amp, FITInitData%N_omega, "Wave_amp", ErrStat2, ErrMsg2 ) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index f1cf2288d9..a73c5583ed 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -89,10 +89,6 @@ typedef ^ ^ SiKi typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) -typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index ad07766ab3..d24d52aaad 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -421,10 +421,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%WvHiCOffS = SeaSt%InitOutData%WvHiCOffS HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn - HD%InitInp%WaveDirMin = SeaSt%InitOutData%WaveDirMin - HD%InitInp%WaveDirMax = SeaSt%InitOutData%WaveDirMax - HD%InitInp%WaveDir = SeaSt%InitOutData%WaveDir - HD%InitInp%WaveMultiDir = SeaSt%InitOutData%WaveMultiDir HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega HD%InitInp%MCFD = SeaSt%InitOutData%MCFD diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 3f5f405d78..e96e60c93d 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -336,10 +336,6 @@ subroutine SetHD_InitInputs() InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn - InitInData_HD%WaveDirMin = InitOutData_SeaSt%WaveDirMin - InitInData_HD%WaveDirMax = InitOutData_SeaSt%WaveDirMax - InitInData_HD%WaveDir = InitOutData_SeaSt%WaveDir - InitInData_HD%WaveMultiDir = InitOutData_SeaSt%WaveMultiDir InitInData_HD%WaveDOmega = InitOutData_SeaSt%WaveDOmega InitInData_HD%MCFD = InitOutData_SeaSt%MCFD diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 1f010fe12e..d060c0d509 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1216,12 +1216,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS InputFileData%WAMIT2%WvLowCOffS = InitInp%WvLowCOffS InputFileData%WAMIT2%WvHiCOffS = InitInp%WvHiCOffS - ! Set the flag for multidirectional waves for WAMIT2 module. It needs to know since the Newman approximation - ! can only use uni-directional waves. - InputFileData%WAMIT2%WaveMultiDir = InitInp%WaveMultiDir - - - ! PotFile - Root name of potential flow files diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index fefef6059c..386fa41225 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -105,10 +105,6 @@ MODULE HydroDyn_Types LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] - REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs members [(meters)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] @@ -933,10 +929,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, end if DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC end if - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField @@ -998,10 +990,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if - call RegPack(Buf, InData%WaveDirMin) - call RegPack(Buf, InData%WaveDirMax) - call RegPack(Buf, InData%WaveDir) - call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%MCFD) call RegPack(Buf, associated(InData%WaveField)) @@ -1091,14 +1079,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevC) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MCFD) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 054cff306b..54ba2f2d5f 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -919,7 +919,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS 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%WaveDir = InitInp%WaveField%WaveDir SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot @@ -954,7 +954,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! 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 + IF ( ( InitInp%WaveField%WaveDirMin < HdroWvDir(1) ) .OR. ( InitInp%WaveField%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, RoutineName) @@ -1215,7 +1215,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS 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%WaveDir = InitInp%WaveField%WaveDir SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 12847ee71b..2ee7a574bb 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -37,7 +37,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz typedef ^ ^ DbKi RdtnTMax - - - "" - -typedef ^ ^ ReKi WaveDir - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - @@ -47,8 +46,6 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ INTEGER WaveMod - - - "" - -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 9e49840140..8a23cba787 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -882,12 +882,12 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS IF ( MnDriftData%DataIs3D ) THEN ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data3D%NumWvDir1 == 1) ) THEN + IF ( InitInp%WaveField%WaveMultiDir .AND. (MnDriftData%Data3D%NumWvDir1 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(MnDriftData%Data3D%WvDir1(1)))//' degrees (first wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data3D%NumWvDir2 == 1) ) THEN + ELSE IF ( InitInp%WaveField%WaveMultiDir .AND. (MnDriftData%Data3D%NumWvDir2 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(MnDriftData%Data3D%WvDir2(1)))//' degrees (second wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & @@ -898,7 +898,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & + IF ( (InitInp%WaveField%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveField%WaveDirMax < -150.0_SiKi) .OR. & (minval(MnDriftData%data3d%WvDir1) > 150.0_SiKi) .OR. (maxval(MnDriftData%data3d%WvDir1) < -150.0_SiKi) .OR. & (minval(MnDriftData%data3d%WvDir2) > 150.0_SiKi) .OR. (maxval(MnDriftData%data3d%WvDir2) < -150.0_SiKi) ) THEN CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & @@ -908,13 +908,13 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Now check the limits for the first wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(MnDriftData%Data3D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(MnDriftData%Data3D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -922,13 +922,13 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Now check the limits for the second wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(MnDriftData%Data3D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(MnDriftData%Data3D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -938,12 +938,12 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ELSEIF ( MnDriftData%DataIs4D ) THEN ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data4D%NumWvDir1 == 1) ) THEN + IF ( InitInp%WaveField%WaveMultiDir .AND. (MnDriftData%Data4D%NumWvDir1 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(MnDriftData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (MnDriftData%Data4D%NumWvDir2 == 1) ) THEN + ELSE IF ( InitInp%WaveField%WaveMultiDir .AND. (MnDriftData%Data4D%NumWvDir2 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(MnDriftData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(MnDriftData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & @@ -954,7 +954,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & + IF ( (InitInp%WaveField%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveField%WaveDirMax < -150.0_SiKi) .OR. & (MINVAL(MnDriftData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(MnDriftData%Data4D%WvDir1) < -150.0_SiKi) .OR. & (MINVAL(MnDriftData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(MnDriftData%Data4D%WvDir2) < -150.0_SiKi) ) THEN CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & @@ -965,13 +965,13 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Now check the limits for the first wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(MnDriftData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(MnDriftData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -979,13 +979,13 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Now check the limits for the second wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(MnDriftData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(MnDriftData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(MnDriftData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(MnDriftData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(MnDriftData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -1417,12 +1417,12 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg IF ( NewmanAppData%DataIs3D ) THEN ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data3D%NumWvDir1 == 1) ) THEN + IF ( InitInp%WaveField%WaveMultiDir .AND. (NewmanAppData%Data3D%NumWvDir1 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(NewmanAppData%Data3D%WvDir1(1)))//' degrees (first wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data3D%NumWvDir2 == 1) ) THEN + ELSE IF ( InitInp%WaveField%WaveMultiDir .AND. (NewmanAppData%Data3D%NumWvDir2 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(NewmanAppData%Data3D%WvDir2(1)))//' degrees (second wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & @@ -1433,7 +1433,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & + IF ( (InitInp%WaveField%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveField%WaveDirMax < -150.0_SiKi) .OR. & (minval(NewmanAppData%data3d%WvDir1) > 150.0_SiKi) .OR. (maxval(NewmanAppData%data3d%WvDir1) < -150.0_SiKi) .OR. & (minval(NewmanAppData%data3d%WvDir2) > 150.0_SiKi) .OR. (maxval(NewmanAppData%data3d%WvDir2) < -150.0_SiKi) ) THEN CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & @@ -1443,13 +1443,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Now check the limits for the first wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(NewmanAppData%Data3D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data3D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(NewmanAppData%Data3D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -1457,13 +1457,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Now check the limits for the second wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(NewmanAppData%Data3D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data3D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(NewmanAppData%Data3D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -1473,12 +1473,12 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ELSEIF ( NewmanAppData%DataIs4D ) THEN ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data4D%NumWvDir1 == 1) ) THEN + IF ( InitInp%WaveField%WaveMultiDir .AND. (NewmanAppData%Data4D%NumWvDir1 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(NewmanAppData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (NewmanAppData%Data4D%NumWvDir2 == 1) ) THEN + ELSE IF ( InitInp%WaveField%WaveMultiDir .AND. (NewmanAppData%Data4D%NumWvDir2 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(NewmanAppData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(NewmanAppData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & @@ -1489,7 +1489,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & + IF ( (InitInp%WaveField%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveField%WaveDirMax < -150.0_SiKi) .OR. & (MINVAL(NewmanAppData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(NewmanAppData%Data4D%WvDir1) < -150.0_SiKi) .OR. & (MINVAL(NewmanAppData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(NewmanAppData%Data4D%WvDir2) < -150.0_SiKi) ) THEN CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & @@ -1500,13 +1500,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Now check the limits for the first wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(NewmanAppData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(NewmanAppData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -1514,13 +1514,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Now check the limits for the second wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(NewmanAppData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(NewmanAppData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(NewmanAppData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(NewmanAppData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(NewmanAppData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -2067,12 +2067,12 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (DiffQTFData%Data4D%NumWvDir1 == 1) ) THEN + IF ( InitInp%WaveField%WaveMultiDir .AND. (DiffQTFData%Data4D%NumWvDir1 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(DiffQTFData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(DiffQTFData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (DiffQTFData%Data4D%NumWvDir2 == 1) ) THEN + ELSE IF ( InitInp%WaveField%WaveMultiDir .AND. (DiffQTFData%Data4D%NumWvDir2 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(DiffQTFData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(DiffQTFData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & @@ -2083,7 +2083,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & + IF ( (InitInp%WaveField%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveField%WaveDirMax < -150.0_SiKi) .OR. & (MINVAL(DiffQTFData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(DiffQTFData%Data4D%WvDir1) < -150.0_SiKi) .OR. & (MINVAL(DiffQTFData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(DiffQTFData%Data4D%WvDir2) < -150.0_SiKi) ) THEN CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & @@ -2094,13 +2094,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Now check the limits for the first wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(DiffQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(DiffQTFData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(DiffQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(DiffQTFData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -2108,13 +2108,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Now check the limits for the second wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(DiffQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(DiffQTFData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(DiffQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(DiffQTFData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(DiffQTFData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -2573,12 +2573,12 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! If we are using multidirectional waves, then we should have more than 1 wave direction in the WAMIT file. - IF ( InitInp%WaveMultiDir .AND. (SumQTFData%Data4D%NumWvDir1 == 1) ) THEN + IF ( InitInp%WaveField%WaveMultiDir .AND. (SumQTFData%Data4D%NumWvDir1 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(SumQTFData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(SumQTFData%Data4D%WvDir1(1)))//' degrees (first wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & ErrStat,ErrMsg,RoutineName) - ELSE IF ( InitInp%WaveMultiDir .AND. (SumQTFData%Data4D%NumWvDir2 == 1) ) THEN + ELSE IF ( InitInp%WaveField%WaveMultiDir .AND. (SumQTFData%Data4D%NumWvDir2 == 1) ) THEN CALL SetErrStat( ErrID_Fatal,' WAMIT output file '//TRIM(SumQTFData%Filename)//' only contains one wave '// & 'direction at '//TRIM(Num2LStr(SumQTFData%Data4D%WvDir2(1)))//' degrees (second wave direction). '// & 'It cannot be used with multidirectional waves. Set WaveDirMod to 0 to use this file.', & @@ -2589,7 +2589,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! now (since time is limited) we will issue a warning if any of the wave directions for multidirectional waves ! or data from the WAMIT file for the wavedirections is close to the +/-pi boundary (>150 degrees, <-150 degrees), ! we will issue a warning. - IF ( (InitInp%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveDirMax < -150.0_SiKi) .OR. & + IF ( (InitInp%WaveField%WaveDirMin > 150.0_SiKi) .OR. (InitInp%WaveField%WaveDirMax < -150.0_SiKi) .OR. & (MINVAL(SumQTFData%Data4D%WvDir1) > 150.0_SiKi) .OR. (MAXVAL(SumQTFData%Data4D%WvDir1) < -150.0_SiKi) .OR. & (MINVAL(SumQTFData%Data4D%WvDir2) > 150.0_SiKi) .OR. (MAXVAL(SumQTFData%Data4D%WvDir2) < -150.0_SiKi) ) THEN CALL SetErrStat( ErrID_Warn,' There may be issues with how the wave direction data is handled when the wave '// & @@ -2600,13 +2600,13 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Now check the limits for the first wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. ! --> FIXME: modify to allow shifting values by TwoPi before comparing - IF ( InitInp%WaveDirMin < MINVAL(SumQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(SumQTFData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(SumQTFData%Data4D%WvDir1) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(SumQTFData%Data4D%WvDir1) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the first wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF @@ -2614,13 +2614,13 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Now check the limits for the second wave direction ! --> FIXME: sometime fix this to handle the above case. See Known Issue #1 at top of file. - IF ( InitInp%WaveDirMin < MINVAL(SumQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMin))//' is not'//& + IF ( InitInp%WaveField%WaveDirMin < MINVAL(SumQTFData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Minimum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMin))//' is not'//& 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF - IF ( InitInp%WaveDirMax > MAXVAL(SumQTFData%Data4D%WvDir2) ) THEN - CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveDirMax))//' is not'//& + IF ( InitInp%WaveField%WaveDirMax > MAXVAL(SumQTFData%Data4D%WvDir2) ) THEN + CALL SetErrStat( ErrID_Fatal,' Maximum wave direction required of '//TRIM(Num2LStr(InitInp%WaveField%WaveDirMax))//' is not'//& 'found in the WAMIT data file '//TRIM(SumQTFData%Filename)//' for the second wave direction.', & ErrStat, ErrMsg, RoutineName) ENDIF diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 5b55f29564..d22ce6a416 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -34,11 +34,6 @@ typedef ^ ^ ReKi WaveDOmega typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" (m) -typedef ^ ^ SiKi WaveDir - - - "Mean incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction from Waves module" - -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction from Waves module" - - typedef ^ ^ INTEGER WaveMod - - - "The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here." - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 53f60b28b0..b802f61b70 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -51,10 +51,6 @@ MODULE WAMIT2_Types REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< Frequency step for incident wave calculations [(rad/s)] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(m)] - REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] @@ -172,10 +168,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%MnDrift = SrcInitInputData%MnDrift @@ -254,10 +246,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%WaveDir) - call RegPack(Buf, InData%WaveMultiDir) - call RegPack(Buf, InData%WaveDirMin) - call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -369,14 +357,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 705bf5c7f0..6abdabba0a 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -57,7 +57,6 @@ MODULE WAMIT_Types INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] - REAL(ReKi) :: WaveDir = 0.0_ReKi !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] @@ -67,8 +66,6 @@ MODULE WAMIT_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] - REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE WAMIT_InitInputType @@ -262,7 +259,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp DstInitInputData%ExctnCutOff = SrcInitInputData%ExctnCutOff 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) @@ -274,8 +270,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -374,7 +368,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%ExctnDisp) call RegPack(Buf, InData%ExctnCutOff) call RegPack(Buf, InData%RdtnTMax) - call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WAMITFile) call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) call RegPack(Buf, InData%NStepWave) @@ -405,8 +398,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveDirMin) - call RegPack(Buf, InData%WaveDirMax) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -548,8 +539,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RdtnTMax) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn @@ -633,10 +622,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) end if call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index f1632c5299..5f57df0877 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -868,10 +868,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - Init%InData_HD%WaveDirMin = Init%OutData_SeaSt%WaveDirMin - Init%InData_HD%WaveDirMax = Init%OutData_SeaSt%WaveDirMax - Init%InData_HD%WaveDir = Init%OutData_SeaSt%WaveDir - Init%InData_HD%WaveMultiDir = Init%OutData_SeaSt%WaveMultiDir Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 7133cad915..2e42396c00 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -27,3 +27,7 @@ typedef ^ ^ SiKi typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - +typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) +typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 0f51e6e554..fa080ca100 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -57,6 +57,10 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -261,6 +265,10 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WtrDens = SrcSeaSt_WaveFieldTypeData%WtrDens DstSeaSt_WaveFieldTypeData%RhoXg = SrcSeaSt_WaveFieldTypeData%RhoXg + DstSeaSt_WaveFieldTypeData%WaveDirMin = SrcSeaSt_WaveFieldTypeData%WaveDirMin + DstSeaSt_WaveFieldTypeData%WaveDirMax = SrcSeaSt_WaveFieldTypeData%WaveDirMax + DstSeaSt_WaveFieldTypeData%WaveDir = SrcSeaSt_WaveFieldTypeData%WaveDir + DstSeaSt_WaveFieldTypeData%WaveMultiDir = SrcSeaSt_WaveFieldTypeData%WaveMultiDir end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -407,6 +415,10 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) end if call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%RhoXg) + call RegPack(Buf, InData%WaveDirMin) + call RegPack(Buf, InData%WaveDirMax) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -639,6 +651,14 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index baaac17099..c66a797fc5 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -222,11 +222,12 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init RETURN END IF - p%WaveField%MSL2SWL = InputFileData%MSL2SWL - p%WaveField%WaveStMod = InputFileData%WaveStMod - p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp - p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 - + p%WaveField%MSL2SWL = InputFileData%MSL2SWL + p%WaveField%WaveStMod = InputFileData%WaveStMod + p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp + p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 + p%WaveField%WaveDir = InputFileData%WaveDir + p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) @@ -359,7 +360,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WtrDpth = InitOut%WtrDpth - InitOut%WaveMultiDir = InputFileData%Waves%WaveMultiDir InitOut%MCFD = InputFileData%Waves%MCFD CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -394,8 +394,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! non-pointer data: - InitOut%WaveDirMin = Waves_InitOut%WaveDirMin ! For WAMIT and WAMIT2 - InitOut%WaveDirMax = Waves_InitOut%WaveDirMax ! For WAMIT and WAMIT2 InitOut%WaveDOmega = Waves_InitOut%WaveDOmega ! For WAMIT and WAMIT2, FIT InitOut%NStepWave = Waves_InitOut%NStepWave ! For WAMIT, WAMIT2, SS_Excitation, Morison @@ -409,11 +407,10 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WvLowCOffS = InputFileData%Waves2%WvLowCOffS InitOut%WvHiCOffS = InputFileData%Waves2%WvHiCOffS InitOut%WaveDirMod = InputFileData%Waves%WaveDirMod - InitOut%WaveDir = InputFileData%Waves%WaveDir ! For WAMIT for use in SS_Excitation ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth InitOut%SeaSt_Interp_p = p%seast_interp_p - + InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index ba4c1406d9..9f9246be48 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -49,6 +49,9 @@ typedef ^ ^ CHARACTER(20) Out typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional" - + typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - @@ -75,10 +78,6 @@ typedef ^ InitOutputType CHARACTER(ChanLen) Wri typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) -typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 5522722dfd..6052f6a0ca 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -185,7 +185,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! WaveDir - Mean wave heading direction. - call ParseVar( FileInfo_In, CurLine, 'WaveDir', InputFileData%Waves%WaveDir, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WaveDir', InputFileData%WaveDir, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WaveDirMod - Directional spreading function {0: None, 1: COS2S} (-) [Used only if WaveMod=2] @@ -674,9 +674,9 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er call WrScr( ' Setting WaveTMax to TMax since WaveMod = 0' ) InputFileData%Waves%WaveTMax = InitInp%TMax end if - if ( .NOT. EqualRealNos(InputFileData%Waves%WaveDir, 0.0_SiKi) ) then + if ( .NOT. EqualRealNos(InputFileData%WaveDir, 0.0_SiKi) ) then call WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) - InputFileData%Waves%WaveDir = 0.0 + InputFileData%WaveDir = 0.0 end if elseif ( InputFileData%Waves%WaveMod == 5 ) then ! User wave elevation file reading in if (InitInp%TMax > InputFileData%Waves%WaveTMax ) then @@ -801,14 +801,14 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er if ( ( InputFileData%Waves%WaveMod > 0 ) .AND. ( InputFileData%Waves%WaveMod /= 6 ) ) then ! .TRUE if we have incident waves, but not user input wave data. - if ( ( InputFileData%Waves%WaveDir <= -180.0 ) .OR. ( InputFileData%Waves%WaveDir > 180.0 ) ) then + if ( ( InputFileData%WaveDir <= -180.0 ) .OR. ( InputFileData%WaveDir > 180.0 ) ) then call SetErrStat( ErrID_Fatal,'WaveDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) return end if else - InputFileData%Waves%WaveDir = 0.0 + InputFileData%WaveDir = 0.0 end if @@ -823,9 +823,9 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Check if we are doing multidirectional waves or not. ! We can only use multi directional waves on WaveMod=2,3,4 - InputFileData%Waves%WaveMultiDir = .FALSE. ! Set flag to false to start + InputFileData%WaveMultiDir = .FALSE. ! Set flag to false to start if ( InputFileData%Waves%WaveMod >= 2 .AND. InputFileData%Waves%WaveMod <= 4 .AND. InputFileData%Waves%WaveDirMod == 1 ) then - InputFileData%Waves%WaveMultiDir = .TRUE. + InputFileData%WaveMultiDir = .TRUE. elseif ( (InputFileData%Waves%WaveMod < 2 .OR. InputFileData%Waves%WaveMod >4) .AND. InputFileData%Waves%WaveDirMod == 1 ) then call SetErrStat( ErrID_Warn,'WaveDirMod unused unless WaveMod == 2, 3, or 4. Ignoring WaveDirMod.',ErrStat,ErrMsg,RoutineName) ENDIF @@ -833,15 +833,15 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Check to see if the for some reason the wave direction spreading range is set to zero. If it is, ! we don't have any spreading, so we will turn off the multidirectional waves. - if ( InputFileData%Waves%WaveMultiDir .AND. EqualRealNos( InputFileData%Waves%WaveDirRange, 0.0_SiKi ) ) then + if ( InputFileData%WaveMultiDir .AND. EqualRealNos( InputFileData%Waves%WaveDirRange, 0.0_SiKi ) ) then call SetErrStat( ErrID_Warn,' WaveDirRange set to zero, so multidirectional waves are turned off.',ErrStat,ErrMsg,RoutineName) - InputFileData%Waves%WaveMultiDir = .FALSE. + InputFileData%WaveMultiDir = .FALSE. ENDIF ! We check the following only if we set WaveMultiDir to true, otherwise ignore them and set them to zero - if ( InputFileData%Waves%WaveMultiDir ) then + if ( InputFileData%WaveMultiDir ) then ! Check WaveDirSpread if ( InputFileData%Waves%WaveDirSpread <= 0.0 ) then @@ -990,7 +990,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if - InputFileData%Current%CurrSSDir = InputFileData%Waves%WaveDir + InputFileData%Current%CurrSSDir = InputFileData%WaveDir else ! The input must have been specified numerically. diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 2357627c04..cb5d0d346f 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -68,6 +68,8 @@ MODULE SeaState_Types CHARACTER(20) :: OutSFmt !< Output format for header strings [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -96,10 +98,6 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] - REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] - REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] @@ -302,6 +300,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt DstInputFileData%WaveStMod = SrcInputFileData%WaveStMod DstInputFileData%WtrDens = SrcInputFileData%WtrDens + DstInputFileData%WaveDir = SrcInputFileData%WaveDir + DstInputFileData%WaveMultiDir = SrcInputFileData%WaveMultiDir end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -396,6 +396,8 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%OutSFmt) call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WaveDir) + call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -532,6 +534,10 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -714,10 +720,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir - DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 @@ -792,10 +794,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%WaveDirMin) - call RegPack(Buf, InData%WaveDirMax) - call RegPack(Buf, InData%WaveDir) - call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -866,14 +864,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index b5c193d982..c6dc85544f 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -93,8 +93,8 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, WaveField%WaveDirArr = 0.0 ! scalars (adjusted later, if necessary) - InitOut%WaveDirMin = 0.0 - InitOut%WaveDirMax = 0.0 + WaveField%WaveDirMin = 0.0 + WaveField%WaveDirMax = 0.0 InitOut%WaveNDir = 1 END SUBROUTINE Initial_InitOut_Arrays diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index c4fa75ad7b..06a995e23a 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -989,8 +989,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END IF ! Store the minimum and maximum wave directions - InitOut%WaveDirMin = MINVAL(WaveField%WaveDirArr) - InitOut%WaveDirMax = MAXVAL(WaveField%WaveDirArr) + WaveField%WaveDirMin = MINVAL(WaveField%WaveDirArr) + WaveField%WaveDirMax = MAXVAL(WaveField%WaveDirArr) ! Set the CosWaveDir and SinWaveDir arrays @@ -1937,9 +1937,9 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !InitOut%WaveDirArr set in UserWaveComponents_Init for WaveMod 7 !InitOut%WaveDirArr = 0, set in Initial_InitOut_Arrays for WaveMod 0 and 6 - ELSEIF(.not. InitInp%WaveMultiDir .or. InitInp%WaveNDir <= 1) THEN ! we have a single wave direction + ELSEIF(.not. WaveField%WaveMultiDir .or. InitInp%WaveNDir <= 1) THEN ! we have a single wave direction - WaveField%WaveDirArr = InitInp%WaveDir + WaveField%WaveDirArr = WaveField%WaveDir ELSE ! multi directional waves @@ -1975,7 +1975,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! This allocates and sets WvTheta: - call CalculateWaveSpreading(InitInp, InitOut, WvTheta, ErrStatTmp, ErrMsgTmp) + call CalculateWaveSpreading(InitInp, InitOut, WaveField, WvTheta, ErrStatTmp, ErrMsgTmp) call SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then call Cleanup() @@ -2063,12 +2063,13 @@ END SUBROUTINE Cleanup END SUBROUTINE CalculateWaveDirection !------------------------------------------------------------------------------------------------------------------------ -SUBROUTINE CalculateWaveSpreading(InitInp, InitOut, WvTheta, ErrStat, ErrMsg ) +SUBROUTINE CalculateWaveSpreading(InitInp, InitOut, WaveField, WvTheta, ErrStat, ErrMsg ) ! Compute the wave direction array !---------------------------------------------------------------------------------------------------------------------------------- TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField REAL(SiKi), ALLOCATABLE, INTENT( OUT) :: WvTheta(:) !< Final set of wave directions (degrees) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -2168,10 +2169,10 @@ SUBROUTINE CalculateWaveSpreading(InitInp, InitOut, WvTheta, ErrStat, ErrMsg ) !> 2. Calculate the spreading function as a function of angle. Step through all _WvSpreadNDir_ steps. DO I=0,WvSpreadNDir ! The current angle as we step through the range - WvSpreadThetas(I) = I*WvSpreadDTheta + InitInp%WaveDir - InitInp%WaveDirRange/(2.0_SiKi) + WvSpreadThetas(I) = I*WvSpreadDTheta + WaveField%WaveDir - InitInp%WaveDirRange/(2.0_SiKi) ! Calculate the wave spreading for the current value of WvSpreadThetas - WvSpreadCos2SArr(I) = WvSpreadCos2SConst*abs( cos(Pi*(WvSpreadThetas(I)-InitInp%WaveDir)/InitInp%WaveDirRange) ) **(2*InitInp%WaveDirSpread) + WvSpreadCos2SArr(I) = WvSpreadCos2SConst*abs( cos(Pi*(WvSpreadThetas(I)-WaveField%WaveDir)/InitInp%WaveDirRange) ) **(2*InitInp%WaveDirSpread) !> 3. Calculate the integral of the spreading function up to the current angle and save it. ! Remember that the first element can't refer to one before it. @@ -2322,7 +2323,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS CASE ( 3 ) ! White-noise WaveS1SddArr(I) = InitInp%WaveHs * InitInp%WaveHs / ( 16.0 * (InitInp%WvHiCOff - InitInp%WvLowCOff) ) CASE ( 4 ) ! User-defined spectrum (irregular) wave. - CALL UserWaveSpctrm ( OmegaArr(I), InitInp%WaveDir, InitInp%DirRoot, WaveS1SddArr(I) ) + CALL UserWaveSpctrm ( OmegaArr(I), WaveField%WaveDir, InitInp%DirRoot, WaveS1SddArr(I) ) ENDSELECT END IF diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 0ffe71b075..bba49031bb 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -25,9 +25,7 @@ typedef ^ ^ ReKi Gravity typedef ^ ^ integer nGrid 3 - - "Grid dimensions" typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WaveDir - - - "Mean incident wave propagation heading direction" (degrees) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WaveDirSpread - - - "Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1]" - typedef ^ ^ SiKi WaveDirRange - - - "Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6]" (degrees) @@ -65,8 +63,6 @@ typedef ^ ^ ReKi PtfmLocatio # Define outputs from the initialization routine here: # -typedef ^ InitOutputType SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ InitOutputType SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ InitOutputType INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ InitOutputType SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ InitOutputType SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index a02c7d6c1b..db00a94b03 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -42,9 +42,7 @@ MODULE Waves_Types INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WaveDirSpread = 0.0_R4Ki !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] REAL(SiKi) :: WaveDirRange = 0.0_R4Ki !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] @@ -83,8 +81,6 @@ MODULE Waves_Types ! ======================= ! ========= Waves_InitOutputType ======= TYPE, PUBLIC :: Waves_InitOutputType - REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] @@ -114,9 +110,7 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WaveDir = SrcInitInputData%WaveDir DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange @@ -250,9 +244,7 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%WvLowCOff) call RegPack(Buf, InData%WvHiCOff) - call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveNDir) - call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WaveDirSpread) call RegPack(Buf, InData%WaveDirRange) @@ -332,12 +324,8 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirSpread) @@ -478,8 +466,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev @@ -504,8 +490,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WaveDirMin) - call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, associated(InData%WaveElev)) @@ -532,10 +516,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) From 3109eaab4662123c12c5b667ce34d6c8915500be Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 2 Nov 2023 09:29:27 -0600 Subject: [PATCH 030/232] SeaSt: remove unused `WaveElev` pointer --- modules/seastate/src/SeaState.f90 | 3 -- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 43 ------------------------- vs-build/SeaState/SeaStateDriver.vfproj | 2 +- 4 files changed, 1 insertion(+), 48 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index c66a797fc5..9c248935ef 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -127,9 +127,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init m%SeaSt_Interp_m%FirstWarn_Clamp = .true. -#ifdef BETA_BUILD - CALL DispBetaNotice( "This is a beta version of SeaState and is for testing purposes only."//NewLine//"This version includes user waves, WaveMod=6 and the ability to write example user waves." ) -#endif ! Initialize the NWTC Subroutine Library diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index bba49031bb..1ef691c0d6 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -65,7 +65,6 @@ typedef ^ ^ ReKi PtfmLocatio # typedef ^ InitOutputType INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ InitOutputType SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ InitOutputType SiKi WaveElev {*}{*}{*} - - "Instantaneous elevation time-series of incident waves at each of the XY grid points" (meters) typedef ^ InitOutputType DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ InitOutputType INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ InitOutputType INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index db00a94b03..af04467baf 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -83,7 +83,6 @@ MODULE Waves_Types TYPE, PUBLIC :: Waves_InitOutputType INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] @@ -461,14 +460,11 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 @@ -481,25 +477,15 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Waves_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' - nullify(InitOutputData%WaveElev) end subroutine subroutine Waves_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Waves_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves_PackInitOutput' - logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveElev)) - if (associated(InData%WaveElev)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) - call RegPackPointer(Buf, c_loc(InData%WaveElev), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev) - end if - end if call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -510,40 +496,11 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Waves_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitOutput' - integer(IntKi) :: LB(3), UB(3) - integer(IntKi) :: stat - logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx - type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev, UB(1:3)-LB(1:3)) - OutData%WaveElev(LB(1):,LB(2):,LB(3):) => OutData%WaveElev - else - allocate(OutData%WaveElev(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev) - call RegUnpack(Buf, OutData%WaveElev) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev => null() - end if call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index 0de503b1af..c9a4786e34 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -5,7 +5,7 @@ - + From 37ac2fe6f3fe1571aba05ac002dfccfd3f9a6759 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 2 Nov 2023 10:32:37 -0600 Subject: [PATCH 031/232] HD: remove unused SS Excitation & Radiation driver codes --- modules/hydrodyn/CMakeLists.txt | 3 - modules/hydrodyn/src/SS_Excitation_Driver.f90 | 299 ------------------ .../hydrodyn/src/SS_Radiation_DriverCode.f90 | 282 ----------------- 3 files changed, 584 deletions(-) delete mode 100644 modules/hydrodyn/src/SS_Excitation_Driver.f90 delete mode 100644 modules/hydrodyn/src/SS_Radiation_DriverCode.f90 diff --git a/modules/hydrodyn/CMakeLists.txt b/modules/hydrodyn/CMakeLists.txt index 7b9a59f9f9..7ef738647b 100644 --- a/modules/hydrodyn/CMakeLists.txt +++ b/modules/hydrodyn/CMakeLists.txt @@ -68,9 +68,6 @@ if(APPLE OR UNIX) endif() -#add_executable(ss_radiation -# src/SS_Radiation_DriverCode.f90) -#target_link_libraries(ss_radiation hydrodynlib nwtclibs) install(TARGETS hydrodynlib hydrodyn_driver hydrodyn_driver_subs hydrodyn_c_binding EXPORT "${CMAKE_PROJECT_NAME}Libraries" diff --git a/modules/hydrodyn/src/SS_Excitation_Driver.f90 b/modules/hydrodyn/src/SS_Excitation_Driver.f90 deleted file mode 100644 index 985ac09210..0000000000 --- a/modules/hydrodyn/src/SS_Excitation_Driver.f90 +++ /dev/null @@ -1,299 +0,0 @@ -!********************************************************************************************************************************** -! SS_Excitation_Driver: This code tests the SS_Excitation module -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2018 National Renewable Energy Laboratory -! -! This file is part of SS_Excitation. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! -!********************************************************************************************************************************** -PROGRAM SS_Excitation_Driver - - USE NWTC_Library - USE SS_Excitation - USE SS_Excitation_Types - - IMPLICIT NONE - - ! Program variables - - REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: waveDT - !REAL(DbKi) :: Time2(145201,1) ! Variable for storing time, in seconds - !REAL(DbKi) :: tdq(145201,7) ! Variable for storing time and body velocities, in m/s or rad/s - !REAL(DbKi) :: dq(145201,6) ! Variable for storing body velocities, in m/s or rad/s - REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds - !INTEGER(B1Ki), ALLOCATABLE :: SaveAry(:) ! Array to store packed data structure - - TYPE(SS_Exc_InitInputType) :: InitInData ! Input data for initialization - TYPE(SS_Exc_InitOutputType) :: InitOutData ! Output data from initialization - - TYPE(SS_Exc_ContinuousStateType) :: x ! Continuous states - TYPE(SS_Exc_ContinuousStateType) :: x_new ! Continuous states at updated time - TYPE(SS_Exc_DiscreteStateType) :: xd ! Discrete states - TYPE(SS_Exc_DiscreteStateType) :: xd_new ! Discrete states at updated time - TYPE(SS_Exc_ConstraintStateType) :: z ! Constraint states - TYPE(SS_Exc_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) - TYPE(SS_Exc_OtherStateType) :: OtherState ! Other states - - TYPE(SS_Exc_ParameterType) :: p ! Parameters - TYPE(SS_Exc_InputType) :: u(1) ! System inputs - REAL(DbKi) :: InputTimes(1) ! System input times - TYPE(SS_Exc_OutputType) :: y ! System outputs - TYPE(SS_Exc_MiscVarType) :: m ! misc/optimization variables - - TYPE(SS_Exc_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states - - - - !Local Variables - INTEGER(IntKi) :: n ! Loop counter (for time step) - INTEGER(IntKi) :: I ! Loop counter (for time step) - INTEGER(IntKi) :: J ! Loop counter (for time step) - REAL(SiKi) :: ElevData - INTEGER(IntKi) :: UnWvEl ! Input file identifier - INTEGER(IntKi) :: Outputy ! Output file identifier - INTEGER(IntKi) :: ErrStat, ErrStat2 ! Status of error message - CHARACTER(1024) :: ErrMsg, ErrMsg2 ! Error message if ErrStat /= ErrID_None - INTEGER :: Sttus ! Error in reading input file - REAL(ReKi) :: Start ! CPU Time at start of the program - REAL(ReKi) :: Finnish ! CPU Time at the end of the program - REAL(ReKi) :: UsrTime - REAL(ReKi) :: Tratio - REAL(ReKi) :: Factor - CHARACTER(8) :: TimePer - INTEGER(4) :: EndTimes (8) ! An array holding the ending clock time of the simulation. - INTEGER(4) :: StrtTime (8) ! An array holding the starting clock time of the simulation. - REAL(ReKi) :: ClckTime - INTEGER :: len ! Number of input arguments - CHARACTER(1024) :: waveFile - - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - - ErrStat = ErrID_None - ErrMsg = '' - - call NWTC_Init() - - ! Call Time - !call cpu_time(start) - !call DATE_AND_TIME ( Values=StrtTime ) - - - - ! Populate the InitInData data structure - - - ! This file name should be the WAMIT file name without extension! - InitInData%InputFile = 'C:\Dev\Envision\all-changes\Test_Models\5MW_Baseline\HydroData\barge' - InitInData%WaveDir = 0.0_ReKi - InitInData%NStepWave = 14520 - waveDT = 0.25 - allocate ( InitInData%WaveElev0(0:InitInData%NStepWave) , STAT=ErrStat2 ) - allocate ( InitInData%WaveTime (0:InitInData%NStepWave) , STAT=ErrStat2 ) - - ! Construct the wave times array - do i = 0,InitInData%NStepWave - InitInData%WaveTime(i) = waveDT*i - end do - - ! Need to read in the wave elevation data to pass in as initialization data - waveFile = 'C:\Dev\Envision\all-changes\Test_Models\5MW_ITIBarge_DLL_WTurb_WavesIrr\barge.Elev' - call GetNewUnit ( UnWvEl, ErrStat, ErrMsg ) - call OpenFInpFile ( UnWvEl, trim(waveFile), ErrStat, ErrMsg ) ! Open wave elevation file. - if ( ErrStat /= 0 ) then - ErrStat = ErrID_Fatal - ErrMsg = ' Could not open wave elevation file.' - print*, ( ErrMsg ) - end if - - call ReadCom ( UnWvEl, trim(waveFile), 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Excitation_Driver') - - do i = 0,InitInData%NStepWave - 1 - call ReadVar( UnWvEl,trim(waveFile), InitInData%WaveElev0(i), 'InitInData%WaveElev0(i)', 'Wave elevation',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Excitation_Driver') - end do - - close ( UnWvEl ) !Close dq input file - - ! Now set the last element of the Wave elevation array to match the initial elevation for wrapping - InitInData%WaveElev0(InitInData%NStepWave) = InitInData%WaveElev0(0) - - - - ! Set the driver's request for time interval here: This should be the Rdtn DT defined in the hydrodyn input file - TimeInterval = 0.005 - - CALL SS_Exc_Init( InitInData, u(1), p, x, xd, z, OtherState, y, m, TimeInterval, InitOutData, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - - ! Initialize output file - call GetNewUnit ( Outputy, ErrStat, ErrMsg ) - CALL OpenFOutFile ( Outputy, (TRIM(InitInData%InputFile)//'.out'), ErrStat, ErrMsg) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error opening output file.' - CALL WrScr( ErrMsg ) - END IF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputHdr - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputUnt - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !............................................................................................................................... - - CALL WrScr( 'Runnig SS_Excitation in Loose Coupling using a Adams-Bashforth-Moulton Method' ) - - CALL SS_Exc_CopyDiscState( xd, xd_new, MESH_NEWCOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - CALL SS_Exc_CopyContState( x, x_new, MESH_NEWCOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - ! - - DO n = 0,InitInData%NStepWave-1 - - Time = n*TimeInterval - InputTimes(1) = Time - - ! Get state variables at next step: constraint states (z) at step n, continuous and discrete states at step n + 1 - CALL SS_Exc_UpdateStates( Time, n, u, InputTimes, p, x_new, xd_new, z, OtherState, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - !print*, x%x - ! Calculate outputs at n - - CALL SS_Exc_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - ! Update x and xd with continuous and discrete states at n + 1 - ! Note that the constraint state guess at n+1 is the value of the constraint state at n (so it doesn't need updating here) - - CALL SS_Exc_CopyContState( x_new, x, MESH_UPDATECOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - CALL SS_Exc_CopyDiscState( xd_new, xd, MESH_UPDATECOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - !Write Output to file - WRITE(Outputy,'(7(e16.6))',IOSTAT=Sttus) y%WriteOutput - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - print*, ErrMsg - ENDIF - END DO - - - CALL SS_Exc_DestroyDiscState( xd_new, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - CALL SS_Exc_DestroyContState( x_new, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - CALL SS_Exc_DestroyInitInput( InitInData, ErrStat, ErrMsg, DEALLOCATEpointers = .true. ) ! pointers were allocated in this data type, so we need to deallocate them here, too - 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_Radiation_DriverCode.f90 b/modules/hydrodyn/src/SS_Radiation_DriverCode.f90 deleted file mode 100644 index 49f8e464c8..0000000000 --- a/modules/hydrodyn/src/SS_Radiation_DriverCode.f90 +++ /dev/null @@ -1,282 +0,0 @@ -!********************************************************************************************************************************** -! SS_Radiation_DriverCode: This code tests the template modules -!.................................................................................................................................. -! LICENSING -! Copyright (C) 2012 National Renewable Energy Laboratory -! -! This file is part of SS_Radiation. -! -! SS_Radiation is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as -! published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. -! -! This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty -! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. -! -! You should have received a copy of the GNU General Public License along with SS_Radiation. -! If not, see . -! -!********************************************************************************************************************************** -PROGRAM SS_Radiation_Driver - - USE NWTC_Library - USE SS_Radiation - USE SS_Radiation_Types - - IMPLICIT NONE - - ! Program variables - - REAL(DbKi) :: Time ! Variable for storing time, in seconds - REAL(DbKi) :: Time2(145201,1) ! Variable for storing time, in seconds - REAL(DbKi) :: tdq(145201,7) ! Variable for storing time and body velocities, in m/s or rad/s - REAL(DbKi) :: dq(145201,6) ! Variable for storing body velocities, in m/s or rad/s - REAL(DbKi) :: TimeInterval ! Interval between time steps, in seconds - INTEGER(B1Ki), ALLOCATABLE :: SaveAry(:) ! Array to store packed data structure - - TYPE(SS_Rad_InitInputType) :: InitInData ! Input data for initialization - TYPE(SS_Rad_InitOutputType) :: InitOutData ! Output data from initialization - - TYPE(SS_Rad_ContinuousStateType) :: x ! Continuous states - TYPE(SS_Rad_ContinuousStateType) :: x_new ! Continuous states at updated time - TYPE(SS_Rad_DiscreteStateType) :: xd ! Discrete states - TYPE(SS_Rad_DiscreteStateType) :: xd_new ! Discrete states at updated time - TYPE(SS_Rad_ConstraintStateType) :: z ! Constraint states - TYPE(SS_Rad_ConstraintStateType) :: z_residual ! Residual of the constraint state equations (Z) - TYPE(SS_Rad_OtherStateType) :: OtherState ! Other states - - TYPE(SS_Rad_ParameterType) :: p ! Parameters - TYPE(SS_Rad_InputType) :: u ! System inputs - TYPE(SS_Rad_OutputType) :: y ! System outputs - TYPE(SS_Rad_MiscVarType) :: m ! misc/optimization variables - - TYPE(SS_Rad_ContinuousStateType) :: dxdt ! First time derivatives of the continuous states - - - - !Local Variables - INTEGER(IntKi) :: n ! Loop counter (for time step) - INTEGER(IntKi) :: I ! Loop counter (for time step) - INTEGER(IntKi) :: J ! Loop counter (for time step) - INTEGER(IntKi) :: Inputdq ! Input file identifier - INTEGER(IntKi) :: Outputy ! Output file identifier - INTEGER(IntKi) :: ErrStat ! Status of error message - CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER :: Sttus ! Error in reading input file - REAL(ReKi) :: Start ! CPU Time at start of the program - REAL(ReKi) :: Finnish ! CPU Time at the end of the program - REAL(ReKi) :: UsrTime - REAL(ReKi) :: Tratio - REAL(ReKi) :: Factor - CHARACTER(8) :: TimePer - INTEGER(4) :: EndTimes (8) ! An array holding the ending clock time of the simulation. - INTEGER(4) :: StrtTime (8) ! An array holding the starting clock time of the simulation. - REAL(ReKi) :: ClckTime - INTEGER :: len ! Number of input arguments - - !............................................................................................................................... - ! Routines called in initialization - !............................................................................................................................... - - ! Call Time - CALL cpu_time(start) - CALL DATE_AND_TIME ( Values=StrtTime ) - - ! Populate the InitInData data structure here: - - InitInData%InputFile = 'C:\Users\tduarte\Documents\SS_Module\Comparisons\FAST_output_freq\spar_IMP_097' - !!! GREG !!!: This file name should be the WAMIT file name without extension! - - - InitInData%Dofs = 1 - !!! GREG: This is a vector of [1x6] containing 0 and 1 if each of the 6 dofs is enabled or not (as we discussed today in the meeting) - - - ! Set the driver's request for time interval here: - TimeInterval = 0.025 ! Glue code's request for delta time (likely based on information from other modules) - !!! GREG: This should be the Rdtn DT defined in the platform input file@ - - CALL SS_Rad_Init( InitInData, u, p, x, xd, z, OtherState, y, m, TimeInterval, InitOutData, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - !!! GREG: This version reads in the desired file containing the platform velocities. You don't need this in your case. - CALL CheckArgs( InitInData%InputFile ) - - CALL Get_Arg_Num (len ) - - ! Read the time dependent input vector dq - CALL OpenFInpFile ( Inputdq, (TRIM(InitInData%InputFile)//'.txt'), ErrStat ) ! Open motion file. - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error allocating memory for the dq array.' - print*, ( ErrMsg ) - END IF - - - - DO I = 1,145201 !Read dq Matrix - READ (Inputdq,*,IOSTAT=Sttus) (tdq (I,J), J=1,7) - ENDDO - - CLOSE ( Inputdq ) !Close dq input file - - Time2(:,1) = tdq(:,1) - dq = tdq(:,2:7) - - !!!GREG: here the output file is opened, you should not need this - !Initialize output file - CALL OpenFOutFile ( Outputy, (TRIM(InitInData%InputFile)//'.out'), ErrStat) - IF ( ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error opening output file.' - CALL WrScr( ErrMsg ) - END IF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputHdr - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - WRITE(Outputy,*,IOSTAT=Sttus) InitOutData%WriteOutputUnt - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - ENDIF - - !............................................................................................................................... - ! Routines called in loose coupling -- the glue code may implement this in various ways - !............................................................................................................................... - - CALL WrScr( 'Runnig SS_Radiation in Loose Coupling using a Adams-Bashforth-Moulton Method' ) - - CALL SS_Rad_CopyDiscState( xd, xd_new, MESH_NEWCOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - CALL SS_Rad_CopyContState( x, x_new, MESH_NEWCOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - ! -!CALL cpu_time(T1) - DO n = 0,145200 - - Time = n*TimeInterval - - ! Modify u (likely from the outputs of another module or a set of test conditions) here: - - u%dq(1,1) = dq (n+1,1) - u%dq(2,1) = dq (n+1,2) - u%dq(3,1) = dq (n+1,3) - u%dq(4,1) = dq (n+1,4) - u%dq(5,1) = dq (n+1,5) - u%dq(6,1) = dq (n+1,6) - - ! Get state variables at next step: constraint states (z) at step n, continuous and discrete states at step n + 1 - - CALL SS_Rad_UpdateStates( Time, u, p, x_new, xd_new, z, OtherState, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - !print*, x%x - ! Calculate outputs at n - - CALL SS_Rad_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - ! Update x and xd with continuous and discrete states at n + 1 - ! Note that the constraint state guess at n+1 is the value of the constraint state at n (so it doesn't need updating here) - - CALL SS_Rad_CopyContState( x_new, x, MESH_UPDATECOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - CALL SS_Rad_CopyDiscState( xd_new, xd, MESH_UPDATECOPY, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - !Write Output to file - WRITE(Outputy,'(7(e16.6))',IOSTAT=Sttus) y%WriteOutput - IF ( Sttus /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' Error writing output file.' - CALL WrScr( ErrMsg ) - print*, ErrMsg - ENDIF - END DO - - - CALL SS_Rad_DestroyDiscState( xd_new, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - CALL SS_Rad_DestroyContState( x_new, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary - CALL WrScr( ErrMsg ) - END IF - - - !............................................................................................................................... - ! Routine to terminate program execution - !............................................................................................................................... - CALL SS_Rad_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - IF ( ErrStat /= ErrID_None ) THEN - CALL WrScr( ErrMsg ) - END IF - - - !!! GREG: This is also to ouput values (dont need it) - CALL DATE_AND_TIME ( VALUES=EndTimes ) - CALL cpu_time(finnish) - - ClckTime = 0.001*( EndTimes(8) - StrtTime(8) ) + ( EndTimes(7) - StrtTime(7) ) + 60.0*( EndTimes(6) - StrtTime(6) ) & - + 3600.0*( EndTimes(5) - StrtTime(5) ) + 86400.0*( EndTimes(3) - StrtTime(3) ) - - UsrTime = finnish-start - - IF ( UsrTime /= 0.0 ) THEN - - TRatio = Time / UsrTime - - IF ( UsrTime > 86400.0 ) THEN - Factor = 1.0/86400.0 - TimePer = ' days' - ELSEIF ( UsrTime > 3600.0 ) THEN - Factor = 1.0/3600.0 - TimePer = ' hours' - ELSEIF ( UsrTime > 60.0 ) THEN - Factor = 1.0/60.0 - TimePer = ' minutes' - ELSE - Factor = 1.0 - TimePer = ' seconds' - ENDIF - - CALL WrScr ( ' Total Real Time: '//TRIM( Flt2LStr( Factor*ClckTime ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Total CPU Time: '//TRIM( Flt2LStr( Factor*UsrTime ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Simulated Time: '//TRIM( Flt2LStr( Factor*REAL( Time ) ) )//TRIM( TimePer ) ) - CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Flt2LStr( TRatio ) ) ) - - ENDIF - - - !Write Output to file - WRITE(Outputy,'(1(e16.6))',IOSTAT=Sttus) TRatio - ! Ending routines - CLOSE( Outputy ) - - - -END PROGRAM SS_Radiation_Driver - From 49344ea5fca2717ce840d86596b7bb4ffa2c9670 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 2 Nov 2023 11:28:35 -0600 Subject: [PATCH 032/232] HD: remove unnecessary `WaveElev0`, `WaveElevC`, and `WaveElev1` vars - also removed extra pointer for WaveTime in SS Excitation module - cleaned up some text handling in SS Excitation (some incorrect routine names in error message and a lot of extra repeated string manipulation) - Do we have a test for SS-Excitation? --- modules/hydrodyn/src/HydroDyn.f90 | 10 +- modules/hydrodyn/src/HydroDyn.txt | 2 - modules/hydrodyn/src/HydroDyn_Types.f90 | 74 +----- modules/hydrodyn/src/SS_Excitation.f90 | 100 ++++---- modules/hydrodyn/src/SS_Excitation.txt | 16 +- modules/hydrodyn/src/SS_Excitation_Types.f90 | 228 +++--------------- modules/hydrodyn/src/WAMIT.f90 | 66 +---- modules/hydrodyn/src/WAMIT.txt | 5 +- modules/hydrodyn/src/WAMIT_Types.f90 | 109 +-------- modules/seastate/src/SeaSt_WaveField.txt | 2 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 2 +- 11 files changed, 113 insertions(+), 501 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index b5dce4f5f5..c2019e87ef 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -284,6 +284,8 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Is there a WAMIT body? IF ( InputFileData%PotMod == 1 ) THEN + InputFileData%WAMIT%WaveField => InitInp%WaveField + p%nWAMITObj = InputFileData%nWAMITObj ! All the data for the various WAMIT bodies are stored in a single WAMIT file p%vecMultiplier = InputFileData%vecMultiplier ! Multiply all vectors and matrices row/column lengths by NBody InputFileData%WAMIT%NBodyMod = InputFileData%NBodyMod @@ -291,7 +293,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file p%NBody = InputFileData%NBody p%NBodyMod = InputFileData%NBodyMod - InputFileData%WAMIT%WaveElev1 => InitInp%WaveField%WaveElev1 call AllocAry( m%F_PtfmAdd, 6*InputFileData%NBody, "m%F_PtfmAdd", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) call AllocAry( m%F_Waves , 6*InputFileData%NBody, "m%F_Waves" , ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -363,11 +364,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%NStepWave2 = InitInp%NStepWave2 InputFileData%WAMIT%WaveDOmega = InitInp%WaveDOmega - ! Init inputs for the SS_Excitation model (set this just in case it will be used) - InputFileData%WAMIT%WaveElev0 => InitInp%WaveField%WaveElev0 - InputFileData%WAMIT%WaveElevC => InitInp%WaveField%WaveElevC - InputFileData%WAMIT%WaveField => InitInp%WaveField - ! InputFileData%WAMIT%seast_interp_p = InitInp%WaveField%seast_interp_p CALL SeaSt_Interp_CopyParam(InitInp%WaveField%seast_interp_p, InputFileData%WAMIT%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2808,7 +2804,7 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call PackMotionMesh(u%PRPMesh, u_op, index, FieldMask=Mask) ! extended input: - u_op(index) = 0.0_R8Ki !u%WaveElev0 + u_op(index) = 0.0_R8Ki END IF diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index a73c5583ed..169545fb18 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -87,8 +87,6 @@ typedef ^ ^ SiKi 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 ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) -typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 386fa41225..6e146faaf0 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -103,8 +103,6 @@ MODULE HydroDyn_Types REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs members [(meters)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] @@ -877,7 +875,7 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' @@ -905,30 +903,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn - if (allocated(SrcInitInputData%WaveElev0)) then - LB(1:1) = lbound(SrcInitInputData%WaveElev0) - UB(1:1) = ubound(SrcInitInputData%WaveElev0) - if (.not. allocated(DstInitInputData%WaveElev0)) then - allocate(DstInitInputData%WaveElev0(LB(1):UB(1)), 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 - end if - if (allocated(SrcInitInputData%WaveElevC)) then - LB(1:3) = lbound(SrcInitInputData%WaveElevC) - UB(1:3) = ubound(SrcInitInputData%WaveElevC) - if (.not. allocated(DstInitInputData%WaveElevC)) then - allocate(DstInitInputData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC - end if DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField @@ -945,12 +919,6 @@ subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InitInputData%WaveElev0)) then - deallocate(InitInputData%WaveElev0) - end if - if (allocated(InitInputData%WaveElevC)) then - deallocate(InitInputData%WaveElevC) - end if nullify(InitInputData%WaveField) end subroutine @@ -980,16 +948,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WvLowCOffS) call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%InvalidWithSSExctn) - call RegPack(Buf, allocated(InData%WaveElev0)) - if (allocated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) - call RegPack(Buf, InData%WaveElev0) - end if - call RegPack(Buf, allocated(InData%WaveElevC)) - if (allocated(InData%WaveElevC)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) - call RegPack(Buf, InData%WaveElevC) - end if call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%MCFD) call RegPack(Buf, associated(InData%WaveField)) @@ -1006,7 +964,7 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(0), UB(0) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -1051,34 +1009,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevC) - if (RegCheckErr(Buf, RoutineName)) return - end if call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MCFD) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 835e642220..f35633aca6 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -101,7 +101,7 @@ function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) if (p%ExctnDisp == 0) then - GetWaveElevation = InterpWrappedStpReal ( real(time, SiKi), p%WaveTime(:), p%WaveElev0(:), m%LastIndWave, p%NStepWave + 1 ) + GetWaveElevation = InterpWrappedStpReal ( real(time, SiKi), p%WaveField%WaveTime, p%WaveField%WaveElev0, m%LastIndWave, p%NStepWave + 1 ) else call SS_Exc_CopyInput(u_in(1), u_out, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! allocates arrays so that SS_Exc_Input_ExtrapInterp will work @@ -111,7 +111,7 @@ function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) do iBody = 1, p%NBody - GetWaveElevation(iBody) = SeaSt_Interp_3D( time, u_out%PtfmPos(1:2,iBody), p%WaveElev1, p%SeaSt_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + GetWaveElevation(iBody) = SeaSt_Interp_3D( time, u_out%PtfmPos(1:2,iBody), p%WaveField%WaveElev1, p%SeaSt_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do @@ -153,10 +153,12 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini INTEGER :: Nlines ! Number of lines in the input file, used to determine N INTEGER :: UnSS ! I/O unit number for the WAMIT output file with the .ss extension; this file contains the state-space matrices. INTEGER :: Sttus ! Error in reading .ssexctn file - real(ReKi) :: WaveDir ! Temp wave direction angle (deg) + real(SiKi) :: WaveDir ! Temp wave direction angle (deg) character(3) :: bodystr integer :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 + character(1024) :: InFile + character(*), parameter :: RoutineName = 'SS_Exc_Init' ! Initialize ErrStat ErrStat = ErrID_None @@ -166,12 +168,21 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini UnSS = -1 p%numStates = 0 + + ! Set wave field data and parameters from InitInp: + p%NStepWave = InitInp%NStepWave + p%SeaSt_Interp_p = InitInp%SeaSt_Interp_p + p%WaveField => InitInp%WaveField + + p%ExctnDisp = InitInp%ExctnDisp p%NBody = InitInp%NBody ! Number of WAMIT bodies: =1 if WAMIT is using NBodyMod > 1, >=1 if NBodyMod=1 + ! Open the .ss input file! + InFile = TRIM(InitInp%InputFile)//'.ssexctn' CALL GetNewUnit( UnSS ) - CALL OpenFInpFile ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', ErrStat2, ErrMsg2 ) ! Open file. - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL OpenFInpFile ( UnSS, TRIM(InFile), ErrStat2, ErrMsg2 ) ! Open file. + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() RETURN @@ -180,24 +191,24 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Determine the number of states and size of the matrices Nlines = 1 - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadCom ( UnSS, InFile, 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS,InFile, WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Check that excitation state-space file Beta angle (in degrees) matches the HydroDyn input file angle - if ( .not. EqualRealNos(InitInp%WaveDir, WaveDir) ) call SetErrStat(ErrID_FATAL,'HydroDyn Wave direction does not match the wave excitation wave direction',ErrStat,ErrMsg,'SS_Exc_Init') + if ( .not. EqualRealNos(InitInp%WaveField%WaveDir, WaveDir) ) call SetErrStat(ErrID_FATAL,'HydroDyn Wave direction does not match the wave excitation wave direction',ErrStat,ErrMsg,RoutineName) - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%Tc, 'p%Tc', 'Time offset (s)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS,InFile, p%Tc, 'p%Tc', 'Time offset (s)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%numStates, 'p%numStates', 'Number of states',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS,InFile, p%numStates, 'p%numStates', 'Number of states',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry( p%spdof, 6*p%NBody, 'p%spdof', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') - CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%spDOF, 6*p%NBody, 'p%spDOF', 'States per DOF',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + call AllocAry( p%spdof, 6*p%NBody, 'p%spdof', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL ReadAry( UnSS,InFile, p%spDOF, 6*p%NBody, 'p%spDOF', 'States per DOF',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() @@ -205,7 +216,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini END IF DO !Loop through all the lines of the file - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',Sttus,ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Header',Sttus,ErrMsg2 )! Reads the first entire line (Title header) IF ( Sttus == ErrID_None ) THEN ! .TRUE. when data is read in successfully Nlines=Nlines+1 ELSE !We must have reached the end of the file @@ -217,7 +228,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini !Verifications on the input file IF ( ( Nlines - 6*p%NBody ) / 2 /= p%numStates) THEN - CALL SetErrStat(ErrID_Severe,'Error in the input file .ssexctn: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,'SS_Exc_Init') + CALL SetErrStat(ErrID_Severe,'Error in the input file .ssexctn: The size of the matrices does not correspond to the number of states!',ErrStat,ErrMsg,RoutineName) END IF @@ -228,9 +239,9 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Now we can allocate the temporary matrices A, B and C - CALL AllocAry( p%A, p%numStates, p%numStates, 'p%A', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - CALL AllocAry( p%B, p%numStates, 'p%B', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - CALL AllocAry( p%C, 6*p%NBody, p%numStates, 'p%C', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL AllocAry( p%A, p%numStates, p%numStates, 'p%A', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( p%B, p%numStates, 'p%B', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( p%C, 6*p%NBody, p%numStates, 'p%C', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() @@ -241,25 +252,25 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini REWIND (UNIT=UnSS) ! REWIND the file so we can read it in a second time. ! Skip the first 4 lines: (NOTE: no error handling here because we would have caught it the first time through) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Wave direction (deg)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Time offset (s)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Number of Excitation States', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) - CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Number of states per dofs', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Header', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Wave direction (deg)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Time offset (s)', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Number of Excitation States', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) + CALL ReadCom ( UnSS, InFile, 'Number of states per dofs', ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) DO I = 1,p%numStates !Read A MatriX - CALL ReadAry( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', p%A(I,:), p%numStates, 'p%A', 'A_Matrix',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadAry( UnSS,InFile, p%A(I,:), p%numStates, 'p%A', 'A_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO DO I = 1,p%numStates !Read B Matrix - CALL ReadVar( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', p%B(I), 'p%B', 'B_Matrix',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadVar( UnSS, InFile, p%B(I), 'p%B', 'B_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO DO I = 1,6*p%NBody !Read C Matrix - CALL ReadAry( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', p%C(I,:), p%numStates, 'p%C', 'C_Matrix',ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL ReadAry( UnSS, InFile, p%C(I,:), p%numStates, 'p%C', 'C_Matrix',ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO CLOSE ( UnSS ) !Close .ss input file UnSS = -1 ! Indicate the file is closed @@ -273,21 +284,10 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini p%DT = Interval - ! Allocate Wave-elevation related arrays - p%NStepWave = InitInp%NStepWave - p%SeaSt_Interp_p = InitInp%SeaSt_Interp_p - p%ExctnDisp = InitInp%ExctnDisp - p%WaveTime => InitInp%WaveTime - p%ExctnDisp = InitInp%ExctnDisp - if (p%ExctnDisp == 0) then - p%WaveElev0 => InitInp%WaveElev0 - else - p%WaveElev1 => InitInp%WaveElev1 - end if ! Define initial system states here: - CALL AllocAry( x%x, p%numStates, 'x%x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL AllocAry( x%x, p%numStates, 'x%x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL CleanUp() RETURN @@ -300,7 +300,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Define other States: DO I=1,SIZE(OtherState%xdot) - CALL SS_Exc_CopyContState( x, OtherState%xdot(i), MESH_NEWCOPY, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + CALL SS_Exc_CopyContState( x, OtherState%xdot(i), MESH_NEWCOPY, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END DO OtherState%n = -1 @@ -311,17 +311,17 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! no inputs ! Define system output initializations (set up mesh) here: - call AllocAry( y%y, p%NBody*6, 'y%y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') + call AllocAry( y%y, p%NBody*6, 'y%y', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) y%y = 0 - call AllocAry( y%WriteOutput, 6*p%NBody+1, 'y%WriteOutput', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') + call AllocAry( y%WriteOutput, 6*p%NBody+1, 'y%WriteOutput', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) y%WriteOutput = 0 ! Define initialization-routine output here: ! For OpenFAST, these outputs are attached (via HydroDyn) to the Radiation Force/Moment channels within HydroDyn - call AllocAry( InitOut%WriteOutputHdr, 6*p%NBody+1, 'InitOut%WriteOutputHdr', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') - call AllocAry( InitOut%WriteOutputUnt, 6*p%NBody+1, 'InitOut%WriteOutputUnt', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Rad_Init') + call AllocAry( InitOut%WriteOutputHdr, 6*p%NBody+1, 'InitOut%WriteOutputHdr', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( InitOut%WriteOutputUnt, 6*p%NBody+1, 'InitOut%WriteOutputUnt', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) InitOut%WriteOutputHdr(1) = 'Time' InitOut%WriteOutputUnt(1) = '(s) ' do i = 1, p%NBody diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 59986becaf..2b1266e3c1 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -15,17 +15,17 @@ # URL: $HeadURL$ ################################################################################################################################### usefrom SeaState_Interp.txt +usefrom SeaSt_WaveField.txt typedef SS_Excitation/SS_Exc InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - typedef ^ ^ IntKi NBody - - - "Number of WAMIT bodies for this State Space model" - typedef ^ ^ IntKi ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - -typedef ^ ^ ReKi WaveDir - - - "Wave direction" rad typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians -typedef ^ ^ SiKi WaveElev0 {*} - - "Wave elevation time history at origin" m -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -typedef ^ ^ SiKi WaveTime {*} - - "Times where wave elevation is known (points to SeaState module data)" s -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - + + typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output" - @@ -63,10 +63,8 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi C {:}{:} - - "C matrix" - typedef ^ ^ INTEGER numStates - 0 - "Number of states" - typedef ^ ^ DbKi Tc - - - "Time shift" s -typedef ^ ^ SiKi WaveElev0 {*} - - "Wave elevation time history at origin" m -typedef ^ ^ SiKi WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -typedef ^ ^ SiKi WaveTime {*} - - "Times where wave elevation is known (points to SeaState module data)" s -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # ..... Inputs ............................. # Define inputs that are contained on the mesh here: diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 84657838fe..30ef6accdf 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -32,6 +32,7 @@ MODULE SS_Excitation_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SeaState_Interp_Types +USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE ! ========= SS_Exc_InitInputType ======= @@ -39,13 +40,10 @@ MODULE SS_Excitation_Types CHARACTER(1024) :: InputFile !< Name of the input file [-] INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: WaveDir = 0.0_ReKi !< Wave direction [rad] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin [m] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Times where wave elevation is known (points to SeaState module data) [s] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_InitInputType ! ======================= ! ========= SS_Exc_InitOutputType ======= @@ -93,10 +91,8 @@ MODULE SS_Excitation_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] REAL(DbKi) :: Tc = 0.0_R8Ki !< Time shift [s] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin [m] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Times where wave elevation is known (points to SeaState module data) [s] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_ParameterType ! ======================= ! ========= SS_Exc_InputType ======= @@ -118,7 +114,7 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' @@ -127,7 +123,6 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%InputFile = SrcInitInputData%InputFile DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp - DstInitInputData%WaveDir = SrcInitInputData%WaveDir DstInitInputData%NStepWave = SrcInitInputData%NStepWave if (allocated(SrcInitInputData%PtfmRefztRot)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) @@ -141,12 +136,10 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if - DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveTime => SrcInitInputData%WaveTime call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -161,11 +154,9 @@ subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%PtfmRefztRot)) then deallocate(InitInputData%PtfmRefztRot) end if - nullify(InitInputData%WaveElev0) - nullify(InitInputData%WaveElev1) - nullify(InitInputData%WaveTime) call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%WaveField) end subroutine subroutine SS_Exc_PackInitInput(Buf, Indata) @@ -177,38 +168,20 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPack(Buf, InData%InputFile) call RegPack(Buf, InData%NBody) call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if - call RegPack(Buf, associated(InData%WaveElev0)) - if (associated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) - call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev0) - end if - end if - call RegPack(Buf, associated(InData%WaveElev1)) - if (associated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) - call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev1) - end if - end if - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) end if end if - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -216,7 +189,7 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -228,8 +201,6 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) @@ -246,79 +217,27 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefztRot) if (RegCheckErr(Buf, RoutineName)) return end if - if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) - OutData%WaveElev0(LB(1):) => OutData%WaveElev0 - else - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev0 => null() - end if - if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) - OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 - else - allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev1 => null() - end if - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpackPointer(Buf, Ptr, PtrIdx) if (RegCheckErr(Buf, RoutineName)) return if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime + call c_f_pointer(Ptr, OutData%WaveField) else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField end if else - OutData%WaveTime => null() + OutData%WaveField => null() end if - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -711,7 +630,7 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' @@ -771,12 +690,10 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if DstParamData%numStates = SrcParamData%numStates DstParamData%Tc = SrcParamData%Tc - DstParamData%WaveElev0 => SrcParamData%WaveElev0 - DstParamData%WaveElev1 => SrcParamData%WaveElev1 - DstParamData%WaveTime => SrcParamData%WaveTime call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstParamData%WaveField => SrcParamData%WaveField end subroutine subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -800,11 +717,9 @@ subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%C)) then deallocate(ParamData%C) end if - nullify(ParamData%WaveElev0) - nullify(ParamData%WaveElev1) - nullify(ParamData%WaveTime) call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%WaveField) end subroutine subroutine SS_Exc_PackParam(Buf, Indata) @@ -839,31 +754,14 @@ subroutine SS_Exc_PackParam(Buf, Indata) end if call RegPack(Buf, InData%numStates) call RegPack(Buf, InData%Tc) - call RegPack(Buf, associated(InData%WaveElev0)) - if (associated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) - call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev0) - end if - end if - call RegPack(Buf, associated(InData%WaveElev1)) - if (associated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) - call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev1) - end if - end if - call RegPack(Buf, associated(InData%WaveTime)) - if (associated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) - call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveTime) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) end if end if - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -871,7 +769,7 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -945,79 +843,27 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Tc) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) - OutData%WaveElev0(LB(1):) => OutData%WaveElev0 - else - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev0 => null() - end if - if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) - OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 - else - allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev1 => null() - end if - if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpackPointer(Buf, Ptr, PtrIdx) if (RegCheckErr(Buf, RoutineName)) return if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) - OutData%WaveTime(LB(1):) => OutData%WaveTime + call c_f_pointer(Ptr, OutData%WaveField) else - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField end if else - OutData%WaveTime => null() + OutData%WaveField => null() end if - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 54ba2f2d5f..21a5550243 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -919,18 +919,13 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS else if ( p%ExctnMod == 2 ) then Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Exctn_InitInp%InputFile = InitInp%WAMITFile - SS_Exctn_InitInp%WaveDir = InitInp%WaveField%WaveDir SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp - ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module - IF (ASSOCIATED(InitInp%WaveElev0)) SS_Exctn_InitInp%WaveElev0 => InitInp%WaveElev0 - IF (ASSOCIATED(InitInp%WaveElev1)) SS_Exctn_InitInp%WaveElev1 => InitInp%WaveElev1 !TODO: Verify what happens within SS_Exctn when we have no waves. - - SS_Exctn_InitInp%WaveTime => InitInp%WaveField%WaveTime + SS_Exctn_InitInp%WaveField => InitInp%WaveField call SS_Exc_Init(SS_Exctn_InitInp, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, & m%SS_Exctn_y, m%SS_Exctn, Interval_Sub, SS_Exctn_InitOut, ErrStat2, ErrMsg2) @@ -1140,7 +1135,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS RETURN END IF do iGrid = 1, p%SeaSt_Interp_p%n(2)*p%SeaSt_Interp_p%n(3) - WaveExctnCGrid(I,iGrid,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveElevC(1,I,iGrid), InitInp%WaveElevC(2,I,iGrid)) + WaveExctnCGrid(I,iGrid,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveField%WaveElevC(1,I,iGrid), InitInp%WaveField%WaveElevC(2,I,iGrid)) end do END DO ! J - All wave excitation forces and moments END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform @@ -1181,56 +1176,23 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS 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 ) - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - else if ( p%ExctnMod == 2 ) then Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Exctn_InitInp%InputFile = InitInp%WAMITFile - SS_Exctn_InitInp%WaveDir = InitInp%WaveField%WaveDir SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot SS_Exctn_InitInp%SeaSt_Interp_p = InitInp%SeaSt_Interp_p SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp + + SS_Exctn_InitInp%WaveField => InitInp%WaveField + ! We have been passed a pointer to WaveElev0 for use by the State Space excitation module. ! If the special case shown below is not used, then the state space model simply uses WaveElev0, as is. ! however, if we are using the special case, then WaveElev0 will be modified. This is okay, because no one else ! is using WaveElev0 data if (p%ExctnDisp == 0 ) then - if (associated(InitInp%WaveElev0)) then - - ! No other modules need this WaveElev0 array so we will simply move the allocation over to the SS_Exctn module - ! call MOVE_ALLOC(InitInp%WaveElev0, SS_Exctn_InitInp%WaveElev0) - SS_Exctn_InitInp%WaveElev0 => InitInp%WaveElev0 + if (allocated(SS_Exctn_InitInp%WaveField%WaveElev0)) then !NOTE THIS OVERWRITES THE WAVEFIELD WaveElev0 data ! Handle special case when NBodyMod=2 and (PtfmRefxt /= 0 or PtfmRefyt /= 0) : Need to phase shift the wave elevation data for the offset body if ( p%NBodyMod==2 .and. (InitInp%PtfmRefxt(1) /= 0 .or. InitInp%PtfmRefyt(1) /= 0) ) then @@ -1269,7 +1231,8 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF ! We'll need the following for wave stretching once we implement it. - CALL ApplyFFT_cx ( SS_Exctn_InitInp%WaveElev0(0:InitInp%NStepWave-1), tmpComplexArr(: ), FFT_Data, ErrStat2 ) + ! NOTE THIS IS OVERWRITING THE WAVEFIELD WaveElev0 PARAMETER DATA + CALL ApplyFFT_cx ( SS_Exctn_InitInp%WaveField%WaveElev0(0:InitInp%NStepWave-1), tmpComplexArr(: ), FFT_Data, ErrStat2 ) CALL SetErrStat(ErrStat2,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1286,20 +1249,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS end if else !TODO: Error message because we need WaveElev0 for ExctnDisp=0 + call SetErrStat( ErrID_Severe, 'SS Excitation does not contain WaveElev0 data.', ErrStat, ErrMsg, RoutineName ) end if - else - SS_Exctn_InitInp%WaveElev1 => InitInp%WaveElev1 end if - - ! We need the WaveTime array to stay intact for use in other modules, so we will make a copy instead of moving the allocation - !ALLOCATE ( SS_Exctn_InitInp%WaveTime (0:InitInp%NStepWave) , STAT=ErrStat2 ) - !IF ( ErrStat2 /= 0 ) THEN - ! CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the SS_Exctn_InitInp%WaveTime array.', ErrStat, ErrMsg, RoutineName) - ! CALL Cleanup() - ! RETURN - !END IF - SS_Exctn_InitInp%WaveTime => InitInp%WaveField%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, & diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 2ee7a574bb..3b45bf61ce 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -42,9 +42,6 @@ typedef ^ ^ Conv_Rdtn_I 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 WaveElev1 {*}{*}{*} - - "First order wave elevation (points to SeaState module data)" - -typedef ^ ^ SiKi WaveElevC {*}{*}{*} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (meters) typedef ^ ^ INTEGER WaveMod - - - "" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" @@ -125,7 +122,7 @@ typedef ^ ^ Conv_Rdtn_P typedef ^ ^ SS_Rad_ParameterType SS_Rdtn - - - "" - typedef ^ ^ SS_Exc_ParameterType SS_Exctn - - - "" - typedef ^ ^ DbKi DT - - - "" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 6abdabba0a..1b743fc2c4 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -62,9 +62,6 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< [-] - REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin (needed for SS_Excitation module) [m] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] - REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] @@ -158,7 +155,7 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' @@ -266,9 +263,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC DstInitInputData%WaveMod = SrcInitInputData%WaveMod call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -308,9 +302,6 @@ subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if call Conv_Rdtn_DestroyInitInput(InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(InitInputData%WaveElev0) - nullify(InitInputData%WaveElev1) - nullify(InitInputData%WaveElevC) call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitInputData%WaveField) @@ -373,30 +364,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, associated(InData%WaveElev0)) - if (associated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) - call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev0) - end if - end if - call RegPack(Buf, associated(InData%WaveElev1)) - if (associated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) - call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElev1) - end if - end if - call RegPack(Buf, associated(InData%WaveElevC)) - if (associated(InData%WaveElevC)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) - call RegPackPointer(Buf, c_loc(InData%WaveElevC), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%WaveElevC) - end if - end if call RegPack(Buf, InData%WaveMod) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) @@ -413,7 +380,7 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(IntKi) :: PtrIdx @@ -548,78 +515,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) - OutData%WaveElev0(LB(1):) => OutData%WaveElev0 - else - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev0 => null() - end if - if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) - OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 - else - allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElev1 => null() - end if - if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%WaveElevC, UB(1:3)-LB(1:3)) - OutData%WaveElevC(LB(1):,LB(2):,LB(3):) => OutData%WaveElevC - else - allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC) - call RegUnpack(Buf, OutData%WaveElevC) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%WaveElevC => null() - end if call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 2e42396c00..3ce8e6be43 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -14,7 +14,7 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:}{:} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) typedef ^ ^ SiKi PWaveAccMCF0 {:}{:}{:}{:} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) typedef ^ ^ SiKi PWaveVel0 {:}{:}{:}{:} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/m) -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (m) +typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index fa080ca100..653c87c6ff 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -45,7 +45,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAcc0 !< Partial derivative of incident wave acceleration in the vertical direction at the still water level [(m/s^2/m)] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveAccMCF0 !< Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members [(m/s^2/m)] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PWaveVel0 !< Partial derivative of incident wave velocity in the vertical direction at the still water level [(m/s/m)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(m)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT) [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] From b6f6b5124a434ecafa82e2fe39e63a1ce3777bde Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 2 Nov 2023 11:56:37 -0600 Subject: [PATCH 033/232] HD/SeaSt: move `MCFD` to WaveField data structure --- modules/hydrodyn/src/HydroDyn.f90 | 1 - modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 3 +-- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 - modules/hydrodyn/src/HydroDyn_Types.f90 | 5 ---- modules/hydrodyn/src/Morison.f90 | 4 ++-- modules/hydrodyn/src/Morison.txt | 1 - modules/hydrodyn/src/Morison_Types.f90 | 5 ---- modules/openfast-library/src/FAST_Subs.f90 | 1 - modules/seastate/src/SeaSt_WaveField.txt | 1 + .../seastate/src/SeaSt_WaveField_Types.f90 | 5 ++++ modules/seastate/src/SeaState.f90 | 2 +- modules/seastate/src/SeaState.txt | 1 + modules/seastate/src/SeaState_Input.f90 | 4 ++-- modules/seastate/src/SeaState_Types.f90 | 5 ++++ modules/seastate/src/Waves.f90 | 24 +++++++++---------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 5 ---- 18 files changed, 30 insertions(+), 40 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index c2019e87ef..b5917e4aec 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -574,7 +574,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy SeaState initialization output into the initialization input type for the Morison module InputFileData%Morison%NStepWave = InitInp%NStepWave - InputFileData%Morison%MCFD = InitInp%MCFD ! Were visualization meshes requested? InputFileData%Morison%VisMeshes = p%VisMeshes diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 169545fb18..fef0416c13 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -88,7 +88,6 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) -typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs members" (meters) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index d24d52aaad..4f1322acdf 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -422,9 +422,8 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega - HD%InitInp%MCFD = SeaSt%InitOutData%MCFD - if(associated(SeaSt%InitOutData%WaveField )) HD%InitInp%WaveField => SeaSt%InitOutData%WaveField + HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! can be set regardless of association(); if not associated, HD shouldn't work !------------------------------------------------------------- diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index e96e60c93d..183cab5b31 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -337,7 +337,6 @@ subroutine SetHD_InitInputs() InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn InitInData_HD%WaveDOmega = InitOutData_SeaSt%WaveDOmega - InitInData_HD%MCFD = InitOutData_SeaSt%MCFD InitInData_HD%WaveField => InitOutData_SeaSt%WaveField diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 6e146faaf0..ee0394231d 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -104,7 +104,6 @@ MODULE HydroDyn_Types REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs members [(meters)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType ! ======================= @@ -904,7 +903,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -949,7 +947,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, InData%MCFD) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -1011,8 +1008,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index e34fc86430..04812ba0fb 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1528,14 +1528,14 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn END IF ! Check radius DO i = 1, member%NElements+1 - IF ( (member%RMG(i) .GT. 1.1_ReKi*REAL(0.5_SiKi*InitInp%MCFD)) .OR. (member%RMG(i) .LT. 0.9_ReKi*REAL(0.5_SiKi*InitInp%MCFD)) ) THEN + IF ( (member%RMG(i) .GT. 1.1_ReKi*REAL(0.5_SiKi*InitInp%WaveField%MCFD)) .OR. (member%RMG(i) .LT. 0.9_ReKi*REAL(0.5_SiKi*InitInp%WaveField%MCFD)) ) THEN ! Error because MacCamy-Fuchs members must have a diameter within +/-10% of MCFD specified in seastate. CALL SetErrStat(ErrID_Fatal, 'MacCamy-Fuchs members must have a diameter within +/-10% of MCFD specified in the SeaState input file. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) RETURN END IF END DO ! Check draft-to-radius ratio - IF ( (-InitInp%Nodes(member%NodeIndx(1))%Position(3)) < 0.5_SiKi*InitInp%MCFD ) THEN + IF ( (-InitInp%Nodes(member%NodeIndx(1))%Position(3)) < 0.5_SiKi*InitInp%WaveField%MCFD ) THEN CALL SetErrStat(ErrID_Fatal, 'Initial draft of MacCamy-Fuchs members should be at least as large as their radius. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) RETURN END IF diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 59cb5b7b8c..59f1f44781 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -271,7 +271,6 @@ typedef ^ ^ CHARACTER(C typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER UnSum - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ SiKi MCFD - - - "Diameter of the MacCamy-Fuchs member." - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 85f196160a..b49ee58f9f 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -334,7 +334,6 @@ MODULE Morison_Types INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] INTEGER(IntKi) :: UnSum = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] - REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of the MacCamy-Fuchs member. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE Morison_InitInputType @@ -3717,7 +3716,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NumOuts = SrcInitInputData%NumOuts DstInitInputData%UnSum = SrcInitInputData%UnSum DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes end subroutine @@ -3985,7 +3983,6 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, InData%UnSum) call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%MCFD) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -4257,8 +4254,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 5f57df0877..932d5a8ead 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -869,7 +869,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega - Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField ! end if diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 3ce8e6be43..2c09248aa2 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -31,3 +31,4 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - +typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 653c87c6ff..d16004d24a 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -61,6 +61,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -269,6 +270,7 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveDirMax = SrcSeaSt_WaveFieldTypeData%WaveDirMax DstSeaSt_WaveFieldTypeData%WaveDir = SrcSeaSt_WaveFieldTypeData%WaveDir DstSeaSt_WaveFieldTypeData%WaveMultiDir = SrcSeaSt_WaveFieldTypeData%WaveMultiDir + DstSeaSt_WaveFieldTypeData%MCFD = SrcSeaSt_WaveFieldTypeData%MCFD end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -419,6 +421,7 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%WaveDirMax) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, InData%MCFD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -659,6 +662,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 9c248935ef..26f3add0ed 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -225,6 +225,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 p%WaveField%WaveDir = InputFileData%WaveDir p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir + p%WaveField%MCFD = InputFileData%MCFD ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) @@ -357,7 +358,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WtrDpth = InitOut%WtrDpth - InitOut%MCFD = InputFileData%Waves%MCFD CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 9f9246be48..ebf374a51b 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -51,6 +51,7 @@ typedef ^ ^ INTEGER Wav typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional" - +typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 6052f6a0ca..24d39db49f 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -373,11 +373,11 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, CurLine = CurLine + 1 ! MacCamy-Fuchs member radius - call ParseVar( FileInfo_In, CurLine, 'MCFD', InputFileData%Waves%MCFD, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'MCFD', InputFileData%MCFD, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; IF ( InputFileData%Waves%WaveModChr == '0' .OR. InputFileData%Waves%WaveModChr == '6' ) THEN - IF ( InputFileData%Waves%MCFD > 0.0_SiKi ) THEN + IF ( InputFileData%MCFD > 0.0_SiKi ) THEN CALL SetErrStat( ErrID_Fatal,' The MacCamy-Fuchs diffraction model is not compatible with WaveMod = 0 or 6. Need to set MCFD to 0.',ErrStat,ErrMsg,RoutineName) RETURN END IF diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index cb5d0d346f..6f3b41bd48 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -70,6 +70,7 @@ MODULE SeaState_Types REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional [-] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -302,6 +303,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WtrDens = SrcInputFileData%WtrDens DstInputFileData%WaveDir = SrcInputFileData%WaveDir DstInputFileData%WaveMultiDir = SrcInputFileData%WaveMultiDir + DstInputFileData%MCFD = SrcInputFileData%MCFD end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -398,6 +400,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) + call RegPack(Buf, InData%MCFD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -538,6 +541,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 06a995e23a..b43ee1b5f0 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -840,7 +840,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0V.', ErrStat,ErrMsg,RoutineName) - IF (InitInp%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model ALLOCATE ( WaveAccC0HxiMCF(0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HxiMCF.', ErrStat,ErrMsg,RoutineName) @@ -918,7 +918,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ALLOCATE ( WaveField%PWaveAcc0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAcc0.', ErrStat,ErrMsg,RoutineName) - IF (InitInp%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model + IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) @@ -1073,8 +1073,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Wavenumber-dependent acceleration scaling for MacCamy-Fuchs model MCFC = 0.0_ReKi - IF (InitInp%MCFD > 0.0_SiKi .AND. I>0_IntKi) THEN - ka = 0.5_ReKi * WaveNmbr * InitInp%MCFD + IF (WaveField%MCFD > 0.0_SiKi .AND. I>0_IntKi) THEN + ka = 0.5_ReKi * WaveNmbr * WaveField%MCFD JPrime = BESSEL_JN(1,ka) / ka - BESSEL_JN(2,ka) YPrime = BESSEL_YN(1,ka) / ka - BESSEL_YN(2,ka) HPrime = SQRT(JPrime*JPrime + YPrime*YPrime) @@ -1101,7 +1101,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) WaveAccC0V (I,J) = ImagOmega* WaveVelC0V (I,J) - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN WaveAccC0HxiMCF(I,J) = WaveAccC0Hxi(I,J) * MCFC WaveAccC0HyiMCF(I,J) = WaveAccC0Hyi(I,J) * MCFC WaveAccC0VMCF(I,J) = WaveAccC0V(I,J) * MCFC @@ -1131,7 +1131,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN PWaveAccC0HxiMCFPz0(I,J) = PWaveAccC0HxiPz0(I,J) * MCFC PWaveAccC0HyiMCFPz0(I,J) = PWaveAccC0HyiPz0(I,J) * MCFC PWaveAccC0VMCFPz0(I,J) = PWaveAccC0VPz0(I,J) * MCFC @@ -1211,7 +1211,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END DO ! J - All points where the incident wave kinematics will be computed without stretching - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching CALL ApplyFFT_cx ( WaveAcc0HxiMCF (:,J), WaveAccC0HxiMCF (:,J), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0HxiMCF.', ErrStat,ErrMsg,RoutineName) @@ -1261,7 +1261,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END DO ! J - All points where the incident wave kinematics will be computed without stretching - IF (InitInp%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field DO J = 1,InitInp%NWaveElevGrid CALL ApplyFFT_cx ( PWaveAcc0HxiMCFPz0 (:,J ), PWaveAccC0HxiMCFPz0(:,J ),FFT_Data, ErrStatTmp ) @@ -1378,7 +1378,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) end do ! MacCamy-Fuchs scaled fluid acceleration - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN primeCount = 1 count = 1 do k = 1, InitInp%NGrid(3) @@ -1417,7 +1417,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END DO END DO - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN primeCount = 1 DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed DO i = 1, InitInp%NGrid(1) @@ -1485,7 +1485,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveField%WaveDynP (InitOut%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) WaveField%WaveVel (InitOut%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) WaveField%WaveAcc (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN WaveField%WaveAccMCF (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) END IF @@ -1493,7 +1493,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveField%PWaveDynP0(InitOut%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) WaveField%PWaveVel0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) WaveField%PWaveAcc0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) - IF (InitInp%MCFD > 0.0_SiKi) THEN + IF (WaveField%MCFD > 0.0_SiKi) THEN WaveField%PWaveAccMCF0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) END IF END IF diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 1ef691c0d6..4bb5a6098d 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -56,7 +56,6 @@ typedef ^ ^ SiKi CrestHmax typedef ^ ^ SiKi CrestTime - - - "time of the wave crest" sec typedef ^ ^ SiKi CrestXi - - - "xi-coordinate for the wave crest" m typedef ^ ^ SiKi CrestYi - - - "yi-coordinate for the wave crest" m -typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index af04467baf..f67bc7fab9 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -73,7 +73,6 @@ MODULE Waves_Types REAL(SiKi) :: CrestTime = 0.0_R4Ki !< time of the wave crest [sec] REAL(SiKi) :: CrestXi = 0.0_R4Ki !< xi-coordinate for the wave crest [m] REAL(SiKi) :: CrestYi = 0.0_R4Ki !< yi-coordinate for the wave crest [m] - REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] @@ -197,7 +196,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%CrestTime = SrcInitInputData%CrestTime DstInitInputData%CrestXi = SrcInitInputData%CrestXi DstInitInputData%CrestYi = SrcInitInputData%CrestYi - DstInitInputData%MCFD = SrcInitInputData%MCFD DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY @@ -294,7 +292,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%CrestTime) call RegPack(Buf, InData%CrestXi) call RegPack(Buf, InData%CrestYi) - call RegPack(Buf, InData%MCFD) call RegPack(Buf, InData%WaveFieldMod) call RegPack(Buf, InData%PtfmLocationX) call RegPack(Buf, InData%PtfmLocationY) @@ -444,8 +441,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%CrestYi) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%PtfmLocationX) From bc1de35543154029794a3461740ffabc020a0299 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 2 Nov 2023 12:46:00 -0600 Subject: [PATCH 034/232] HD/SeaSt: move WvLowCOff & WvHiCOff to WaveField --- modules/hydrodyn/src/HydroDyn.txt | 3 +- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 2 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 2 - modules/hydrodyn/src/HydroDyn_Input.f90 | 4 -- modules/hydrodyn/src/HydroDyn_Types.f90 | 10 --- modules/hydrodyn/src/WAMIT2.f90 | 20 +++--- modules/hydrodyn/src/WAMIT2.txt | 3 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 10 --- modules/hydrodyn/src/WAMIT_Types.f90 | 1 - modules/openfast-library/src/FAST_Subs.f90 | 2 - modules/seastate/src/SeaSt_WaveField.txt | 2 + .../seastate/src/SeaSt_WaveField_Types.f90 | 10 +++ modules/seastate/src/SeaState.f90 | 5 +- modules/seastate/src/SeaState.txt | 66 +++++++++---------- modules/seastate/src/SeaState_Input.f90 | 14 ++-- modules/seastate/src/SeaState_Types.f90 | 20 +++--- modules/seastate/src/Waves.f90 | 6 +- modules/seastate/src/Waves.txt | 2 - modules/seastate/src/Waves_Types.f90 | 10 --- 19 files changed, 80 insertions(+), 112 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index fef0416c13..e7bf6c8f63 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -80,8 +80,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - -typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) + typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 4f1322acdf..bbe4383899 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -413,8 +413,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod HD%InitInp%WaveDirMod = SeaSt%InitOutData%WaveDirMod - HD%InitInp%WvLowCOff = SeaSt%InitOutData%WvLowCOff - HD%InitInp%WvHiCOff = SeaSt%InitOutData%WvHiCOff HD%InitInp%WvLowCOffD = SeaSt%InitOutData%WvLowCOffD HD%InitInp%WvHiCOffD = SeaSt%InitOutData%WvHiCOffD HD%InitInp%WvLowCOffS = SeaSt%InitOutData%WvLowCOffS diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 183cab5b31..03143662c6 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -327,8 +327,6 @@ subroutine SetHD_InitInputs() InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod InitInData_HD%WaveDirMod = InitOutData_SeaSt%WaveDirMod - InitInData_HD%WvLowCOff = InitOutData_SeaSt%WvLowCOff - InitInData_HD%WvHiCOff = InitOutData_SeaSt%WvHiCOff InitInData_HD%WvLowCOffD = InitOutData_SeaSt%WvLowCOffD InitInData_HD%WvHiCOffD = InitOutData_SeaSt%WvHiCOffD InitInData_HD%WvLowCOffS = InitOutData_SeaSt%WvLowCOffS diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index d060c0d509..88c3501aa3 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1205,10 +1205,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF - ! Copy over the first order frequency limits to the WAMIT2 module which needs them. - InputFileData%WAMIT2%WvLowCOff = InitInp%WvLowCOff - InputFileData%WAMIT2%WvHiCOff = InitInp%WvHiCOff - ! Copy over the 2nd order limits to the WAMIT2 module which needs them. InputFileData%WAMIT2%WvLowCOffD = InitInp%WvLowCOffD diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index ee0394231d..928574f6f7 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -96,8 +96,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] @@ -895,8 +893,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS @@ -939,8 +935,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) - call RegPack(Buf, InData%WvLowCOff) - call RegPack(Buf, InData%WvHiCOff) call RegPack(Buf, InData%WvLowCOffD) call RegPack(Buf, InData%WvHiCOffD) call RegPack(Buf, InData%WvLowCOffS) @@ -992,10 +986,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOffD) diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 8a23cba787..b544cb2c5f 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -848,9 +848,9 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS IF ( MINVAL( MnDriftData%Data4D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data4D%WvFreq1)))// & ' rad/s first wave period) data in '//TRIM(MnDriftData%Filename)// & - ' is above the low frequency cutoff set by WvLowCOff.',ErrStat,ErrMsg,RoutineName) + ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MINVAL( MnDriftData%Data4D%WvFreq2 ) > InitInp%WvLowCOff ) THEN + IF ( MINVAL( MnDriftData%Data4D%WvFreq2 ) > InitInp%WaveField%WvLowCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data4D%WvFreq2)))// & ' rad/s for second wave period) data in '//TRIM(MnDriftData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) @@ -1155,7 +1155,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS !BJJ: If WaveMod==1, this could result in zeroing out the wrong values... !InitInp%WvLowCOff and InitInp%WvHiCOff are not used in SeaState when WaveMod = 0,1, or 6 ! Probably could just remove this IF statement???? - IF ( (Omega1 >= InitInp%WvLowCOff) .AND. (Omega1 <= InitInp%WvHiCOff) ) THEN + IF ( (Omega1 >= InitInp%WaveField%WvLowCOff) .AND. (Omega1 <= InitInp%WaveField%WvHiCOff) ) THEN ! Now get the QTF value that corresponds to this frequency and wavedirection pair. IF ( MnDriftData%DataIs3D ) THEN @@ -1357,7 +1357,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg IF ( NewmanAppData%DataIs3D ) THEN ! Check the low frequency cutoff - IF ( MINVAL( NewmanAppData%Data3D%WvFreq1 ) > InitInp%WvLowCOff ) THEN + IF ( MINVAL( NewmanAppData%Data3D%WvFreq1 ) > InitInp%WaveField%WvLowCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(NewmanAppData%Data3D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(NewmanAppData%Filename)// & ' is above the low frequency cutoff set by WvLowCOff.', & @@ -1366,7 +1366,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(NewmanAppData%Data3D%WvFreq1 ) < InitInp%WvHiCOff ) THEN + IF ( MAXVAL(NewmanAppData%Data3D%WvFreq1 ) < InitInp%WaveField%WvHiCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(NewmanAppData%Data3D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(NewmanAppData%Filename)// & ' is below the high frequency cutoff set by WvHiCOff.', & @@ -1376,13 +1376,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ELSE IF ( NewmanAppData%DataIs4D ) THEN ! only check if not 3D data. If there is 3D data, we default to using it for calculations ! Check the low frequency cutoff - IF ( MINVAL( NewmanAppData%Data4D%WvFreq1 ) > InitInp%WvLowCOff ) THEN + IF ( MINVAL( NewmanAppData%Data4D%WvFreq1 ) > InitInp%WaveField%WvLowCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(NewmanAppData%Data4D%WvFreq1)))// & ' rad/s first wave period) data in '//TRIM(NewmanAppData%Filename)// & ' is above the low frequency cutoff set by WvLowCOff.', & ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MINVAL( NewmanAppData%Data4D%WvFreq2 ) > InitInp%WvLowCOff ) THEN + IF ( MINVAL( NewmanAppData%Data4D%WvFreq2 ) > InitInp%WaveField%WvLowCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(NewmanAppData%Data4D%WvFreq2)))// & ' rad/s for second wave period) data in '//TRIM(NewmanAppData%Filename)// & ' is above the low frequency cutoff set by WvLowCOff.', & @@ -1391,13 +1391,13 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(NewmanAppData%Data4D%WvFreq1) < InitInp%WvHiCOff ) THEN + IF ( MAXVAL(NewmanAppData%Data4D%WvFreq1) < InitInp%WaveField%WvHiCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(NewmanAppData%Data4D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(NewmanAppData%Filename)// & ' is below the high frequency cutoff set by WvHiCOff.', & ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MAXVAL(NewmanAppData%Data4D%WvFreq2) < InitInp%WvHiCOff ) THEN + IF ( MAXVAL(NewmanAppData%Data4D%WvFreq2) < InitInp%WaveField%WvHiCOff ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(NewmanAppData%Data4D%WvFreq1)))// & ' rad/s second wave period) data in '//TRIM(NewmanAppData%Filename)// & ' is below the high frequency cutoff set by WvHiCOff.', & @@ -1720,7 +1720,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Only get a QTF value if within the range of frequencies between the cutoffs for the difference frequency - IF ( (Omega1 >= InitInp%WvLowCOff) .AND. (Omega1 <= InitInp%WvHiCOff) ) THEN + IF ( (Omega1 >= InitInp%WaveField%WvLowCOff) .AND. (Omega1 <= InitInp%WaveField%WvHiCOff) ) THEN ! Now get the QTF value that corresponds to this frequency and wavedirection pair. IF ( NewmanAppData%DataIs3D ) THEN diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index d22ce6a416..3e20494b06 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -46,8 +46,7 @@ typedef ^ ^ LOGICAL MnDriftF typedef ^ ^ LOGICAL NewmanAppF - - - "Flag indicating Newman approximation should be calculated" - typedef ^ ^ LOGICAL DiffQTFF - - - "Flag indicating the full difference QTF should be calculated" - typedef ^ ^ LOGICAL SumQTFF - - - "Flag indicating the full sum QTF should be calculated" - -typedef ^ ^ ReKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ ReKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) + typedef ^ ^ ReKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ ReKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ ReKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index b802f61b70..f9bd49a459 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -61,8 +61,6 @@ MODULE WAMIT2_Types LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] - REAL(ReKi) :: WvLowCOff = 0.0_ReKi !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(ReKi) :: WvHiCOff = 0.0_ReKi !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(ReKi) :: WvLowCOffD = 0.0_ReKi !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(ReKi) :: WvHiCOffD = 0.0_ReKi !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(ReKi) :: WvLowCOffS = 0.0_ReKi !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] @@ -178,8 +176,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS @@ -262,8 +258,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NewmanAppF) call RegPack(Buf, InData%DiffQTFF) call RegPack(Buf, InData%SumQTFF) - call RegPack(Buf, InData%WvLowCOff) - call RegPack(Buf, InData%WvHiCOff) call RegPack(Buf, InData%WvLowCOffD) call RegPack(Buf, InData%WvHiCOffD) call RegPack(Buf, InData%WvLowCOffS) @@ -395,10 +389,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOffD) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 1b743fc2c4..0d6c94a275 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -34,7 +34,6 @@ MODULE WAMIT_Types USE Conv_Radiation_Types USE SS_Radiation_Types USE SS_Excitation_Types -USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE ! ========= WAMIT_InitInputType ======= diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 932d5a8ead..4ea1764137 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -860,8 +860,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod - Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff - Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff Init%InData_HD%WvLowCOffD = Init%OutData_SeaSt%WvLowCOffD Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD Init%InData_HD%WvLowCOffS = Init%OutData_SeaSt%WvLowCOffS diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 2c09248aa2..bd16289f6e 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -32,3 +32,5 @@ typedef ^ ^ SiKi typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" +typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index d16004d24a..b0faf1fa49 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -62,6 +62,8 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -271,6 +273,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveDir = SrcSeaSt_WaveFieldTypeData%WaveDir DstSeaSt_WaveFieldTypeData%WaveMultiDir = SrcSeaSt_WaveFieldTypeData%WaveMultiDir DstSeaSt_WaveFieldTypeData%MCFD = SrcSeaSt_WaveFieldTypeData%MCFD + DstSeaSt_WaveFieldTypeData%WvLowCOff = SrcSeaSt_WaveFieldTypeData%WvLowCOff + DstSeaSt_WaveFieldTypeData%WvHiCOff = SrcSeaSt_WaveFieldTypeData%WvHiCOff end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -422,6 +426,8 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%MCFD) + call RegPack(Buf, InData%WvLowCOff) + call RegPack(Buf, InData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -664,6 +670,10 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 26f3add0ed..65304add9f 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -227,6 +227,9 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir p%WaveField%MCFD = InputFileData%MCFD + p%WaveField%WvLowCOff = InputFileData%WvLowCOff + p%WaveField%WvHiCOff = InputFileData%WvHiCOff + ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below @@ -397,8 +400,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT InitOut%WaveMod = InputFileData%Waves%WaveMod - InitOut%WvLowCOff = InputFileData%Waves%WvLowCOff - InitOut%WvHiCOff = InputFileData%Waves%WvHiCOff InitOut%WvLowCOffD = InputFileData%Waves2%WvLowCOffD InitOut%WvHiCOffD = InputFileData%Waves2%WvHiCOffD InitOut%WvLowCOffS = InputFileData%Waves2%WvLowCOffS diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index ebf374a51b..852f243023 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -21,37 +21,39 @@ usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt # # -typedef SeaState/SeaSt SeaSt_InputFile LOGICAL EchoFlag - - - "Echo the input file" -typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m -typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m -typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m -typedef ^ ^ ReKi Z_Depth - - - "Depth of the domain the Z direction" m -typedef ^ ^ INTEGER NX - - - "Number of nodes in half of the X-direction domain" -typedef ^ ^ INTEGER NY - - - "Number of nodes in half of the Y-direction domain" -typedef ^ ^ INTEGER NZ - - - "Number of nodes in half of the Z-direction domain" -typedef ^ ^ Waves_InitInputType Waves - - - "Initialization data for Waves module" - -typedef ^ ^ Waves2_InitInputType Waves2 - - - "Initialization data for Waves2 module" - -typedef ^ ^ Current_InitInputType Current - - - "Initialization data for Current module" - -typedef ^ ^ LOGICAL Echo - - - "Echo the input files to a file with the same name as the input but with a .echo extension [T/F]" - -typedef ^ ^ INTEGER NWaveElev - - - "Number of user-requested points where the incident wave elevations can be output" - -typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) -typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics will be computed" - -typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) -typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files]" - -typedef ^ ^ LOGICAL OutAll - - - "Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F]" - -typedef ^ ^ INTEGER NumOuts - - - "The number of outputs for this module as requested in the input file" - -typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts" - -typedef ^ ^ LOGICAL SeaStSum - - - "Generate a SeaState summary file [T/F]" - -typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - -typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - -typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - -typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) -typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional" - -typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" +typedef SeaState/SeaSt SeaSt_InputFile LOGICAL EchoFlag - - - "Echo the input file" +typedef ^ ^ ReKi MSL2SWL - - - "Mean Sea Level to Still Water Level offset" m +typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m +typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m +typedef ^ ^ ReKi Z_Depth - - - "Depth of the domain the Z direction" m +typedef ^ ^ INTEGER NX - - - "Number of nodes in half of the X-direction domain" +typedef ^ ^ INTEGER NY - - - "Number of nodes in half of the Y-direction domain" +typedef ^ ^ INTEGER NZ - - - "Number of nodes in half of the Z-direction domain" +typedef ^ ^ Waves_InitInputType Waves - - - "Initialization data for Waves module" - +typedef ^ ^ Waves2_InitInputType Waves2 - - - "Initialization data for Waves2 module" - +typedef ^ ^ Current_InitInputType Current - - - "Initialization data for Current module" - +typedef ^ ^ LOGICAL Echo - - - "Echo the input files to a file with the same name as the input but with a .echo extension [T/F]" - +typedef ^ ^ INTEGER NWaveElev - - - "Number of user-requested points where the incident wave elevations can be output" - +typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) +typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) +typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics will be computed" - +typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) +typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files]" - +typedef ^ ^ LOGICAL OutAll - - - "Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F]" - +typedef ^ ^ INTEGER NumOuts - - - "The number of outputs for this module as requested in the input file" - +typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts" - +typedef ^ ^ LOGICAL SeaStSum - - - "Generate a SeaState summary file [T/F]" - +typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - +typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - +typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - +typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional" - +typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" +typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - @@ -84,8 +86,6 @@ typedef ^ ^ INTEGER NStepWave typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - -typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 24d39db49f..6077bb7c29 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -177,11 +177,11 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! WvLowCOff - Low Cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). - call ParseVar( FileInfo_In, CurLine, 'WvLowCOff', InputFileData%Waves%WvLowCOff, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WvLowCOff', InputFileData%WvLowCOff, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WvHiCOff - High Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). - call ParseVar( FileInfo_In, CurLine, 'WvHiCOff', InputFileData%Waves%WvHiCOff, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WvHiCOff', InputFileData%WvHiCOff, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WaveDir - Mean wave heading direction. @@ -774,24 +774,24 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WvLowCOff and WvHiCOff - Wave Cut-off frequency - if ( InputFileData%Waves%WvLowCOff < 0 ) then + if ( InputFileData%WvLowCOff < 0 ) then call SetErrStat( ErrID_Fatal,'WvLowCOff must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) return end if ! Threshold upper cut-off based on sampling rate if ( EqualRealNos(InputFileData%Waves%WaveDT, 0.0_DbKi) ) then - InputFileData%Waves%WvHiCOff = 10000.0; ! This is not going to be used because WaveDT is zero. + InputFileData%WvHiCOff = 10000.0; ! This is not going to be used because WaveDT is zero. else TmpFreq = REAL( Pi/InputFileData%Waves%WaveDT,SiKi) - if ( InputFileData%Waves%WvHiCOff > TmpFreq ) then - InputFileData%Waves%WvHiCOff = TmpFreq + if ( InputFileData%WvHiCOff > TmpFreq ) then + InputFileData%WvHiCOff = TmpFreq call SetErrStat( ErrID_Info,'WvLowCOff adjusted to '//trim(num2lstr(TmpFreq))//' rad/s, based on WaveDT.',ErrStat,ErrMsg,RoutineName) end if end if if (InputFileData%Waves%WaveMod > 2 .and. InputFileData%Waves%WaveMod /= 6) then - if ( InputFileData%Waves%WvLowCOff >= InputFileData%Waves%WvHiCOff ) then + if ( InputFileData%WvLowCOff >= InputFileData%WvHiCOff ) then call SetErrSTat( ErrID_Fatal,'WvLowCOff must be less than WvHiCOff.',ErrStat,ErrMsg,RoutineName) return end if diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 6f3b41bd48..5db56481b3 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -71,6 +71,8 @@ MODULE SeaState_Types REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional [-] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -104,8 +106,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] @@ -304,6 +304,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveDir = SrcInputFileData%WaveDir DstInputFileData%WaveMultiDir = SrcInputFileData%WaveMultiDir DstInputFileData%MCFD = SrcInputFileData%MCFD + DstInputFileData%WvLowCOff = SrcInputFileData%WvLowCOff + DstInputFileData%WvHiCOff = SrcInputFileData%WvHiCOff end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -401,6 +403,8 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%MCFD) + call RegPack(Buf, InData%WvLowCOff) + call RegPack(Buf, InData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -543,6 +547,10 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -730,8 +738,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod - DstInitOutputData%WvLowCOff = SrcInitOutputData%WvLowCOff - DstInitOutputData%WvHiCOff = SrcInitOutputData%WvHiCOff DstInitOutputData%WvLowCOffD = SrcInitOutputData%WvLowCOffD DstInitOutputData%WvHiCOffD = SrcInitOutputData%WvHiCOffD DstInitOutputData%WvLowCOffS = SrcInitOutputData%WvLowCOffS @@ -804,8 +810,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) - call RegPack(Buf, InData%WvLowCOff) - call RegPack(Buf, InData%WvHiCOff) call RegPack(Buf, InData%WvLowCOffD) call RegPack(Buf, InData%WvHiCOffD) call RegPack(Buf, InData%WvLowCOffS) @@ -879,10 +883,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOffD) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index b43ee1b5f0..688ecf95e1 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -2240,7 +2240,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS DO I = 0,InitOut%NStepWave2 ! Apply limits to the existing WaveElevC0 arrays if outside frequency range - IF ( OmegaArr(I) < InitInp%WvLowCOff .OR. OmegaArr(I) > InitInp%WvHiCOff ) THEN + IF ( OmegaArr(I) < WaveField%WvLowCOff .OR. OmegaArr(I) > WaveField%WvHiCOff ) THEN WaveField%WaveElevC0(:,I) = 0.0_SiKi ENDIF @@ -2307,7 +2307,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS DO I = 0,InitOut%NStepWave2 - IF ( OmegaArr(I) < InitInp%WvLowCOff .OR. OmegaArr(I) > InitInp%WvHiCOff ) THEN ! .TRUE. if OmegaArr(I) is above or below the cut-off frequency + IF ( OmegaArr(I) < WaveField%WvLowCOff .OR. OmegaArr(I) > WaveField%WvHiCOff ) THEN ! .TRUE. if OmegaArr(I) is above or below the cut-off frequency ! Zero-out the wave spectrum above the cut-off frequency. We must cut-off the frequency in order to ! void nonphysical wave forces. Waves that have wavelengths much smaller than the platform diameter ! (high frequency) do not contribute to the net force because regions of positive and negative @@ -2321,7 +2321,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS CASE ( 2 ) ! JONSWAP/Pierson-Moskowitz spectrum (irregular) wave. WaveS1SddArr(I) = JONSWAP ( OmegaArr(I), InitInp%WaveHs, InitInp%WaveTp, InitInp%WavePkShp ) CASE ( 3 ) ! White-noise - WaveS1SddArr(I) = InitInp%WaveHs * InitInp%WaveHs / ( 16.0 * (InitInp%WvHiCOff - InitInp%WvLowCOff) ) + WaveS1SddArr(I) = InitInp%WaveHs * InitInp%WaveHs / ( 16.0 * (WaveField%WvHiCOff - WaveField%WvLowCOff) ) CASE ( 4 ) ! User-defined spectrum (irregular) wave. CALL UserWaveSpctrm ( OmegaArr(I), WaveField%WaveDir, InitInp%DirRoot, WaveS1SddArr(I) ) ENDSELECT diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 4bb5a6098d..85f86e7b77 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -23,8 +23,6 @@ typedef ^ ^ CHARACTER(1024) DirRoot typedef ^ ^ CHARACTER(1024) WvKinFile - - - "The root name of user input wave kinematics files" - typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" (m/s^2) typedef ^ ^ integer nGrid 3 - - "Grid dimensions" -typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WaveDirSpread - - - "Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1]" - diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index f67bc7fab9..1fcbfe5a7e 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -40,8 +40,6 @@ MODULE Waves_Types CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] - REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WaveDirSpread = 0.0_R4Ki !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] @@ -106,8 +104,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%nGrid = SrcInitInputData%nGrid - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread @@ -239,8 +235,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WvKinFile) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%nGrid) - call RegPack(Buf, InData%WvLowCOff) - call RegPack(Buf, InData%WvHiCOff) call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WaveDirSpread) @@ -316,10 +310,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) From 8d9ad2b5aecf83dd06d2bdc601b7e9de8f56641a Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 2 Nov 2023 13:57:50 -0600 Subject: [PATCH 035/232] Adds standalone mode (Farmsize = -1) and fixes pinned rod inertial forces --- modules/moordyn/src/MoorDyn.f90 | 61 ++++++++++++++++-------- modules/moordyn/src/MoorDyn_Driver.f90 | 41 +++++++++++++--- modules/moordyn/src/MoorDyn_Registry.txt | 5 +- modules/moordyn/src/MoorDyn_Rod.f90 | 7 ++- modules/moordyn/src/MoorDyn_Types.f90 | 2 + 5 files changed, 83 insertions(+), 33 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 2bc70eedc2..c342cc189e 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -201,6 +201,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%PtfmInit = InitInp%PtfmInit(:,1) ! is this copying necssary in case this is an individual instance in FAST.Farm? + p%Standalone = InitInp%Standalone + ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) @@ -208,7 +210,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' >>> MoorDyn is running in array mode <<< ') ! could make sure the size of this is right: SIZE(InitInp%FarmCoupledKinematics) p%nTurbines = InitInp%FarmSize - else ! FarmSize==0 indicates normal, FAST module mode + else if (InitInp%FarmSize < 0) then ! Farmsize==-1 indicates standlone, run MoorDyn as a standalone code with no openfast coupling + p%Standalone = 1 + p%nTurbines = 1 + else ! FarmSize==0 indicates normal, FAST module mode p%nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case END IF @@ -1009,7 +1014,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else if ((let1 == "CONNECT") .or. (let1 == "CON") .or. (let1 == "FREE")) then m%RodList(l)%typeNum = 0 - p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + p%nFreeRods=p%nFreeRods+1 m%RodStateIs1(p%nFreeRods) = Nx+1 m%RodStateIsN(p%nFreeRods) = Nx+12 @@ -1769,14 +1774,18 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) ! defaults to identity orientation matrix !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< - ! calculate initial point relative position, adjusted due to initial platform translations - u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< ! set absolute initial positions in MoorDyn - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + IF (p%Standalone == 1) THEN + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + ELSE + ! calculate initial point relative position, adjusted due to initial platform translations + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + ENDIF m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6))))) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element @@ -1793,18 +1802,24 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er OrMatRef = TRANSPOSE( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation - ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math - u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) - u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) - u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Rod's relative orientation with the turbine's initial orientation u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< ! set absolute initial positions in MoorDyn - m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + IF (p%Standalone == 1) THEN + m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + ELSE + ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + ENDIF m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, OrMatRef)) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation + + m%RodList(m%CpldRodIs(l,iTurb))%r6 = [0,0,-5,0,0,-1] ! Hack for testing the pinned rods + ! >>> still need to set Rod initial orientations accounting for PtfmInit rotation <<< CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) @@ -1819,15 +1834,17 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set reference position as per input file <<< what about turbine positions in array? rRef(1:3) = m%PointList(m%CpldPointIs(l,iTurb))%r CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) - - ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math - u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) - u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) - u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - + ! set absolute initial positions in MoorDyn - m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - + IF (p%Standalone == 1) THEN + m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + ELSE + ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + ENDIF CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! lastly, do this to set the attached line endpoint positions: @@ -2973,8 +2990,10 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er END DO DO l = 1,p%nCpldRods(iTurb) - CALL Rod_DoRHS(m%RodList(m%CpldRodIs(l,iTurb)), m, p) - ! NOTE: this won't compute net loads on Rod. Need Rod_GetNetForceAndMass for that. Change? <<<< + IF (m%RodList(m%CpldRodIs(l,iTurb))%typeNum /= -1) THEN ! For a coupled pinned rod, Rod_GetStateDeriv already calls doRHS + CALL Rod_DoRHS(m%RodList(m%CpldRodIs(l,iTurb)), m, p) + ! NOTE: this won't compute net loads on Rod. Need Rod_GetNetForceAndMass for that. Change? <<<< + ENDIF END DO DO l = 1,p%nCpldBodies(iTurb) diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 83e2e5e65b..46ed87cd17 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -173,6 +173,11 @@ PROGRAM MoorDyn_Driver ! do OpenFAST vs FAST.Farm related setup MD_InitInp%FarmSize = drvrInitInp%FarmSize + IF (MD_InitInp%FarmSize < 0) THEN + MD_InitInp%Standalone = 1 + ELSE + MD_InitInp%Standalone = 0 + ENDIF if (drvrInitInp%FarmSize > 0) then ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) nTurbines = drvrInitInp%FarmSize @@ -493,7 +498,11 @@ PROGRAM MoorDyn_Driver J = 1 ! the starting index of the relevant DOFs in the input array ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + IF (MD_InitInp%Standalone == 1) THEN + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) + ELSE + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + ENDIF MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -507,7 +516,11 @@ PROGRAM MoorDyn_Driver ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< DO l = 1,MD_p%nCpldRods(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + IF (MD_InitInp%Standalone == 1) THEN + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) + ELSE + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + ENDIF MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -521,7 +534,11 @@ PROGRAM MoorDyn_Driver ! any coupled points (type -1) DO l = 1, MD_p%nCpldPoints(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + IF (MD_InitInp%Standalone == 1) THEN + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) + ELSE + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + ENDIF MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) @@ -582,7 +599,11 @@ PROGRAM MoorDyn_Driver J = 1 ! the starting index of the relevant DOFs in the input array ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + IF (MD_InitInp%Standalone == 1) THEN + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) + ELSE + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + ENDIF MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -596,7 +617,11 @@ PROGRAM MoorDyn_Driver ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< DO l = 1,MD_p%nCpldRods(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + IF (MD_InitInp%Standalone == 1) THEN + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) + ELSE + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + ENDIF MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -610,7 +635,11 @@ PROGRAM MoorDyn_Driver ! any coupled points (type -1) DO l = 1, MD_p%nCpldPoints(iTurb) - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + IF (MD_InitInp%Standalone == 1) THEN + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) + ELSE + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + ENDIF MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 7965106d56..48baad2dd0 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -24,7 +24,8 @@ typedef MoorDyn/MD InitInputType ReKi g - -99 typedef ^ ^ ReKi rhoW - -999.9 - "sea density" "[kg/m^3]" typedef ^ ^ ReKi WtrDepth - -999.9 - "depth of water" "[m]" typedef ^ ^ ReKi PtfmInit {:}{:} - - "initial position of platform(s) shape: 6, nTurbines" - -typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0" - +typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0, standalone mode if -1" - +typedef ^ ^ IntKi Standalone - 0 - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - typedef ^ ^ ReKi Tmax - - - "simulation duration" "[s]" typedef ^ ^ CHARACTER(1024) FileName - "" - "MoorDyn input file" @@ -148,7 +149,7 @@ typedef ^ ^ DbKi M {3}{3} typedef ^ MD_Rod IntKi IdNum - - - "integer identifier of this Line" typedef ^ ^ CHARACTER(10) type - - - "type of Rod. should match one of RodProp names" typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated rod properties" - -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=point" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=point, -1=coupledpinned" typedef ^ ^ IntKi AttachedA {10} - - "list of IdNums of lines attached to end A" typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index f7f25e4d93..feb5e6dc53 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -491,8 +491,7 @@ SUBROUTINE Rod_GetStateDeriv(Rod, Xd, m, p) ELSE ! pinned rod, 6 states (rotational only) ! account for moment in response to end A acceleration due to inertial coupling (off-diagonal sub-matrix terms) - !Fnet(4:6) = Fnet(4:6) - MATMUL(M_out(4:6,1:3), Rod%a6(1:3)) ! <<0 [-] + INTEGER(IntKi) :: Standalone = 0 !< Indicates MoorDyn run as standalone code if 1, coupled if 0, standalone mode if -1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] REAL(ReKi) :: Tmax !< simulation duration [[s]] CHARACTER(1024) :: FileName !< MoorDyn input file [-] @@ -459,6 +460,7 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] LOGICAL :: VisMeshes !< Using visualization meshes as requested by glue code [-] TYPE(VisDiam) , DIMENSION(:), ALLOCATABLE :: VisRodsDiam !< Diameters for visualization of rods [-] + INTEGER(IntKi) :: Standalone !< Indicates MoorDyn run as standalone code if 1, coupled if 0 [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= From 6d16c6e518c1441d38c7cb1bc5c611deaca3c396 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 2 Nov 2023 14:03:15 -0600 Subject: [PATCH 036/232] Additonaly standalone variable in registry --- modules/moordyn/src/MoorDyn_Registry.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 48baad2dd0..440a83b940 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -428,6 +428,7 @@ typedef ^ ^ Integer Jac_nx - typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} - - "Mapping array from index of dX array to corresponding state index" - typedef ^ ^ Logical VisMeshes - - - "Using visualization meshes as requested by glue code" - typedef ^ ^ VisDiam VisRodsDiam {:} - - "Diameters for visualization of rods" - +typedef ^ ^ IntKi Standalone - - - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - # ============================== Inputs ============================================================================================================================================ From ec9837923ac8023f1270dd0d33f7b03c9f0f9147 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 2 Nov 2023 14:46:11 -0600 Subject: [PATCH 037/232] HD/SeaSt: WvLowCOffD, WvHiCOffD, WvLowCOffS, WvHiCOffS cleanup Also removed some duplicate checks on these inputs in HD and Waves because it was already checked in SeaState_ProcessInit --- modules/hydrodyn/src/HydroDyn.txt | 4 -- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 4 -- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 4 -- modules/hydrodyn/src/HydroDyn_Input.f90 | 31 --------- modules/hydrodyn/src/HydroDyn_Types.f90 | 20 ------ modules/hydrodyn/src/WAMIT2.f90 | 69 +++++-------------- modules/hydrodyn/src/WAMIT2.txt | 5 -- modules/hydrodyn/src/WAMIT2_Types.f90 | 20 ------ modules/openfast-library/src/FAST_Subs.f90 | 4 -- modules/seastate/src/SeaSt_WaveField.txt | 60 ++++++++-------- .../seastate/src/SeaSt_WaveField_Types.f90 | 20 ++++++ modules/seastate/src/SeaState.f90 | 8 +-- modules/seastate/src/SeaState.txt | 8 +-- modules/seastate/src/SeaState_Input.f90 | 16 ++--- modules/seastate/src/SeaState_Types.f90 | 40 +++++------ modules/seastate/src/Waves2.f90 | 54 ++------------- modules/seastate/src/Waves2.txt | 5 -- modules/seastate/src/Waves2_Types.f90 | 20 ------ 18 files changed, 112 insertions(+), 280 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index e7bf6c8f63..156042a21f 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -81,10 +81,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - -typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index bbe4383899..4e8870f162 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -413,10 +413,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod HD%InitInp%WaveDirMod = SeaSt%InitOutData%WaveDirMod - HD%InitInp%WvLowCOffD = SeaSt%InitOutData%WvLowCOffD - HD%InitInp%WvHiCOffD = SeaSt%InitOutData%WvHiCOffD - HD%InitInp%WvLowCOffS = SeaSt%InitOutData%WvLowCOffS - HD%InitInp%WvHiCOffS = SeaSt%InitOutData%WvHiCOffS HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 03143662c6..d630d8bb01 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -327,10 +327,6 @@ subroutine SetHD_InitInputs() InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod InitInData_HD%WaveDirMod = InitOutData_SeaSt%WaveDirMod - InitInData_HD%WvLowCOffD = InitOutData_SeaSt%WvLowCOffD - InitInData_HD%WvHiCOffD = InitOutData_SeaSt%WvHiCOffD - InitInData_HD%WvLowCOffS = InitOutData_SeaSt%WvLowCOffS - InitInData_HD%WvHiCOffS = InitOutData_SeaSt%WvHiCOffS InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 88c3501aa3..9e74424680 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1204,14 +1204,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF END IF - - - ! Copy over the 2nd order limits to the WAMIT2 module which needs them. - InputFileData%WAMIT2%WvLowCOffD = InitInp%WvLowCOffD - InputFileData%WAMIT2%WvHiCOffD = InitInp%WvHiCOffD - InputFileData%WAMIT2%WvLowCOffS = InitInp%WvLowCOffS - InputFileData%WAMIT2%WvHiCOffS = InitInp%WvHiCOffS - ! PotFile - Root name of potential flow files @@ -1453,29 +1445,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF - ! Check that the min / max diff frequencies make sense if using any DiffQTF method - IF ( InputFileData%WAMIT2%DiffQTF /= 0 .OR. InputFileData%WAMIT2%MnDrift /= 0 .OR. InputFileData%WAMIT2%NewmanApp /=0 ) THEN - IF ( ( InputFileData%WAMIT2%WvHiCOffD < InputFileData%WAMIT2%WvLowCOffD ) .OR. ( InputFileData%WAMIT2%WvLowCOffD < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'WvHiCOffD must be larger than WvLowCOffD. Both must be positive.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ELSE ! set to zero since we don't need them - InputFileData%WAMIT2%WvLowCOffD = 0.0 - InputFileData%WAMIT2%WvHiCOffD = 0.0 - END IF - - - ! Check that the min / max diff frequencies make sense if using SumQTF - IF ( InputFileData%WAMIT2%SumQTF /= 0 ) THEN - IF ( ( InputFileData%WAMIT2%WvHiCOffS < InputFileData%WAMIT2%WvLowCOffS ) .OR. ( InputFileData%WAMIT2%WvLowCOffS < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal,'WvHiCOffS must be larger than WvLowCOffS. Both must be positive.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - ELSE ! set to zero since we don't need them - InputFileData%WAMIT2%WvLowCOffS = 0.0 - InputFileData%WAMIT2%WvHiCOffS = 0.0 - END IF - ! now that it has been established that the input parameters for second order are good, we check to make sure that the WAMIT files actually exist. ! Check MnDrift file diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 928574f6f7..dded194377 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -96,10 +96,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] @@ -893,10 +889,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveField => SrcInitInputData%WaveField @@ -935,10 +927,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) - call RegPack(Buf, InData%WvLowCOffD) - call RegPack(Buf, InData%WvHiCOffD) - call RegPack(Buf, InData%WvLowCOffS) - call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, associated(InData%WaveField)) @@ -986,14 +974,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index b544cb2c5f..848e1ab697 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -813,7 +813,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS !> 1. Check the data to see if low cutoff on the difference frequency is 0. If it is above zero, that implies no mean drift !! term since \f$ \omega_1=\omega_2 \f$ - IF ( InitInp%WvLowCOffD > 0.0_SiKi ) THEN + IF ( InitInp%WaveField%WvLowCOffD > 0.0_SiKi ) THEN CALL SetErrStat( ErrID_Warn, ' WvLowCOffD > 0.0, so no mean drift term is calculated (the mean drift uses only the equal '//& 'frequency terms of the QTF). Setting the mean drift force to 0.',ErrStat,ErrMsg,RoutineName) RETURN @@ -828,7 +828,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS IF ( MnDriftData%DataIs3D ) THEN ! Check the low frequency cutoff - IF ( MINVAL( MnDriftData%Data3D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN + IF ( MINVAL( MnDriftData%Data3D%WvFreq1 ) > InitInp%WaveField%WvLowCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data3D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(MnDriftData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) @@ -836,7 +836,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency ! cutoff is typically too high for this in most cases. - IF ( (MAXVAL(MnDriftData%Data3D%WvFreq1 ) < InitInp%WvHiCOffD) ) THEN + IF ( (MAXVAL(MnDriftData%Data3D%WvFreq1 ) < InitInp%WaveField%WvHiCOffD) ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(MnDriftData%Data3D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(MnDriftData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffD.',ErrStat,ErrMsg,RoutineName) @@ -845,12 +845,12 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ELSE IF ( MnDriftData%DataIs4D ) THEN ! only check if not 3D data. If there is 3D data, we default to using it for calculations ! Check the low frequency cutoff - IF ( MINVAL( MnDriftData%Data4D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN + IF ( MINVAL( MnDriftData%Data4D%WvFreq1 ) > InitInp%WaveField%WvLowCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data4D%WvFreq1)))// & ' rad/s first wave period) data in '//TRIM(MnDriftData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MINVAL( MnDriftData%Data4D%WvFreq2 ) > InitInp%WaveField%WvLowCOff ) THEN + IF ( MINVAL( MnDriftData%Data4D%WvFreq2 ) > InitInp%WaveField%WvLowCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(MnDriftData%Data4D%WvFreq2)))// & ' rad/s for second wave period) data in '//TRIM(MnDriftData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffD.',ErrStat,ErrMsg,RoutineName) @@ -858,12 +858,12 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency ! cutoff is typically too high for this in most cases. - IF ( (MAXVAL(MnDriftData%Data4D%WvFreq1) < InitInp%WvHiCOffD) ) THEN + IF ( (MAXVAL(MnDriftData%Data4D%WvFreq1) < InitInp%WaveField%WvHiCOffD) ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(MnDriftData%Data4D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(MnDriftData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffD.',ErrStat,ErrMsg,RoutineName) ENDIF - IF ( (MAXVAL(MnDriftData%Data4D%WvFreq2) < InitInp%WvHiCOffD) ) THEN + IF ( (MAXVAL(MnDriftData%Data4D%WvFreq2) < InitInp%WaveField%WvHiCOffD) ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(MnDriftData%Data4D%WvFreq1)))// & ' rad/s second wave period) data in '//TRIM(MnDriftData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffD.',ErrStat,ErrMsg,RoutineName) @@ -2028,13 +2028,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS IF ( DiffQTFData%DataIs4D ) THEN ! We must have a 4D data set ! Check the low frequency cutoff - IF ( MINVAL( DiffQTFData%Data4D%WvFreq1 ) > InitInp%WvLowCOffD ) THEN + IF ( MINVAL( DiffQTFData%Data4D%WvFreq1 ) > InitInp%WaveField%WvLowCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(DiffQTFData%Data4D%WvFreq1)))// & ' rad/s first wave period) data in '//TRIM(DiffQTFData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffD.', & ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MINVAL( DiffQTFData%Data4D%WvFreq2 ) > InitInp%WvLowCOffD ) THEN + IF ( MINVAL( DiffQTFData%Data4D%WvFreq2 ) > InitInp%WaveField%WvLowCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(DiffQTFData%Data4D%WvFreq2)))// & ' rad/s for second wave period) data in '//TRIM(DiffQTFData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffD.', & @@ -2043,13 +2043,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(DiffQTFData%Data4D%WvFreq1) < InitInp%WvHiCOffD ) THEN + IF ( MAXVAL(DiffQTFData%Data4D%WvFreq1) < InitInp%WaveField%WvHiCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(DiffQTFData%Data4D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(DiffQTFData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffD.', & ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MAXVAL(DiffQTFData%Data4D%WvFreq2) < InitInp%WvHiCOffD ) THEN + IF ( MAXVAL(DiffQTFData%Data4D%WvFreq2) < InitInp%WaveField%WvHiCOffD ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(DiffQTFData%Data4D%WvFreq1)))// & ' rad/s second wave period) data in '//TRIM(DiffQTFData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffD.', & @@ -2252,7 +2252,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Only perform calculations if the difference frequency is in the right range - IF ( (OmegaDiff >= InitInp%WvLowCOffD) .AND. (OmegaDiff <= InitInp%WvHiCOffD) ) THEN + IF ( (OmegaDiff >= InitInp%WaveField%WvLowCOffD) .AND. (OmegaDiff <= InitInp%WaveField%WvHiCOffD) ) THEN ! Set the \f$ H^- \f$ term to zero before we start TmpHMinusC = CMPLX(0.0_SiKi,0.0_SiKi,SiKi) @@ -2534,13 +2534,13 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat IF ( SumQTFData%DataIs4D ) THEN ! We must have a 4D data set ! Check the low frequency cutoff - IF ( MINVAL( SumQTFData%Data4D%WvFreq1 ) > InitInp%WvLowCOffS ) THEN + IF ( MINVAL( SumQTFData%Data4D%WvFreq1 ) > InitInp%WaveField%WvLowCOffS ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(SumQTFData%Data4D%WvFreq1)))// & ' rad/s first wave period) data in '//TRIM(SumQTFData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffS.', & ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MINVAL( SumQTFData%Data4D%WvFreq2 ) > InitInp%WvLowCOffS ) THEN + IF ( MINVAL( SumQTFData%Data4D%WvFreq2 ) > InitInp%WaveField%WvLowCOffS ) THEN CALL SetErrStat( ErrID_Fatal,' The lowest frequency ( '//TRIM(Num2LStr(MINVAL(SumQTFData%Data4D%WvFreq2)))// & ' rad/s for second wave period) data in '//TRIM(SumQTFData%Filename)// & ' is above the low frequency cutoff set by WvLowCOffS.', & @@ -2549,13 +2549,13 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Check the high frequency cutoff -- using the Difference high frequency cutoff. The first order high frequency ! cutoff is typically too high for this in most cases. - IF ( MAXVAL(SumQTFData%Data4D%WvFreq1) < InitInp%WvHiCOffS ) THEN + IF ( MAXVAL(SumQTFData%Data4D%WvFreq1) < InitInp%WaveField%WvHiCOffS ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(SumQTFData%Data4D%WvFreq1)))// & ' rad/s for first wave period) data in '//TRIM(SumQTFData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffS.', & ErrStat,ErrMsg,RoutineName) ENDIF - IF ( MAXVAL(SumQTFData%Data4D%WvFreq2) < InitInp%WvHiCOffS ) THEN + IF ( MAXVAL(SumQTFData%Data4D%WvFreq2) < InitInp%WaveField%WvHiCOffS ) THEN CALL SetErrStat( ErrID_Fatal,' The highest frequency ( '//TRIM(Num2LStr(MAXVAL(SumQTFData%Data4D%WvFreq1)))// & ' rad/s second wave period) data in '//TRIM(SumQTFData%Filename)// & ' is below the high frequency cutoff set by WvHiCOffS.', & @@ -2756,7 +2756,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat OmegaSum = 2.0_SiKi * Omega1 ! the sum frequency ! Only perform calculations if the difference frequency is in the right range - IF ( (OmegaSum >= InitInp%WvLowCOffS) .AND. (OmegaSum <= InitInp%WvHiCOffS) ) THEN + IF ( (OmegaSum >= InitInp%WaveField%WvLowCOffS) .AND. (OmegaSum <= InitInp%WaveField%WvHiCOffS) ) THEN ! Find the wave amplitude at frequency omega @@ -2857,7 +2857,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Only perform calculations if the difference frequency is in the right range - IF ( (OmegaSum >= InitInp%WvLowCOffS) .AND. (OmegaSum <= InitInp%WvHiCOffS) ) THEN + IF ( (OmegaSum >= InitInp%WaveField%WvLowCOffS) .AND. (OmegaSum <= InitInp%WaveField%WvHiCOffS) ) THEN !> Now do the inner sum. We are going to perform a sum up to the maximum frequency that we !! can support (Nyquist frequency) for the given WaveDOmega and NStepWave2 (WaveOmegaMax = @@ -3196,39 +3196,6 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, END IF IF ( ErrStat >= AbortErrLev ) RETURN - - !-------------------------------------------------------------------------------- - !> ### Check the Min and Max frequencies for the full QTF cases - !! - !! -- these checks are performed based on the DiffQTFF and SumQTFF flags - !-------------------------------------------------------------------------------- - - - !> 1. Check that the min / max diff frequencies make sense if using DiffQTF - - IF ( InitInp%DiffQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffD < InitInp%WvLowCOffD ) .OR. ( InitInp%WvLowCOffD < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to WAMIT2_Init: '//NewLine// & - ' WvHiCOffD must be larger than WvLowCOffD. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - END IF - - - !> 2. Check that the min / max diff frequencies make sense if using SumQTF - - IF ( InitInp%SumQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffS < InitInp%WvLowCOffS ) .OR. ( InitInp%WvLowCOffS < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to WAMIT2_Init: '//NewLine// & - ' WvHiCOffS must be larger than WvLowCOffS. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) - RETURN - END IF - END IF - - - !-------------------------------------------------------------------------------- !> ### Assemble the names of the WAMIT data files we are using and verify existence !-------------------------------------------------------------------------------- diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 3e20494b06..d115901343 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -47,11 +47,6 @@ typedef ^ ^ LOGICAL NewmanAppF typedef ^ ^ LOGICAL DiffQTFF - - - "Flag indicating the full difference QTF should be calculated" - typedef ^ ^ LOGICAL SumQTFF - - - "Flag indicating the full sum QTF should be calculated" - -typedef ^ ^ ReKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ ReKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ ReKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ ReKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) - diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index f9bd49a459..17ea9ea850 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -61,10 +61,6 @@ MODULE WAMIT2_Types LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] - REAL(ReKi) :: WvLowCOffD = 0.0_ReKi !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffD = 0.0_ReKi !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvLowCOffS = 0.0_ReKi !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffS = 0.0_ReKi !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE WAMIT2_InitInputType ! ======================= ! ========= WAMIT2_MiscVarType ======= @@ -176,10 +172,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS end subroutine subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -258,10 +250,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NewmanAppF) call RegPack(Buf, InData%DiffQTFF) call RegPack(Buf, InData%SumQTFF) - call RegPack(Buf, InData%WvLowCOffD) - call RegPack(Buf, InData%WvHiCOffD) - call RegPack(Buf, InData%WvLowCOffS) - call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -389,14 +377,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 4ea1764137..306a86e989 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -860,10 +860,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod - Init%InData_HD%WvLowCOffD = Init%OutData_SeaSt%WvLowCOffD - Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD - Init%InData_HD%WvLowCOffS = Init%OutData_SeaSt%WvLowCOffS - Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index bd16289f6e..f7d83fe3cf 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -5,32 +5,36 @@ usefrom SeaState_Interp.txt #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- -typedef SeaSt_WaveField SeaSt_WaveFieldType SiKi WaveTime {:} - - "Time array" (s) -typedef ^ ^ SiKi WaveDynP {:}{:}{:}{:} - - "Incident wave dynamic pressure" (N/m^2) -typedef ^ ^ SiKi WaveAcc {:}{:}{:}{:}{:} - - "Incident wave acceleration" (m/s^2) -typedef ^ ^ SiKi WaveAccMCF {:}{:}{:}{:}{:} - - "Scaled acceleration for MacCamy-Fuchs members" (m/s^2) -typedef ^ ^ SiKi WaveVel {:}{:}{:}{:}{:} - - "Incident wave velocity" (m/s) -typedef ^ ^ SiKi PWaveDynP0 {:}{:}{:} - - "Partial derivative of dynamic pressure in the vertical direction at the still water level" (Pa/m) -typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:}{:} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) -typedef ^ ^ SiKi PWaveAccMCF0 {:}{:}{:}{:} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) -typedef ^ ^ SiKi PWaveVel0 {:}{:}{:}{:} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/m) -typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) -typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) -typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) -typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" -typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) -typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) -typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (m) -typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) -typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) +typedef SeaSt_WaveField SeaSt_WaveFieldType SiKi WaveTime {:} - - "Time array" (s) +typedef ^ ^ SiKi WaveDynP {:}{:}{:}{:} - - "Incident wave dynamic pressure" (N/m^2) +typedef ^ ^ SiKi WaveAcc {:}{:}{:}{:}{:} - - "Incident wave acceleration" (m/s^2) +typedef ^ ^ SiKi WaveAccMCF {:}{:}{:}{:}{:} - - "Scaled acceleration for MacCamy-Fuchs members" (m/s^2) +typedef ^ ^ SiKi WaveVel {:}{:}{:}{:}{:} - - "Incident wave velocity" (m/s) +typedef ^ ^ SiKi PWaveDynP0 {:}{:}{:} - - "Partial derivative of dynamic pressure in the vertical direction at the still water level" (Pa/m) +typedef ^ ^ SiKi PWaveAcc0 {:}{:}{:}{:} - - "Partial derivative of incident wave acceleration in the vertical direction at the still water level" (m/s^2/m) +typedef ^ ^ SiKi PWaveAccMCF0 {:}{:}{:}{:} - - "Partial derivative of scaled wave acceleration in the vertical direction at the still water level for MacCamy-Fuchs members" (m/s^2/m) +typedef ^ ^ SiKi PWaveVel0 {:}{:}{:}{:} - - "Partial derivative of incident wave velocity in the vertical direction at the still water level" (m/s/m) +typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) +typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) +typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) +typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) +typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" +typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) +typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) +typedef ^ ^ SiKi WaveElevC {:}{:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part" (m) +typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) +typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) -typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) -typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - -typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) -typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) -typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - -typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" -typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - +typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) +typedef ^ ^ SiKi WaveDirMax - - - "Maximum wave direction." (degrees) +typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) +typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - +typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" +typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index b0faf1fa49..8b22969e8e 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -64,6 +64,10 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -275,6 +279,10 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%MCFD = SrcSeaSt_WaveFieldTypeData%MCFD DstSeaSt_WaveFieldTypeData%WvLowCOff = SrcSeaSt_WaveFieldTypeData%WvLowCOff DstSeaSt_WaveFieldTypeData%WvHiCOff = SrcSeaSt_WaveFieldTypeData%WvHiCOff + DstSeaSt_WaveFieldTypeData%WvLowCOffD = SrcSeaSt_WaveFieldTypeData%WvLowCOffD + DstSeaSt_WaveFieldTypeData%WvHiCOffD = SrcSeaSt_WaveFieldTypeData%WvHiCOffD + DstSeaSt_WaveFieldTypeData%WvLowCOffS = SrcSeaSt_WaveFieldTypeData%WvLowCOffS + DstSeaSt_WaveFieldTypeData%WvHiCOffS = SrcSeaSt_WaveFieldTypeData%WvHiCOffS end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -428,6 +436,10 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%MCFD) call RegPack(Buf, InData%WvLowCOff) call RegPack(Buf, InData%WvHiCOff) + call RegPack(Buf, InData%WvLowCOffD) + call RegPack(Buf, InData%WvHiCOffD) + call RegPack(Buf, InData%WvLowCOffS) + call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -674,6 +686,14 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 65304add9f..dd21224e54 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -229,6 +229,10 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%WvLowCOff = InputFileData%WvLowCOff p%WaveField%WvHiCOff = InputFileData%WvHiCOff + p%WaveField%WvLowCOffD = InputFileData%WvLowCOffD + p%WaveField%WvHiCOffD = InputFileData%WvHiCOffD + p%WaveField%WvLowCOffS = InputFileData%WvLowCOffS + p%WaveField%WvHiCOffS = InputFileData%WvHiCOffS ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) @@ -400,10 +404,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT InitOut%WaveMod = InputFileData%Waves%WaveMod - InitOut%WvLowCOffD = InputFileData%Waves2%WvLowCOffD - InitOut%WvHiCOffD = InputFileData%Waves2%WvHiCOffD - InitOut%WvLowCOffS = InputFileData%Waves2%WvLowCOffS - InitOut%WvHiCOffS = InputFileData%Waves2%WvHiCOffS InitOut%WaveDirMod = InputFileData%Waves%WaveDirMod ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 852f243023..a192514b03 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -54,6 +54,10 @@ typedef ^ ^ LOGICAL WaveMul typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) +typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - @@ -86,10 +90,6 @@ typedef ^ ^ INTEGER NStepWave typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - -typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs member" (meters) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 6077bb7c29..d955ef0672 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -273,19 +273,19 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! WvLowCOffD -- Minimum frequency used in the difference methods (rad/s) [Only used if DiffQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvLowCOffD', InputFileData%Waves2%WvLowCOffD, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WvLowCOffD', InputFileData%WvLowCOffD, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WvHiCOffD -- Maximum frequency used in the difference methods (rad/s) [Only used if DiffQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvHiCOffD', InputFileData%Waves2%WvHiCOffD, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WvHiCOffD', InputFileData%WvHiCOffD, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WvLowCOffS -- Minimum frequency used in the sum-QTF (rad/s) [Only used if SumQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvLowCOffS', InputFileData%Waves2%WvLowCOffS, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WvLowCOffS', InputFileData%WvLowCOffS, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WvHiCOffS -- Maximum frequency used in the sum-QTF (rad/s) [Only used if SumQTF /= 0] - call ParseVar( FileInfo_In, CurLine, 'WvHiCOffS', InputFileData%Waves2%WvHiCOffS, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WvHiCOffS', InputFileData%WvHiCOffS, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; !------------------------------------------------------------------------------------------------- @@ -918,13 +918,13 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Difference frequency cutoffs ! WvLowCOffD and WvHiCOffD - Wave Cut-off frequency - if ( InputFileData%Waves2%WvLowCOffD < 0 ) then + if ( InputFileData%WvLowCOffD < 0 ) then call SetErrStat( ErrID_Fatal,'WvLowCOffD must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) return end if ! Check that the order given makes sense. - if ( InputFileData%Waves2%WvLowCOffD >= InputFileData%Waves2%WvHiCOffD ) then + if ( InputFileData%WvLowCOffD >= InputFileData%WvHiCOffD ) then call SetErrStat( ErrID_Fatal,'WvLowCOffD must be less than WvHiCOffD.',ErrStat,ErrMsg,RoutineName) return end if @@ -933,13 +933,13 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Sum frequency cutoffs ! WvLowCOffS and WvHiCOffD - Wave Cut-off frequency - if ( InputFileData%Waves2%WvLowCOffS < 0 ) then + if ( InputFileData%WvLowCOffS < 0 ) then call SetErrStat( ErrID_Fatal,'WvLowCOffS must be greater than or equal to zero.',ErrStat,ErrMsg,RoutineName) return end if ! Check that the order given makes sense. - if ( InputFileData%Waves2%WvLowCOffS >= InputFileData%Waves2%WvHiCOffS ) then + if ( InputFileData%WvLowCOffS >= InputFileData%WvHiCOffS ) then call SetErrStat( ErrID_Fatal,'WvLowCOffS must be less than WvHiCOffS.',ErrStat,ErrMsg,RoutineName) return end if diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 5db56481b3..07ddf95775 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -73,6 +73,10 @@ MODULE SeaState_Types REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -106,10 +110,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs member [(meters)] @@ -306,6 +306,10 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%MCFD = SrcInputFileData%MCFD DstInputFileData%WvLowCOff = SrcInputFileData%WvLowCOff DstInputFileData%WvHiCOff = SrcInputFileData%WvHiCOff + DstInputFileData%WvLowCOffD = SrcInputFileData%WvLowCOffD + DstInputFileData%WvHiCOffD = SrcInputFileData%WvHiCOffD + DstInputFileData%WvLowCOffS = SrcInputFileData%WvLowCOffS + DstInputFileData%WvHiCOffS = SrcInputFileData%WvHiCOffS end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -405,6 +409,10 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%MCFD) call RegPack(Buf, InData%WvLowCOff) call RegPack(Buf, InData%WvHiCOff) + call RegPack(Buf, InData%WvLowCOffD) + call RegPack(Buf, InData%WvHiCOffD) + call RegPack(Buf, InData%WvLowCOffS) + call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -551,6 +559,14 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -738,10 +754,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod - DstInitOutputData%WvLowCOffD = SrcInitOutputData%WvLowCOffD - DstInitOutputData%WvHiCOffD = SrcInitOutputData%WvHiCOffD - DstInitOutputData%WvLowCOffS = SrcInitOutputData%WvLowCOffS - DstInitOutputData%WvHiCOffS = SrcInitOutputData%WvHiCOffS DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn call SeaSt_Interp_CopyParam(SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -810,10 +822,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) - call RegPack(Buf, InData%WvLowCOffD) - call RegPack(Buf, InData%WvHiCOffD) - call RegPack(Buf, InData%WvLowCOffS) - call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%InvalidWithSSExctn) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, InData%MCFD) @@ -883,14 +891,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index d0f450f46f..7fd14cda95 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -197,48 +197,6 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) ErrMsgTmp = "" - !----------------------------------------------------------------------------- - !> Before attempting to do any real calculations, we first check what was - !! passed in through _InitInp_ to make sure it makes sense. That routine will - !! then copy over the relevant information that should be kept in parameters - !! (_p_). - !! - !! _InitInp_ will also check the flags, existence of files, and set flags - !! accordingly. - !----------------------------------------------------------------------------- - - - !-------------------------------------------------------------------------------- - ! Check the Min and Max frequencies for the full QTF cases - ! -- these checks are performed based on the DiffQTFF and SumQTFF flags - !-------------------------------------------------------------------------------- - - ! 1. Check that the min / max diff frequencies make sense if using DiffQTF - - IF ( InitInp%WvDiffQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffD < InitInp%WvLowCOffD ) .OR. ( InitInp%WvLowCOffD < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to Waves2_Init: '//NewLine// & - ' WvHiCOffD must be larger than WvLowCOffD. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp() - RETURN - END IF - END IF - - - ! 2. Check that the min / max diff frequencies make sense if using SumQTF - - IF ( InitInp%WvSumQTFF .eqv. .TRUE. ) THEN - IF ( ( InitInp%WvHiCOffS < InitInp%WvLowCOffS ) .OR. ( InitInp%WvLowCOffS < 0.0 ) ) THEN - CALL SetErrStat( ErrID_Fatal, ' Programming Error in call to Waves2_Init: '//NewLine// & - ' WvHiCOffS must be larger than WvLowCOffS. Both must be positive.'// & - ' --> This should have been checked by the calling program.', ErrStat, ErrMsg, RoutineName) - CALL CleanUp - RETURN - END IF - END IF - - !-------------------------------------------------------------------------------- ! Check the size of arrays that were passed in containing the wave info @@ -582,7 +540,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> * \f$ \omega^- = \mu^- \Delta \omega \f$ Omega_minus = mu_minus * InitInp%WaveDOmega - IF ( Omega_minus >= InitInp%WvLowCOffD .AND. Omega_minus <= InitInp%WvHiCOffD ) THEN + IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. DO m=1,InitInp%NStepWave2-mu_minus @@ -965,7 +923,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) mu_plus = 2 * n Omega_plus = 2.0_SiKi * Omega_n - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) k_nm = k_nm_plus( n, n, k_n, k_n ) @@ -1060,7 +1018,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ Omega_plus = mu_plus * InitInp%WaveDOmega - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. @@ -1358,7 +1316,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta !> * \f$ \omega^- = \mu^- \Delta \omega \f$ Omega_minus = mu_minus * InitInp%WaveDOmega - IF ( Omega_minus >= InitInp%WvLowCOffD .AND. Omega_minus <= InitInp%WvHiCOffD ) THEN + IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. DO m=1,InitInp%NStepWave2-mu_minus @@ -1492,7 +1450,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat mu_plus = 2 * n Omega_plus = 2.0_SiKi * Omega_n - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) R_n = k_n * tanh( k_n * InitInp%WtrDpth ) D_plus = TransFuncD_plus(n,n,k_n,k_n,R_n,R_n) @@ -1551,7 +1509,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ Omega_plus = mu_plus * InitInp%WaveDOmega - IF ( Omega_plus >= InitInp%WvLowCOffS .AND. Omega_plus <= InitInp%WvHiCOffS ) THEN + IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 818c9dd4b6..b5937d2e1b 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -37,11 +37,6 @@ typedef ^ ^ SiKi WaveKinGrid typedef ^ ^ LOGICAL WvDiffQTFF - - - "Full difference QTF second order forces flag" (-) typedef ^ ^ LOGICAL WvSumQTFF - - - "Full sum QTF second order forces flag" (-) -typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) - # Define outputs from the initialization routine here: # diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 62928607de..3fec995105 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -49,10 +49,6 @@ MODULE Waves2_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] - REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE Waves2_InitInputType ! ======================= ! ========= Waves2_InitOutputType ======= @@ -131,10 +127,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS end subroutine subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -186,10 +178,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) end if call RegPack(Buf, InData%WvDiffQTFF) call RegPack(Buf, InData%WvSumQTFF) - call RegPack(Buf, InData%WvLowCOffD) - call RegPack(Buf, InData%WvHiCOffD) - call RegPack(Buf, InData%WvLowCOffS) - call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -265,14 +253,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvSumQTFF) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) From 5ccfb2f06762627271ae547ffcd8ccd1fec18560 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 2 Nov 2023 17:14:25 -0600 Subject: [PATCH 038/232] Smoother handling of standalone --- modules/moordyn/src/MoorDyn.f90 | 48 ++++++++++---------------- modules/moordyn/src/MoorDyn_Driver.f90 | 13 ++++--- 2 files changed, 25 insertions(+), 36 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 2f9f5821bd..a3f12e8399 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1768,24 +1768,21 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er J = J + 1 rRef = m%BodyList(m%CpldBodyIs(l,iTurb))%r6 ! for now set reference position as per input file <<< - !OrMatRef = CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) ! defaults to identity orientation matrix - !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< - - - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< ! set absolute initial positions in MoorDyn - IF (p%Standalone == 1) THEN - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) - ELSE + IF (p%Standalone /= 1) THEN + !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< + OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< + ! calculate initial point relative position, adjusted due to initial platform translations u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6))))) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation ENDIF - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6))))) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element @@ -1798,29 +1795,24 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er J = J + 1 rRef = m%RodList(m%CpldRodIs(l,iTurb))%r6 ! for now set reference position as per input file <<< - OrMatRef = TRANSPOSE( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< - CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation - - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Rod's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< - + ! set absolute initial positions in MoorDyn - IF (p%Standalone == 1) THEN - m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) - ELSE + IF (p%Standalone /= 1) THEN + OrMatRef = TRANSPOSE( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation + OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Rod's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< + ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, OrMatRef)) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation ENDIF - m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, OrMatRef)) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation - - m%RodList(m%CpldRodIs(l,iTurb))%r6 = [0,0,-5,0,0,-1] ! Hack for testing the pinned rods - ! >>> still need to set Rod initial orientations accounting for PtfmInit rotation <<< - + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! lastly, do this to set the attached line endpoint positions: @@ -1832,12 +1824,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set reference position as per input file <<< what about turbine positions in array? rRef(1:3) = m%PointList(m%CpldPointIs(l,iTurb))%r - CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) - + ! set absolute initial positions in MoorDyn - IF (p%Standalone == 1) THEN - m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) - ELSE + IF (p%Standalone /= 1) THEN + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index ca250b3585..5902736cd5 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -172,15 +172,14 @@ PROGRAM MoorDyn_Driver ! do OpenFAST vs FAST.Farm related setup MD_InitInp%FarmSize = drvrInitInp%FarmSize - IF (MD_InitInp%FarmSize < 0) THEN - MD_InitInp%Standalone = 1 - ELSE - MD_InitInp%Standalone = 0 - ENDIF + MD_InitInp%Standalone = 0 if (drvrInitInp%FarmSize > 0) then ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) nTurbines = drvrInitInp%FarmSize - else ! FarmSize==0 indicates normal, FAST module mode + else if (drvrInitInp%FarmSize < 0) then ! FarmSize<0 indicates standalone mode + MD_InitInp%Standalone = 1 + nTurbines = 1 ! to keep routines happy + else ! FarmSize==0 indicates normal, FAST module mode nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case end if @@ -589,7 +588,7 @@ PROGRAM MoorDyn_Driver MD_uTimes(2) = MD_uTimes(1) - dtC !MD_uTimes(3) = MD_uTimes(2) - dtC - ! update coupled object kinematics iff we're reading input time series + ! update coupled object kinematics if we're reading input time series if (drvrInitInp%InputsMod == 1 ) then DO iTurb = 1, MD_p%nTurbines From a8e2e9c40f38432dbca20e78db05f69fa74eb36d Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 3 Nov 2023 10:03:07 -0600 Subject: [PATCH 039/232] HD/SeaSt: `WaveDOmega` now in WaveField type --- modules/hydrodyn/src/HydroDyn.f90 | 8 ++--- modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 2 -- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 2 -- modules/hydrodyn/src/HydroDyn_Types.f90 | 5 --- modules/hydrodyn/src/WAMIT.f90 | 6 ++-- modules/hydrodyn/src/WAMIT.txt | 1 - modules/hydrodyn/src/WAMIT2.f90 | 24 ++++++------- modules/hydrodyn/src/WAMIT2.txt | 1 - modules/hydrodyn/src/WAMIT2_Types.f90 | 5 --- modules/hydrodyn/src/WAMIT_Types.f90 | 5 --- modules/openfast-library/src/FAST_Subs.f90 | 2 -- modules/seastate/src/SeaSt_WaveField.txt | 1 + .../seastate/src/SeaSt_WaveField_Types.f90 | 5 +++ modules/seastate/src/SeaState.f90 | 3 +- modules/seastate/src/SeaState.txt | 11 +++--- modules/seastate/src/SeaState_Output.f90 | 4 +-- modules/seastate/src/SeaState_Types.f90 | 15 +++----- modules/seastate/src/UserWaves.f90 | 22 ++++++------ modules/seastate/src/Waves.f90 | 20 +++++------ modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves2.f90 | 36 +++++++++---------- modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 5 --- modules/seastate/src/Waves_Types.f90 | 5 --- 25 files changed, 76 insertions(+), 115 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index b5917e4aec..07f20268f9 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -362,7 +362,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%NStepWave = InitInp%NStepWave InputFileData%WAMIT%NStepWave2 = InitInp%NStepWave2 - InputFileData%WAMIT%WaveDOmega = InitInp%WaveDOmega ! InputFileData%WAMIT%seast_interp_p = InitInp%WaveField%seast_interp_p CALL SeaSt_Interp_CopyParam(InitInp%WaveField%seast_interp_p, InputFileData%WAMIT%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -432,7 +431,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Copy Waves initialization output into the initialization input type for the WAMIT module InputFileData%WAMIT2%NStepWave = InitInp%NStepWave InputFileData%WAMIT2%NStepWave2 = InitInp%NStepWave2 - InputFileData%WAMIT2%WaveDOmega = InitInp%WaveDOmega InputFileData%WAMIT2%Gravity = InitInp%Gravity InputFileData%WAMIT2%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file @@ -546,14 +544,14 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I END IF ! Populate wave arrays (Need to double chech this part. It doesn't look right!) - Np = 2*(InitInp%WaveDOmega + 1) + Np = 2*(InitInp%WaveField%WaveDOmega + 1) DO I = 1 , InitInp%NStepWave2 dftreal = InitInp%WaveField%WaveElevC0( 1, ABS(I ) ) dftimag = InitInp%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) FITInitData%Wave_amp (I) = sqrt( dftreal**2 + dftimag**2 ) * 2.0 / Np - FITInitData%Wave_omega (I) = I*InitInp%WaveDOmega - FITInitData%Wave_number(I) = I*InitInp%WaveDOmega**2. / InputFileData%Gravity + FITInitData%Wave_omega (I) = I*InitInp%WaveField%WaveDOmega + FITInitData%Wave_number(I) = I*InitInp%WaveField%WaveDOmega**2. / InputFileData%Gravity FITInitData%Wave_phase (I) = atan2( dftimag, dftreal ) END DO diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 156042a21f..c2874bded4 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -82,7 +82,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # # diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 4e8870f162..fdd8d072d3 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -414,8 +414,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod HD%InitInp%WaveDirMod = SeaSt%InitOutData%WaveDirMod HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn - - HD%InitInp%WaveDOmega = SeaSt%InitOutData%WaveDOmega HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! can be set regardless of association(); if not associated, HD shouldn't work diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index d630d8bb01..1cd5ed04f7 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -329,8 +329,6 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveDirMod = InitOutData_SeaSt%WaveDirMod InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn - - InitInData_HD%WaveDOmega = InitOutData_SeaSt%WaveDOmega InitInData_HD%WaveField => InitOutData_SeaSt%WaveField diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index dded194377..c03441339b 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -97,7 +97,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] - REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType ! ======================= @@ -890,7 +889,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -928,7 +926,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%InvalidWithSSExctn) - call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -976,8 +973,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 21a5550243..f3efd9ca5a 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -1065,7 +1065,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the frequency of this component: - Omega = I*InitInp%WaveDOmega + Omega = I*InitInp%WaveField%WaveDOmega ! Compute the discrete Fourier transform of the instantaneous value of the @@ -1120,7 +1120,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the frequency of this component: - Omega = I*InitInp%WaveDOmega + Omega = I*InitInp%WaveField%WaveDOmega ! Compute the discrete Fourier transform of the instantaneous value of the ! total excitation force on the support platfrom from incident waves: @@ -1206,7 +1206,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the frequency of this component: - Omega = I*InitInp%WaveDOmega + Omega = I*InitInp%WaveField%WaveDOmega ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 3b45bf61ce..9823937a68 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -41,7 +41,6 @@ typedef ^ ^ CHARACTER(1 typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - -typedef ^ ^ ReKi WaveDOmega - - - "" - typedef ^ ^ INTEGER WaveMod - - - "" - typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 848e1ab697..a998ad0002 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -1146,7 +1146,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 ! Calculate the frequency - Omega1 = J * InitInp%WaveDOmega + Omega1 = J * InitInp%WaveField%WaveDOmega ! Only get a QTF value if within the range of frequencies we have wave amplitudes for (first order cutoffs). This @@ -1716,7 +1716,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 ! Calculate the frequency - Omega1 = J * InitInp%WaveDOmega + Omega1 = J * InitInp%WaveField%WaveDOmega ! Only get a QTF value if within the range of frequencies between the cutoffs for the difference frequency @@ -1816,7 +1816,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg DO J=1,InitInp%NStepWave2 ! Frequency - Omega1 = J * InitInp%WaveDOmega + Omega1 = J * InitInp%WaveField%WaveDOmega !> Phase shift due to offset in location, only for NBodyMod==2 if (p%NBodyMod == 2) then @@ -2248,7 +2248,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS DO J=1,InitInp%NStepWave2-1 ! Calculate the frequency -- This is the difference frequency. - OmegaDiff = J * InitInp%WaveDOmega + OmegaDiff = J * InitInp%WaveField%WaveDOmega ! Only perform calculations if the difference frequency is in the right range @@ -2262,8 +2262,8 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS DO K=1,InitInp%NStepWave2-J ! note the funny upper limit. This is because we are doing a summation on a triangular area. ! set the two frequencies that the difference frequency comes from - Omega1 = (J + K) * InitInp%WaveDOmega ! the mth frequency -- \mu^- + n = m - Omega2 = K * InitInp%WaveDOmega ! the nth frequency + Omega1 = (J + K) * InitInp%WaveField%WaveDOmega ! the mth frequency -- \mu^- + n = m + Omega2 = K * InitInp%WaveField%WaveDOmega ! the nth frequency ! Find the Wave amplitudes 1 and 2 aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J+K), InitInp%WaveField%WaveElevC0(2,J+K), SiKi) / InitInp%NStepWave2 @@ -2752,7 +2752,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat DO J=1,FLOOR(REAL(InitInp%NStepWave2-1)/2.0_SiKi) ! The frequency - Omega1 = REAL(J,ReKi) * InitInp%WaveDOmega + Omega1 = REAL(J,ReKi) * InitInp%WaveField%WaveDOmega OmegaSum = 2.0_SiKi * Omega1 ! the sum frequency ! Only perform calculations if the difference frequency is in the right range @@ -2832,11 +2832,11 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! so, we don't need a really small WaveDT !This section has been removed since it is kind of annoying. - ! IF ( InitInp%WvHiCOffS > InitInp%NStepWave2*InitInp%WaveDOmega ) THEN + ! IF ( InitInp%WvHiCOffS > InitInp%NStepWave2*InitInp%WaveField%WaveDOmega ) THEN ! CALL SetErrStat( ErrID_Warn,' The high frequency cutoff for second order wave forces, WvHiCOffS, '// & ! 'is larger than the Nyquist frequency for the given time step of WaveDT. The Nyquist frequency '// & ! '(highest frequency) that can be computed is OmegaMax = PI/WaveDT = '// & - ! TRIM(Num2LStr(InitInp%NStepWave2*InitInp%WaveDOmega))// & + ! TRIM(Num2LStr(InitInp%NStepWave2*InitInp%WaveField%WaveDOmega))// & ! ' radians/second. If you need those frequencies, decrease WaveDT. For reference, 2*PI '// & ! 'radians/second corresponds to a wavelength of ~1 meter.',& ! ErrStat,ErrMsg,RoutineName) @@ -2848,7 +2848,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat DO J=1,InitInp%NStepWave2 ! Calculate the frequency -- This is the sum frequency. - OmegaSum = J * InitInp%WaveDOmega + OmegaSum = J * InitInp%WaveField%WaveDOmega @@ -2869,8 +2869,8 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat DO K=0,FLOOR(Real(J-1)/2.0_SiKi) ! Calculate the frequency pair - Omega1 = K * InitInp%WaveDOmega - Omega2 = (J-K) * InitInp%WaveDOmega + Omega1 = K * InitInp%WaveField%WaveDOmega + Omega2 = (J-K) * InitInp%WaveField%WaveDOmega ! Find the wave amplitude at frequency omega. Remove the NStepWave2 normalization built into WaveElevC0 from Waves module aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1, K), InitInp%WaveField%WaveElevC0(2, K), SiKi ) / InitInp%NStepWave2 diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index d115901343..4c419435be 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -30,7 +30,6 @@ typedef ^ ^ R8Ki PtfmRefztRo typedef ^ ^ ReKi WAMITULEN - - - "WAMIT unit length scale" - typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ ReKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" (m) diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 17ea9ea850..c5baeb509f 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -48,7 +48,6 @@ MODULE WAMIT2_Types REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< WAMIT unit length scale [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] - REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< Frequency step for incident wave calculations [(rad/s)] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(m)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] @@ -159,7 +158,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%WaveMod = SrcInitInputData%WaveMod @@ -231,7 +229,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WAMITULEN) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveMod) @@ -333,8 +330,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDpth) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 0d6c94a275..101b780cfc 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -60,7 +60,6 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] - REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] @@ -261,7 +260,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err if (ErrStat >= AbortErrLev) return DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveMod = SrcInitInputData%WaveMod call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -362,7 +360,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%WaveMod) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) @@ -512,8 +509,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 306a86e989..99a84d89d9 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -861,8 +861,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - - Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField ! end if diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index f7d83fe3cf..855ca41c8a 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -38,3 +38,4 @@ typedef ^ ^ SiKi WvLowCOffD typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 8b22969e8e..df8793c23c 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -68,6 +68,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -283,6 +284,7 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WvHiCOffD = SrcSeaSt_WaveFieldTypeData%WvHiCOffD DstSeaSt_WaveFieldTypeData%WvLowCOffS = SrcSeaSt_WaveFieldTypeData%WvLowCOffS DstSeaSt_WaveFieldTypeData%WvHiCOffS = SrcSeaSt_WaveFieldTypeData%WvHiCOffS + DstSeaSt_WaveFieldTypeData%WaveDOmega = SrcSeaSt_WaveFieldTypeData%WaveDOmega end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -440,6 +442,7 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%WvHiCOffD) call RegPack(Buf, InData%WvLowCOffS) call RegPack(Buf, InData%WvHiCOffS) + call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -694,6 +697,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index dd21224e54..7dbd5f7af9 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -233,6 +233,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%WvHiCOffD = InputFileData%WvHiCOffD p%WaveField%WvLowCOffS = InputFileData%WvLowCOffS p%WaveField%WvHiCOffS = InputFileData%WvHiCOffS + p%WaveField%WaveDOmega = InputFileData%WaveDOmega ! For WAMIT and WAMIT2, FIT ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) @@ -292,7 +293,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Set a few things from the Waves module output InputFileData%Waves2%NStepWave = Waves_InitOut%NStepWave InputFileData%Waves2%NStepWave2 = Waves_InitOut%NStepWave2 - InputFileData%Waves2%WaveDOmega = Waves_InitOut%WaveDOmega CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -398,7 +398,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Copy Waves InitOut data to SeaState InitOut ! non-pointer data: - InitOut%WaveDOmega = Waves_InitOut%WaveDOmega ! For WAMIT and WAMIT2, FIT InitOut%NStepWave = Waves_InitOut%NStepWave ! For WAMIT, WAMIT2, SS_Excitation, Morison InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index a192514b03..846f080b63 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -54,10 +54,11 @@ typedef ^ ^ LOGICAL WaveMul typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" typedef ^ ^ SiKi WvLowCOff - - - "Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) typedef ^ ^ SiKi WvHiCOff - - - "High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4]" (rad/s) -typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) -typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) -typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffD - - - "Minimum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffD - - - "Maximum frequency used in the difference methods [Ignored if all difference methods = 0]" (rad/s) +typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) +typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - @@ -85,14 +86,12 @@ typedef ^ InitOutputType CHARACTER(ChanLen) Wri typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - -typedef ^ ^ SiKi MCFD - - - "Diameter of MacCamy-Fuchs member" (meters) 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 ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index fd88ba99dd..4c4ab386f0 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -1097,8 +1097,8 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS ! Write the data DO I = -1*Waves_InitOut%NStepWave2+1,Waves_InitOut%NStepWave2 - WaveNmbr = WaveNumber ( I*Waves_InitOut%WaveDOmega, InitInp%Gravity, InputFileData%Waves%WtrDpth ) - WRITE( UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*Waves_InitOut%WaveDOmega, & + WaveNmbr = WaveNumber ( I*p%WaveField%WaveDOmega, InitInp%Gravity, InputFileData%Waves%WtrDpth ) + WRITE( UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*p%WaveField%WaveDOmega, & p%WaveField%WaveDirArr(ABS(I)), p%WaveField%WaveElevC0( 1,ABS(I ) ) , p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) END DO END IF diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 07ddf95775..94dc11010c 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -77,6 +77,7 @@ MODULE SeaState_Types REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -105,14 +106,12 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] - REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] - REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs member [(meters)] 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(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType @@ -310,6 +309,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WvHiCOffD = SrcInputFileData%WvHiCOffD DstInputFileData%WvLowCOffS = SrcInputFileData%WvLowCOffS DstInputFileData%WvHiCOffS = SrcInputFileData%WvHiCOffS + DstInputFileData%WaveDOmega = SrcInputFileData%WaveDOmega end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -413,6 +413,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%WvHiCOffD) call RegPack(Buf, InData%WvLowCOffS) call RegPack(Buf, InData%WvHiCOffS) + call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -567,6 +568,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -749,7 +752,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod @@ -758,7 +760,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SeaSt_Interp_CopyParam(SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitOutputData%MCFD = SrcInitOutputData%MCFD if (allocated(SrcInitOutputData%WaveElevSeries)) then LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries) @@ -817,14 +818,12 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%InvalidWithSSExctn) call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) - call RegPack(Buf, InData%MCFD) call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) @@ -881,8 +880,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) @@ -894,8 +891,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p - call RegUnpack(Buf, OutData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index c6dc85544f..88388cdc38 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -333,7 +333,7 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs InitOut%NStepWave = 2*PSF ( InitOut%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. InitOut%NStepWave2 = InitOut%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. InitOut%WaveTMax = InitOut%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. + WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. ! >>> Allocate and initialize (set to 0) InitOut arrays call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -467,7 +467,7 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) InitOut%NStepWave2 = InitOut%NStepWave/2 InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this - InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax ! bjj added this + WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! bjj added this ! >>> Allocate and initialize (set to 0) InitOut arrays call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -650,11 +650,11 @@ END SUBROUTINE UserWaves_Init !----------------------------------------------------------------------------------------------------------------------- !> This subroutine reads in the wave components from a file and reconstructs the frequency information. -SUBROUTINE WaveComp_ReadFile ( InitInp, InitOut, WaveCompData, ErrStat, ErrMsg ) +SUBROUTINE WaveComp_ReadFile ( InitInp, WaveDOmega, WaveCompData, ErrStat, ErrMsg ) IMPLICIT NONE TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut !< Output data for initialization routine + REAL(SiKi), INTENT(INOUT) :: WaveDOmega !< wave field data TYPE(WaveCompInputDataFile), INTENT( OUT) :: WaveCompData !< Wave component file data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error Status at return CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -762,7 +762,7 @@ SUBROUTINE WaveComp_ReadFile ( InitInp, InitOut, WaveCompData, ErrStat, ErrMsg ) END IF ! Compute the frequency step for incident wave calculations. - InitOut%WaveDOmega = TwoPi/InitInp%WaveTMax + WaveDOmega = TwoPi/InitInp%WaveTMax !-------------------------------------------------- ! Read in the data @@ -820,7 +820,7 @@ SUBROUTINE WaveComp_ReadFile ( InitInp, InitOut, WaveCompData, ErrStat, ErrMsg ) END IF ! Check if the frequency is valid - OmegaRatio = WaveAngFreq/InitOut%WaveDOmega + OmegaRatio = WaveAngFreq/WaveDOmega IF (ABS(OmegaRatio - REAL(NINT(OmegaRatio),SiKi))>WaveDOmega_RelTol) THEN CALL SetErrStat( ErrID_Fatal, 'The wave frequency on line number '//TRIM(Num2LStr(I))//' is not an integer multiple of the frequency resolution given by 1/WaveTMax.', ErrStat, ErrMsg, RoutineName ) CALL CleanUpError() @@ -899,8 +899,8 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs ! Statement to user CALL WrScr1 ( ' Reading in wave component data from wave kinematics files with root name "'//TRIM(InitInp%WvKinFile)//'".' ) - ! Read in the wave component data - CALL WaveComp_ReadFile (InitInp, InitOut, WaveCompData, ErrStatTmp, ErrMsgTmp ) + ! Read in the wave component data ! NOTE THAT THIS OVERWRITES InitInp%WaveTMax + CALL WaveComp_ReadFile (InitInp, WaveField%WaveDOmega, WaveCompData, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -911,8 +911,8 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs MaxWaveAngFreq = MAXVAL(WaveCompData%WaveAngFreq) ! NStepWave2 should be large enough to accommodate the highest user frequency component and ! produce a time step no larger than the user WaveDT. - InitOut%NStepWave2 = MAX( NINT(MaxWaveAngFreq / InitOut%WaveDOmega) + 1_IntKi, & - CEILING(TwoPi/(InitInp%WaveDt*InitOut%WaveDOmega)) ) + InitOut%NStepWave2 = MAX( NINT(MaxWaveAngFreq / WaveField%WaveDOmega) + 1_IntKi, & + CEILING(TwoPi/(InitInp%WaveDt*WaveField%WaveDOmega)) ) InitOut%NStepWave2 = PSF ( InitOut%NStepWave2, 9 ) ! Make sure NStepWave2 is a product of small factors (PSF) greater or equal to what's required by the user input InitOut%NStepWave = InitOut%NStepWave2 * 2_IntKi ! NStepWave is guaranteed to be even InitOut%WaveTMax = InitInp%WaveTMax ! Copy over WaveTMax. @@ -944,7 +944,7 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs ! Copy the wave frequency component information to the InitOut%WaveElevC0 array DO I=1,WaveCompData%NCompWave - J = NINT(WaveCompData%WaveAngFreq(I)/InitOut%WaveDOmega) + J = NINT(WaveCompData%WaveAngFreq(I)/WaveField%WaveDOmega) IF ( .NOT. IsSpecified(J) ) THEN IsSpecified(J) = .TRUE. WaveField%WaveElevC0(1,J) = WaveCompData%WaveAmp(I) * COS(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 688ecf95e1..2fe6ce7b99 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -574,7 +574,7 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) InitOut%NStepWave = 2 ! We must have at least two elements in order to interpolate later on InitOut%NStepWave2 = 1 InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this... I don't think it was set anywhere for this wavemod. - InitOut%WaveDOmega = 0.0 + WaveField%WaveDOmega = 0.0 ! >>> Allocate and initialize (set to 0) InitOut arrays call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -784,7 +784,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) InitOut%NStepWave2 = InitOut%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. InitOut%WaveTMax = InitOut%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - InitOut%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. + WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. ! >>> Allocate and initialize (set to 0) InitOut arrays call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -974,7 +974,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Compute the positive-frequency components (including zero) of the discrete ! Fourier transforms of the wave kinematics: DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms - OmegaArr(I) = I*InitOut%WaveDOmega + OmegaArr(I) = I*WaveField%WaveDOmega END DO call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) @@ -2252,7 +2252,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS END IF - I_WaveTp = NINT ( TwoPi/(InitOut%WaveDOmega*InitInp%WaveTp) ) ! Compute the index of the frequency component nearest to WaveTp. Note, we don't check if it's a valid index into the arrays + I_WaveTp = NINT ( TwoPi/(WaveField%WaveDOmega*InitInp%WaveTp) ) ! Compute the index of the frequency component nearest to WaveTp. Note, we don't check if it's a valid index into the arrays ! Compute the discrete Fourier transform of the realization of a White ! Gaussian Noise (WGN) time series process with unit variance: @@ -2300,7 +2300,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS WGNC(I_WaveTp) = WGNC(I_WaveTp) * ( SQRT(2.0_SiKi) / ABS(WGNC(I_WaveTp)) ) ! Plane progressive (regular) wave; the wave spectrum is an impulse function centered on frequency component closest to WaveTp. - WaveS1SddArr(I_WaveTp) = 0.5_SiKi * (InitInp%WaveHs/2.0_SiKi)**2 / InitOut%WaveDOmega + WaveS1SddArr(I_WaveTp) = 0.5_SiKi * (InitInp%WaveHs/2.0_SiKi)**2 / WaveField%WaveDOmega END IF ELSE @@ -2407,16 +2407,16 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ! Modify the wave components to implement the constrained wave ! Compute the relevant sums - m0 = InitOut%WaveDOmega * SUM(WaveS1SddArr) - m2 = InitOut%WaveDOmega * SUM(WaveS1SddArr*OmegaArr*OmegaArr) + m0 = WaveField%WaveDOmega * SUM(WaveS1SddArr) + m2 = WaveField%WaveDOmega * SUM(WaveS1SddArr*OmegaArr*OmegaArr) WaveElevC0ReSum = SUM(WaveField%WaveElevC0(1,:))/m0 WaveElevC0ImOmegaSum = SUM(WaveField%WaveElevC0(2,:) * OmegaArr)/m2 ! Apply the part of the modification that is independent from the crest elevation - WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) - WaveElevC0ReSum * WaveS1SddArr * InitOut%WaveDOmega - WaveField%WaveElevC0(2,:) = WaveField%WaveElevC0(2,:) - WaveElevC0ImOmegaSum * OmegaArr * WaveS1SddArr * InitOut%WaveDOmega + WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) - WaveElevC0ReSum * WaveS1SddArr * WaveField%WaveDOmega + WaveField%WaveElevC0(2,:) = WaveField%WaveElevC0(2,:) - WaveElevC0ImOmegaSum * OmegaArr * WaveS1SddArr * WaveField%WaveDOmega Crest = 0.5_SiKi * InitInp%CrestHmax ! Set crest elevation to half of crest height - tmpArr = InitOut%NStepWave2/m0 * InitOut%WaveDOmega * WaveS1SddArr + tmpArr = InitOut%NStepWave2/m0 * WaveField%WaveDOmega * WaveS1SddArr IF (InitInp%ConstWaveMod == 1) THEN ! Crest elevation prescribed diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 85f86e7b77..e68c04a803 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -61,7 +61,6 @@ typedef ^ ^ ReKi PtfmLocatio # Define outputs from the initialization routine here: # typedef ^ InitOutputType INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ InitOutputType SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ InitOutputType DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ InitOutputType INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ InitOutputType INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index 7fd14cda95..113bcab12a 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -538,7 +538,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) ! The frequency we are dealing with !> * \f$ \omega^- = \mu^- \Delta \omega \f$ - Omega_minus = mu_minus * InitInp%WaveDOmega + Omega_minus = mu_minus * WaveField%WaveDOmega IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN @@ -546,8 +546,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) DO m=1,InitInp%NStepWave2-mu_minus ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_minus + m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) k_nm = k_nm_minus( n, m, k_n, k_m ) @@ -916,7 +916,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) ! an odd number DO n=1,FLOOR( REAL(InitInp%NStepWave2-1) / 2.0_SiKi ) ! Only - Omega_n = n * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega = 2 \omega_n \f$ @@ -1016,15 +1016,15 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ - Omega_plus = mu_plus * InitInp%WaveDOmega + Omega_plus = mu_plus * WaveField%WaveDOmega IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^+} \f$ terms at each frequency. DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_plus - m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) k_nm = k_nm_plus( n, m, k_n, k_m ) @@ -1314,7 +1314,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta ! The frequency we are dealing with !> * \f$ \omega^- = \mu^- \Delta \omega \f$ - Omega_minus = mu_minus * InitInp%WaveDOmega + Omega_minus = mu_minus * WaveField%WaveDOmega IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN @@ -1322,8 +1322,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta DO m=1,InitInp%NStepWave2-mu_minus ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_minus + m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) R_n = k_n * tanh( k_n * InitInp%WtrDpth ) @@ -1443,7 +1443,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat DO n=1,FLOOR( REAL(InitInp%NStepWave2-1) / 2.0_SiKi ) ! Only - Omega_n = n * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega = 2 \omega_n \f$ @@ -1507,7 +1507,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ - Omega_plus = mu_plus * InitInp%WaveDOmega + Omega_plus = mu_plus * WaveField%WaveDOmega IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN @@ -1515,8 +1515,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat DO m=1,FLOOR( REAL(mu_plus - 1) / 2.0_SiKi ) ! Calculate the value of the n index from \f$ \mu^+ = n + m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_plus - m - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) R_n = k_n * tanh( k_n * InitInp%WtrDpth ) @@ -1629,8 +1629,8 @@ FUNCTION TransFuncB_minus(n,m,k_n,k_m,z) ELSE ! Frequencies - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega ! Wavenumbers k_nm = k_nm_minus( n,m,k_n,k_m ) @@ -1691,8 +1691,8 @@ FUNCTION TransFuncB_plus(n,m,k_n,k_m,z) ELSE ! Frequencies - Omega_n = n * InitInp%WaveDOmega - Omega_m = m * InitInp%WaveDOmega + Omega_n = n * WaveField%WaveDOmega + Omega_m = m * WaveField%WaveDOmega ! Wavenumbers k_nm = k_nm_plus( n,m,k_n,k_m ) diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index b5937d2e1b..5e0e1777b0 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -23,7 +23,6 @@ typedef ^ ^ ReKi WtrDpth typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 3fec995105..a3b97f8619 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -39,7 +39,6 @@ MODULE Waves2_Types REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] - REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] @@ -84,7 +83,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid @@ -156,7 +154,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%NWaveElevGrid) @@ -197,8 +194,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%nGrid) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 1fcbfe5a7e..57b509e65e 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -79,7 +79,6 @@ MODULE Waves_Types ! ========= Waves_InitOutputType ======= TYPE, PUBLIC :: Waves_InitOutputType INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] @@ -449,7 +448,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat = ErrID_None ErrMsg = '' DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 @@ -470,7 +468,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WaveNDir) - call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) @@ -484,8 +481,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) From 0296905b147902d53513f755e3f0952fa3ed4b3e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 3 Nov 2023 10:30:47 -0600 Subject: [PATCH 040/232] HD/SeaSt: cleanup `WaveDirMod` usage --- modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 1 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 - modules/hydrodyn/src/HydroDyn_Types.f90 | 5 ----- modules/openfast-library/src/FAST_Subs.f90 | 1 - modules/seastate/src/SeaSt_WaveField.txt | 4 ++++ modules/seastate/src/SeaSt_WaveField_Types.f90 | 2 ++ modules/seastate/src/SeaState.f90 | 5 ++--- modules/seastate/src/SeaState.txt | 1 + modules/seastate/src/SeaState_Input.f90 | 8 ++++---- modules/seastate/src/SeaState_Types.f90 | 5 +++++ modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 5 ----- 13 files changed, 18 insertions(+), 22 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index c2874bded4..1ca3ca182a 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -79,7 +79,6 @@ typedef ^ ^ logical typedef ^ ^ INTEGER NStepWave - 0 - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index fdd8d072d3..47af07d211 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -412,7 +412,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, HD%InitInp%NStepWave = SeaSt%InitOutData%NStepWave HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod - HD%InitInp%WaveDirMod = SeaSt%InitOutData%WaveDirMod HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! can be set regardless of association(); if not associated, HD shouldn't work diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 1cd5ed04f7..0bb05e5e7f 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -326,7 +326,6 @@ subroutine SetHD_InitInputs() InitInData_HD%NStepWave = InitOutData_SeaSt%NStepWave InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod - InitInData_HD%WaveDirMod = InitOutData_SeaSt%WaveDirMod InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index c03441339b..9730e80eb3 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -95,7 +95,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType @@ -887,7 +886,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -924,7 +922,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -969,8 +966,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 99a84d89d9..35fd7b2691 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -859,7 +859,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod - Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 855ca41c8a..4fc32a47a5 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -2,6 +2,10 @@ # Data structures for representing wave fields. # usefrom SeaState_Interp.txt + +param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - +param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - + #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index df8793c23c..6696022b36 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -34,6 +34,8 @@ MODULE SeaSt_WaveField_Types USE SeaState_Interp_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 7dbd5f7af9..2152a2da8e 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -403,7 +403,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT InitOut%WaveMod = InputFileData%Waves%WaveMod - InitOut%WaveDirMod = InputFileData%Waves%WaveDirMod ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth InitOut%SeaSt_Interp_p = p%seast_interp_p @@ -412,7 +411,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Tell HydroDyn if state-space wave excitation is not allowed: InitOut%InvalidWithSSExctn = InputFileData%Waves%WaveMod == 6 .or. & !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 ) - InputFileData%Waves%WaveDirMod /= 0 .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) + InputFileData%WaveDirMod /= WaveDirMod_None .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) InputFileData%Waves2%WvDiffQTFF .or. & !call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) InputFileData%Waves2%WvSumQTFF !call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) @@ -476,7 +475,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init call SetErrStat( ErrID_Fatal, 'Still water conditions must be used for linearization. Set WaveMod=0.', ErrStat, ErrMsg, RoutineName ) end if - if ( InputFileData%Waves%WaveDirMod /= 0 ) then + if ( InputFileData%WaveDirMod /= WaveDirMod_None ) then call SetErrStat( ErrID_Fatal, 'No directional spreading must be used for linearization. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) end if diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 846f080b63..c851f4e770 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -49,6 +49,7 @@ typedef ^ ^ CHARACTER(20) OutFmt typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) +typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional" - typedef ^ ^ SiKi MCFD - - - "Diameter of members that will use the MacCamy-Fuchs diffraction model" diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index d955ef0672..acc9356467 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -189,7 +189,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! WaveDirMod - Directional spreading function {0: None, 1: COS2S} (-) [Used only if WaveMod=2] - call ParseVar( FileInfo_In, CurLine, 'WaveDirMod', InputFileData%Waves%WaveDirMod, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WaveDirMod', InputFileData%WaveDirMod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! WaveDirSpread - Spreading coefficient [only used if WaveMod=2 and WaveDirMod=1] @@ -816,7 +816,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Multi-directional waves ! Check the WaveDirMod value - if ( InputFileData%Waves%WaveDirMod < 0 .OR. InputFileData%Waves%WaveDirMod > 1 ) then + if ( InputFileData%WaveDirMod /= WaveDirMod_None .AND. InputFileData%WaveDirMod /= WaveDirMod_COS2S ) then call SetErrStat( ErrID_Fatal,'WaveDirMod must be either 0 (No spreading) or 1 (COS2S spreading function)',ErrStat,ErrMsg,RoutineName) return end if @@ -824,9 +824,9 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Check if we are doing multidirectional waves or not. ! We can only use multi directional waves on WaveMod=2,3,4 InputFileData%WaveMultiDir = .FALSE. ! Set flag to false to start - if ( InputFileData%Waves%WaveMod >= 2 .AND. InputFileData%Waves%WaveMod <= 4 .AND. InputFileData%Waves%WaveDirMod == 1 ) then + if ( InputFileData%Waves%WaveMod >= 2 .AND. InputFileData%Waves%WaveMod <= 4 .AND. InputFileData%WaveDirMod == WaveDirMod_COS2S ) then InputFileData%WaveMultiDir = .TRUE. - elseif ( (InputFileData%Waves%WaveMod < 2 .OR. InputFileData%Waves%WaveMod >4) .AND. InputFileData%Waves%WaveDirMod == 1 ) then + elseif ( (InputFileData%Waves%WaveMod < 2 .OR. InputFileData%Waves%WaveMod >4) .AND. InputFileData%WaveDirMod == WaveDirMod_COS2S ) then call SetErrStat( ErrID_Warn,'WaveDirMod unused unless WaveMod == 2, 3, or 4. Ignoring WaveDirMod.',ErrStat,ErrMsg,RoutineName) ENDIF diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 94dc11010c..582ee0e9a0 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -68,6 +68,7 @@ MODULE SeaState_Types CHARACTER(20) :: OutSFmt !< Output format for header strings [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional [-] REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] @@ -300,6 +301,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt DstInputFileData%WaveStMod = SrcInputFileData%WaveStMod DstInputFileData%WtrDens = SrcInputFileData%WtrDens + DstInputFileData%WaveDirMod = SrcInputFileData%WaveDirMod DstInputFileData%WaveDir = SrcInputFileData%WaveDir DstInputFileData%WaveMultiDir = SrcInputFileData%WaveMultiDir DstInputFileData%MCFD = SrcInputFileData%MCFD @@ -404,6 +406,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%OutSFmt) call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, InData%WtrDens) + call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WaveDir) call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%MCFD) @@ -550,6 +553,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMultiDir) diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index e68c04a803..6242c0dd26 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -24,7 +24,6 @@ typedef ^ ^ CHARACTER(1024) WvKinFile typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" (m/s^2) typedef ^ ^ integer nGrid 3 - - "Grid dimensions" typedef ^ ^ INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) -typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WaveDirSpread - - - "Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1]" - typedef ^ ^ SiKi WaveDirRange - - - "Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6]" (degrees) typedef ^ ^ DbKi WaveDT - - - "Time step for incident wave calculations" (sec) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 57b509e65e..ef3fcea5ab 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -41,7 +41,6 @@ MODULE Waves_Types REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WaveDirSpread = 0.0_R4Ki !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] REAL(SiKi) :: WaveDirRange = 0.0_R4Ki !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Time step for incident wave calculations [(sec)] @@ -104,7 +103,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange DstInitInputData%WaveDT = SrcInitInputData%WaveDT @@ -235,7 +233,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%WaveNDir) - call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WaveDirSpread) call RegPack(Buf, InData%WaveDirRange) call RegPack(Buf, InData%WaveDT) @@ -311,8 +308,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirSpread) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirRange) From 4923a595420824c05245929e3f2038111e4fe17c Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Sun, 5 Nov 2023 17:54:34 -0700 Subject: [PATCH 041/232] HD/SeaSt: `WtrDpth` level 1 - not all of the WtrDpth variables have been updated in the submodules. Need to decide which modules need EffWtrDpth vs WtrDpth, yet. - moved the init of many WaveField parameters to ProcessInit routine in SeaState. - removed some --- modules/hydrodyn/src/HydroDyn.f90 | 5 +-- modules/hydrodyn/src/HydroDyn.txt | 3 -- modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 5 +-- modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 - modules/hydrodyn/src/HydroDyn_DriverSubs.f90 | 2 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 18 -------- modules/openfast-library/src/FAST_Subs.f90 | 8 ++-- modules/seastate/src/SeaSt_WaveField.txt | 1 + .../seastate/src/SeaSt_WaveField_Types.f90 | 5 +++ modules/seastate/src/SeaState.f90 | 43 ++---------------- modules/seastate/src/SeaState.txt | 6 +-- modules/seastate/src/SeaState_Input.f90 | 45 +++++++++++++++---- modules/seastate/src/SeaState_Interp.txt | 8 ++-- modules/seastate/src/SeaState_Types.f90 | 36 +++------------ 14 files changed, 65 insertions(+), 121 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 07f20268f9..552e7848de 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -189,7 +189,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - InputFileData%Morison%WtrDpth = InitInp%WtrDpth + InputFileData%Morison%WtrDpth = InitInp%WaveField%WtrDpth InputFileData%Morison%WaveField => InitInp%WaveField InputFileData%WAMIT%WaveField => InitInp%WaveField @@ -824,7 +824,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%OutFmt = InputFileData%OutFmt p%OutSFmt = InputFileData%OutSFmt p%NumOuts = InputFileData%NumOuts - p%WtrDpth = InputFileData%Morison%WtrDpth CALL HDOUT_Init( HydroDyn_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2423,7 +2422,7 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return - perturb_t = 0.02_ReKi*D2R * max(p%WtrDpth,1.0_ReKi) ! translation input scaling + perturb_t = 0.02_ReKi*D2R * max(p%WaveField%EffWtrDpth,1.0_ReKi) ! translation input scaling perturb = 2*D2R ! rotational input scaling index = 0 diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 1ca3ca182a..17f6910614 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -35,7 +35,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi AddCLin {:}{:}{:} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {:}{:}{:} - - "Additional linear damping matrix" - typedef ^ ^ ReKi AddBQuad {:}{:}{:} - - "Additional quadratic damping (drag) matrix" - -typedef ^ ^ SeaSt_InitInputType SeaState - - - "Initialization data for SeaState module" - typedef ^ ^ CHARACTER(1024) PotFile {:} - - "The name of the root potential flow file (without extension for WAMIT, complete name for FIT)" - typedef ^ ^ INTEGER nWAMITObj - - - "number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1" - typedef ^ ^ INTEGER vecMultiplier - - - "multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1" - @@ -72,7 +71,6 @@ typedef ^ ^ FileInfoTyp 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 ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" -typedef ^ ^ ReKi WtrDpth - - - "Water depth from the driver; may be overwritten " "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # @@ -156,7 +154,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER totalExctnStates - - - "Number of excitation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalRdtnStates - - - "Number of radiation states for all WAMIT bodies" - typedef ^ ^ INTEGER NStepWave - - - "Number of data points in the wave kinematics arrays" - -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ ReKi AddF0 {:}{:} - - "Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m)" - typedef ^ ^ ReKi AddCLin {:}{:}{:} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {:}{:}{:} - - "Additional linear damping matrix" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 47af07d211..7546d54313 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -404,7 +404,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! Values passed in HD%InitInp%Gravity = REAL(Gravity_C, ReKi) - HD%InitInp%WtrDpth = REAL(SeaSt%InitOutData%WtrDpth, ReKi) ! use values from SeaState HD%InitInp%TMax = REAL(TMax_C, DbKi) ! Transfer data from SeaState @@ -682,7 +681,7 @@ subroutine CheckDepth(ErrStat3,ErrMsg3) real(ReKi) :: tmpZpos !< temporary z-position ErrStat3 = ErrID_None ErrMsg3 = "" - tmpZpos=-0.001_ReKi*abs(HD%p%WtrDpth) ! Initial comparison value close to surface + tmpZpos=-0.001_ReKi*abs(HD%p%WaveField%EffWtrDpth) ! Initial comparison value close to surface if ( NumNodePts == 1 .and. HD%u(1)%Morison%Mesh%Committed ) then do i=1,HD%u(1)%Morison%Mesh%Nnodes ! Find lowest Morison node @@ -690,7 +689,7 @@ subroutine CheckDepth(ErrStat3,ErrMsg3) tmpZpos = HD%u(1)%Morison%Mesh%Position(3,i) endif enddo - if (tmpZpos < -abs(HD%p%WtrDpth)*0.9_ReKi) then ! within 10% of the seafloor + if (tmpZpos < -abs(HD%p%WaveField%EffWtrDpth)*0.9_ReKi) then ! within 10% of the seafloor ErrStat3 = ErrID_Severe ErrMsg3 = "Inconsistent model"//NewLine//" -- Single library input node for simulating rigid floating structure."// & NewLine//" -- Lowest Morison node is is in lowest 10% of water depth indicating fixed bottom structure from HydroDyn."// & diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 0bb05e5e7f..8a3f60fb29 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -322,7 +322,6 @@ subroutine SetHD_InitInputs() InitInData_HD%Linearize = drvrData%Linearize ! Data from InitOutData_SeaSt: - InitInData_HD%WtrDpth = InitOutData_SeaSt%WtrDpth InitInData_HD%NStepWave = InitOutData_SeaSt%NStepWave InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod diff --git a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 index 11bef74431..a9cc5e2c77 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverSubs.f90 @@ -1010,7 +1010,7 @@ SUBROUTINE PRP_Perturb_u( n, perturb_sign, p, u, EDRPMotion, du, Motion_HDRP, ma fieldIndx6= mod(n-1,6)+1 ! 1=x, 2=y 3=z 4=theta_x, 5=theta_y 6=theta_z (variable) ! Perturbation amplitude - perturb_t = 0.02_ReKi*D2R * max(p%WtrDpth,1.0_ReKi) ! translation input scaling + perturb_t = 0.02_ReKi*D2R * max(p%WaveField%EffWtrDpth,1.0_ReKi) ! translation input scaling perturb = 2*D2R ! rotational input scaling !perturb_t = 1.0 !perturb = 0.1 diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 9730e80eb3..258ddb6793 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -49,7 +49,6 @@ MODULE HydroDyn_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] - TYPE(SeaSt_InitInputType) :: SeaState !< Initialization data for SeaState module [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: PotFile !< The name of the root potential flow file (without extension for WAMIT, complete name for FIT) [-] INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] @@ -89,7 +88,6 @@ MODULE HydroDyn_Types CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth from the driver; may be overwritten [m] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] @@ -174,7 +172,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: totalExctnStates = 0_IntKi !< Number of excitation states for all WAMIT bodies [-] INTEGER(IntKi) :: totalRdtnStates = 0_IntKi !< Number of radiation states for all WAMIT bodies [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of data points in the wave kinematics arrays [-] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] @@ -276,9 +273,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad end if - call SeaSt_CopyInitInput(SrcInputFileData%SeaState, DstInputFileData%SeaState, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcInputFileData%PotFile)) then LB(1:1) = lbound(SrcInputFileData%PotFile) UB(1:1) = ubound(SrcInputFileData%PotFile) @@ -458,8 +452,6 @@ subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%AddBQuad)) then deallocate(InputFileData%AddBQuad) end if - call SeaSt_DestroyInitInput(InputFileData%SeaState, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputFileData%PotFile)) then deallocate(InputFileData%PotFile) end if @@ -527,7 +519,6 @@ subroutine HydroDyn_PackInputFile(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) call RegPack(Buf, InData%AddBQuad) end if - call SeaSt_PackInitInput(Buf, InData%SeaState) call RegPack(Buf, allocated(InData%PotFile)) if (allocated(InData%PotFile)) then call RegPackBounds(Buf, 1, lbound(InData%PotFile), ubound(InData%PotFile)) @@ -670,7 +661,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AddBQuad) if (RegCheckErr(Buf, RoutineName)) return end if - call SeaSt_UnpackInitInput(Buf, OutData%SeaState) ! SeaState if (allocated(OutData%PotFile)) deallocate(OutData%PotFile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -880,7 +870,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%OutRootName = SrcInitInputData%OutRootName DstInitInputData%Linearize = SrcInitInputData%Linearize DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%TMax = SrcInitInputData%TMax DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%NStepWave = SrcInitInputData%NStepWave @@ -916,7 +905,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%OutRootName) call RegPack(Buf, InData%Linearize) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%TMax) call RegPack(Buf, InData%VisMeshes) call RegPack(Buf, InData%NStepWave) @@ -954,8 +942,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%VisMeshes) @@ -2072,7 +2058,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%WtrDpth = SrcParamData%WtrDpth if (allocated(SrcParamData%AddF0)) then LB(1:2) = lbound(SrcParamData%AddF0) UB(1:2) = ubound(SrcParamData%AddF0) @@ -2288,7 +2273,6 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%totalExctnStates) call RegPack(Buf, InData%totalRdtnStates) call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) @@ -2416,8 +2400,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 35fd7b2691..a9bb5f9ed8 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -855,7 +855,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true - Init%InData_HD%WtrDpth = Init%OutData_SeaSt%WtrDpth Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod @@ -917,7 +916,7 @@ 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 - Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WtrDpth + Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WaveField%WtrDpth ELSE Init%InData_SD%WtrDpth = 0.0_ReKi END IF @@ -1035,12 +1034,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_MAP%sea_density = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState - Init%InData_MAP%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState ! differences for MAP++ Init%InData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name - Init%InData_MAP%depth = -Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState + Init%InData_MAP%depth = -Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize @@ -1088,7 +1086,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn Init%InData_MD%rhoW = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState - Init%InData_MD%WtrDepth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState + Init%InData_MD%WtrDepth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) Init%InData_MD%Linearize = p_FAST%Linearize diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 4fc32a47a5..dca4ab497c 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -29,6 +29,7 @@ typedef ^ ^ SiKi WaveElevC typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part" (m) typedef ^ ^ SiKi WaveDirArr {:} - - "Wave direction array. Each frequency has a unique direction of WaveNDir > 1" (degrees) +typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ SiKi RhoXg - - - "= WtrDens*Gravity" - typedef ^ ^ SiKi WaveDirMin - - - "Minimum wave direction." (degrees) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 6696022b36..23de9d71fa 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -57,6 +57,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] @@ -273,6 +274,7 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr end if + DstSeaSt_WaveFieldTypeData%WtrDpth = SrcSeaSt_WaveFieldTypeData%WtrDpth DstSeaSt_WaveFieldTypeData%WtrDens = SrcSeaSt_WaveFieldTypeData%WtrDens DstSeaSt_WaveFieldTypeData%RhoXg = SrcSeaSt_WaveFieldTypeData%RhoXg DstSeaSt_WaveFieldTypeData%WaveDirMin = SrcSeaSt_WaveFieldTypeData%WaveDirMin @@ -431,6 +433,7 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) call RegPack(Buf, InData%WaveDirArr) end if + call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%RhoXg) call RegPack(Buf, InData%WaveDirMin) @@ -673,6 +676,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveDirArr) if (RegCheckErr(Buf, RoutineName)) return end if + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%RhoXg) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 2152a2da8e..de29ed7dd8 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -211,29 +211,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY - ! Allocate the WaveFieldType to store wave field information - ALLOCATE(p%WaveField, STAT=ErrStat2) - IF (ErrStat2 /=0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating WaveField.",ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - END IF - - p%WaveField%MSL2SWL = InputFileData%MSL2SWL - p%WaveField%WaveStMod = InputFileData%WaveStMod - p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp - p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 - p%WaveField%WaveDir = InputFileData%WaveDir - p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir - p%WaveField%MCFD = InputFileData%MCFD - - p%WaveField%WvLowCOff = InputFileData%WvLowCOff - p%WaveField%WvHiCOff = InputFileData%WvHiCOff - p%WaveField%WvLowCOffD = InputFileData%WvLowCOffD - p%WaveField%WvHiCOffD = InputFileData%WvHiCOffD - p%WaveField%WvLowCOffS = InputFileData%WvLowCOffS - p%WaveField%WvHiCOffS = InputFileData%WvHiCOffS - p%WaveField%WaveDOmega = InputFileData%WaveDOmega ! For WAMIT and WAMIT2, FIT ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) @@ -360,11 +337,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Define initialization-routine output here: InitOut%Ver = SeaSt_ProgDesc ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: - InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL - p%WaveField%EffWtrDpth = InputFileData%Waves%WtrDpth ! Effective water depth measured from the SWL ! bjj: does WtrDpth change later? Because otherwise EffWtrDpth is the same as WtrDpth - - p%WtrDpth = InitOut%WtrDpth - CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN @@ -387,8 +359,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init SeaSt_Interp_InitInp%pZero(3) = -InputFileData%Y_HalfWidth SeaSt_Interp_InitInp%pZero(4) = -InputFileData%Z_Depth ! zi SeaSt_Interp_InitInp%Z_Depth = InputFileData%Z_Depth - call SeaSt_Interp_Init(SeaSt_Interp_InitInp, p%seast_interp_p, ErrStat2, ErrMsg2) - CALL SeaSt_Interp_CopyParam( p%seast_interp_p, p%WaveField%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + call SeaSt_Interp_Init(SeaSt_Interp_InitInp, p%WaveField%seast_interp_p, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) 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! @@ -403,10 +375,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT InitOut%WaveMod = InputFileData%Waves%WaveMod - ! InitOut%WtrDpth = InputFileData%Waves%WtrDpth - InitOut%SeaSt_Interp_p = p%seast_interp_p - InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: @@ -444,7 +413,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init do it = 1,size(p%WaveField%WaveTime) do i = 1, size(InitOut%WaveElevSeries,DIM=2) - InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev1, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev1, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do end do @@ -452,7 +421,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init if (allocated(p%WaveField%WaveElev2)) then do it = 1,size(p%WaveField%WaveTime) do i = 1, size(InitOut%WaveElevSeries,DIM=2) - TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev2, p%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev2, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) InitOut%WaveElevSeries(it,i) = InitOut%WaveElevSeries(it,i) + TmpElev end do @@ -510,10 +479,6 @@ SUBROUTINE CleanUp() if (allocated(tmpWaveKinzi )) deallocate(tmpWaveKinzi ) if (allocated(tmpWaveElevxi)) deallocate(tmpWaveElevxi) if (allocated(tmpWaveElevyi)) deallocate(tmpWaveElevyi) - ! if (allocated(WaveElevSt )) deallocate(WaveElevSt ) - ! if (allocated(WaveVel0 )) deallocate(WaveVel0 ) - ! if (allocated(WaveAcc0 )) deallocate(WaveAcc0 ) - ! if (allocated(WaveDynP0 )) deallocate(WaveDynP0 ) if (allocated(WaveVel2S0 )) deallocate(WaveVel2S0 ) if (allocated(WaveAcc2S0 )) deallocate(WaveAcc2S0 ) if (allocated(WaveDynP2S0 )) deallocate(WaveDynP2S0 ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index c851f4e770..d152ff3e18 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -48,6 +48,7 @@ typedef ^ ^ LOGICAL SeaStSu typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - typedef ^ ^ INTEGER WaveStMod - - - "Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching}" - +typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ ReKi WtrDens - - - "Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default)" (kg/m^3) typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ SiKi WaveDir - - - "Incident wave propagation heading direction" (degrees) @@ -86,13 +87,10 @@ typedef ^ ^ Logical Lin typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" -typedef ^ ^ ReKi WtrDpth - - - "Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default)" (m) typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ INTEGER WaveDirMod - - - "Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6]" - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - 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 ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # @@ -141,7 +139,6 @@ typedef ^ ^ INTEGER NWa typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (m) typedef ^ ^ DbKi DT - - - "Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states" - typedef ^ ^ OutParmType OutParam {:} - - "" - typedef ^ ^ INTEGER NumOuts - - - "Number of SeaState module-level outputs (not the total number including sub-modules" - @@ -151,7 +148,6 @@ typedef ^ ^ CHARACTER(20) Out typedef ^ ^ CHARACTER(1) Delim - - - "Delimiter string for outputs, defaults to space" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" # # diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index acc9356467..3108cc9e4e 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -99,7 +99,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! WtrDpth - Water depth - call ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDpth', InputFileData%Waves%WtrDpth, defWtrDpth, ErrStat2, ErrMsg2, UnEc ) + call ParseVarWDefault ( FileInfo_In, CurLine, 'WtrDpth', InputFileData%WtrDpth, defWtrDpth, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! MSL2SWL @@ -121,7 +121,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! Z_Depth - Depth of the domain the Z direction. - call ParseVarWDefault ( FileInfo_In, CurLine, 'Z_Depth', InputFileData%Z_Depth, defWtrDpth+InputFileData%MSL2SWL, ErrStat2, ErrMsg2, UnEc ) + call ParseVarWDefault ( FileInfo_In, CurLine, 'Z_Depth', InputFileData%Z_Depth, defWtrDpth+InputFileData%MSL2SWL, ErrStat2, ErrMsg2, UnEc ) !bjj: wouldn't the default be better with InputFileData%WtrDpth + InputFileData%MSL2SWL since we may have specified a WtrDpth already? if (Failed()) return; ! NX - Number of nodes in half of the X-direction domain. @@ -524,14 +524,12 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Initialize ErrStat ErrStat = ErrID_None - ErrStat2 = ErrID_None ErrMsg = "" - ErrMsg2 = "" - !------------------------------------------------------------------------- - ! Check environmental conditions - !------------------------------------------------------------------------- + !------------------------------------------------------------------------- + ! Check environmental conditions + !------------------------------------------------------------------------- ! WtrDens - Water density. @@ -545,7 +543,8 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WtrDpth - Water depth ! First adjust water depth based on MSL2SWL values - InputFileData%Waves%WtrDpth = InputFileData%Waves%WtrDpth + InputFileData%MSL2SWL + InputFileData%Waves%WtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL + if ( InputFileData%Waves%WtrDpth <= 0.0 ) then call SetErrStat( ErrID_Fatal,'WtrDpth + MSL2SWL must be greater than zero.',ErrStat,ErrMsg,RoutineName) @@ -1206,6 +1205,36 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er InputFileData%Waves2%WaveKinGridzi = InputFileData%Waves%WaveKinGridzi ENDIF + + !------------------------------------------------------------ + ! Allocate the WaveFieldType to store wave field information + !------------------------------------------------------------ + ALLOCATE(p%WaveField, STAT=ErrStat2) + IF (ErrStat2 /=0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating WaveField.",ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + p%WaveField%WtrDpth = InputFileData%WtrDpth + p%WaveField%MSL2SWL = InputFileData%MSL2SWL + p%WaveField%EffWtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL + + p%WaveField%WaveStMod = InputFileData%WaveStMod + p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp + p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 + p%WaveField%WaveDir = InputFileData%WaveDir + p%WaveField%WaveMultiDir = InputFileData%WaveMultiDir + p%WaveField%MCFD = InputFileData%MCFD + + p%WaveField%WvLowCOff = InputFileData%WvLowCOff + p%WaveField%WvHiCOff = InputFileData%WvHiCOff + p%WaveField%WvLowCOffD = InputFileData%WvLowCOffD + p%WaveField%WvHiCOffD = InputFileData%WvHiCOffD + p%WaveField%WvLowCOffS = InputFileData%WvLowCOffS + p%WaveField%WvHiCOffS = InputFileData%WvHiCOffS + p%WaveField%WaveDOmega = InputFileData%WaveDOmega ! For WAMIT and WAMIT2, FIT + + end subroutine SeaStateInput_ProcessInitData end module SeaState_Input diff --git a/modules/seastate/src/SeaState_Interp.txt b/modules/seastate/src/SeaState_Interp.txt index 43b005aa88..7373451f90 100644 --- a/modules/seastate/src/SeaState_Interp.txt +++ b/modules/seastate/src/SeaState_Interp.txt @@ -33,10 +33,10 @@ typedef ^ MiscVarType logical FirstWa # ..... 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 IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - -typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" -typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m +typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - +typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" +typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 582ee0e9a0..87e4b10b66 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -67,6 +67,7 @@ MODULE SeaState_Types CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] @@ -106,13 +107,10 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] 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(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType @@ -163,7 +161,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] @@ -173,7 +170,6 @@ MODULE SeaState_Types CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to space [-] INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] END TYPE SeaSt_ParameterType ! ======================= @@ -300,6 +296,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutFmt = SrcInputFileData%OutFmt DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt DstInputFileData%WaveStMod = SrcInputFileData%WaveStMod + DstInputFileData%WtrDpth = SrcInputFileData%WtrDpth DstInputFileData%WtrDens = SrcInputFileData%WtrDens DstInputFileData%WaveDirMod = SrcInputFileData%WaveDirMod DstInputFileData%WaveDir = SrcInputFileData%WaveDir @@ -405,6 +402,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%OutFmt) call RegPack(Buf, InData%OutSFmt) call RegPack(Buf, InData%WaveStMod) + call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WtrDens) call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%WaveDir) @@ -551,6 +549,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDirMod) @@ -756,15 +756,10 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod - DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn - call SeaSt_Interp_CopyParam(SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WaveElevSeries)) then LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries) @@ -797,8 +792,6 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WaveElevSeries)) then deallocate(InitOutputData%WaveElevSeries) end if @@ -822,13 +815,10 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveDirMod) call RegPack(Buf, InData%InvalidWithSSExctn) - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) @@ -883,19 +873,14 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1232,7 +1217,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveKinzi = SrcParamData%WaveKinzi end if - DstParamData%WtrDpth = SrcParamData%WtrDpth DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) @@ -1257,9 +1241,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%Delim = SrcParamData%Delim DstParamData%UnOutFile = SrcParamData%UnOutFile DstParamData%OutDec = SrcParamData%OutDec - call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (associated(SrcParamData%WaveField)) then if (.not. associated(DstParamData%WaveField)) then allocate(DstParamData%WaveField, stat=ErrStat2) @@ -1311,8 +1292,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%OutParam) end if - call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (associated(ParamData%WaveField)) then call SeaSt_WaveField_DestroySeaSt_WaveFieldType(ParamData%WaveField, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1365,7 +1344,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) call RegPack(Buf, InData%WaveKinzi) end if - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then @@ -1383,7 +1361,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%Delim) call RegPack(Buf, InData%UnOutFile) call RegPack(Buf, InData%OutDec) - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -1496,8 +1473,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinzi) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) @@ -1529,7 +1504,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 2bda79fe32a09aec53827947f7f7baad5a05575c Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 6 Nov 2023 13:09:24 -0700 Subject: [PATCH 042/232] HD/SeaSt: cleanup SeaSt_Interp - parameters are stored in single place in WaveField - misc vars should be stored in modules that call the interp routines; otherwise warnings about clamping get printed to screen MANY times --- modules/hydrodyn/src/HydroDyn.f90 | 4 - modules/hydrodyn/src/Morison.f90 | 10 +-- modules/hydrodyn/src/Morison.txt | 1 + modules/hydrodyn/src/Morison_Types.f90 | 8 ++ modules/hydrodyn/src/SS_Excitation.f90 | 3 +- modules/hydrodyn/src/SS_Excitation.txt | 2 - modules/hydrodyn/src/SS_Excitation_Types.f90 | 16 ---- modules/hydrodyn/src/WAMIT.f90 | 62 +++++++------- modules/hydrodyn/src/WAMIT.txt | 5 +- modules/hydrodyn/src/WAMIT_Types.f90 | 49 +++++++---- modules/seastate/src/SeaSt_WaveField.f90 | 84 +++++++++---------- modules/seastate/src/SeaState.f90 | 6 +- modules/seastate/src/SeaState_Interp.f90 | 2 +- modules/seastate/src/SeaState_Interp.txt | 10 +-- .../seastate/src/SeaState_Interp_Types.f90 | 8 +- 15 files changed, 136 insertions(+), 134 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 552e7848de..f1916fffb5 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -363,10 +363,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT%NStepWave = InitInp%NStepWave InputFileData%WAMIT%NStepWave2 = InitInp%NStepWave2 - ! InputFileData%WAMIT%seast_interp_p = InitInp%WaveField%seast_interp_p - CALL SeaSt_Interp_CopyParam(InitInp%WaveField%seast_interp_p, InputFileData%WAMIT%seast_interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL WAMIT_Init(InputFileData%WAMIT, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), z%WAMIT, OtherState%WAMIT(1), & y%WAMIT(1), m%WAMIT(1), Interval, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 04812ba0fb..78ad9db674 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2610,7 +2610,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !=============================================================================================== ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below - CALL WaveField_GetWaveKin( p%WaveField, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetWaveKin( p%WaveField, m%SeaSt_Interp_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Compute fluid velocity relative to the structure DO j = 1, p%NNodes @@ -3044,7 +3044,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Compute the distributed loads at the point of intersection between the member and the free surface ! !----------------------------------------------------------------------------------------------------! ! Get wave kinematics at the free-surface intersection. Set forceNodeInWater=.TRUE. to guarantee the free-surface intersection is in water. - CALL WaveField_GetNodeWaveKin( p%WaveField, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%SeaSt_Interp_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynPFSInt = REAL(FDynP,ReKi) FVFSInt = REAL(FV, ReKi) @@ -3586,7 +3586,7 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, Time, pos, ErrStat2, ErrMsg2 ) + Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetTotalWaveElev @@ -3604,7 +3604,7 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - CALL WaveField_GetNodeWaveNormal( p%WaveField, Time, pos, r, n, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveNormal( p%WaveField, m%SeaSt_Interp_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetFreeSurfaceNormal @@ -4219,7 +4219,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END IF ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( p%WaveField, m%SeaSt_Interp_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 59f1f44781..78a76a371d 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -326,6 +326,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s typedef ^ ^ INTEGER LastIndWave - - - "Last time index used in the wave kinematics arrays" - typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - +typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index b49ee58f9f..ae222dc4d3 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -389,6 +389,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] INTEGER(IntKi) :: LastIndWave = 0_IntKi !< Last time index used in the wave kinematics arrays [-] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] + TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -4872,6 +4873,9 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call NWTC_Library_CopyMeshMapType(SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) @@ -4953,6 +4957,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyMeshMapType(MiscData%VisMeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Morison_PackMisc(Buf, Indata) @@ -5068,6 +5074,7 @@ subroutine Morison_PackMisc(Buf, Indata) end if call RegPack(Buf, InData%LastIndWave) call NWTC_Library_PackMeshMapType(Buf, InData%VisMeshMap) + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5364,6 +5371,7 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_UnpackMeshMapType(Buf, OutData%VisMeshMap) ! VisMeshMap + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index f35633aca6..fc492693de 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -111,7 +111,7 @@ function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) do iBody = 1, p%NBody - GetWaveElevation(iBody) = SeaSt_Interp_3D( time, u_out%PtfmPos(1:2,iBody), p%WaveField%WaveElev1, p%SeaSt_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + GetWaveElevation(iBody) = SeaSt_Interp_3D( time, u_out%PtfmPos(1:2,iBody), p%WaveField%WaveElev1, p%WaveField%SeaSt_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do @@ -171,7 +171,6 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini ! Set wave field data and parameters from InitInp: p%NStepWave = InitInp%NStepWave - p%SeaSt_Interp_p = InitInp%SeaSt_Interp_p p%WaveField => InitInp%WaveField p%ExctnDisp = InitInp%ExctnDisp diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 2b1266e3c1..5bfaaad57c 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -22,7 +22,6 @@ typedef ^ ^ IntKi typedef ^ ^ IntKi ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - @@ -63,7 +62,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi C {:}{:} - - "C matrix" - typedef ^ ^ INTEGER numStates - 0 - "Number of states" - typedef ^ ^ DbKi Tc - - - "Time shift" s -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # ..... Inputs ............................. diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 30ef6accdf..b0a19f34f5 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -42,7 +42,6 @@ MODULE SS_Excitation_Types INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_InitInputType ! ======================= @@ -91,7 +90,6 @@ MODULE SS_Excitation_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] REAL(DbKi) :: Tc = 0.0_R8Ki !< Time shift [s] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_ParameterType ! ======================= @@ -136,9 +134,6 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if - call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -154,8 +149,6 @@ subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%PtfmRefztRot)) then deallocate(InitInputData%PtfmRefztRot) end if - call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitInputData%WaveField) end subroutine @@ -174,7 +167,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -217,7 +209,6 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefztRot) if (RegCheckErr(Buf, RoutineName)) return end if - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -690,9 +681,6 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if DstParamData%numStates = SrcParamData%numStates DstParamData%Tc = SrcParamData%Tc - call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstParamData%WaveField => SrcParamData%WaveField end subroutine @@ -717,8 +705,6 @@ subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%C)) then deallocate(ParamData%C) end if - call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%WaveField) end subroutine @@ -754,7 +740,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) end if call RegPack(Buf, InData%numStates) call RegPack(Buf, InData%Tc) - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -843,7 +828,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Tc) if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index f3efd9ca5a..77794470a3 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -223,7 +223,8 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS p%ExctnCutOff = InitInp%ExctnCutOff p%NBodyMod = InitInp%NBodyMod p%NBody = InitInp%NBody ! In the context of this WAMIT object NBody is 1 if NBodyMod > 1 [there are NBody different WAMIT objects in this case] - p%seast_interp_p = InitInp%seast_interp_p + p%WaveField => InitInp%WaveField + ! This module's implementation requires that if NBodyMod = 2 or 3, then there is one instance of a WAMIT module for each body, therefore, HydroDyn may have NBody > 1, but this WAMIT module will have NBody = 1 if ( (p%NBodyMod > 1) .and. (p%NBody > 1) ) then CALL SetErrStat( ErrID_Fatal, "DEVELOPER ERROR: If NBodyMod = 2 or 3, then NBody for the a WAMIT object must be equal to 1", ErrStat, ErrMsg, RoutineName) @@ -243,9 +244,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS do iBody = 1, p%NBody p%F_HS_Moment_Offset(1,iBody) = 0.0_ReKi p%F_HS_Moment_Offset(2,iBody) = 0.0_ReKi - p%F_HS_Moment_Offset(3,iBody) = InitInp%WaveField%RhoXg*InitInp%PtfmVol0(iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position - p%F_HS_Moment_Offset(4,iBody) = InitInp%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOByt(iBody) - InitInp%PtfmRefyt(iBody) ) ! and the moment about X due to the COB being offset from the local WAMIT reference point - p%F_HS_Moment_Offset(5,iBody) = -InitInp%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOBxt(iBody) - InitInp%PtfmRefxt(iBody) ) ! and the moment about Y due to the COB being offset from the localWAMIT reference point + p%F_HS_Moment_Offset(3,iBody) = p%WaveField%RhoXg*InitInp%PtfmVol0(iBody) ! except for the hydrostatic buoyancy force from Archimede's Principle when the support platform is in its undisplaced position + p%F_HS_Moment_Offset(4,iBody) = p%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOByt(iBody) - InitInp%PtfmRefyt(iBody) ) ! and the moment about X due to the COB being offset from the local WAMIT reference point + p%F_HS_Moment_Offset(5,iBody) = -p%WaveField%RhoXg*InitInp%PtfmVol0(iBody)*( InitInp%PtfmCOBxt(iBody) - InitInp%PtfmRefxt(iBody) ) ! and the moment about Y due to the COB being offset from the localWAMIT reference point p%F_HS_Moment_Offset(6,iBody) = 0.0_ReKi end do @@ -259,16 +260,16 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! element-by-element multiplication, instead of matrix-by-matrix ! multiplication: - SttcDim(1,1) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - SttcDim(1,4) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Force-rotation/Moment-translation - Hydrostatic restoring - SttcDim(4,4) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**4 ! Moment-rotation + SttcDim(1,1) = p%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation + SttcDim(1,4) = p%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Force-rotation/Moment-translation - Hydrostatic restoring + SttcDim(4,4) = p%WaveField%RhoXg *InitInp%WAMITULEN**4 ! Moment-rotation - RdtnDim(1,1) = InitInp%WaveField%WtrDens*InitInp%WAMITULEN**3 ! Force-translation - RdtnDim(1,4) = InitInp%WaveField%WtrDens*InitInp%WAMITULEN**4 ! Force-rotation/Moment-translation - Hydrodynamic added mass and damping - RdtnDim(4,4) = InitInp%WaveField%WtrDens*InitInp%WAMITULEN**5 ! Moment-rotation + RdtnDim(1,1) = p%WaveField%WtrDens*InitInp%WAMITULEN**3 ! Force-translation + RdtnDim(1,4) = p%WaveField%WtrDens*InitInp%WAMITULEN**4 ! Force-rotation/Moment-translation - Hydrodynamic added mass and damping + RdtnDim(4,4) = p%WaveField%WtrDens*InitInp%WAMITULEN**5 ! Moment-rotation - DffrctDim(1) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - Hydrodynamic wave excitation force - DffrctDim(4) = InitInp%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Moment-rotation + DffrctDim(1) = p%WaveField%RhoXg *InitInp%WAMITULEN**2 ! Force-translation - Hydrodynamic wave excitation force + DffrctDim(4) = p%WaveField%RhoXg *InitInp%WAMITULEN**3 ! Moment-rotation DO I = 1,3 ! Loop through all force-translation elements (rows) @@ -925,7 +926,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp !TODO: Verify what happens within SS_Exctn when we have no waves. - SS_Exctn_InitInp%WaveField => InitInp%WaveField + SS_Exctn_InitInp%WaveField => p%WaveField call SS_Exc_Init(SS_Exctn_InitInp, m%SS_Exctn_u, p%SS_Exctn, x%SS_Exctn, xd%SS_Exctn, z%SS_Exctn, OtherState%SS_Exctn, & m%SS_Exctn_y, m%SS_Exctn, Interval_Sub, SS_Exctn_InitOut, ErrStat2, ErrMsg2) @@ -949,7 +950,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! NOTE: we may end up inadvertantly aborting if the wave direction crosses ! the -Pi / Pi boundary (-180/180 degrees). - IF ( ( InitInp%WaveField%WaveDirMin < HdroWvDir(1) ) .OR. ( InitInp%WaveField%WaveDirMax > HdroWvDir(NInpWvDir) ) ) THEN + IF ( ( p%WaveField%WaveDirMin < HdroWvDir(1) ) .OR. ( p%WaveField%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, RoutineName) @@ -969,13 +970,13 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF if (p%ExctnDisp > 0 ) then - ALLOCATE ( WaveExctnCGrid(0:InitInp%NStepWave2 ,p%SeaSt_Interp_p%n(2)*p%SeaSt_Interp_p%n(3),6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( WaveExctnCGrid(0:InitInp%NStepWave2 ,p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3),6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF - ALLOCATE ( p%WaveExctnGrid (0:InitInp%NStepWave,p%SeaSt_Interp_p%n(2),p%SeaSt_Interp_p%n(3), 6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctnGrid (0:InitInp%NStepWave,p%WaveField%SeaSt_Interp_p%n(2),p%WaveField%SeaSt_Interp_p%n(3), 6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -1065,7 +1066,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the frequency of this component: - Omega = I*InitInp%WaveField%WaveDOmega + Omega = I*p%WaveField%WaveDOmega ! Compute the discrete Fourier transform of the instantaneous value of the @@ -1073,14 +1074,14 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments TmpCoord(1) = Omega - TmpCoord(2) = InitInp%WaveField%WaveDirArr(I) + TmpCoord(2) = p%WaveField%WaveDirArr(I) CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN END IF - WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveField%WaveElevC0(1,I), InitInp%WaveField%WaveElevC0(2,I)) + WaveExctnC(I,J) = WaveExctnC(I,J) * CMPLX(p%WaveField%WaveElevC0(1,I), p%WaveField%WaveElevC0(2,I)) END DO ! J - All wave excitation forces and moments @@ -1120,22 +1121,22 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the frequency of this component: - Omega = I*InitInp%WaveField%WaveDOmega + Omega = I*p%WaveField%WaveDOmega ! Compute the discrete Fourier transform of the instantaneous value of the ! total excitation force on the support platfrom from incident waves: DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments TmpCoord(1) = Omega - TmpCoord(2) = InitInp%WaveField%WaveDirArr(I) + TmpCoord(2) = p%WaveField%WaveDirArr(I) CALL WAMIT_Interp2D_Cplx( TmpCoord, HdroExctn(:,:,J), HdroFreq, HdroWvDir, LastInd2, WaveExctnC(I,J), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN END IF - do iGrid = 1, p%SeaSt_Interp_p%n(2)*p%SeaSt_Interp_p%n(3) - WaveExctnCGrid(I,iGrid,J) = WaveExctnC(I,J) * CMPLX(InitInp%WaveField%WaveElevC(1,I,iGrid), InitInp%WaveField%WaveElevC(2,I,iGrid)) + do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) + WaveExctnCGrid(I,iGrid,J) = WaveExctnC(I,J) * CMPLX(p%WaveField%WaveElevC(1,I,iGrid), p%WaveField%WaveElevC(2,I,iGrid)) end do END DO ! J - All wave excitation forces and moments END DO ! I - The positive frequency components (including zero) of the discrete Fourier transform @@ -1151,9 +1152,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments - do iGrid = 1, p%SeaSt_Interp_p%n(2)*p%SeaSt_Interp_p%n(3) - iX = mod(iGrid-1, p%SeaSt_Interp_p%n(2)) + 1 ! 1st n index is time - iY = (iGrid-1) / p%SeaSt_Interp_p%n(2) + 1 + do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) + iX = mod(iGrid-1, p%WaveField%SeaSt_Interp_p%n(2)) + 1 ! 1st n index is time + iY = (iGrid-1) / p%WaveField%SeaSt_Interp_p%n(2) + 1 CALL ApplyFFT_cx ( p%WaveExctnGrid(0:InitInp%NStepWave-1,iX,iY,J), WaveExctnCGrid(:,iGrid,J), FFT_Data, ErrStat2 ) CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN @@ -1182,10 +1183,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot - SS_Exctn_InitInp%SeaSt_Interp_p = InitInp%SeaSt_Interp_p SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp - SS_Exctn_InitInp%WaveField => InitInp%WaveField + SS_Exctn_InitInp%WaveField => p%WaveField ! We have been passed a pointer to WaveElev0 for use by the State Space excitation module. ! If the special case shown below is not used, then the state space model simply uses WaveElev0, as is. @@ -1206,7 +1206,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the frequency of this component: - Omega = I*InitInp%WaveField%WaveDOmega + Omega = I*p%WaveField%WaveDOmega ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) @@ -1214,7 +1214,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS TmpIm = -sin(tmpAngle) Fxy = CMPLX( TmpRe, TmpIm ) - tmpComplexArr(I) = Fxy*CMPLX(InitInp%WaveField%WaveElevC0(1,I), InitInp%WaveField%WaveElevC0(2,I)) + tmpComplexArr(I) = Fxy*CMPLX(p%WaveField%WaveElevC0(1,I), p%WaveField%WaveElevC0(2,I)) end do @@ -1847,7 +1847,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E END IF iStart = (iBody-1)*6+1 ! WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for each WAMIT Body - m%F_Waves1(iStart:iStart+5) = SeaSt_Interp_3D_Vec6( Time, bodyPosition, p%WaveExctnGrid(:,:,:,iStart:iStart+5), p%SeaSt_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + m%F_Waves1(iStart:iStart+5) = SeaSt_Interp_3D_Vec6( Time, bodyPosition, p%WaveExctnGrid(:,:,:,iStart:iStart+5), p%WaveField%SeaSt_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SeaState_CalcOutput' ) END DO end if diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 9823937a68..3db557b378 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -42,8 +42,7 @@ typedef ^ ^ Conv_Rdtn_I typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ INTEGER WaveMod - - - "" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - -typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # # @@ -121,7 +120,7 @@ typedef ^ ^ Conv_Rdtn_P typedef ^ ^ SS_Rad_ParameterType SS_Rdtn - - - "" - typedef ^ ^ SS_Exc_ParameterType SS_Exctn - - - "" - typedef ^ ^ DbKi DT - - - "" - -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "parameter information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 101b780cfc..df37499e43 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -61,7 +61,6 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE WAMIT_InitInputType ! ======================= @@ -132,7 +131,7 @@ MODULE WAMIT_Types TYPE(SS_Rad_ParameterType) :: SS_Rdtn !< [-] TYPE(SS_Exc_ParameterType) :: SS_Exctn !< [-] REAL(DbKi) :: DT = 0.0_R8Ki !< [-] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE WAMIT_ParameterType ! ======================= ! ========= WAMIT_InputType ======= @@ -261,9 +260,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveMod = SrcInitInputData%WaveMod - call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -299,8 +295,6 @@ subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if call Conv_Rdtn_DestroyInitInput(InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitInputData%WaveField) end subroutine @@ -361,7 +355,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMod) - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -511,7 +504,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1155,9 +1147,7 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstParamData%DT = SrcParamData%DT - call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + DstParamData%WaveField => SrcParamData%WaveField end subroutine subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1190,14 +1180,14 @@ subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call SS_Exc_DestroyParam(ParamData%SS_Exctn, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(ParamData%WaveField) end subroutine subroutine WAMIT_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackParam' + logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NBody) call RegPack(Buf, InData%NBodyMod) @@ -1236,7 +1226,13 @@ subroutine WAMIT_PackParam(Buf, Indata) call SS_Rad_PackParam(Buf, InData%SS_Rdtn) call SS_Exc_PackParam(Buf, InData%SS_Exctn) call RegPack(Buf, InData%DT) - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1247,6 +1243,8 @@ subroutine WAMIT_UnPackParam(Buf, OutData) integer(IntKi) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return @@ -1339,7 +1337,26 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call SS_Exc_UnpackParam(Buf, OutData%SS_Exctn) ! SS_Exctn call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if end subroutine subroutine WAMIT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 74b40cbefd..c8ffabbc84 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -20,8 +20,9 @@ MODULE SeaSt_WaveField CONTAINS !-------------------- Subroutine for wave elevation ------------------! -FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -29,7 +30,6 @@ FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeWaveElev1 REAL(SiKi) :: Zeta - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev1' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -38,7 +38,7 @@ FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev1)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Zeta = 0.0_SiKi @@ -48,8 +48,9 @@ FUNCTION WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat, ErrMsg ) END FUNCTION WaveField_GetNodeWaveElev1 -FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -57,7 +58,6 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeWaveElev2 REAL(SiKi) :: Zeta - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev2' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -66,7 +66,7 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev2)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Zeta = 0.0_SiKi @@ -76,8 +76,9 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat, ErrMsg ) END FUNCTION WaveField_GetNodeWaveElev2 -FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation @@ -85,7 +86,6 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) REAL(SiKi) :: WaveField_GetNodeTotalWaveElev REAL(SiKi) :: Zeta1, Zeta2 - !LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeTotalWaveElev' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -93,17 +93,18 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - Zeta1 = WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + Zeta1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta2 = WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + Zeta2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 END FUNCTION WaveField_GetNodeTotalWaveElev -SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, Time, pos, r, n, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, SeaSt_Interp_m, Time, pos, r, n, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. REAL(ReKi), INTENT( IN ) :: r ! Distance for central differencing @@ -120,15 +121,15 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, Time, pos, r, n, ErrStat, Err r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) @@ -138,8 +139,9 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, Time, pos, r, n, ErrStat, Err END SUBROUTINE WaveField_GetNodeWaveNormal !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT( INOUT ) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater @@ -156,8 +158,6 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveKin' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -170,9 +170,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod FAMCF(:) = 0.0 ! Wave elevation - WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev = WaveElev1 + WaveElev2 @@ -181,16 +181,16 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) + FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) + FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, seast_interp_m, ErrStat2, ErrMsg2 ) + FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ELSE ! Node is above the SWL @@ -212,23 +212,23 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) + FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) + FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, seast_interp_m, ErrStat2, ErrMsg2 ) + FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) + FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching - CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) + CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV(:) = SeaSt_Interp_4D_vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -243,14 +243,14 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF END IF @@ -294,8 +294,9 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, Time, pos, forceNodeInWater, nod END SUBROUTINE WaveField_GetNodeWaveKin !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(3) LOGICAL, INTENT( IN ) :: forceNodeInWater @@ -306,8 +307,6 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nod REAL(SiKi) :: WaveElev REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m - LOGICAL :: FirstWarn_Clamp CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVel' INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 @@ -319,7 +318,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nod posXY0 = (/pos(1),pos(2),0.0_ReKi/) ! Wave elevation - WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, Time, pos, ErrStat2, ErrMsg2 ) + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (WaveField%WaveStMod == 0) THEN ! No wave stretching @@ -362,7 +361,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nod ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -394,8 +393,9 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, Time, pos, forceNodeInWater, nod END SUBROUTINE WaveField_GetNodeWaveVel -SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) +SUBROUTINE WaveField_GetWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField + TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(:,:) LOGICAL, INTENT( IN ) :: forceNodeInWater @@ -422,7 +422,7 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, Time, pos, forceNodeInWater, nodeInW NumPoints = size(pos, dim=2) DO i = 1, NumPoints - CALL WaveField_GetNodeWaveKin( WaveField, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynP(i) = REAL(FDynP_node,ReKi) FV(:, i) = REAL(FV_node, ReKi) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index de29ed7dd8..300482704e 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -726,7 +726,7 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveKin positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) - CALL WaveField_GetNodeWaveKin( p%WaveField, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%seast_interp_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -734,9 +734,9 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO diff --git a/modules/seastate/src/SeaState_Interp.f90 b/modules/seastate/src/SeaState_Interp.f90 index 1b921bc40d..143ad80180 100644 --- a/modules/seastate/src/SeaState_Interp.f90 +++ b/modules/seastate/src/SeaState_Interp.f90 @@ -408,7 +408,7 @@ FUNCTION SeaSt_Interp_4D_Vec( pKinXX, m, ErrStat, ErrMsg ) ! I/O variables real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN ) :: m !< Parameters + TYPE(SeaSt_Interp_MiscVarType), INTENT(IN ) :: m !< misc vars for interpolation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None diff --git a/modules/seastate/src/SeaState_Interp.txt b/modules/seastate/src/SeaState_Interp.txt index 7373451f90..44b897843c 100644 --- a/modules/seastate/src/SeaState_Interp.txt +++ b/modules/seastate/src/SeaState_Interp.txt @@ -24,11 +24,11 @@ typedef ^ InitOutputType ProgDesc Ver - # ..... 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 SiKi N3D {8} - - "this is the 3-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field" - -typedef ^ MiscVarType SiKi N4D {16} - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field" - -typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field" - -typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field" - -typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - +typedef ^ MiscVarType SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - +typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - +typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index bc0ca2fcfd..e02fbe8fc2 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -48,10 +48,10 @@ MODULE SeaState_Interp_Types ! ======================= ! ========= SeaSt_Interp_MiscVarType ======= TYPE, PUBLIC :: SeaSt_Interp_MiscVarType - REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the 3-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] END TYPE SeaSt_Interp_MiscVarType ! ======================= From ee52170f5f8b643f94bd47b6c149b76b8e8bc4eb Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 6 Nov 2023 13:38:30 -0700 Subject: [PATCH 043/232] SeaSt: use `WtrDpth` and `EffWtrDpth` instead of current method of using WtrDpth for both. --- modules/seastate/src/Current.f90 | 14 ++--- modules/seastate/src/Current.txt | 2 +- modules/seastate/src/Current_Types.f90 | 8 +-- modules/seastate/src/SeaState_Input.f90 | 15 ++---- modules/seastate/src/SeaState_Output.f90 | 18 +++---- modules/seastate/src/Waves.f90 | 36 ++++++------- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves2.f90 | 68 ++++++++++++------------ modules/seastate/src/Waves2.txt | 1 - modules/seastate/src/Waves2_Types.f90 | 5 -- modules/seastate/src/Waves_Types.f90 | 5 -- 11 files changed, 76 insertions(+), 97 deletions(-) diff --git a/modules/seastate/src/Current.f90 b/modules/seastate/src/Current.f90 index 68af11a166..5d57f642e5 100644 --- a/modules/seastate/src/Current.f90 +++ b/modules/seastate/src/Current.f90 @@ -42,7 +42,7 @@ MODULE Current !JASON: MOVE THIS USER-DEFINED ROUTINE (UserCurrent) TO THE UserSubs.f90 OF HydroDyn WHEN THE PLATFORM LOADING FUNCTIONALITY HAS BEEN DOCUMENTED!!!!! !> This is a dummy routine for holding the place of a user-specified !! current profile. Modify this code to create your own profile. -SUBROUTINE UserCurrent ( zi, WtrDpth, DirRoot, CurrVxi, CurrVyi ) +SUBROUTINE UserCurrent ( zi, EffWtrDpth, DirRoot, CurrVxi, CurrVyi ) IMPLICIT NONE @@ -51,8 +51,8 @@ SUBROUTINE UserCurrent ( zi, WtrDpth, DirRoot, CurrVxi, CurrVyi ) REAL(SiKi), INTENT(OUT) :: CurrVxi !< xi-component of the current velocity at elevation zi, m/s. REAL(SiKi), INTENT(OUT) :: CurrVyi !< yi-component of the current velocity at elevation zi, m/s. - REAL(SiKi), INTENT(IN ) :: WtrDpth !< Water depth ( WtrDpth > 0 ), meters. - REAL(SiKi), INTENT(IN ) :: zi !< Elevation (-WtrDpth <= zi <= 0 ), meters. + REAL(SiKi), INTENT(IN ) :: EffWtrDpth !< Effective water depth ( EffWtrDpth > 0 ), meters. + REAL(SiKi), INTENT(IN ) :: zi !< Elevation (-EffWtrDpth <= zi <= 0 ), meters. CHARACTER(*), INTENT(IN ) :: DirRoot !< The name of the root file including the full path to the current working directory. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. @@ -86,7 +86,7 @@ SUBROUTINE Calc_Current( InitInp, z, h , DirRoot, CurrVxi, CurrVyi ) REAL(SiKi), INTENT(OUT) :: CurrVxi !< xi-component of the current velocity at elevation z (m/s) REAL(SiKi), INTENT(OUT) :: CurrVyi !< yi-component of the current velocity at elevation z (m/s) - REAL(SiKi), INTENT(IN ) :: h !< Water depth (meters) This quantity must be positive-valued + REAL(SiKi), INTENT(IN ) :: h !< Effective water depth (meters) This quantity must be positive-valued REAL(SiKi), INTENT(IN ) :: z !< Elevation relative to the mean sea level (meters) CHARACTER(*), INTENT(IN ) :: DirRoot !< The name of the root file including the full path to the current working directory. !! This may be useful if you want this routine to write a permanent record of what it does @@ -207,7 +207,7 @@ SUBROUTINE Current_Init( InitInp, InitOut, ErrStat, ErrMsg ) DO I = 1, InitInp%NGridPts - CALL Calc_Current( InitInp, InitInp%WaveKinGridzi(I), InitInp%WtrDpth, InitInp%DirRoot, CurrVxi, CurrVyi ) + CALL Calc_Current( InitInp, InitInp%WaveKinGridzi(I), InitInp%EffWtrDpth, InitInp%DirRoot, CurrVxi, CurrVyi ) InitOut%CurrVxi(I) = CurrVxi InitOut%CurrVyi(I) = CurrVyi @@ -218,8 +218,8 @@ SUBROUTINE Current_Init( InitInp, InitOut, ErrStat, ErrMsg ) ! Compute the partial derivative for wave stretching - CALL Calc_Current( InitInp, 0.0_SiKi, InitInp%WtrDpth, InitInp%DirRoot, CurrVxi0, CurrVyi0 ) - CALL Calc_Current( InitInp, -SmllNmbr, InitInp%WtrDpth, InitInp%DirRoot, CurrVxiS, CurrVyiS ) + CALL Calc_Current( InitInp, 0.0_SiKi, InitInp%EffWtrDpth, InitInp%DirRoot, CurrVxi0, CurrVyi0 ) + CALL Calc_Current( InitInp, -SmllNmbr, InitInp%EffWtrDpth, InitInp%DirRoot, CurrVxiS, CurrVyiS ) InitOut%PCurrVxiPz0 = ( CurrVxi0 - CurrVxiS )/SmllNmbr ! xi-direction InitOut%PCurrVyiPz0 = ( CurrVyi0 - CurrVyiS )/SmllNmbr ! yi-direction diff --git a/modules/seastate/src/Current.txt b/modules/seastate/src/Current.txt index a0a501ac32..f4f6ccd0e3 100644 --- a/modules/seastate/src/Current.txt +++ b/modules/seastate/src/Current.txt @@ -27,7 +27,7 @@ typedef ^ ^ SiKi Cu typedef ^ ^ SiKi CurrDIV - - - "" - typedef ^ ^ SiKi CurrDIDir - - - "" - typedef ^ ^ INTEGER CurrMod - - - "" - -typedef ^ ^ SiKi WtrDpth - - - "" - +typedef ^ ^ SiKi EffWtrDpth - - - "" - typedef ^ ^ SiKi WaveKinGridzi {:} - - "" - typedef ^ ^ INTEGER NGridPts - - - "" - typedef ^ ^ CHARACTER(1024) DirRoot - "" - "" - diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index f33e649352..e0893fc9ac 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -44,7 +44,7 @@ MODULE Current_Types REAL(SiKi) :: CurrDIV = 0.0_R4Ki !< [-] REAL(SiKi) :: CurrDIDir = 0.0_R4Ki !< [-] INTEGER(IntKi) :: CurrMod = 0_IntKi !< [-] - REAL(SiKi) :: WtrDpth = 0.0_R4Ki !< [-] + REAL(SiKi) :: EffWtrDpth = 0.0_R4Ki !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< [-] INTEGER(IntKi) :: NGridPts = 0_IntKi !< [-] CHARACTER(1024) :: DirRoot !< [-] @@ -80,7 +80,7 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir DstInitInputData%CurrMod = SrcInitInputData%CurrMod - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%EffWtrDpth = SrcInitInputData%EffWtrDpth if (allocated(SrcInitInputData%WaveKinGridzi)) then LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) @@ -123,7 +123,7 @@ subroutine Current_PackInitInput(Buf, Indata) call RegPack(Buf, InData%CurrDIV) call RegPack(Buf, InData%CurrDIDir) call RegPack(Buf, InData%CurrMod) - call RegPack(Buf, InData%WtrDpth) + call RegPack(Buf, InData%EffWtrDpth) call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) @@ -160,7 +160,7 @@ subroutine Current_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%CurrMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) + call RegUnpack(Buf, OutData%EffWtrDpth) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) call RegUnpack(Buf, IsAllocAssoc) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 3108cc9e4e..c09d20c81c 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -533,20 +533,13 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WtrDens - Water density. - if ( InputFileData%WtrDens < 0.0 ) then call SetErrStat( ErrID_Fatal,'WtrDens must not be negative.',ErrStat,ErrMsg,RoutineName) return end if - ! WtrDpth - Water depth - - ! First adjust water depth based on MSL2SWL values - InputFileData%Waves%WtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL - - - if ( InputFileData%Waves%WtrDpth <= 0.0 ) then + if ( InputFileData%WtrDpth + InputFileData%MSL2SWL <= 0.0 ) then call SetErrStat( ErrID_Fatal,'WtrDpth + MSL2SWL must be greater than zero.',ErrStat,ErrMsg,RoutineName) return end if @@ -564,8 +557,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er end if ! Z_Depth - Depth of the domain the Z direction (m) - - if ( ( InputFileData%Z_Depth <= 0.0_ReKi ) .or. ( InputFileData%Z_Depth > InputFileData%Waves%WtrDpth ) ) then + if ( ( InputFileData%Z_Depth <= 0.0_ReKi ) .or. ( InputFileData%Z_Depth > InputFileData%WtrDpth + InputFileData%MSL2SWL ) ) then call SetErrStat( ErrID_Fatal,'Z_Depth must be greater than zero and less than or equal to the WtrDpth + MSL2SWL.',ErrStat,ErrMsg,RoutineName) return end if @@ -1119,7 +1111,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Current ! For wave kinematic calculations, the effective water depth is the user input water depth (positive valued) + MSL2SWL (positive when SWL is above MSL). - InputFileData%Current%WtrDpth = InputFileData%Waves%WtrDpth ! already adjusted for the MSL2SWL. + InputFileData%Current%EffWtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL ! adjusted for the MSL2SWL. ! Waves @@ -1191,7 +1183,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er InputFileData%Waves2%NWaveKinGrid = InputFileData%Waves%NWaveKinGrid ! Number of points where the incident wave kinematics will be computed (-) if ( InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) then InputFileData%Waves2%Gravity = InitInp%Gravity - InputFileData%Waves2%WtrDpth = InputFileData%Waves%WtrDpth InputFileData%Waves2%NGrid = p%NGrid InputFileData%Waves2%NWaveElevGrid = InputFileData%Waves%NWaveElevGrid diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 4c4ab386f0..c5e601a261 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -1030,12 +1030,12 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS WRITE( UnSum, '(A/)') trim(GetVersion(SeaSt_ProgDesc)) IF (InputFileData%Waves%WaveMod /= 0 .and. InputFileData%Waves%WaveMod /= 6) THEN - WRITE( UnSum, '(1X,A61,F8.2,A4/)' ) 'The Mean Sea Level to Still Water Level (MSL2SWL) Offset is :',InputFileData%MSL2SWL,' (m)' - WRITE( UnSum, '(1X,A15,F8.2,A8)' ) 'Water Density: ', InputFileData%WtrDens, '(kg/m^3)' - WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19)' ) 'Water Depth : ', InputFileData%Waves%WtrDpth - InputFileData%MSL2SWL, '(m) relative to MSL; ', & - InputFileData%Waves%WtrDpth, '(m) relative to SWL' - WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19/)' ) 'Grid Z_Depth : ', InputFileData%Z_Depth - InputFileData%MSL2SWL, '(m) relative to MSL; ', & - InputFileData%Z_Depth, '(m) relative to SWL' + WRITE( UnSum, '(1X,A61,F8.2,A4/)' ) 'The Mean Sea Level to Still Water Level (MSL2SWL) Offset is :',p%WaveField%MSL2SWL,' (m)' + WRITE( UnSum, '(1X,A15,F8.2,A8)' ) 'Water Density: ', p%WaveField%WtrDens, '(kg/m^3)' + WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19)' ) 'Water Depth : ', p%WaveField%WtrDpth, '(m) relative to MSL; ', & + p%WaveField%EffWtrDpth, '(m) relative to SWL' + WRITE( UnSum, '(1X,A15,F8.2,A20,F8.2,A19/)' ) 'Grid Z_Depth : ', InputFileData%Z_Depth - p%WaveField%MSL2SWL, '(m) relative to MSL; ', & + InputFileData%Z_Depth, '(m) relative to SWL' end if Frmt = '(1X,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2)' @@ -1045,7 +1045,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS WRITE( UnSum, '(1X,A78)' ) ' Xi Yi Zi relative to MSL Z relative to SWL' do i= 1, p%NGridPts ! NOTE: The Waves%WaveKinxi, yi, zi arrays hold all the grid point locations - WRITE(UnSum,Frmt) InputFileData%Waves%WaveKinGridxi(i), InputFileData%Waves%WaveKinGridyi(i), InputFileData%Waves%WaveKinGridzi(i) + InputFileData%MSL2SWL, InputFileData%Waves%WaveKinGridzi(i) + WRITE(UnSum,Frmt) InputFileData%Waves%WaveKinGridxi(i), InputFileData%Waves%WaveKinGridyi(i), InputFileData%Waves%WaveKinGridzi(i) + p%WaveField%MSL2SWL, InputFileData%Waves%WaveKinGridzi(i) end do ! ! Write User-requested Wave Kinematics locations @@ -1057,7 +1057,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS Frmt = '(1X,I5, 2X,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2,2x,ES18.4e2)' do i= 1, p%NWaveKin ! NOTE: The InputFileData%WaveKinxi, yi, zi arrays hold the User-request kinematics output locations - WRITE(UnSum,Frmt) i, p%WaveKinxi(i), p%WaveKinyi(i), p%WaveKinzi(i) + InputFileData%MSL2SWL, p%WaveKinzi(i) + WRITE(UnSum,Frmt) i, p%WaveKinxi(i), p%WaveKinyi(i), p%WaveKinzi(i) + p%WaveField%MSL2SWL, p%WaveKinzi(i) end do else @@ -1097,7 +1097,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS ! Write the data DO I = -1*Waves_InitOut%NStepWave2+1,Waves_InitOut%NStepWave2 - WaveNmbr = WaveNumber ( I*p%WaveField%WaveDOmega, InitInp%Gravity, InputFileData%Waves%WtrDpth ) + WaveNmbr = WaveNumber ( I*p%WaveField%WaveDOmega, InitInp%Gravity, p%WaveField%EffWtrDpth ) WRITE( UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*p%WaveField%WaveDOmega, & p%WaveField%WaveDirArr(ABS(I)), p%WaveField%WaveElevC0( 1,ABS(I ) ) , p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) END DO diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 2fe6ce7b99..b615b42d6e 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -711,8 +711,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) NWaveKin0Prime = 0 DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN NWaveKin0Prime = NWaveKin0Prime + 1 END IF END DO ! J - All Morison nodes where the incident wave kinematics will be computed @@ -736,8 +736,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) I = 1 DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) WaveKinPrimeMap(I) = J @@ -1036,7 +1036,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) ! some redundant calculations with later, but insignificant - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, InitInp%WtrDpth ) + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) ! apply the phase shift tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) @@ -1069,7 +1069,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Compute the wavenumber: - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, InitInp%WtrDpth ) + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) ! Wavenumber-dependent acceleration scaling for MacCamy-Fuchs model MCFC = 0.0_ReKi @@ -1090,12 +1090,12 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & InitInp%WaveKinGridyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) - WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) + WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, InitInp%WtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) @@ -1116,14 +1116,14 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) ! Partial derivatives at zi = 0 - PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*InitInp%WtrDpth ) + PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*WaveField%EffWtrDpth ) PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr IF (I == 0_IntKi) THEN ! Zero frequency component - Need to avoid division by zero. PWaveVelC0VPz0 (I,J) = 0.0_ReKi ELSE - PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*InitInp%WtrDpth ) + PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*WaveField%EffWtrDpth ) END IF PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) @@ -1352,9 +1352,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! jj = mod( (count-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 ! kk = (count-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 - IF ( ( InitInp%WaveKinGridzi(count) < -InitInp%WtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN + IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and WtrDpth have already been adjusted using MSL2SWL + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL WaveField%WaveDynP(:,i,j,k ) = 0.0 WaveField%WaveVel (:,i,j,k,:) = 0.0 @@ -1384,9 +1384,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) do k = 1, InitInp%NGrid(3) do j = 1, InitInp%NGrid(2) do i = 1, InitInp%NGrid(1) - IF ( ( InitInp%WaveKinGridzi(count) < -InitInp%WtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN + IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and WtrDpth have already been adjusted using MSL2SWL + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL WaveField%WaveAccMCF(:,i,j,k,:) = 0.0 ELSE ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) @@ -1528,7 +1528,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tm ! Loop through the positive frequency components (including zero). DO I = 0,InitOut%NStepWave2 - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, InitInp%WtrDpth ) + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) tmpComplexArr(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) * & EXP( -ImagNmbr*WaveNmbr*( Xcoord*CosWaveDir(I)+ & Ycoord*SinWaveDir(I) ) ) @@ -2470,7 +2470,7 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ! Modify the wave phase so that the crest shows up at the right place and the right time DO I = 1,InitOut%NStepWave2-1 - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, InitInp%WtrDpth ) + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) ConstWavePhase = WaveNmbr*(CosWaveDir(I)*InitInp%CrestXi + & SinWaveDir(I)*InitInp%CrestYi) - & OmegaArr(I)*InitInp%CrestTime diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 6242c0dd26..6f8a0cf285 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -37,7 +37,6 @@ typedef ^ ^ CHARACTER(80) WavePkShpCh typedef ^ ^ INTEGER WaveSeed {2} - - "Random seeds of incident waves [-2147483648 to 2147483647]" - typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (meters) typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations are computed (the XY grid point locations)" - typedef ^ ^ INTEGER NWaveKinGrid - - - "Number of grid points where the incident wave kinematics will be computed" - typedef ^ ^ SiKi WaveKinGridxi {:} - - "xi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level" (meters) diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index 113bcab12a..5925f07527 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -273,14 +273,14 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) ! Since we have no stretching, NWaveKin0Prime and WaveKinzi0Prime(:) are ! equal to the number of, and the zi-coordinates for, the points in the - ! WaveKinGridzi(:) array between, and including, -WtrDpth and 0.0. + ! WaveKinGridzi(:) array between, and including, -EffWtrDpth and 0.0. ! Determine NWaveKin0Prime here: NWaveKin0Prime = 0 DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN NWaveKin0Prime = NWaveKin0Prime + 1 END IF END DO ! J - All Morison nodes where the incident wave kinematics will be computed @@ -304,8 +304,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) I = 1 DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and WtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -InitInp%WtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) WaveKinPrimeMap(I) = J @@ -548,8 +548,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) n = mu_minus + m Omega_n = n * WaveField%WaveDOmega Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) k_nm = k_nm_minus( n, m, k_n, k_m ) @@ -573,7 +573,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> Calculate \f$ U^- \f$ terms for the velocity calculations (\f$B^-\f$ provided by waves2::transfuncb_minus) - ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor + ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nm}^- = B_{nm}^- \left(k_n \cos \theta_n - k_m \cos \theta_m \right) \f$ Ux_nm_minus = B_minus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) - k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) @@ -581,7 +581,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) Uy_nm_minus = B_minus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) - k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _z{U}_{nm}^- = \imath B_{nm}^- k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ - Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) + Uz_nm_minus = ImagNmbr * B_minus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) !> Acceleration calculations @@ -924,7 +924,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) Omega_plus = 2.0_SiKi * Omega_n IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) k_nm = k_nm_plus( n, n, k_n, k_n ) @@ -948,7 +948,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) - ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor + ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nn}^+ = B_{nn}^+ 2 k_n \cos \theta_n \f$ Ux_nm_plus = B_plus * 2.0_SiKi * k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) @@ -956,7 +956,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) Uy_nm_plus = B_plus * 2.0_SiKi * k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) !> * \f$ _z{U}_{nn}^+ = \imath B_{nn}^+ k_{nn} \tanh \left( k_{nn} ( h + z ) \right) \f$ - Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) + Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) !> Acceleration calculations @@ -1025,8 +1025,8 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) n = mu_plus - m Omega_n = n * WaveField%WaveDOmega Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) k_nm = k_nm_plus( n, m, k_n, k_m ) @@ -1050,7 +1050,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !> Calculate \f$ U^+ \f$ terms for the velocity calculations (\f$B^+\f$ provided by waves2::transfuncb_plus) - ! NOTE: InitInp%WtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor + ! NOTE: WaveField%EffWtrDpth + WaveKinzi0Prime(I) is the height above the ocean floor !> * \f$ _x{U}_{nm}^+ = B_{nm}^+ \left(k_n \cos \theta_n + k_m \cos \theta_m \right) \f$ Ux_nm_plus = B_plus * ( k_n * COS( D2R_S*WaveField%WaveDirArr(n) ) + k_m * COS( D2R_S*WaveField%WaveDirArr(m) ) ) @@ -1058,7 +1058,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) Uy_nm_plus = B_plus * ( k_n * SIN( D2R_S*WaveField%WaveDirArr(n) ) + k_m * SIN( D2R_S*WaveField%WaveDirArr(m) ) ) !> * \f$ _z{U}_{nm}^+ = \imath B_{nm}^+ k_{nm} \tanh \left( k_{nm} ( h + z ) \right) \f$ - Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( InitInp%WtrDpth + WaveKinzi0Prime(I) ) ) + Uz_nm_plus = ImagNmbr * B_plus * k_nm * tanh( k_nm * ( WaveField%EffWtrDpth + WaveKinzi0Prime(I) ) ) !> Acceleration calculations @@ -1324,10 +1324,10 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta n = mu_minus + m Omega_n = n * WaveField%WaveDOmega Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) D_minus = TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) !> Calculate the value of @@ -1451,8 +1451,8 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat Omega_plus = 2.0_SiKi * Omega_n IF ( Omega_plus >= WaveField%WvLowCOffS .AND. Omega_plus <= WaveField%WvHiCOffS ) THEN - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) D_plus = TransFuncD_plus(n,n,k_n,k_n,R_n,R_n) !> Calculate the value of @@ -1517,10 +1517,10 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat n = mu_plus - m Omega_n = n * WaveField%WaveDOmega Omega_m = m * WaveField%WaveDOmega - k_n = WaveNumber( Omega_n, InitInp%Gravity, InitInp%WtrDpth ) - k_m = WaveNumber( Omega_m, InitInp%Gravity, InitInp%WtrDpth ) - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + k_n = WaveNumber( Omega_n, InitInp%Gravity, WaveField%EffWtrDpth ) + k_m = WaveNumber( Omega_m, InitInp%Gravity, WaveField%EffWtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) !> Calculate the value of @@ -1636,8 +1636,8 @@ FUNCTION TransFuncB_minus(n,m,k_n,k_m,z) k_nm = k_nm_minus( n,m,k_n,k_m ) ! Effect of depth scaling - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) ! Transfer function D_minus D_minus = TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) @@ -1645,7 +1645,7 @@ FUNCTION TransFuncB_minus(n,m,k_n,k_m,z) ! Calculation of B_minus TransFuncB_minus = REAL(InitInp%Gravity*InitInp%Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & - * COSHNumOvrCOSHDen(k_nm, REAL(InitInp%WtrDpth,SiKi), z) * D_minus / ( Omega_n - Omega_m ) + * COSHNumOvrCOSHDen(k_nm, REAL(WaveField%EffWtrDpth,SiKi), z) * D_minus / ( Omega_n - Omega_m ) ENDIF @@ -1698,15 +1698,15 @@ FUNCTION TransFuncB_plus(n,m,k_n,k_m,z) k_nm = k_nm_plus( n,m,k_n,k_m ) ! Effect of depth scaling - R_n = k_n * tanh( k_n * InitInp%WtrDpth ) - R_m = k_m * tanh( k_m * InitInp%WtrDpth ) + R_n = k_n * tanh( k_n * WaveField%EffWtrDpth ) + R_m = k_m * tanh( k_m * WaveField%EffWtrDpth ) ! Transfer function D_plus D_plus = TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) ! Calculation of B_plus TransFuncB_plus = REAL(InitInp%Gravity*InitInp%Gravity,SiKi) / ( 4.0_SiKi * Omega_n * Omega_m ) & - * COSHNumOvrCOSHDen(k_nm, REAL(InitInp%WtrDpth,SiKi), z) * D_plus / ( Omega_n + Omega_m ) + * COSHNumOvrCOSHDen(k_nm, REAL(WaveField%EffWtrDpth,SiKi), z) * D_plus / ( Omega_n + Omega_m ) ENDIF @@ -1824,7 +1824,7 @@ FUNCTION TransFuncD_minus(n,m,k_n,k_m,R_n,R_m) Num2 = 2*SqrtRnMinusRm*SqrtRnMinusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) + R_n*R_m ) ! Calculate the denominator - Den = SqrtRnMinusRm*SqrtRnMinusRm - k_nm * tanh( k_nm * InitInp%WtrDpth ) + Den = SqrtRnMinusRm*SqrtRnMinusRm - k_nm * tanh( k_nm * WaveField%EffWtrDpth ) TransFuncD_minus = (Num1+Num2) / Den @@ -1888,7 +1888,7 @@ FUNCTION TransFuncD_plus(n,m,k_n,k_m,R_n,R_m) Num2 = 2*SqrtRnPlusRm*SqrtRnPlusRm*( k_n * k_m * COS( D2R_S*WaveField%WaveDirArr(n) - D2R_S*WaveField%WaveDirArr(m) ) - R_n*R_m ) ! Calculate the denominator - Den = SqrtRnPlusRm*SqrtRnPlusRm - k_nm * tanh( k_nm * InitInp%WtrDpth ) + Den = SqrtRnPlusRm*SqrtRnPlusRm - k_nm * tanh( k_nm * WaveField%EffWtrDpth ) TransFuncD_plus = (Num1+Num2) / Den diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 5e0e1777b0..363b29017b 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -19,7 +19,6 @@ include Registry_NWTC_Library.txt # e.g., the name of the input file, the file root name,etc. # typedef Waves2/Waves2 InitInputType ReKi Gravity - - - "Gravitational acceleration" (m/s^2) -typedef ^ ^ ReKi WtrDpth - - - "Water depth" (meters) typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index a3b97f8619..aff4cce40e 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -36,7 +36,6 @@ MODULE Waves2_Types ! ========= Waves2_InitInputType ======= TYPE, PUBLIC :: Waves2_InitInputType REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] @@ -80,7 +79,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er ErrStat = ErrID_None ErrMsg = '' DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir @@ -151,7 +149,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves2_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%WaveMultiDir) @@ -188,8 +185,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index ef3fcea5ab..a469081ccc 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -54,7 +54,6 @@ MODULE Waves_Types INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] @@ -116,7 +115,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax DstInitInputData%WaveTp = SrcInitInputData%WaveTp - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then @@ -246,7 +244,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveSeed) call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%WaveTp) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%NWaveElevGrid) call RegPack(Buf, InData%NWaveKinGrid) call RegPack(Buf, allocated(InData%WaveKinGridxi)) @@ -334,8 +331,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTp) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElevGrid) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveKinGrid) From 9add32c422c16b4b99f39f30a593b1936ca8e29e Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 6 Nov 2023 14:36:47 -0700 Subject: [PATCH 044/232] HD: use `EffWtrDpth` from WaveField instead of modified `WtrDpth` - also remove checks on WtrDens and WtrDpth that were already done in SeaState --- modules/hydrodyn/src/HydroDyn.f90 | 3 --- modules/hydrodyn/src/HydroDyn_Input.f90 | 22 ---------------------- modules/hydrodyn/src/Morison.f90 | 24 +++++++++++------------- modules/hydrodyn/src/Morison.txt | 2 -- modules/hydrodyn/src/Morison_Types.f90 | 10 ---------- modules/hydrodyn/src/WAMIT.f90 | 4 ++-- modules/hydrodyn/src/WAMIT.txt | 1 - modules/hydrodyn/src/WAMIT2.f90 | 12 ++++++------ modules/hydrodyn/src/WAMIT2.txt | 1 - modules/hydrodyn/src/WAMIT2_Types.f90 | 5 ----- modules/hydrodyn/src/WAMIT_Types.f90 | 5 ----- 11 files changed, 19 insertions(+), 70 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index f1916fffb5..947a75d1b6 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -189,7 +189,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I RETURN END IF - InputFileData%Morison%WtrDpth = InitInp%WaveField%WtrDpth InputFileData%Morison%WaveField => InitInp%WaveField InputFileData%WAMIT%WaveField => InitInp%WaveField @@ -290,7 +289,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%vecMultiplier = InputFileData%vecMultiplier ! Multiply all vectors and matrices row/column lengths by NBody InputFileData%WAMIT%NBodyMod = InputFileData%NBodyMod InputFileData%WAMIT%Gravity = InitInp%Gravity - InputFileData%WAMIT%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file p%NBody = InputFileData%NBody p%NBodyMod = InputFileData%NBodyMod call AllocAry( m%F_PtfmAdd, 6*InputFileData%NBody, "m%F_PtfmAdd", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -428,7 +426,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I InputFileData%WAMIT2%NStepWave = InitInp%NStepWave InputFileData%WAMIT2%NStepWave2 = InitInp%NStepWave2 InputFileData%WAMIT2%Gravity = InitInp%Gravity - InputFileData%WAMIT2%WtrDpth = InputFileData%Morison%WtrDpth ! The data in InputFileData%Morison%WtrDpth was directly placed there when we parsed the HydroDyn input file ! Set values for all NBodyMods InputFileData%WAMIT2%NBodyMod = InputFileData%NBodyMod ! There are restrictions in WAMIT2 on which files may be used for MnDriftF or NewmanAppF for BodyMod > 1 diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 9e74424680..856122177b 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1128,29 +1128,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! Check environmental conditions !------------------------------------------------------------------------- - - ! WtrDens - Water density. ! shouldn't this be checked in SeaState instead (and omitted here?) - - IF ( InitInp%WaveField%WtrDens < 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WtrDens must not be negative.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - - ! WtrDpth - Water depth - - ! First adjust water depth based on MSL2SWL values - InputFileData%Morison%WtrDpth = InputFileData%Morison%WtrDpth + InitInp%WaveField%MSL2SWL - - IF ( InputFileData%Morison%WtrDpth <= 0.0 ) THEN - CALL SetErrStat( ErrID_Fatal,'WtrDpth must be greater than zero.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - - ! MSL2SWL - Mean sea level to still water level - - IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InitInp%WaveField%MSL2SWL, 0.0_ReKi) ) THEN CALL SetErrStat( ErrID_Fatal,'SeaState MSL2SWL must be 0 when PotMod = 1 (WAMIT).',ErrStat,ErrMsg,RoutineName) RETURN diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 78ad9db674..2dea05984d 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1441,7 +1441,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn character(*), intent ( out) :: errMsg ! Error message if errStat /= ErrID_None integer(IntKi) :: N, i - real(ReKi) :: WtrDepth,s, dl + real(ReKi) :: s, dl real(ReKi) :: vec(3) real(ReKi) :: memLength real(ReKi) :: Za @@ -1461,7 +1461,6 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn errStat = ErrID_None errMSg = '' - WtrDepth = InitInp%WtrDpth N = member%NElements dl = member%dl @@ -1557,7 +1556,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%l_fill = 0.0_ReKi else member%z_overfill =0 - if ( Zb <= -InitInp%WtrDpth ) then + if ( Zb <= -InitInp%WaveField%EffWtrDpth ) then member%memfloodstatus = 0 ! member fully buried in seabed member%l_fill = 0 else @@ -1585,7 +1584,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn call SetErrStat(ErrID_Fatal, 'The lower end-plate of a member must not cross the water plane. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) end if end if - if ( ( Za < -WtrDepth .and. Zb >= -WtrDepth ) .and. ( phi > 10.0*d2r .or. abs((member%RMG(N+1) - member%RMG(1))/member%RefLength)>0.1 ) ) then + if ( ( Za < -InitInp%WaveField%EffWtrDpth .and. Zb >= -InitInp%WaveField%EffWtrDpth ) .and. ( phi > 10.0*d2r .or. abs((member%RMG(N+1) - member%RMG(1))/member%RefLength)>0.1 ) ) then call SetErrStat(ErrID_Fatal, 'A member which crosses the seabed must not be inclined more than 10 degrees from vertical or have a taper larger than 0.1. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) end if @@ -1596,20 +1595,20 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%h_floor = 0.0_ReKi member%i_floor = member%NElements+1 ! Default to entire member is below the seabed member%doEndBuoyancy = .false. - if (Za < -WtrDepth) then + if (Za < -InitInp%WaveField%EffWtrDpth) then do i= 2, member%NElements+1 Za = InitInp%Nodes(member%NodeIndx(i))%Position(3) - if (Za > -WtrDepth) then ! find the lowest node above the seabed + if (Za > -InitInp%WaveField%EffWtrDpth) then ! find the lowest node above the seabed if (cosPhi < 0.173648178 ) then ! phi > 80 degrees and member is seabed crossing call SetErrStat(ErrID_Fatal, 'A seabed crossing member must have an inclination angle of <= 80 degrees from vertical. This is not true for Member ID '//trim(num2lstr(member%MemberID)), errStat, errMsg, 'SetMemberProperties' ) end if - member%h_floor = (-WtrDepth-Za)/cosPhi ! get the distance from the node to the seabed along the member axis (negative value) + member%h_floor = (-InitInp%WaveField%EffWtrDpth-Za)/cosPhi ! get the distance from the node to the seabed along the member axis (negative value) member%i_floor = i-1 ! record the number of the element that pierces the seabed member%doEndBuoyancy = .true. exit - else if ( EqualRealNos(Za, -WtrDepth ) ) then + else if ( EqualRealNos(Za, -InitInp%WaveField%EffWtrDpth ) ) then member%doEndBuoyancy = .true. end if end do @@ -1714,7 +1713,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! Determine volumes to add to Non-WAMIT modeled members, etc. if (.not. member%PropPot) then - if (Zb < -WtrDepth) then + if (Zb < -InitInp%WaveField%EffWtrDpth) then ! fully buried element, do not add these volume contributions to totals else if (0.0 >= Zb) then ! Bug fix per OpenFAST issue #844 GJH 2/3/2022 ! fully submerged elements. @@ -1747,7 +1746,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn li = dl*(i-1) ! fully buried element - if (Zb < -WtrDepth) then + if (Zb < -InitInp%WaveField%EffWtrDpth) then member%floodstatus(i) = 0 ! fully filled elements @@ -1921,7 +1920,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In ! Define parameters here: p%DT = Interval - p%WtrDpth = InitInp%WtrDpth p%Gravity = InitInp%Gravity p%NNodes = InitInp%NNodes p%NJoints = InitInp%NJoints @@ -2123,7 +2121,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In tMG = -999.0 An_drag = 0.0 - IF ( (InitInp%InpJoints(i)%Position(3)-p%WaveField%MSL2SWL) >= -p%WtrDpth ) THEN + IF ( (InitInp%InpJoints(i)%Position(3)-p%WaveField%MSL2SWL) >= -InitInp%WaveField%EffWtrDpth ) THEN !bjj: ask Lu if this is correct. I wonder if this check is supposed to be against WtrDpth ! loop through each member attached to the joint, getting the radius of its appropriate end DO J = 1, InitInp%InpJoints(I)%NConnections @@ -2216,7 +2214,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%I_MG_End(:,:,i) = MatMul( MatMul(R_I, Irl_mat), Transpose(R_I) ) ! final moment of inertia matrix for node - END IF ! InitInp%InpJoints(i)%Position(3) >= -p%WtrDpth + END IF ! InitInp%InpJoints(i)%Position(3) >= -WtrDpth p%DragMod_End (i) = InitInp%Nodes(i)%JAxFDMod IF ( InitInp%Nodes(i)%JAxVnCOff .LE. 0.0_ReKi) THEN diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 78a76a371d..90fb49bf71 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -225,7 +225,6 @@ typedef ^ ^ INTEGER # e.g., the name of the input file, the file root name,etc. # typedef ^ InitInputType ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - typedef ^ ^ INTEGER NJoints - - - "Number of user-specified joints" - @@ -334,7 +333,6 @@ typedef ^ ^ SeaSt_Interp_Mi # typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" (sec) typedef ^ ^ ReKi Gravity - - - "Gravity (scalar, positive-valued)" m/s^2 -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m typedef ^ ^ INTEGER WaveDisp - - - "Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) " - typedef ^ ^ INTEGER AMMod - - - "Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState]" - typedef ^ ^ INTEGER NMembers - - - "number of members" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index ae222dc4d3..07a4d3449b 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -288,7 +288,6 @@ MODULE Morison_Types ! ========= Morison_InitInputType ======= TYPE, PUBLIC :: Morison_InitInputType REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] @@ -396,7 +395,6 @@ MODULE Morison_Types TYPE, PUBLIC :: Morison_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [(sec)] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] INTEGER(IntKi) :: NMembers = 0_IntKi !< number of members [-] @@ -3495,7 +3493,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E ErrStat = ErrID_None ErrMsg = '' DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp DstInitInputData%AMMod = SrcInitInputData%AMMod DstInitInputData%NJoints = SrcInitInputData%NJoints @@ -3846,7 +3843,6 @@ subroutine Morison_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveDisp) call RegPack(Buf, InData%AMMod) call RegPack(Buf, InData%NJoints) @@ -4008,8 +4004,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%AMMod) @@ -5389,7 +5383,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM ErrMsg = '' DstParamData%DT = SrcParamData%DT DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDpth = SrcParamData%WtrDpth DstParamData%WaveDisp = SrcParamData%WaveDisp DstParamData%AMMod = SrcParamData%AMMod DstParamData%NMembers = SrcParamData%NMembers @@ -5678,7 +5671,6 @@ subroutine Morison_PackParam(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveDisp) call RegPack(Buf, InData%AMMod) call RegPack(Buf, InData%NMembers) @@ -5801,8 +5793,6 @@ subroutine Morison_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%AMMod) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 77794470a3..9ae780e37d 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -1023,7 +1023,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS do J = 1, NInpWvDir do I = 1, NInpFreq ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) - WaveNmbr = WaveNumber ( HdroFreq(I), InitInp%Gravity, InitInp%WtrDpth ) + WaveNmbr = WaveNumber ( HdroFreq(I), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) TmpRe = cos(tmpAngle) TmpIm = -sin(tmpAngle) @@ -1208,7 +1208,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS Omega = I*p%WaveField%WaveDOmega ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) - WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) + WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) TmpRe = cos(tmpAngle) TmpIm = -sin(tmpAngle) diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 3db557b378..99e24bd793 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -22,7 +22,6 @@ usefrom SeaSt_WaveField.txt typedef WAMIT/WAMIT InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" m typedef ^ ^ ReKi PtfmVol0 {:} - - "" - typedef ^ ^ LOGICAL HasWAMIT - - - ".TRUE. if using WAMIT model, .FALSE. otherwise" - typedef ^ ^ ReKi WAMITULEN - - - "" - diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index a998ad0002..50b767c0f7 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -1827,7 +1827,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J)*D2R) ) PhaseShiftXY = CMPLX( cos(TmpReal1), -sin(TmpReal1) ) @@ -2296,8 +2296,8 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J+K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J+K)*D2R) ) TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(K)*D2R) ) @@ -2790,7 +2790,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J)*D2R) ) ! Set the phase shift for the set of sum frequencies @@ -2903,8 +2903,8 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! of above is mathematically equivalent, but only because each frequency has only one wave ! direction associated with it through the equal energy approach used in multidirectional waves. - WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned - WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WtrDpth ) ! SiKi returned + WaveNmbr1 = WaveNumber ( REAL(Omega1,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned + WaveNmbr2 = WaveNumber ( REAL(Omega2,SiKi), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) ! SiKi returned TmpReal1 = WaveNmbr1 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(K)*D2R) ) TmpReal2 = WaveNmbr2 * ( InitInp%PtfmRefxt(1)*cos(InitInp%WaveField%WaveDirArr(J-K)*D2R) + InitInp%PtfmRefyt(1)*sin(InitInp%WaveField%WaveDirArr(J-K)*D2R) ) diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 4c419435be..6ce9ba3822 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -31,7 +31,6 @@ typedef ^ ^ ReKi WAMITULEN typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) -typedef ^ ^ ReKi WtrDpth - - - "Water depth (positive-valued)" (m) typedef ^ ^ INTEGER WaveMod - - - "The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here." - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index c5baeb509f..b882fd5637 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -49,7 +49,6 @@ MODULE WAMIT2_Types INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(m)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] @@ -159,7 +158,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%MnDrift = SrcInitInputData%MnDrift @@ -230,7 +228,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, InData%WaveMod) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -332,8 +329,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index df37499e43..eb9b6dfc04 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -41,7 +41,6 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< [-] @@ -161,7 +160,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth if (allocated(SrcInitInputData%PtfmVol0)) then LB(1:1) = lbound(SrcInitInputData%PtfmVol0) UB(1:1) = ubound(SrcInitInputData%PtfmVol0) @@ -307,7 +305,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NBody) call RegPack(Buf, InData%NBodyMod) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDpth) call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) @@ -381,8 +378,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From a733f8e3f0ef57411cb34d8c24ef28ea3062e7d1 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 6 Nov 2023 17:30:36 -0700 Subject: [PATCH 045/232] Coupled pinned bodies --- modules/moordyn/src/MoorDyn.f90 | 120 +++++++++++++------- modules/moordyn/src/MoorDyn_Body.f90 | 133 ++++++++++++++++------- modules/moordyn/src/MoorDyn_Registry.txt | 6 +- 3 files changed, 175 insertions(+), 84 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index a3f12e8399..da79fe50a3 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -773,7 +773,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CG entry (col 10) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) end if - ! process mements of inertia + ! process moments of inertia CALL SplitByBars(tempString3, N, tempStrings) if (N == 1) then ! if only one entry, use it for all directions READ(tempString3, *) m%BodyList(l)%BodyI(1) @@ -839,6 +839,20 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%CpldBodyIs(p%nCpldBodies(1),1) = l ! body initial position due to coupling will be adjusted later + + else if ((let1 == "VESSELPINNED") .or. (let1 == "VESPIN") .or. (let1 == "COUPLEDPINNED") .or. (let1 == "CPLDPIN")) then ! if a pinned coupled body, add to list and add + m%BodyList(l)%typeNum = 2 + + p%nCpldBodies(1)=p%nCpldBodies(1)+1 ! add + p%nFreeBodies =p%nFreeBodies+1 ! add this pinned body to the free list because it is half free + + m%BodyStateIs1(p%nFreeBodies) = Nx+1 + m%BodyStateIsN(p%nFreeBodies) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned body + + m%CpldBodyIs(p%nCpldBodies(1),1) = l + m%FreeBodyIs(p%nFreeBodies) = l + ! TODO: add option for body coupling to different turbines in FAST.Farm <<< @@ -1010,7 +1024,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! TODO: add option for body coupling to different turbines in FAST.Farm <<< - else if ((let1 == "CONNECT") .or. (let1 == "CON") .or. (let1 == "FREE")) then + else if ((let1 == "ROD") .or. (let1 == "R") .or. (let1 == "FREE")) then m%RodList(l)%typeNum = 0 p%nFreeRods=p%nFreeRods+1 @@ -1949,7 +1963,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! >>> maybe this should be skipped <<<< - ! Go through Bodys and write the coordinates to the state vector + ! Go through free Bodys (including pinned) and write the coordinates to the state vector DO l = 1,p%nFreeBodies CALL Body_Initialize(m%BodyList(m%FreeBodyIs(l)), x%states(m%BodyStateIs1(l) : m%BodyStateIsN(l)), m) END DO @@ -2972,8 +2986,8 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er DO iTurb = 1,p%nTurbines DO l = 1,p%nCpldPoints(iTurb) - ! >>>>>>>> here we should pass along accelerations and include inertial loads in the calculation!!! <<>>>>>>> here we should pass along accelerations and include inertial loads in the calculation!!! << 0) print *, "initializing Body ", Body%idNum + + ! the r6 and v6 vectors should have already been set + ! r and rd of ends have already been set by setup function or by parent object <<<<< right? <<<<< + + if (Body%typeNum == 0) then ! free body type + + ! assign initial body kinematics to state vector + states(1:6 ) = Body%v6 ! zero velocities for initialization (set to 0 in Body_Setup) + states(7:12) = Body%r6 + + else if (Body%typeNum ==2 ) then ! pinned rod type (coupled or attached to something previously via setPinKin) + + states(1:3) = Body%v6(4:6) ! zero velocities for initialization (set to 0 in Body_Setup) + states(4:6) = Body%r6(4:6) ! body orentations + + end if + ! set positions of any dependent points and rods now (before they are initialized) CALL Body_SetDependentKin(Body, 0.0_DbKi, m) @@ -203,12 +216,12 @@ END SUBROUTINE Body_InitializeUnfree ! set kinematics for Bodies if they are coupled (or ground) !-------------------------------------------------------------- - SUBROUTINE Body_SetKinematics(Body, r_in, v_in, a_in, t, m) + SUBROUTINE Body_SetKinematics(Body, r6_in, v6_in, a6_in, t, m) Type(MD_Body), INTENT(INOUT) :: Body ! the Body object - Real(DbKi), INTENT(IN ) :: r_in(6) ! 6-DOF position - Real(DbKi), INTENT(IN ) :: v_in(6) ! 6-DOF velocity - Real(DbKi), INTENT(IN ) :: a_in(6) ! 6-DOF acceleration (only used for coupled rods) + Real(DbKi), INTENT(IN ) :: r6_in(6) ! 6-DOF position + Real(DbKi), INTENT(IN ) :: v6_in(6) ! 6-DOF velocity + Real(DbKi), INTENT(IN ) :: a6_in(6) ! 6-DOF acceleration (only used for coupled rods) Real(DbKi), INTENT(IN ) :: t ! instantaneous time TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Points) @@ -218,26 +231,24 @@ SUBROUTINE Body_SetKinematics(Body, r_in, v_in, a_in, t, m) ! store current time Body%time = t - ! if (abs(Body%typeNum) == 2) then ! body coupled in 6 DOF, or ground - Body%r6 = r_in - Body%v6 = v_in - Body%a6 = a_in + if (Body%typeNum == 2) then ! body pinned to coupling point + + ! set Body translational kinematics based on BCs (linear model for now) + Body%r6(1:3) = r6_in(1:3) + Body%v6(1:3) = v6_in(1:3) + Body%a6(1:3) = a6_in(1:3) + + ! Body rotations are left alone and will be handled, along with passing kinematics to dependent objects, by separate call to setState + + else ! body rigidly coupled to coupling point + Body%r6 = r6_in + Body%v6 = v6_in + Body%a6 = a6_in ! since this body has no states and all DOFs have been set, pass its kinematics to dependent attachments CALL Body_SetDependentKin(Body, t, m) - - ! else if (abs(Body%typeNum) == 1) then ! body pinned at reference point - ! - ! ! set Body *end A only* kinematics based on BCs (linear model for now) - ! Body%r6(1:3) = r_in(1:3) - ! Body%v6(1:3) = v_in(1:3) - ! - ! ! Body is pinned so only ref point posiiton is specified, rotations are left alone and will be - ! ! handled, along with passing kinematics to attached objects, by separate call to setState - ! - ! else - ! print *, "Error: Body_SetKinematics called for a free Body." ! <<< - ! end if + + end if END SUBROUTINE Body_SetKinematics !-------------------------------------------------------------- @@ -257,14 +268,26 @@ SUBROUTINE Body_SetState(Body, X, t, m) ! store current time Body%time = t + if (Body%typeNum == 0) then ! free Body type - - Body%r6 = X(7:12) ! get positions - Body%v6 = X(1:6) ! get velocities - + Body%r6 = X(7:12) ! get positions + Body%v6 = X(1:6) ! get velocities + + ! set positions of any dependent points and rods + CALL Body_SetDependentKin(Body, t, m) + + else if (Body%typeNum == 2) then + + Body%r6(4:6) = X(4:6) ! get positions + Body%v6(4:6) = X(1:3) ! get velocities + - ! set positions of any dependent points and rods - CALL Body_SetDependentKin(Body, t, m) + ! set positions of any dependent points and rods + CALL Body_SetDependentKin(Body, t, m) + + else + print *, "Error: Body::setState called for a non-free Body type in MoorDyn" ! <<< + end if END SUBROUTINE Body_SetState !-------------------------------------------------------------- @@ -336,6 +359,8 @@ SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) INTEGER(IntKi) :: J ! index + Real(DbKi) :: Fnet (6) ! net force and moment about reference point + Real(DbKi) :: acc(6) ! 6DOF acceleration vector Real(DbKi) :: y_temp (6) ! temporary vector for LU decomposition @@ -349,15 +374,35 @@ SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) CALL Body_DoRHS(Body, m, p) - ! solve for accelerations in [M]{a}={f} using LU decomposition - CALL LUsolve(6, Body%M, LU_temp, Body%F6net, y_temp, acc) + IF (Body%typeNum == 0) THEN ! Free body + + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(6, Body%M, LU_temp, Body%F6net, y_temp, acc) - ! fill in state derivatives - Xd(7:12) = Body%v6 ! dxdt = V (velocities) - Xd(1:6) = acc ! dVdt = a (accelerations) + ! fill in state derivatives + Xd(7:12) = Body%v6 ! dxdt = V (velocities) + Xd(1:6) = acc ! dVdt = a (accelerations) - ! store accelerations in case they're useful as output - Body%a6 = acc + ! store accelerations in case they're useful as output + Body%a6 = acc + + ELSE ! Pinned Body, 6 states (rotational only) + + ! Account for moment response due to inertial coupling + Fnet = Body%F6net + Fnet(4:6) = Fnet(4:6) - MATMUL(Body%M(4:6,1:3), Body%a6(1:3)) + + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(3, Body%M(4:6,4:6), LU_temp(4:6,4:6), Fnet(4:6), y_temp(4:6), acc(4:6)) + + ! fill in state derivatives + Xd(4:6) = Body%v6(4:6) ! dxdt = V (velocities) + Xd(1:3) = acc(4:6) ! dVdt = a (accelerations) + + ! store accelerations in case they're useful as output + Body%a6(4:6) = acc(4:6) + + ENDIF ! check for NaNs (should check all state derivatives, not just first 6) DO J = 1, 6 @@ -477,9 +522,15 @@ SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) ! add inertial loads as appropriate if (Body%typeNum == -1) then - F6_iner = 0.0_DbKi !-MATMUL(Body%M, Body%a6) <<<<<<<< why does including F6_iner cause instability??? + F6_iner = -MATMUL(Body%M, Body%a6) ! <<<<<<<< why does including F6_iner cause instability??? Fnet_out = Body%F6net + F6_iner ! add inertial loads - + + else if (Body%typeNum == 2) then ! pinned coupled body + ! inertial loads ... from input translational ... and solved rotational ... acceleration + F6_iner(1:3) = -MATMUL(Body%M6net(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M6net(1:3,4:6), Body%a6(4:6)) + Fnet_out(1:3) = Body%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads + Fnet_out(4:6) = 0.0_DbKi + else print *, "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!" end if diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 7f29fcb13d..a8406ef193 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -88,7 +88,7 @@ typedef ^ ^ DbKi CaEnd - # this is the Body type, which holds data for each body object typedef ^ MD_Body IntKi IdNum - - - "integer identifier of this Point" -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=vessel" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned" typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of points attached to this body" typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" typedef ^ ^ IntKi nAttachedC - 0 - "number of attached points" @@ -117,7 +117,7 @@ typedef ^ ^ DbKi rCG {3} # this is the Point type, which holds data for each point object typedef ^ MD_Point IntKi IdNum - - - "integer identifier of this point" typedef ^ ^ CHARACTER(10) type - - - "type of point: fix, vessel, point" -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=vessel, 0=free" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=coupled, 0=free" typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this point node" typedef ^ ^ IntKi Top {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" typedef ^ ^ IntKi nAttached - 0 - "number of attached lines" @@ -143,7 +143,7 @@ typedef ^ ^ DbKi M {3}{3} typedef ^ MD_Rod IntKi IdNum - - - "integer identifier of this Line" typedef ^ ^ CHARACTER(10) type - - - "type of Rod. should match one of RodProp names" typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated rod properties" - -typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=point, -1=coupledpinned" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=pinned, 2=fixed, -1=coupledpinned, -2=coupled" typedef ^ ^ IntKi AttachedA {10} - - "list of IdNums of lines attached to end A" typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" From 3ec0b5faa6d88ff2b549352db289e486078c531d Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 7 Nov 2023 13:27:27 -0700 Subject: [PATCH 046/232] HD/SeaSt: cleanup `WaveMod` - added parameters instead of comparing with numbers everywhere - removed preprocessor-directive code for BETA_BUILD - cleaned up some logic... I'm not convinced some of the data checks that use WaveMod are complete after all models have been added... - moved some error checks from SeaSt_ParseInput() to SeaStateInput_ProcessInitData() - remove some outdated comments --- modules/hydrodyn/src/HydroDyn.f90 | 5 +- modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 1 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 1 - modules/hydrodyn/src/HydroDyn_Input.f90 | 28 ++- modules/hydrodyn/src/HydroDyn_Types.f90 | 5 - modules/hydrodyn/src/WAMIT.f90 | 20 ++- modules/hydrodyn/src/WAMIT.txt | 1 - modules/hydrodyn/src/WAMIT2.f90 | 3 +- modules/hydrodyn/src/WAMIT2.txt | 1 - modules/hydrodyn/src/WAMIT2_Types.f90 | 5 - modules/hydrodyn/src/WAMIT_Types.f90 | 5 - modules/openfast-library/src/FAST_Subs.f90 | 1 - modules/seastate/src/SeaSt_WaveField.txt | 15 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 14 ++ modules/seastate/src/SeaState.f90 | 14 +- modules/seastate/src/SeaState.txt | 3 +- modules/seastate/src/SeaState_Input.f90 | 169 ++++++++---------- modules/seastate/src/SeaState_Interp.txt | 4 +- modules/seastate/src/SeaState_Output.f90 | 4 +- modules/seastate/src/SeaState_Types.f90 | 15 +- modules/seastate/src/UserWaves.f90 | 6 +- modules/seastate/src/Waves.f90 | 49 +++-- modules/seastate/src/Waves.txt | 2 - modules/seastate/src/Waves_Types.f90 | 10 -- 25 files changed, 173 insertions(+), 209 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 947a75d1b6..ef6a709f5c 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -145,10 +145,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%UnOutFile = -1 !bjj: this was being written to the screen when I had an error in my HD input file, so I'm going to initialize here. p%WaveField => InitInp%WaveField - -#ifdef BETA_BUILD - CALL DispBetaNotice( "This is a beta version of HydroDyn and is for testing purposes only."//NewLine//"This version includes user waves, WaveMod=6 and the ability to write example user waves." ) -#endif + ! Initialize the NWTC Subroutine Library diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 17f6910614..42eb66871c 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -76,7 +76,6 @@ typedef ^ ^ logical # typedef ^ ^ INTEGER NStepWave - 0 - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - -typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 7546d54313..89b5ae38ce 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -410,7 +410,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup HD%InitInp%NStepWave = SeaSt%InitOutData%NStepWave HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 - HD%InitInp%WaveMod = SeaSt%InitOutData%WaveMod HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! can be set regardless of association(); if not associated, HD shouldn't work diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 8a3f60fb29..5afba8e9d4 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -324,7 +324,6 @@ subroutine SetHD_InitInputs() ! Data from InitOutData_SeaSt: InitInData_HD%NStepWave = InitOutData_SeaSt%NStepWave InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 - InitInData_HD%WaveMod = InitOutData_SeaSt%WaveMod InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 856122177b..6446e752a9 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1127,6 +1127,10 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !------------------------------------------------------------------------- ! Check environmental conditions !------------------------------------------------------------------------- + if (.not. associated(InitInp%WaveField) .or. InitInp%NStepWave == 0) then + call SetErrStat( ErrID_Fatal,' No SeaState information available.',ErrStat,ErrMsg,RoutineName) + return + endif ! MSL2SWL - Mean sea level to still water level IF ( InputFileData%PotMod == 1 .AND. .NOT. EqualRealNos(InitInp%WaveField%MSL2SWL, 0.0_ReKi) ) THEN @@ -1135,14 +1139,9 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF - ! WaveMod - Wave kinematics model switch. -- Check that actual data was passed in from SeaState. If none exists, then set WaveMod=0 and warn - if (.not. associated(InitInp%WaveField) .or. InitInp%NStepWave == 0) then - call SetErrStat( ErrID_Fatal,' No SeaState wave information available. Setting WaveMod=0.',ErrStat,ErrMsg,RoutineName) - return - endif - - IF ( InputFileData%PotMod > 0 .and. InitInp%WaveMod == 6 ) THEN - CALL SetErrStat( ErrID_Fatal,'WaveMod must be 0, 1, 1P#, 2, 3, 4, or 5 when PotMod is not 0',ErrStat,ErrMsg,RoutineName) + ! WaveMod - Wave kinematics model switch. + IF ( InputFileData%PotMod > 0 .and. InitInp%WaveField%WaveMod == WaveMod_ExtFull ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveMod cannot be 6 when PotMod is not 0.',ErrStat,ErrMsg,RoutineName) RETURN END IF @@ -1150,9 +1149,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! LIN-TODO: !errors if: !if ( & - ! (WaveModIn /= 0) .or. & - ! (InputFileData%Waves2%WvDiffQTFF /= .false.) .or. & - ! (InputFileData%Waves2%WvSumQTFF /= .false.) .or. & ! (InputFileData%PotMod /= 0 .or. InputFileData%PotMod /=1) .or. & ! (InputFileData%WAMIT%ExctnMod /=0 .or. InputFileData%WAMIT%ExctnMod /=2) .or. & ! (InputFileData%WAMIT%RdtnMod /=0 .or. InputFileData%WAMIT%RdtnMod /=2) .or. & @@ -1164,8 +1160,8 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. - IF ( InitInp%WaveMod /= 0 .AND. InputFileData%Morison%NMembers > 0 ) THEN - IF ( InitInp%WaveMod /= 6 ) THEN + IF ( InitInp%WaveField%WaveMod /= WaveMod_None .AND. InputFileData%Morison%NMembers > 0 ) THEN + IF ( InitInp%WaveField%WaveMod /= WaveMod_ExtFull ) THEN IF ( ( InitInp%WaveField%WaveStMod /= 0 ) .AND. ( InitInp%WaveField%WaveStMod /= 1 ) .AND. & ( InitInp%WaveField%WaveStMod /= 2 ) .AND. ( InitInp%WaveField%WaveStMod /= 3 ) ) THEN ErrMsg = ' WaveStMod must be 0, 1, 2, or 3.' @@ -1236,7 +1232,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS END IF ! ExctnDisp - Method of computing Wave Excitation - if ( InputFileData%PotMod /= 1 .or. InputFileData%WAMIT%ExctnMod == 0 .or. InitInp%WaveMod == 0) then + if ( InputFileData%PotMod /= 1 .or. InputFileData%WAMIT%ExctnMod == 0 .or. InitInp%WaveField%WaveMod == WaveMod_None) then InputFileData%WAMIT%ExctnDisp = 0 !Force ExctnDisp = 0, so that the Grid of Wave Excitation forces is not computed (saves time and memory) end if @@ -1485,7 +1481,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS if ( (InputFileData%WAMIT%ExctnMod == 2) ) then if ( InitInp%InvalidWithSSExctn ) then - call SetErrStat( ErrID_Fatal, 'Given SeaState conditions cannot be used with state-space wave excitations. In SeaState, set WaveMod to 0, 1, 1P#, 2, 3, 4, or 5; WaveDirMod=0; WvDiffQTF=FALSE; and WvSumQTF=FALSE. Or in HydroDyn set ExctnMod to 0 or 1.', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal, 'Given SeaState conditions cannot be used with state-space wave excitations. In SeaState, WaveMod cannot be 6; WaveDirMod must be 0; WvDiffQTF must be FALSE; and WvSumQTF must be FALSE. Or in HydroDyn set ExctnMod to 0 or 1.', ErrStat, ErrMsg, RoutineName ) end if @@ -2357,10 +2353,8 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !---------------------------------------------------------- ! WAMIT - InputFileData%WAMIT%WaveMod = InitInp%WaveMod InputFileData%WAMIT%HasWAMIT = InputFileData%PotMod == 1 ! WAMIT2 - InputFileData%WAMIT2%WaveMod = InitInp%WaveMod InputFileData%WAMIT2%HasWAMIT = InputFileData%PotMod == 1 ! Morison InputFileData%Morison%UnSum = InputFileData%UnSum diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 258ddb6793..04a3285133 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -92,7 +92,6 @@ MODULE HydroDyn_Types LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] - INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType @@ -874,7 +873,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -909,7 +907,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%VisMeshes) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -950,8 +947,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 9ae780e37d..bc783290ec 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -902,8 +902,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS else ! Initialize the variables associated with the incident wave: - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? - CASE ( 0 ) ! No waves, NOTE: for this case we are forcing ExctnDisp = 0, so only p%WaveExctn needs to be allocated, not p%WaveExctnGrid + SELECT CASE ( InitInp%WaveField%WaveMod ) ! Which incident wave kinematics model are we using? + + CASE ( WaveMod_None ) ! No waves, NOTE: for this case we are forcing ExctnDisp = 0, so only p%WaveExctn needs to be allocated, not p%WaveExctnGrid if ( p%ExctnMod == 1 ) then ! Initialize everything to zero: @@ -937,7 +938,14 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS return end if end if - CASE ( 1, 2, 3, 4, 5, 7, 10 ) ! Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, white-noise wave, or user-defined spectrum (irregular) wave. + + CASE ( WaveMod_ExtFull ) ! User wave data. + + CALL SetErrStat( ErrID_Fatal, 'User input wave data not applicable for floating platforms.', ErrStat, ErrMsg, RoutineName) + CALL Cleanup() + RETURN + + CASE DEFAULT ! remaining cases: ( 1, 2, 3, 4, 5, 7, 10 ) ! Plane progressive (regular) wave, JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, white-noise wave, or user-defined spectrum (irregular) wave. if ( p%ExctnMod == 1 ) then @@ -1275,12 +1283,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS xd%BdyPosFilt = 0.0_ReKi END IF - CASE ( 6 ) ! User wave data. - - CALL SetErrStat( ErrID_Fatal, 'User input wave data not applicable for floating platforms.', ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - ENDSELECT end if diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 99e24bd793..aa7f7a287f 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -40,7 +40,6 @@ typedef ^ ^ CHARACTER(1 typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - -typedef ^ ^ INTEGER WaveMod - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index 50b767c0f7..d525565638 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -1153,7 +1153,7 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! is done only for efficiency. !BJJ: If WaveMod==1, this could result in zeroing out the wrong values... - !InitInp%WvLowCOff and InitInp%WvHiCOff are not used in SeaState when WaveMod = 0,1, or 6 + !InitInp%WvLowCOff and InitInp%WvHiCOff are not used in SeaState when WaveMod = 0,1, or 6 (WaveMod_ExtFull) ! Probably could just remove this IF statement???? IF ( (Omega1 >= InitInp%WaveField%WvLowCOff) .AND. (Omega1 <= InitInp%WaveField%WvHiCOff) ) THEN @@ -1353,7 +1353,6 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg !! frequencies where \f$ \omega_1=\omega_2 \f$, the data read in from the files must contain the full range of frequencies !! present in the waves. !bjj: InitInp%WvLowCOff and InitInp%WvHiCOff aren't supposed to be used when WaveMod=0, 1, or 6, but they are used here regardless of those conditions. -! Can we get rid of these checks???? IF ( NewmanAppData%DataIs3D ) THEN ! Check the low frequency cutoff diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 6ce9ba3822..4ce1646217 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -32,7 +32,6 @@ typedef ^ ^ INTEGER NStepWave typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) -typedef ^ ^ INTEGER WaveMod - - - "The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here." - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" #[note: only one of MnDriff / NewmanApp / DiffQTF can be non-zero diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index b882fd5637..f2becc27f6 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -49,7 +49,6 @@ MODULE WAMIT2_Types INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] @@ -158,7 +157,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%MnDrift = SrcInitInputData%MnDrift DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp @@ -228,7 +226,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WaveMod) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -329,8 +326,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index eb9b6dfc04..96d096c199 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -59,7 +59,6 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] - INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE WAMIT_InitInputType ! ======================= @@ -257,7 +256,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err if (ErrStat >= AbortErrLev) return DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveMod = SrcInitInputData%WaveMod DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -351,7 +349,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveMod) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -497,8 +494,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index a9bb5f9ed8..c76c10b6dd 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -857,7 +857,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 - Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index dca4ab497c..55febd4d8c 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -3,8 +3,18 @@ # usefrom SeaState_Interp.txt -param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - -param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - +param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - +param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - + +param SeaSt_WaveField - INTEGER WaveMod_None - 0 - "WaveMod = 0 [Incident wave kinematics model: NONE (still water)]" - +param SeaSt_WaveField - INTEGER WaveMod_Regular - 1 - "WaveMod = 1 [Incident wave kinematics model: Regular (periodic)]" - +param SeaSt_WaveField - INTEGER WaveMod_RegularUsrPh - 10 - "WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)]" - +param SeaSt_WaveField - INTEGER WaveMod_JONSWAP - 2 - "WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)]" - +param SeaSt_WaveField - INTEGER WaveMod_WhiteNoise - 3 - "WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)]" - +param SeaSt_WaveField - INTEGER WaveMod_UserSpctrm - 4 - "WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)]" - +param SeaSt_WaveField - INTEGER WaveMod_ExtElev - 5 - "WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series]" - +param SeaSt_WaveField - INTEGER WaveMod_ExtFull - 6 - "WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)]" - +param SeaSt_WaveField - INTEGER WaveMod_UserFreq - 7 - "WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components]" - #--------------------------------------------------------------------------------------------------------------------------------------------------------- # @@ -44,3 +54,4 @@ 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 ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) +typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters." - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 23de9d71fa..4456bbb8f4 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -36,6 +36,15 @@ MODULE SeaSt_WaveField_Types IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_COS2S = 1 ! WaveDirMod = 1 [Directional spreading function is COS2S] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_None = 0 ! WaveMod = 0 [Incident wave kinematics model: NONE (still water)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_Regular = 1 ! WaveMod = 1 [Incident wave kinematics model: Regular (periodic)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_RegularUsrPh = 10 ! WaveMod = 1P# [Incident wave kinematics model: Regular (user specified phase)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_JONSWAP = 2 ! WaveMod = 2 [Incident wave kinematics model: JONSWAP/Pierson-Moskowitz spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_WhiteNoise = 3 ! WaveMod = 3 [Incident wave kinematics model: White noise spectrum (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserSpctrm = 4 ! WaveMod = 4 [Incident wave kinematics model: user-defined spectrum from routine UserWaveSpctrm (irregular)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] @@ -72,6 +81,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -289,6 +299,7 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WvLowCOffS = SrcSeaSt_WaveFieldTypeData%WvLowCOffS DstSeaSt_WaveFieldTypeData%WvHiCOffS = SrcSeaSt_WaveFieldTypeData%WvHiCOffS DstSeaSt_WaveFieldTypeData%WaveDOmega = SrcSeaSt_WaveFieldTypeData%WaveDOmega + DstSeaSt_WaveFieldTypeData%WaveMod = SrcSeaSt_WaveFieldTypeData%WaveMod end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -448,6 +459,7 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%WvLowCOffS) call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, InData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -706,6 +718,8 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 300482704e..4de3b4b867 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -259,7 +259,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init m%LastIndWave = 1 - IF ( InputFileData%Waves%WaveMod /= 6 ) THEN + IF ( InputFileData%WaveMod /= WaveMod_ExtFull ) THEN !---------------------------------- ! Initialize Waves2 module @@ -325,7 +325,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ENDIF ! InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF - END IF ! Check for WaveMod = 6 + END IF ! Check for WaveMod = 6 (WaveMod_ExtFull) ! Create the Output file if requested p%OutSwtch = InputFileData%OutSwtch @@ -373,19 +373,17 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%NStepWave = Waves_InitOut%NStepWave ! For WAMIT, WAMIT2, SS_Excitation, Morison InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT - - InitOut%WaveMod = InputFileData%Waves%WaveMod InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: - InitOut%InvalidWithSSExctn = InputFileData%Waves%WaveMod == 6 .or. & !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 ) + InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & !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 ) InputFileData%WaveDirMod /= WaveDirMod_None .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) InputFileData%Waves2%WvDiffQTFF .or. & !call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) InputFileData%Waves2%WvSumQTFF !call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) ! Write Wave Kinematics? - if ( InputFileData%Waves%WaveMod /= 6 ) then + if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then if ( InitInp%WrWvKinMod == 2 ) then call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & p%Z_Depth, p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) @@ -433,14 +431,14 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF ( InitInp%hasIce ) THEN - IF ((InputFileData%Waves%WaveMod /= 0) .OR. (InputFileData%Current%CurrMod /= 0) ) THEN + IF ((InputFileData%WaveMod /= WaveMod_None) .OR. (InputFileData%Current%CurrMod /= 0) ) THEN CALL SetErrStat(ErrID_Fatal,'Waves and Current must be turned off in SeaState when ice loading is computed. Set WaveMod=0 and CurrMod=0.',ErrStat,ErrMsg,RoutineName) END IF END IF if (InitInp%Linearize) then - if ( InputFileData%Waves%WaveMod /= 0 ) then + if ( InputFileData%WaveMod /= WaveMod_None ) then call SetErrStat( ErrID_Fatal, 'Still water conditions must be used for linearization. Set WaveMod=0.', ErrStat, ErrMsg, RoutineName ) end if diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index d152ff3e18..f7c2acba08 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -61,6 +61,8 @@ typedef ^ ^ SiKi WvHiCOf typedef ^ ^ SiKi WvLowCOffS - - - "Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) +typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters." - +typedef ^ ^ CHARACTER(80) WaveModChr - - - "String to temporarially hold the value of the wave kinematics input line" typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - @@ -89,7 +91,6 @@ typedef ^ ^ CHARACTER(ChanLen) Wri typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) 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 ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index c09d20c81c..aefcba814b 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -143,15 +143,9 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, CurLine = CurLine + 1 ! WaveMod - Wave kinematics model switch. - call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%Waves%WaveModChr, ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%WaveModChr, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - call Conv2UC( InputFileData%Waves%WaveModChr ) ! Convert Line to upper case. - - InputFileData%Waves%WavePhase = 0.0 - InputFileData%Waves%WaveNDAmp = .FALSE. - - ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. call ParseVar( FileInfo_In, CurLine, 'WaveStMod', InputFileData%WaveStMod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; @@ -297,20 +291,11 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, ! ConstWaveMod - Constrained wave model switch. call ParseVar( FileInfo_In, CurLine, 'ConstWaveMod', InputFileData%Waves%ConstWaveMod, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - IF ( ( InputFileData%Waves%ConstWaveMod /= 0 ) .AND. ( InputFileData%Waves%ConstWaveMod /= 1 ) .AND. & - ( InputFileData%Waves%ConstWaveMod /= 2 ) ) THEN - call SetErrStat( ErrID_Fatal,'ConstWaveMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF + ! CrestHmax - Crest height call ParseVar( FileInfo_In, CurLine, 'CrestHmax', InputFileData%Waves%CrestHmax, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - IF ( (InputFileData%Waves%WaveModChr == '2') .AND. ( InputFileData%Waves%ConstWaveMod>0 ) .AND. & - ( InputFileData%Waves%CrestHmax < InputFileData%Waves%WaveHs ) ) THEN - call SetErrStat( ErrID_Fatal,'CrestHmax must be larger than WaveHs.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF ! CrestTime -Time of the crest call ParseVar( FileInfo_In, CurLine, 'CrestTime', InputFileData%Waves%CrestTime, ErrStat2, ErrMsg2, UnEc ) @@ -376,12 +361,6 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, call ParseVar( FileInfo_In, CurLine, 'MCFD', InputFileData%MCFD, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - IF ( InputFileData%Waves%WaveModChr == '0' .OR. InputFileData%Waves%WaveModChr == '6' ) THEN - IF ( InputFileData%MCFD > 0.0_SiKi ) THEN - CALL SetErrStat( ErrID_Fatal,' The MacCamy-Fuchs diffraction model is not compatible with WaveMod = 0 or 6. Need to set MCFD to 0.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF - END IF !------------------------------------------------------------------------------------------------- ! Data section for OUTPUT @@ -516,7 +495,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er character(1024) :: TmpPath ! Temporary storage for relative path name real(ReKi) :: xpos, ypos, zpos real(SiKi) :: TmpFreq - integer :: WaveModIn integer(IntKi) :: ErrStat2, IOS character(ErrMsgLen) :: ErrMsg2 @@ -580,20 +558,22 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if - ! WaveMod - Wave kinematics model switch. - if ( LEN_TRIM(InputFileData%Waves%WaveModChr) > 1 ) then + InputFileData%Waves%WavePhase = 0.0 + + if ( LEN_TRIM(InputFileData%WaveModChr) > 1 ) then + call Conv2UC( InputFileData%WaveModChr ) ! Convert Line to upper case. - if ( InputFileData%Waves%WaveModChr(1:2) == '1P' ) then ! The user wants to specify the phase in place of a random phase + if ( InputFileData%WaveModChr(1:2) == '1P' ) then ! The user wants to specify the phase in place of a random phase - read (InputFileData%Waves%WaveModChr(3:),*,IOSTAT=IOS ) InputFileData%Waves%WavePhase + InputFileData%WaveMod = WaveMod_RegularUsrPh ! Internally define WaveMod = 10 to mean regular waves with a specified (nonrandom) phase + + read (InputFileData%WaveModChr(3:),*,IOSTAT=IOS ) InputFileData%Waves%WavePhase call CheckIOS ( IOS, "", 'WavePhase', NumType, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) return - WaveModIn = 1 - InputFileData%Waves%WaveMod = 10 ! Internally define WaveMod = 10 to mean regular waves with a specified (nonrandom) phase InputFileData%Waves%WavePhase = InputFileData%Waves%WavePhase*D2R ! Convert the phase from degrees to radians else ! The user must have specified WaveMod incorrectly. @@ -603,36 +583,28 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er else ! The line below only works for 1 digit reads - read( InputFileData%Waves%WaveModChr, *, IOSTAT=IOS ) InputFileData%Waves%WaveMod + read( InputFileData%WaveModChr, *, IOSTAT=IOS ) InputFileData%WaveMod call CheckIOS ( IOS, "", 'WaveMod', NumType, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) return - WaveModIn = InputFileData%Waves%WaveMod - end if ! LEN_TRIM(InputFileData%Waves%WaveModChr) - - if ( WaveModIn < 0 .OR. WaveModIn > 7 ) then + SELECT CASE(InputFileData%WaveMod) + CASE(WaveMod_None) + CASE(WaveMod_Regular) + CASE(WaveMod_RegularUsrPh) + CASE(WaveMod_JONSWAP) + CASE(WaveMod_WhiteNoise) + CASE(WaveMod_UserSpctrm) + CASE(WaveMod_ExtElev) + CASE(WaveMod_ExtFull) + CASE(WaveMod_UserFreq) + CASE DEFAULT call SetErrStat( ErrID_Fatal,'WaveMod must be 0, 1, 1P#, 2, 3, 4, 5, 6, or 7',ErrStat,ErrMsg,RoutineName) return - end if + END SELECT - ! Linearization Checks - ! LIN-TODO: - !errors if: - !if ( & - ! (WaveModIn /= 0) .or. & - ! (InputFileData%Waves2%WvDiffQTFF /= .false.) .or. & - ! (InputFileData%Waves2%WvSumQTFF /= .false.) .or. & - ! (InputFileData%PotMod /= 0 .or. InputFileData%PotMod /=1) .or. & - ! (InputFileData%WAMIT%ExctnMod /=0 .or. InputFileData%WAMIT%ExctnMod /=2) .or. & - ! (InputFileData%WAMIT%RdtnMod /=0 .or. InputFileData%WAMIT%RdtnMod /=2) .or. & - ! (InputFileData%WAMIT2%MnDrift /=0) .or. & - ! (InputFileData%WAMIT2%NewmanApp /= 0) .or. & - ! (InputFileData%WAMIT2%SumQTF /= 0 ) ) then - ! - !end if ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. @@ -640,27 +612,23 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! TODO: We are only implementing WaveStMod = 0 (No stretching) at this point in time. 1 Mar 2013 GJH ! All three methods of wave stretching tentatively implemented. - IF ( InputFileData%Waves%WaveMod /= 0 .AND. InputFileData%Waves%WaveMod /= 6 ) THEN + IF ( InputFileData%WaveMod /= WaveMod_None .AND. InputFileData%WaveMod /= WaveMod_ExtFull ) THEN IF ( (InputFileData%WaveStMod /= 0) .AND. (InputFileData%WaveStMod /= 1) .AND. & (InputFileData%WaveStMod /= 2) .AND. (InputFileData%WaveStMod /= 3) ) THEN CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0, 1, 2, or 3.',ErrStat,ErrMsg,RoutineName) RETURN END IF - ELSE ! Wave stretching is not supported when WaveMod = 0 or 6. + ELSE ! Wave stretching is not supported when WaveMod = 0 (WaveMod_None) or 6 (WaveMod_ExtFull). InputFileData%WaveStMod = 0_IntKi END IF ! WaveTMax - Analysis time for incident wave calculations. - if ( InputFileData%Waves%WaveMod == 0 ) then ! .TRUE if we have incident waves. + if ( InputFileData%WaveMod == WaveMod_None ) then ! .TRUE if we have incident waves. ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. ! Setting WaveTMax = 0 breaks interpolation. Should probably set it to just TMax instead. - ! if ( .NOT. EqualRealNos(InputFileData%Waves%WaveTMax, 0.0_DbKi) ) then - ! call WrScr( ' Setting WaveTMax to 0.0 since WaveMod = 0' ) - ! InputFileData%Waves%WaveTMax = 0.0 - ! end if if ( .NOT. EqualRealNos(InputFileData%Waves%WaveTMax, InitInp%TMax) ) then call WrScr( ' Setting WaveTMax to TMax since WaveMod = 0' ) InputFileData%Waves%WaveTMax = InitInp%TMax @@ -669,7 +637,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er call WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) InputFileData%WaveDir = 0.0 end if - elseif ( InputFileData%Waves%WaveMod == 5 ) then ! User wave elevation file reading in + elseif ( InputFileData%WaveMod == WaveMod_ExtElev ) then ! User wave elevation file reading in if (InitInp%TMax > InputFileData%Waves%WaveTMax ) then call SetErrstat( ErrID_Fatal, ' WaveTMax must be larger than the simulation time for user wave elevations (WaveMod == 5).',ErrStat,ErrMsg,RoutineName) return @@ -683,7 +651,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveDT - Time step for incident wave calculations - if ( InputFileData%Waves%WaveMod > 0 ) then ! .TRUE if we have incident waves. + if ( InputFileData%WaveMod /= WaveMod_None ) then ! .TRUE if we have incident waves. if ( InputFileData%Waves%WaveDT <= 0.0 ) then call SetErrStat( ErrID_Fatal,'WaveDT must be greater than zero.',ErrStat,ErrMsg,RoutineName) @@ -701,8 +669,8 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveHs - Significant wave height - - if ( ( InputFileData%Waves%WaveMod /= 0 ) .AND. ( InputFileData%Waves%WaveMod /= 4 ) .AND. ( InputFileData%Waves%WaveMod /= 5 ) ) then ! .TRUE. (when WaveMod = 1, 2, 3, or 10) if we have plane progressive (regular), JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, or white-noise waves, but not user-defined or GH Bladed wave data. + !bjj: is this check still appropriate? do we need to add something for WaveMod 6 or 7? Otherwise, fix the comment on the next line + if ( ( InputFileData%WaveMod /= WaveMod_None ) .AND. ( InputFileData%WaveMod /= WaveMod_UserSpctrm ) .AND. ( InputFileData%WaveMod /= WaveMod_ExtElev ) ) then ! .TRUE. (when WaveMod = 1, 2, 3, or 10) if we have plane progressive (regular), JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, or white-noise waves, but not user-defined or GH Bladed wave data. if ( InputFileData%Waves%WaveHs <= 0.0 ) then call SetErrStat( ErrID_Fatal,'WaveHs must be greater than zero.',ErrStat,ErrMsg,RoutineName) @@ -717,26 +685,19 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveTp - Peak spectral period. - ! We commented out the if else block due to a bug when WaveMod == 3, and then WaveTp is hence set to 0.0. See line 1092 of Waves.f90 (as of 11/24/2014) GJH - !if ( ( InputFileData%Waves%WaveMod == 1 ) .OR. ( InputFileData%Waves%WaveMod == 2 ) .OR. ( InputFileData%Waves%WaveMod == 10 ) ) then ! .TRUE. (when WaveMod = 1, 2, or 10) if we have plane progressive (regular), JONSWAP/Pierson-Moskowitz spectrum (irregular) waves. - - if ( InputFileData%Waves%WaveTp <= 0.0 ) then - call SetErrStat( ErrID_Fatal,'WaveTp must be greater than zero.',ErrStat,ErrMsg,RoutineName) - return - end if - - ! else - - ! InputFileData%Waves%WaveTp = 0.0 + if ( InputFileData%Waves%WaveTp <= 0.0 ) then + call SetErrStat( ErrID_Fatal,'WaveTp must be greater than zero.',ErrStat,ErrMsg,RoutineName) + return + end if - ! end if + ! WavePkShp - Peak shape parameter. call Conv2UC( InputFileData%Waves%WavePkShpChr ) ! Convert Line to upper case. - if ( InputFileData%Waves%WaveMod == 2 ) then ! .TRUE if we have JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, but not GH Bladed wave data. + if ( InputFileData%WaveMod == WaveMod_JONSWAP ) then ! .TRUE if we have JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, but not GH Bladed wave data. if ( TRIM(InputFileData%Waves%WavePkShpChr) == 'DEFAULT' ) then ! .TRUE. when one wants to use the default value of the peak shape parameter, conditioned on significant wave height and peak spectral period. @@ -781,7 +742,8 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er end if end if - if (InputFileData%Waves%WaveMod > 2 .and. InputFileData%Waves%WaveMod /= 6) then + !bjj: do we even need this check on WaveMod? Even if it's not being used, we can check that low < Hi, right? + if (InputFileData%WaveMod > WaveMod_JONSWAP .and. InputFileData%WaveMod /= WaveMod_ExtFull) then if ( InputFileData%WvLowCOff >= InputFileData%WvHiCOff ) then call SetErrSTat( ErrID_Fatal,'WvLowCOff must be less than WvHiCOff.',ErrStat,ErrMsg,RoutineName) return @@ -790,7 +752,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveDir - Wave heading direction. - if ( ( InputFileData%Waves%WaveMod > 0 ) .AND. ( InputFileData%Waves%WaveMod /= 6 ) ) then ! .TRUE if we have incident waves, but not user input wave data. + if ( ( InputFileData%WaveMod /= WaveMod_None ) .AND. ( InputFileData%WaveMod /= WaveMod_ExtFull ) ) then ! .TRUE if we have incident waves, but not user input wave data. if ( ( InputFileData%WaveDir <= -180.0 ) .OR. ( InputFileData%WaveDir > 180.0 ) ) then call SetErrStat( ErrID_Fatal,'WaveDir must be greater than -180 and less than or equal to 180.',ErrStat,ErrMsg,RoutineName) @@ -815,10 +777,12 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Check if we are doing multidirectional waves or not. ! We can only use multi directional waves on WaveMod=2,3,4 InputFileData%WaveMultiDir = .FALSE. ! Set flag to false to start - if ( InputFileData%Waves%WaveMod >= 2 .AND. InputFileData%Waves%WaveMod <= 4 .AND. InputFileData%WaveDirMod == WaveDirMod_COS2S ) then - InputFileData%WaveMultiDir = .TRUE. - elseif ( (InputFileData%Waves%WaveMod < 2 .OR. InputFileData%Waves%WaveMod >4) .AND. InputFileData%WaveDirMod == WaveDirMod_COS2S ) then - call SetErrStat( ErrID_Warn,'WaveDirMod unused unless WaveMod == 2, 3, or 4. Ignoring WaveDirMod.',ErrStat,ErrMsg,RoutineName) + IF (InputFileData%WaveDirMod == WaveDirMod_COS2S ) THEN + if ( InputFileData%WaveMod == WaveMod_JONSWAP .OR. InputFileData%WaveMod == WaveMod_WhiteNoise .OR. InputFileData%WaveMod == WaveMod_UserSpctrm ) then + InputFileData%WaveMultiDir = .TRUE. + else + call SetErrStat( ErrID_Warn,'WaveDirMod unused unless WaveMod == 2, 3, or 4. Ignoring WaveDirMod.',ErrStat,ErrMsg,RoutineName) + end if ENDIF @@ -872,21 +836,14 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveSeed(1), !WaveSeed(2) - - if ( .NOT. ( ( InputFileData%Waves%WaveMod > 0 ) .AND. ( InputFileData%Waves%WaveMod /= 5 ) .AND. ( InputFileData%Waves%WaveMod /= 10 ) ) ) then !.TRUE. for plane progressive (regular) with random phase or irregular wave - - DO I = 1,2 - + if ( InputFileData%WaveMod == WaveMod_None .or. InputFileData%WaveMod == WaveMod_ExtElev .or. InputFileData%WaveMod == WaveMod_RegularUsrPh ) then !bjj: what about WaveMod_ExtFull and/or WaveMod_UserFreq InputFileData%Waves%WaveSeed(I) = 0 - - end DO !I - end if ! WvKinFile - if ( InputFileData%Waves%WaveMod == 5 .OR. InputFileData%Waves%WaveMod == 6 .OR. InputFileData%Waves%WaveMod == 7) then ! .TRUE if we are to read user-supplied wave elevation or wave kinematics file(s). + if ( InputFileData%WaveMod == WaveMod_ExtElev .OR. InputFileData%WaveMod == WaveMod_ExtFull .OR. InputFileData%WaveMod == WaveMod_UserFreq) then ! .TRUE if we are to read user-supplied wave elevation or wave kinematics file(s). if ( LEN_TRIM( InputFileData%Waves%WvKinFile ) == 0 ) then call SetErrStat( ErrID_Fatal,'WvKinFile must not be an empty string.',ErrStat,ErrMsg,RoutineName) @@ -935,6 +892,24 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if + !------------------------------------------------------------------------- + ! Check Constrained Waves section + !------------------------------------------------------------------------- + + ! ConstWaveMod + IF ( ( InputFileData%Waves%ConstWaveMod /= 0 ) .AND. ( InputFileData%Waves%ConstWaveMod /= 1 ) .AND. & + ( InputFileData%Waves%ConstWaveMod /= 2 ) ) THEN + call SetErrStat( ErrID_Fatal,'ConstWaveMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + + ! CrestHmax + IF ( ( InputFileData%WaveMod == WaveMod_JONSWAP ) .AND. ( InputFileData%Waves%ConstWaveMod>0 ) .AND. & + ( InputFileData%Waves%CrestHmax < InputFileData%Waves%WaveHs ) ) THEN + call SetErrStat( ErrID_Fatal,'CrestHmax must be larger than WaveHs.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + !------------------------------------------------------------------------- ! Check Current section !------------------------------------------------------------------------- @@ -947,7 +922,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if - if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%Waves%WaveMod == 6 ) ) then + if ( ( InputFileData%Current%CurrMod /= 0 ) .AND. ( InputFileData%WaveMod == WaveMod_ExtFull ) ) then call SetErrStat( ErrID_Fatal,'CurrMod must be set to 0 when WaveMod is set to 6: user-input wave data.',ErrStat,ErrMsg,RoutineName) return end if @@ -976,7 +951,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er if ( TRIM(InputFileData%Current%CurrSSDirChr) == 'DEFAULT' ) then ! .TRUE. when one wants to use the default value of codirectionality between sub-surface current and incident wave propogation heading directions. - if ( InputFileData%Waves%WaveMod == 0 ) then + if ( InputFileData%WaveMod == WaveMod_None ) then call SetErrStat( ErrID_Fatal,'CurrSSDir must not be set to ''DEFAULT'' when WaveMod is set to 0.',ErrStat,ErrMsg,RoutineName) return end if @@ -1085,6 +1060,15 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er end if + !------------------------------------------------------------------------------------------------- + ! Data section for MacCamy-Fuchs diffraction model + !------------------------------------------------------------------------------------------------- + IF ( InputFileData%WaveMod == WaveMod_None .OR. InputFileData%WaveMod == WaveMod_ExtFull ) THEN + IF ( InputFileData%MCFD > 0.0_SiKi ) THEN + CALL SetErrStat( ErrID_Fatal,' The MacCamy-Fuchs diffraction model is not compatible with WaveMod = 0 or 6. Need to set MCFD to 0.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + END IF !------------------------------------------------------------------------------------------------- ! Data section for OUTPUT @@ -1210,6 +1194,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er p%WaveField%MSL2SWL = InputFileData%MSL2SWL p%WaveField%EffWtrDpth = InputFileData%WtrDpth + InputFileData%MSL2SWL + p%WaveField%WaveMod = InputFileData%WaveMod p%WaveField%WaveStMod = InputFileData%WaveStMod p%WaveField%WtrDens = InputFileData%WtrDens ! may have overwritten default InitInp p%WaveField%RhoXg = p%WaveField%WtrDens*InitInp%Gravity ! For WAMIT and WAMIT2 diff --git a/modules/seastate/src/SeaState_Interp.txt b/modules/seastate/src/SeaState_Interp.txt index 44b897843c..36ed7f9b51 100644 --- a/modules/seastate/src/SeaState_Interp.txt +++ b/modules/seastate/src/SeaState_Interp.txt @@ -12,10 +12,10 @@ include Registry_NWTC_Library.txt ######################### -typedef SeaState_Interp/SeaSt_Interp InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - +typedef SeaState_Interp/SeaSt_Interp InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m +typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m # Init Output typedef ^ InitOutputType ProgDesc Ver - - - "Version information of this submodule" - diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index c5e601a261..a3d9c5175e 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -1028,7 +1028,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS WRITE (UnSum,'(/,A/)', IOSTAT=ErrStat2) 'This summary file was generated by '//trim(SeaSt_ProgDesc%Name)//' on '//CurDate()//' at '//CurTime()//'.' WRITE( UnSum, '(A/)') trim(GetVersion(SeaSt_ProgDesc)) - IF (InputFileData%Waves%WaveMod /= 0 .and. InputFileData%Waves%WaveMod /= 6) THEN + IF (InputFileData%WaveMod /= WaveMod_None .and. InputFileData%WaveMod /= WaveMod_ExtFull) THEN WRITE( UnSum, '(1X,A61,F8.2,A4/)' ) 'The Mean Sea Level to Still Water Level (MSL2SWL) Offset is :',p%WaveField%MSL2SWL,' (m)' WRITE( UnSum, '(1X,A15,F8.2,A8)' ) 'Water Density: ', p%WaveField%WtrDens, '(kg/m^3)' @@ -1085,7 +1085,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS end do end if - IF (InputFileData%Waves%WaveMod /= 6) THEN + IF (InputFileData%WaveMod /= WaveMod_ExtFull) THEN ! Write wave kinematics at (0,0) WRITE( UnSum, '(/)' ) WRITE( UnSum, '(1X,A28/)' ) 'Wave Kinematics DFT at (0,0)' diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 87e4b10b66..9697daa092 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -80,6 +80,8 @@ MODULE SeaState_Types REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] + CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -109,7 +111,6 @@ MODULE SeaState_Types TYPE(ProgDesc) :: Ver !< Version of SeaState [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] - INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] 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(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] @@ -309,6 +310,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WvLowCOffS = SrcInputFileData%WvLowCOffS DstInputFileData%WvHiCOffS = SrcInputFileData%WvHiCOffS DstInputFileData%WaveDOmega = SrcInputFileData%WaveDOmega + DstInputFileData%WaveMod = SrcInputFileData%WaveMod + DstInputFileData%WaveModChr = SrcInputFileData%WaveModChr end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -415,6 +418,8 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%WvLowCOffS) call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%WaveDOmega) + call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%WaveModChr) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -575,6 +580,10 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WaveModChr) + if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -758,7 +767,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 - DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn if (allocated(SrcInitOutputData%WaveElevSeries)) then LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) @@ -817,7 +825,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveMod) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then @@ -877,8 +884,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 88388cdc38..4c0d83bfe6 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -101,7 +101,7 @@ END SUBROUTINE Initial_InitOut_Arrays !----------------------------------------------------------------------------------------------------------------------! ! ! -! WaveMod = 5 ! +! WaveMod = 5 (WaveMod_ExtElev) ! ! ! !----------------------------------------------------------------------------------------------------------------------! @@ -411,7 +411,7 @@ END SUBROUTINE UserWaveElevations_Init !----------------------------------------------------------------------------------------------------------------------! ! ! -! WaveMod = 6 ! +! WaveMod = 6 (WaveMod_ExtFull) ! ! ! !----------------------------------------------------------------------------------------------------------------------! @@ -644,7 +644,7 @@ END SUBROUTINE UserWaves_Init !----------------------------------------------------------------------------------------------------------------------! ! ! -! WaveMod = 7 ! +! WaveMod = 7 (WaveMod_UserFreq) ! ! ! !----------------------------------------------------------------------------------------------------------------------! diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index b615b42d6e..5566e1986c 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -570,7 +570,7 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Initialize everything to zero: - !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 + !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) InitOut%NStepWave = 2 ! We must have at least two elements in order to interpolate later on InitOut%NStepWave2 = 1 InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this... I don't think it was set anywhere for this wavemod. @@ -773,9 +773,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine ! using file information (an FFT was performed there, so the information was needed before now). - ! Same with WaveMod = 7. With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. + ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. ! Need to make sure the wave-direction in formation is not overwritten later. - IF (InitInp%WaveMod /= 5 .AND. InitInp%WaveMod /= 7) THEN + IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... IF ( MOD(InitOut%NStepWave,2) == 1 ) InitOut%NStepWave = InitOut%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. @@ -1010,7 +1010,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !=== Constrained New Waves === ! Modify the wave components to implement the constrained wave ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 - IF ( InitInp%WaveMod == 2 .AND. InitInp%ConstWaveMod > 0) THEN + IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod > 0) THEN ! adjust InitOut%WaveElevC0 for constrained wave: call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -1628,10 +1628,6 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Local Variables: INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for processing CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for procesing -! REAL(ReKi), ALLOCATABLE :: tmpWaveKinzi(:) - -! TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - ! Initialize ErrStat @@ -1648,19 +1644,14 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Define initialization-routine output here: - !InitOut%WriteOutputHdr = (/ 'Time', 'Column2' /) - !InitOut%WriteOutputUnt = (/ '(s)', '(-)' /) - - - ! Initialize the variables associated with the incident wave: - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? + SELECT CASE ( WaveField%WaveMod ) ! Which incident wave kinematics model are we using? - CASE ( 0 ) ! None=still water. + CASE ( WaveMod_None ) ! None=still water. CALL StillWaterWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') @@ -1668,7 +1659,7 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) - CASE ( 1, 2, 3, 4, 10 ) ! 1, 10: Plane progressive (regular) wave, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, 3: white-noise, or 4: user-defined spectrum (irregular) wave. + CASE ( WaveMod_Regular, WaveMod_JONSWAP, WaveMod_WhiteNoise, WaveMod_UserSpctrm, WaveMod_RegularUsrPh ) ! 1, 10: Plane progressive (regular) wave, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, 3: white-noise, or 4: user-defined spectrum (irregular) wave. ! Now call the init with all the zi locations for the Morrison member nodes CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) @@ -1676,7 +1667,7 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN - CASE ( 5 ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. + CASE ( WaveMod_ExtElev ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. ! Get the wave frequency information from the file (by FFT of the elevation) CALL UserWaveElevations_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) @@ -1689,13 +1680,13 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN - CASE ( 6 ) ! User-supplied wave kinematics data. + CASE ( WaveMod_ExtFull ) ! User-supplied wave kinematics data. CALL UserWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN - CASE ( 7 ) + CASE ( WaveMod_UserFreq ) ! Get the wave frequency information from the file (by reading in wave frequency components) CALL UserWaveComponents_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) @@ -1931,11 +1922,11 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ErrMsg = "" - IF (InitInp%WaveMod == 7) THEN ! wavemod 0 and 6 aren't called from this routine, but they fall into this case, too + IF (WaveField%WaveMod == WaveMod_UserFreq) THEN ! wavemod 0 (WaveMod_None) and 6 (WaveMod_ExtFull) aren't called from this routine, but they fall into this case, too RETURN !InitOut%WaveDirArr set in UserWaveComponents_Init for WaveMod 7 - !InitOut%WaveDirArr = 0, set in Initial_InitOut_Arrays for WaveMod 0 and 6 + !InitOut%WaveDirArr = 0, set in Initial_InitOut_Arrays for WaveMod 0 and 6 (WaveMod_ExtFull) ELSEIF(.not. WaveField%WaveMultiDir .or. InitInp%WaveNDir <= 1) THEN ! we have a single wave direction @@ -2235,7 +2226,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS REAL(SiKi) :: WaveS2Sdd ! Two-sided power spectral density of the wave spectrum per unit time for the current frequency component (m^2/(rad/s)) - IF ( InitInp%WaveMod == 5 .OR. InitInp%WaveMod == 7) THEN ! Wave elevation or frequency component data read in + IF ( WaveField%WaveMod == WaveMod_ExtElev .OR. WaveField%WaveMod == WaveMod_UserFreq) THEN ! Wave elevation or frequency component data read in (5 or 7) DO I = 0,InitOut%NStepWave2 @@ -2268,8 +2259,8 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS WGNC(1) = (0.0,0.0) WGNC(InitOut%NStepWave2) = (0.0,0.0) - IF ( InitInp%WaveMod == 10 ) THEN ! .TRUE. for plane progressive (regular) waves with a specified phase - DO I = 0,InitOut%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + IF ( WaveField%WaveMod == WaveMod_RegularUsrPh ) THEN ! .TRUE. for plane progressive (regular) waves with a specified phase + DO I = 0,InitOut%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms IF (I==1) CYCLE WGNC(I) = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp, InitInp%WavePhase ) @@ -2286,7 +2277,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS ! For (WaveMod=1 plane progressive (regular); and WaveMod=10 plane progressive (regular) waves with a specified phase) ! adjust WGNC and set PSD at specified frequency !------------------------------------ - IF (InitInp%WaveMod == 10 .or. InitInp%WaveMod == 1) THEN + IF (WaveField%WaveMod == WaveMod_RegularUsrPh .or. WaveField%WaveMod == WaveMod_Regular) THEN !10 or 1 WaveS1SddArr = 0.0 IF (I_WaveTp < InitOut%NStepWave2 .and. (I_WaveTp > 1 .or. I_WaveTp == 0) ) THEN @@ -2317,12 +2308,12 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS ELSE - SELECT CASE ( InitInp%WaveMod ) ! Which incident wave kinematics model are we using? - CASE ( 2 ) ! JONSWAP/Pierson-Moskowitz spectrum (irregular) wave. + SELECT CASE ( WaveField%WaveMod ) ! Which incident wave kinematics model are we using? + CASE ( WaveMod_JONSWAP ) ! JONSWAP/Pierson-Moskowitz spectrum (irregular) wave. WaveS1SddArr(I) = JONSWAP ( OmegaArr(I), InitInp%WaveHs, InitInp%WaveTp, InitInp%WavePkShp ) - CASE ( 3 ) ! White-noise + CASE ( WaveMod_WhiteNoise ) ! White-noise WaveS1SddArr(I) = InitInp%WaveHs * InitInp%WaveHs / ( 16.0 * (WaveField%WvHiCOff - WaveField%WvLowCOff) ) - CASE ( 4 ) ! User-defined spectrum (irregular) wave. + CASE ( WaveMod_UserSpctrm ) ! User-defined spectrum (irregular) wave. CALL UserWaveSpctrm ( OmegaArr(I), WaveField%WaveDir, InitInp%DirRoot, WaveS1SddArr(I) ) ENDSELECT diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 6f8a0cf285..a2183177c3 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -28,8 +28,6 @@ typedef ^ ^ SiKi WaveDirSpre typedef ^ ^ SiKi WaveDirRange - - - "Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6]" (degrees) typedef ^ ^ DbKi WaveDT - - - "Time step for incident wave calculations" (sec) typedef ^ ^ SiKi WaveHs - - - "Significant wave height of incident waves" (meters) -typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED }" - -typedef ^ ^ CHARACTER(80) WaveModChr - - - "String to temporarially hold the value of the wave kinematics input line" typedef ^ ^ LOGICAL WaveNDAmp - - - "Flag for normally-distributed amplitudes in incident waves spectrum [flag]" - typedef ^ ^ SiKi WavePhase - - - "Specified phase for regular waves" (radians) typedef ^ ^ SiKi WavePkShp - - - "Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz]" - diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index a469081ccc..b4490900b8 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -45,8 +45,6 @@ MODULE Waves_Types REAL(SiKi) :: WaveDirRange = 0.0_R4Ki !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Time step for incident wave calculations [(sec)] REAL(SiKi) :: WaveHs = 0.0_R4Ki !< Significant wave height of incident waves [(meters)] - INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] LOGICAL :: WaveNDAmp = .false. !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] @@ -106,8 +104,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange DstInitInputData%WaveDT = SrcInitInputData%WaveDT DstInitInputData%WaveHs = SrcInitInputData%WaveHs - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveModChr = SrcInitInputData%WaveModChr DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp DstInitInputData%WavePhase = SrcInitInputData%WavePhase DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp @@ -235,8 +231,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDirRange) call RegPack(Buf, InData%WaveDT) call RegPack(Buf, InData%WaveHs) - call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveModChr) call RegPack(Buf, InData%WaveNDAmp) call RegPack(Buf, InData%WavePhase) call RegPack(Buf, InData%WavePkShp) @@ -313,10 +307,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveHs) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveModChr) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveNDAmp) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WavePhase) From f86ffc078b08707ec857246ab816169ba2b5c889 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 7 Nov 2023 14:06:41 -0700 Subject: [PATCH 047/232] SeaSt: remove extra `WaveSeed` arrays --- modules/nwtc-library/src/NWTC_RandomNumber.f90 | 4 ++-- modules/seastate/src/SeaState_Input.f90 | 14 ++------------ modules/seastate/src/Waves.txt | 3 +-- modules/seastate/src/Waves_Types.f90 | 5 ----- 4 files changed, 5 insertions(+), 21 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_RandomNumber.f90 b/modules/nwtc-library/src/NWTC_RandomNumber.f90 index f12b9a8528..52c4f0640c 100644 --- a/modules/nwtc-library/src/NWTC_RandomNumber.f90 +++ b/modules/nwtc-library/src/NWTC_RandomNumber.f90 @@ -46,8 +46,8 @@ SUBROUTINE RandNum_Init(p, ErrStat, ErrMsg ) IMPLICIT NONE TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN ) :: p ! PARAMETERs for random number generation - INTEGER(IntKi) , INTENT(OUT) :: ErrStat ! allocation status - CHARACTER(*) , INTENT(OUT) :: ErrMsg ! error message + INTEGER(IntKi) , INTENT(OUT) :: ErrStat ! allocation status + CHARACTER(*) , INTENT(OUT) :: ErrMsg ! error message INTEGER :: I ! loop counter INTEGER(IntKi), ALLOCATABLE :: NextSeed(:) ! The array that holds the next random seed for each component diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index aefcba814b..a521e613a5 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -203,9 +203,8 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, ! WaveSeed(1) - call ParseVar( FileInfo_In, CurLine, 'WaveSeed(1)', InputFileData%Waves%WaveSeed(1), ErrStat2, ErrMsg2, UnEc ) + call ParseVar( FileInfo_In, CurLine, 'WaveSeed(1)', InputFileData%Waves%RNG%RandSeed(1), ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; - InputFileData%Waves%RNG%RandSeed(1) = InputFileData%Waves%WaveSeed(1) !WaveSeed(2) call ParseVar( FileInfo_In, CurLine, 'WaveSeed(2)', Line, ErrStat2, ErrMsg2, UnEc ) ! Read into a string and then parse @@ -219,14 +218,11 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; endif - read (Line,*,IOSTAT=ErrStat2) InputFileData%Waves%WaveSeed(2) + read (Line,*,IOSTAT=ErrStat2) InputFileData%Waves%RNG%RandSeed(2) if (ErrStat2 == 0) then ! the user entered a number - InputFileData%Waves%RNG%RandSeed(2) = InputFileData%Waves%WaveSeed(2) - InputFileData%Waves%RNG%RNG_type = "NORMAL" InputFileData%Waves%RNG%pRNG = pRNG_INTRINSIC - else InputFileData%Waves%RNG%RandSeed(2) = 0 @@ -835,12 +831,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er end if - ! WaveSeed(1), !WaveSeed(2) - if ( InputFileData%WaveMod == WaveMod_None .or. InputFileData%WaveMod == WaveMod_ExtElev .or. InputFileData%WaveMod == WaveMod_RegularUsrPh ) then !bjj: what about WaveMod_ExtFull and/or WaveMod_UserFreq - InputFileData%Waves%WaveSeed(I) = 0 - end if - - ! WvKinFile if ( InputFileData%WaveMod == WaveMod_ExtElev .OR. InputFileData%WaveMod == WaveMod_ExtFull .OR. InputFileData%WaveMod == WaveMod_UserFreq) then ! .TRUE if we are to read user-supplied wave elevation or wave kinematics file(s). diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index a2183177c3..5bde178eb0 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -32,7 +32,6 @@ typedef ^ ^ LOGICAL WaveNDAmp typedef ^ ^ SiKi WavePhase - - - "Specified phase for regular waves" (radians) typedef ^ ^ SiKi WavePkShp - - - "Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz]" - typedef ^ ^ CHARACTER(80) WavePkShpChr - - - "String to temporarially hold value of peak shape parameter input line" - -typedef ^ ^ INTEGER WaveSeed {2} - - "Random seeds of incident waves [-2147483648 to 2147483647]" - typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations are computed (the XY grid point locations)" - @@ -44,7 +43,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" - +typedef ^ ^ NWTC_RandomNumber_ParameterType RNG - - - "Parameters for the pseudo random number generator" - typedef ^ ^ INTEGER ConstWaveMod - - - "Mode of the constrained wave" - typedef ^ ^ SiKi CrestHmax - - - "crest height or double the crest elevation" m typedef ^ ^ SiKi CrestTime - - - "time of the wave crest" sec diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index b4490900b8..996e0f75ff 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -49,7 +49,6 @@ MODULE Waves_Types REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] @@ -108,7 +107,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WavePhase = SrcInitInputData%WavePhase DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr - DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax DstInitInputData%WaveTp = SrcInitInputData%WaveTp DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid @@ -235,7 +233,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WavePhase) call RegPack(Buf, InData%WavePkShp) call RegPack(Buf, InData%WavePkShpChr) - call RegPack(Buf, InData%WaveSeed) call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%WaveTp) call RegPack(Buf, InData%NWaveElevGrid) @@ -315,8 +312,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WavePkShpChr) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveSeed) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTp) From 827f2d257d9105273a13e62c87d72295fb4a2155 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 7 Nov 2023 14:56:03 -0700 Subject: [PATCH 048/232] HD: additional cleanup of MSL2SWL --- modules/hydrodyn/src/Morison.f90 | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 2dea05984d..218c52563a 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -503,11 +503,10 @@ SUBROUTINE FloodedBallastPartSegment(R1, R2, L, rho, V, m, h_c, Il, Ir) END SUBROUTINE FloodedBallastPartSegment !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, numJoints, numNodes, nodes, numMembers, members, & +SUBROUTINE WriteSummaryFile( UnSum, numJoints, numNodes, nodes, numMembers, members, & NOutputs, OutParam, MOutLst, JOutLst, uMesh, yMesh, p, m, errStat, errMsg ) INTEGER, INTENT ( IN ) :: UnSum - REAL(ReKi), INTENT ( IN ) :: MSL2SWL INTEGER, INTENT ( IN ) :: numJoints INTEGER, INTENT ( IN ) :: numNodes TYPE(Morison_NodeType), ALLOCATABLE, INTENT ( IN ) :: nodes(:) @@ -681,7 +680,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, numJoints, numNodes, nodes, numMemb DO J = 1, yMesh%Nnodes - if ( yMesh%Position(3,J) <= MSL2SWL ) then ! need to check relative to MSL2SWL offset because the Mesh Positons are relative to MSL + if ( yMesh%Position(3,J) <= p%WaveField%MSL2SWL ) then ! need to check relative to MSL2SWL offset because the Mesh Positons are relative to MSL if (J <= numJoints) then ptLoad = F_B(:,J) + m%F_B_end(:,J) @@ -789,7 +788,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, numJoints, numNodes, nodes, numMemb do I = 1,numJoints ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = nodes(i)%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL write( UnSum, '(1X,I5,(2X,A10),3(2X,F10.4),2(2X,A10),2(2X,ES10.3),10(2X,A10),3(2X,ES10.3))' ) i,' - ', pos, ' - ', ' - ', nodes(i)%tMG, nodes(i)%MGdensity, ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', ' - ', nodes(i)%JAxCd, nodes(i)%JAxCa, nodes(i)%JAxCp end do c = numJoints @@ -803,7 +802,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, numJoints, numNodes, nodes, numMemb end if ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = nodes(c)%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL if (members(j)%flipped) then II=members(j)%NElements+2-I else @@ -903,9 +902,9 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, numJoints, numNodes, nodes, numMemb node2 = nodes(mem%NodeIndx(mem%NElements+1)) ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = node1%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL pos2 = node2%Position - pos2(3) = pos2(3) + MSL2SWL + pos2(3) = pos2(3) + p%WaveField%MSL2SWL outLoc = pos*(1-s) + pos2*s WRITE( UnSum, '(1X,A10,3(2x,F10.4),2x,I10,7(2x,F10.4))' ) OutParam(I)%Name, outLoc, MOutLst(mbrIndx)%MemberID, pos,pos2, s END IF @@ -931,7 +930,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, numJoints, numNodes, nodes, numMemb m1 = JOutLst(nodeIndx)%JointIDIndx ! need to add MSL2SWL offset from this because the Positons are relative to SWL, but we should report them relative to MSL here pos = nodes(m1)%Position - pos(3) = pos(3) + MSL2SWL + pos(3) = pos(3) + p%WaveField%MSL2SWL WRITE( UnSum, '(1X,A10,3(2x,F10.4),2x,I10)' ) OutParam(I)%Name, pos, JOutLst(nodeIndx)%JointID END IF @@ -1427,8 +1426,7 @@ subroutine FlipMemberNodeData( member, nodes, doSwap) end subroutine FlipMemberNodeData !---------------------------------------------------------------------------------------------------------------------------------- -subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIndx, MmbrFilledIDIndx, propSet1, propSet2, InitInp, errStat, errMsg ) - real(ReKi), intent (in ) :: MSL2SWL +subroutine SetMemberProperties( gravity, member, MCoefMod, MmbrCoefIDIndx, MmbrFilledIDIndx, propSet1, propSet2, InitInp, errStat, errMsg ) real(ReKi), intent (in ) :: gravity type(Morison_MemberType), intent (inout) :: member integer(IntKi), intent (in ) :: MCoefMod @@ -1483,7 +1481,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn ! These are all per node and not done here, yet do i = 1, member%NElements+1 - call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(member%NodeIndx(i)), MSL2SWL, member%tMG(i), member%MGDensity(i) ) + call SetNodeMG( InitInp%NMGDepths, InitInp%MGDepths, InitInp%Nodes(member%NodeIndx(i)), InitInp%WaveField%MSL2SWL, member%tMG(i), member%MGDensity(i) ) end do member%R( 1) = propSet1%PropD / 2.0 @@ -1499,7 +1497,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%RMG(i) = member%R(i) + member%tMG(i) end do - call SetExternalHydroCoefs( MSL2SWL, MCoefMod, MmbrCoefIDIndx, InitInp%SimplCd, InitInp%SimplCdMG, InitInp%SimplCa, InitInp%SimplCaMG, InitInp%SimplCp, & + call SetExternalHydroCoefs( InitInp%WaveField%MSL2SWL, MCoefMod, MmbrCoefIDIndx, InitInp%SimplCd, InitInp%SimplCdMG, InitInp%SimplCa, InitInp%SimplCaMG, InitInp%SimplCp, & InitInp%SimplCpMG, InitInp%SimplAxCd, InitInp%SimplAxCdMG, InitInp%SimplAxCa, InitInp%SimplAxCaMG, InitInp%SimplAxCp, InitInp%SimplAxCpMG, & InitInp%SimplCb, InitInp%SimplCbMG, InitInp%SimplMCF, & InitInp%CoefMembers, InitInp%NCoefDpth, InitInp%CoefDpths, InitInp%Nodes, member ) @@ -1544,7 +1542,7 @@ subroutine SetMemberProperties( MSL2SWL, gravity, member, MCoefMod, MmbrCoefIDIn member%MmbrFilledIDIndx = MmbrFilledIDIndx ! Set this to the parameter version of this member data if ( MmbrFilledIDIndx > 0 ) then member%FillDens = InitInp%FilledGroups(MmbrFilledIDIndx)%FillDens - member%FillFSLoc = InitInp%FilledGroups(MmbrFilledIDIndx)%FillFSLoc - MSL2SWL + member%FillFSLoc = InitInp%FilledGroups(MmbrFilledIDIndx)%FillFSLoc - InitInp%WaveField%MSL2SWL if (member%FillFSLoc >= Zb) then member%z_overfill = member%FillFSLoc - Zb member%l_fill = member%RefLength @@ -1868,7 +1866,7 @@ subroutine SetupMembers( InitInp, p, m, errStat, errMsg ) prop2Indx = InitInp%InpMembers(I)%MPropSetID2Indx end if ! Now populate the various member data arrays using the HydroDyn input file data - call SetMemberProperties( p%WaveField%MSL2SWL, InitInp%Gravity, p%Members(i), InitInp%InpMembers(i)%MCoefMod, InitInp%InpMembers(i)%MmbrCoefIDIndx, InitInp%InpMembers(i)%MmbrFilledIDIndx, InitInp%MPropSets(prop1Indx), InitInp%MPropSets(prop2Indx), InitInp, errStat2, errMsg2 ) + call SetMemberProperties( InitInp%Gravity, p%Members(i), InitInp%InpMembers(i)%MCoefMod, InitInp%InpMembers(i)%MmbrCoefIDIndx, InitInp%InpMembers(i)%MmbrFilledIDIndx, InitInp%MPropSets(prop1Indx), InitInp%MPropSets(prop2Indx), InitInp, errStat2, errMsg2 ) call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'SetupMembers') if (ErrStat >= AbortErrLev) return end do @@ -2252,7 +2250,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In if ( errStat >= AbortErrLev ) return ! Write Summary information to *HydroDyn* summary file now that everything has been initialized. - CALL WriteSummaryFile( InitInp%UnSum, p%WaveField%MSL2SWL, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & + CALL WriteSummaryFile( InitInp%UnSum, InitInp%NJoints, InitInp%NNodes, InitInp%Nodes, p%NMembers, p%Members, & p%NumOuts, p%OutParam, p%MOutLst, p%JOutLst, u%Mesh, y%Mesh, p, m, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if ( errStat >= AbortErrLev ) return From ea8b3e6509f7ab1233ef2a587b62df009d05eb01 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 8 Nov 2023 11:21:48 -0700 Subject: [PATCH 049/232] SeaSt: cleanup `WvDiffQTFF` and `WvSumQTFF` --- modules/seastate/src/SeaState.f90 | 13 ++----- modules/seastate/src/SeaState.txt | 3 +- modules/seastate/src/SeaState_Types.f90 | 8 ---- modules/seastate/src/Waves2.f90 | 20 +++------- modules/seastate/src/Waves2.txt | 7 ---- modules/seastate/src/Waves2_Types.f90 | 49 ------------------------- 6 files changed, 11 insertions(+), 89 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 4de3b4b867..929b1f8eaa 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -91,9 +91,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(Waves_InitOutputType) :: Waves_InitOut ! Initialization Outputs from the Waves submodule initialization TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 submodule initialization TYPE(SeaSt_Interp_InitInputType) :: SeaSt_Interp_InitInp -! TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 module initialization TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization - INTEGER :: I,J,K ! Generic counters + INTEGER :: I ! Generic counters INTEGER :: it ! Generic counters REAL(ReKi) :: TmpElev ! temporary wave elevation @@ -267,11 +266,10 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN - ! Set a few things from the Waves module output + CALL Waves2_Init(InputFileData%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) InputFileData%Waves2%NStepWave = Waves_InitOut%NStepWave InputFileData%Waves2%NStepWave2 = Waves_InitOut%NStepWave2 - CALL Waves2_Init(InputFileData%Waves2, p%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -280,7 +278,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! The acceleration, velocity, and dynamic pressures will get added to the parts passed to the morrison module later... ! Difference frequency results - IF ( p%Waves2%WvDiffQTFF ) THEN + IF ( InputFileData%Waves2%WvDiffQTFF ) THEN ! Dynamic pressure -- difference frequency terms CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D @@ -298,7 +296,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ENDIF ! second order wave kinematics difference frequency results ! Sum frequency results - IF ( p%Waves2%WvSumQTFF ) THEN + IF ( InputFileData%Waves2%WvSumQTFF ) THEN ! Dynamic pressure -- sum frequency terms CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S @@ -318,9 +316,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ELSE ! these need to be set to zero since we don't have a UseWaves2 flag: InputFileData%Waves2%NWaveElevGrid = 0 - p%Waves2%WvDiffQTFF = .FALSE. - p%Waves2%WvSumQTFF = .FALSE. - ENDIF ! InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index f7c2acba08..f1b5a89c22 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -124,8 +124,7 @@ typedef ^ ^ SeaSt_Interp_MiscVarType # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType Waves2_ParameterType Waves2 - - - "Parameter data for the Waves2 module" - -typedef ^ ^ DbKi WaveDT - - - "Wave DT" sec +typedef ^ ParameterType DbKi WaveDT - - - "Wave DT" sec typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" typedef ^ ^ ReKi deltaGrid 3 - - "delta between grid points in x, y, and theta (for z)" m,m,rad diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 9697daa092..faa14e00ed 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -146,7 +146,6 @@ MODULE SeaState_Types ! ======================= ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType - TYPE(Waves2_ParameterType) :: Waves2 !< Parameter data for the Waves2 module [-] REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] @@ -1149,9 +1148,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'SeaSt_CopyParam' ErrStat = ErrID_None ErrMsg = '' - call Waves2_CopyParam(SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return DstParamData%WaveDT = SrcParamData%WaveDT DstParamData%NGridPts = SrcParamData%NGridPts DstParamData%NGrid = SrcParamData%NGrid @@ -1271,8 +1267,6 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - call Waves2_DestroyParam(ParamData%Waves2, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%WaveElevxi)) then deallocate(ParamData%WaveElevxi) end if @@ -1313,7 +1307,6 @@ subroutine SeaSt_PackParam(Buf, Indata) integer(IntKi) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - call Waves2_PackParam(Buf, InData%Waves2) call RegPack(Buf, InData%WaveDT) call RegPack(Buf, InData%NGridPts) call RegPack(Buf, InData%NGrid) @@ -1387,7 +1380,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - call Waves2_UnpackParam(Buf, OutData%Waves2) ! Waves2 call RegUnpack(Buf, OutData%WaveDT) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NGridPts) diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index 5925f07527..f5a94414d8 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -59,11 +59,10 @@ MODULE Waves2 !> @brief !! This routine is called at the start of the simulation to perform initialization steps. !! The parameters that are set here are not changed during the simulation. -SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) +SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(Waves2_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine - TYPE(Waves2_ParameterType), INTENT( OUT) :: p !< Parameters TYPE(Waves2_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField !< WaveFieldType INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -230,16 +229,9 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- - ! Now copy over things to parameters... + ! !-------------------------------------------------------------------------------- - ! Difference QTF - p%WvDiffQTFF = InitInp%WvDiffQTFF ! Flag for calculation - - ! Summation QTF - p%WvSumQTFF = InitInp%WvSumQTFF ! Flag for calculation - - ! The wave elevation information in frequency space -- we need to normalize this by NStepWave2 ALLOCATE ( WaveElevC0Norm(0:InitInp%NStepWave2) , STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) then @@ -426,7 +418,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- - IF(p%WvDiffQTFF) THEN + IF(InitInp%WvDiffQTFF) THEN ! Tell our nice users what is about to happen that may take a while: CALL WrScr ( ' Calculating second order difference frequency wave kinematics.' ) @@ -726,7 +718,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) END IF - ENDIF ! p%WvDiffQTFF + ENDIF ! WvDiffQTFF @@ -751,7 +743,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- - IF(p%WvSumQTFF) THEN + IF(InitInp%WvSumQTFF) THEN ! Tell our nice users what is about to happen that may take a while: CALL WrScr ( ' Calculating second order sum frequency wave kinematics.' ) @@ -1236,7 +1228,7 @@ SUBROUTINE Waves2_Init( InitInp, p, InitOut, WaveField, ErrStat, ErrMsg ) - ENDIF ! p%WvSumQTFF + ENDIF ! WvSumQTFF diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index 363b29017b..cd8c1dfeb9 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -46,10 +46,3 @@ typedef ^ ^ SiKi WaveVel2D typedef ^ ^ SiKi WaveVel2S {:}{:}{:}{:}{:} - - "Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.)" (m/s) - -# ..... 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 LOGICAL WvDiffQTFF - - - "Full difference QTF second order forces flag" (-) -typedef ^ ParameterType LOGICAL WvSumQTFF - - - "Full sum QTF second order forces flag" (-) - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index aff4cce40e..a8bca43538 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -59,12 +59,6 @@ MODULE Waves2_Types REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveVel2S !< Instantaneous 2nd-order sum frequency correction for the velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at each of the NWaveKinGrid points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] END TYPE Waves2_InitOutputType ! ======================= -! ========= Waves2_ParameterType ======= - TYPE, PUBLIC :: Waves2_ParameterType - LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] - END TYPE Waves2_ParameterType -! ======================= CONTAINS subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -488,48 +482,5 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - -subroutine Waves2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(Waves2_ParameterType), intent(in) :: SrcParamData - type(Waves2_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Waves2_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF - DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF -end subroutine - -subroutine Waves2_DestroyParam(ParamData, ErrStat, ErrMsg) - type(Waves2_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'Waves2_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine Waves2_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(Waves2_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'Waves2_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WvDiffQTFF) - call RegPack(Buf, InData%WvSumQTFF) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine Waves2_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(Waves2_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'Waves2_UnPackParam' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WvDiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvSumQTFF) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine END MODULE Waves2_Types !ENDOFREGISTRYGENERATEDFILE From fc085562b3dea5aafda08938c42c1d1d9ead2eab Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 8 Nov 2023 10:28:49 -0700 Subject: [PATCH 050/232] SeaState: Fix typo in message about adjusting WvHiCoff based on WaveDT --- modules/seastate/src/SeaState_Input.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 708a46827d..33442766b6 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -819,7 +819,7 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er TmpFreq = REAL( Pi/InputFileData%Waves%WaveDT,SiKi) if ( InputFileData%Waves%WvHiCOff > TmpFreq ) then InputFileData%Waves%WvHiCOff = TmpFreq - call SetErrStat( ErrID_Info,'WvLowCOff adjusted to '//trim(num2lstr(TmpFreq))//' rad/s, based on WaveDT.',ErrStat,ErrMsg,RoutineName) + call SetErrStat( ErrID_Info,'WvHiCOff adjusted to '//trim(num2lstr(TmpFreq))//' rad/s, based on WaveDT.',ErrStat,ErrMsg,RoutineName) end if end if From dca51650b2865b9412f5e92f95ce837f25affdb4 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 8 Nov 2023 11:38:41 -0700 Subject: [PATCH 051/232] HD/SeaSt: `NStepWave` and `NStepWave2` stored in WaveField --- modules/hydrodyn/src/HydroDyn.f90 | 31 +- modules/hydrodyn/src/HydroDyn.txt | 4 - modules/hydrodyn/src/HydroDyn_C_Binding.f90 | 2 - modules/hydrodyn/src/HydroDyn_DriverCode.f90 | 3 - modules/hydrodyn/src/HydroDyn_Input.f90 | 7 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 15 - modules/hydrodyn/src/Morison.f90 | 1 - modules/hydrodyn/src/Morison.txt | 2 - modules/hydrodyn/src/Morison_Types.f90 | 10 - modules/hydrodyn/src/SS_Excitation.f90 | 3 +- modules/hydrodyn/src/SS_Excitation.txt | 2 - modules/hydrodyn/src/SS_Excitation_Types.f90 | 10 - modules/hydrodyn/src/WAMIT.f90 | 37 ++- modules/hydrodyn/src/WAMIT.txt | 3 - modules/hydrodyn/src/WAMIT2.f90 | 121 ++++---- modules/hydrodyn/src/WAMIT2.txt | 5 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 15 - modules/hydrodyn/src/WAMIT_Types.f90 | 15 - modules/openfast-library/src/FAST_Subs.f90 | 3 - modules/seastate/src/SeaSt_WaveField.txt | 3 + .../seastate/src/SeaSt_WaveField_Types.f90 | 10 + modules/seastate/src/SeaState.f90 | 21 +- modules/seastate/src/SeaState.txt | 19 +- modules/seastate/src/SeaState_Output.f90 | 9 +- modules/seastate/src/SeaState_Types.f90 | 15 - modules/seastate/src/UserWaves.f90 | 82 +++--- modules/seastate/src/Waves.f90 | 275 +++++++++--------- modules/seastate/src/Waves.txt | 2 - modules/seastate/src/Waves2.f90 | 168 +++++------ modules/seastate/src/Waves2.txt | 6 - modules/seastate/src/Waves2_Types.f90 | 15 - modules/seastate/src/Waves_Types.f90 | 10 - 32 files changed, 380 insertions(+), 544 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index ef6a709f5c..ccfe24f358 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -269,10 +269,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data - - ! Copy Waves initialization output into the initialization input type for the WAMIT module - !p%NWaveElev = InputFileData%Waves%NWaveElev - p%NStepWave = InitInp%NStepWave m%LastIndWave = 1 @@ -353,10 +349,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I return end if - ! Copy SeaState initialization output into the initialization input type for the WAMIT module - - InputFileData%WAMIT%NStepWave = InitInp%NStepWave - InputFileData%WAMIT%NStepWave2 = InitInp%NStepWave2 CALL WAMIT_Init(InputFileData%WAMIT, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), z%WAMIT, OtherState%WAMIT(1), & y%WAMIT(1), m%WAMIT(1), Interval, ErrStat2, ErrMsg2 ) @@ -420,8 +412,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%WAMIT2used = .TRUE. ! Copy Waves initialization output into the initialization input type for the WAMIT module - InputFileData%WAMIT2%NStepWave = InitInp%NStepWave - InputFileData%WAMIT2%NStepWave2 = InitInp%NStepWave2 InputFileData%WAMIT2%Gravity = InitInp%Gravity ! Set values for all NBodyMods @@ -516,7 +506,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Waves ! Need to pre-process the incoming wave data to be compatible with FIT - FITInitData%N_omega = InitInp%NStepWave2 + FITInitData%N_omega = p%WaveField%NStepWave2 FITInitData%Wave_angle = p%WaveField%WaveDir ! allocate waves data arrays for FIT @@ -534,14 +524,14 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I END IF ! Populate wave arrays (Need to double chech this part. It doesn't look right!) - Np = 2*(InitInp%WaveField%WaveDOmega + 1) - DO I = 1 , InitInp%NStepWave2 + Np = 2*(p%WaveField%WaveDOmega + 1) + DO I = 1 , p%WaveField%NStepWave2 - dftreal = InitInp%WaveField%WaveElevC0( 1, ABS(I ) ) - dftimag = InitInp%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) + dftreal = p%WaveField%WaveElevC0( 1, ABS(I ) ) + dftimag = p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) FITInitData%Wave_amp (I) = sqrt( dftreal**2 + dftimag**2 ) * 2.0 / Np - FITInitData%Wave_omega (I) = I*InitInp%WaveField%WaveDOmega - FITInitData%Wave_number(I) = I*InitInp%WaveField%WaveDOmega**2. / InputFileData%Gravity + FITInitData%Wave_omega (I) = I*p%WaveField%WaveDOmega + FITInitData%Wave_number(I) = I*p%WaveField%WaveDOmega**2. / InputFileData%Gravity FITInitData%Wave_phase (I) = atan2( dftimag, dftreal ) END DO @@ -560,9 +550,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Are there Morison elements? IF ( InputFileData%Morison%NMembers > 0 ) THEN - ! Copy SeaState initialization output into the initialization input type for the Morison module - InputFileData%Morison%NStepWave = InitInp%NStepWave - ! Were visualization meshes requested? InputFileData%Morison%VisMeshes = p%VisMeshes @@ -1306,7 +1293,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, if (p%WAMIT2used) then if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then - call WAMIT2_CalcOutput( Time, p%WaveField%WaveTime, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) + call WAMIT2_CalcOutput( Time, p%WaveField, p%WAMIT2(1), y%WAMIT2(1), m%WAMIT2(1), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) do iBody=1,p%NBody y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(1)%Mesh%Force (:,iBody) @@ -1317,7 +1304,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, else do iBody=1,p%NBody - call WAMIT2_CalcOutput( Time, p%WaveField%WaveTime, p%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) + call WAMIT2_CalcOutput( Time, p%WaveField, p%WAMIT2(iBody), y%WAMIT2(iBody), m%WAMIT2(iBody), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT2(iBody)%Mesh%Force (:,1) y%WAMITMesh%Moment(:,iBody) = y%WAMITMesh%Moment(:,iBody) + y%WAMIT2(iBody)%Mesh%Moment(:,1) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 42eb66871c..be9ab3a78b 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -74,9 +74,6 @@ typedef ^ ^ ReKi typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # -typedef ^ ^ INTEGER NStepWave - 0 - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - 0 - "NStepWave / 2" - - typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - # @@ -152,7 +149,6 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER totalStates - - - "Number of excitation and radiation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalExctnStates - - - "Number of excitation states for all WAMIT bodies" - typedef ^ ^ INTEGER totalRdtnStates - - - "Number of radiation states for all WAMIT bodies" - -typedef ^ ^ INTEGER NStepWave - - - "Number of data points in the wave kinematics arrays" - typedef ^ ^ ReKi AddF0 {:}{:} - - "Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m)" - typedef ^ ^ ReKi AddCLin {:}{:}{:} - - "Additional stiffness matrix" - typedef ^ ^ ReKi AddBLin {:}{:}{:} - - "Additional linear damping matrix" - diff --git a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 index 89b5ae38ce..00a5e67e30 100644 --- a/modules/hydrodyn/src/HydroDyn_C_Binding.f90 +++ b/modules/hydrodyn/src/HydroDyn_C_Binding.f90 @@ -408,8 +408,6 @@ SUBROUTINE HydroDyn_C_Init( OutRootName_C, ! Transfer data from SeaState ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup - HD%InitInp%NStepWave = SeaSt%InitOutData%NStepWave - HD%InitInp%NStepWave2 = SeaSt%InitOutData%NStepWave2 HD%InitInp%InvalidWithSSExctn = SeaSt%InitOutData%InvalidWithSSExctn HD%InitInp%WaveField => SeaSt%InitOutData%WaveField ! can be set regardless of association(); if not associated, HD shouldn't work diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index 5afba8e9d4..ad0b1d7494 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -322,9 +322,6 @@ subroutine SetHD_InitInputs() InitInData_HD%Linearize = drvrData%Linearize ! Data from InitOutData_SeaSt: - InitInData_HD%NStepWave = InitOutData_SeaSt%NStepWave - InitInData_HD%NStepWave2 = InitOutData_SeaSt%NStepWave2 - InitInData_HD%InvalidWithSSExctn = InitOutData_SeaSt%InvalidWithSSExctn InitInData_HD%WaveField => InitOutData_SeaSt%WaveField diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 6446e752a9..64f6115894 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1127,7 +1127,12 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS !------------------------------------------------------------------------- ! Check environmental conditions !------------------------------------------------------------------------- - if (.not. associated(InitInp%WaveField) .or. InitInp%NStepWave == 0) then + if (.not. associated(InitInp%WaveField)) then + call SetErrStat( ErrID_Fatal,' No SeaState information available.',ErrStat,ErrMsg,RoutineName) + return + endif + + if (InitInp%WaveField%NStepWave == 0) then call SetErrStat( ErrID_Fatal,' No SeaState information available.',ErrStat,ErrMsg,RoutineName) return endif diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 04a3285133..4bfc1c2dbe 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -90,8 +90,6 @@ MODULE HydroDyn_Types REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] - INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType @@ -170,7 +168,6 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: totalStates = 0_IntKi !< Number of excitation and radiation states for all WAMIT bodies [-] INTEGER(IntKi) :: totalExctnStates = 0_IntKi !< Number of excitation states for all WAMIT bodies [-] INTEGER(IntKi) :: totalRdtnStates = 0_IntKi !< Number of radiation states for all WAMIT bodies [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of data points in the wave kinematics arrays [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] @@ -871,8 +868,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%TMax = SrcInitInputData%TMax DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -905,8 +900,6 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, InData%TMax) call RegPack(Buf, InData%VisMeshes) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -943,10 +936,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%VisMeshes) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) @@ -2052,7 +2041,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%totalStates = SrcParamData%totalStates DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates - DstParamData%NStepWave = SrcParamData%NStepWave if (allocated(SrcParamData%AddF0)) then LB(1:2) = lbound(SrcParamData%AddF0) UB(1:2) = ubound(SrcParamData%AddF0) @@ -2267,7 +2255,6 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%totalStates) call RegPack(Buf, InData%totalExctnStates) call RegPack(Buf, InData%totalRdtnStates) - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) @@ -2393,8 +2380,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%totalRdtnStates) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 218c52563a..e843896dc3 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1921,7 +1921,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%Gravity = InitInp%Gravity p%NNodes = InitInp%NNodes p%NJoints = InitInp%NJoints - p%NStepWave = InitInp%NStepWave p%NumOuts = InitInp%NumOuts p%NMOutputs = InitInp%NMOutputs ! Number of members to output [ >=0 and <10] p%WaveDisp = InitInp%WaveDisp diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 90fb49bf71..41fef50552 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -269,7 +269,6 @@ typedef ^ ^ Morison_JOu typedef ^ ^ CHARACTER(ChanLen) OutList {:} - - "This list size needs to be the maximum # of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs" - typedef ^ ^ INTEGER NumOuts - - - "" - typedef ^ ^ INTEGER UnSum - - - "" - -typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # @@ -349,7 +348,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi DP_Const_End {:}{:} - - "Constant part of Joint dynamic pressure term" N typedef ^ ^ ReKi Mass_MG_End {:} - - "Joint marine growth mass" kg typedef ^ ^ ReKi AM_End {:}{:}{:} - - "3x3 Joint added mass matrix, constant for all t" N -typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NMOutputs - - - "" - typedef ^ ^ Morison_MOutput MOutLst {:} - - "" - typedef ^ ^ INTEGER NJOutputs - - - "" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 07a4d3449b..0a60529f37 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -332,7 +332,6 @@ MODULE Morison_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< This list size needs to be the maximum # of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] INTEGER(IntKi) :: UnSum = 0_IntKi !< [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE Morison_InitInputType @@ -411,7 +410,6 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP_Const_End !< Constant part of Joint dynamic pressure term [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mass_MG_End !< Joint marine growth mass [kg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AM_End !< 3x3 Joint added mass matrix, constant for all t [N] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] @@ -3713,7 +3711,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NumOuts = SrcInitInputData%NumOuts DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%NStepWave = SrcInitInputData%NStepWave DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes end subroutine @@ -3979,7 +3976,6 @@ subroutine Morison_PackInitInput(Buf, Indata) end if call RegPack(Buf, InData%NumOuts) call RegPack(Buf, InData%UnSum) - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -4247,8 +4243,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%UnSum) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5524,7 +5518,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%AM_End = SrcParamData%AM_End end if - DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%NMOutputs = SrcParamData%NMOutputs if (allocated(SrcParamData%MOutLst)) then LB(1:1) = lbound(SrcParamData%MOutLst) @@ -5735,7 +5728,6 @@ subroutine Morison_PackParam(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%AM_End), ubound(InData%AM_End)) call RegPack(Buf, InData%AM_End) end if - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NMOutputs) call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then @@ -5958,8 +5950,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AM_End) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index fc492693de..9cc0bf72ff 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -101,7 +101,7 @@ function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) if (p%ExctnDisp == 0) then - GetWaveElevation = InterpWrappedStpReal ( real(time, SiKi), p%WaveField%WaveTime, p%WaveField%WaveElev0, m%LastIndWave, p%NStepWave + 1 ) + GetWaveElevation = InterpWrappedStpReal ( real(time, SiKi), p%WaveField%WaveTime, p%WaveField%WaveElev0, m%LastIndWave, p%WaveField%NStepWave + 1 ) else call SS_Exc_CopyInput(u_in(1), u_out, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! allocates arrays so that SS_Exc_Input_ExtrapInterp will work @@ -170,7 +170,6 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini p%numStates = 0 ! Set wave field data and parameters from InitInp: - p%NStepWave = InitInp%NStepWave p%WaveField => InitInp%WaveField p%ExctnDisp = InitInp%ExctnDisp diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 5bfaaad57c..f5b9311d60 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -20,7 +20,6 @@ usefrom SeaSt_WaveField.txt typedef SS_Excitation/SS_Exc InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - typedef ^ ^ IntKi NBody - - - "Number of WAMIT bodies for this State Space model" - typedef ^ ^ IntKi ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - -typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - @@ -55,7 +54,6 @@ typedef ^ ^ SeaSt_Interp_MiscVarType typedef ^ ParameterType DbKi DT - - - "Time step" s typedef ^ ^ IntKi NBody - - - "Number of WAMIT bodies for this State Space model" - typedef ^ ^ IntKi ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - -typedef ^ ^ INTEGER NStepWave - - - "Number of timesteps in the WaveTime array" - typedef ^ ^ IntKi spDOF {:} - - "States per DOF" - typedef ^ ^ ReKi A {:}{:} - - "A matrix" - typedef ^ ^ ReKi B {:} - - "B matrix" - diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index b0a19f34f5..d2ba97c733 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -40,7 +40,6 @@ MODULE SS_Excitation_Types CHARACTER(1024) :: InputFile !< Name of the input file [-] INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE SS_Exc_InitInputType @@ -83,7 +82,6 @@ MODULE SS_Excitation_Types REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [s] INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spDOF !< States per DOF [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: B !< B matrix [-] @@ -121,7 +119,6 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%InputFile = SrcInitInputData%InputFile DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp - DstInitInputData%NStepWave = SrcInitInputData%NStepWave if (allocated(SrcInitInputData%PtfmRefztRot)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) @@ -161,7 +158,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPack(Buf, InData%InputFile) call RegPack(Buf, InData%NBody) call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) @@ -193,8 +189,6 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -630,7 +624,6 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%DT = SrcParamData%DT DstParamData%NBody = SrcParamData%NBody DstParamData%ExctnDisp = SrcParamData%ExctnDisp - DstParamData%NStepWave = SrcParamData%NStepWave if (allocated(SrcParamData%spDOF)) then LB(1:1) = lbound(SrcParamData%spDOF) UB(1:1) = ubound(SrcParamData%spDOF) @@ -717,7 +710,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) call RegPack(Buf, InData%DT) call RegPack(Buf, InData%NBody) call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, allocated(InData%spDOF)) if (allocated(InData%spDOF)) then call RegPackBounds(Buf, 1, lbound(InData%spDOF), ubound(InData%spDOF)) @@ -766,8 +758,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%spDOF)) deallocate(OutData%spDOF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index bc783290ec..9d89726b96 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -217,7 +217,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ErrMsg = "" ! Copy Output Init data from Waves Module Init call - p%NStepWave = InitInp%NStepWave p%ExctnMod = InitInp%ExctnMod p%ExctnDisp = InitInp%ExctnDisp p%ExctnCutOff = InitInp%ExctnCutOff @@ -909,7 +908,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Initialize everything to zero: - ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctn (0:p%WaveField%NStepWave,6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -921,7 +920,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS else if ( p%ExctnMod == 2 ) then Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Exctn_InitInp%InputFile = InitInp%WAMITFile - SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp @@ -970,7 +968,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! ALLOCATE the arrays: - ALLOCATE ( WaveExctnC(0:InitInp%NStepWave2 ,6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( WaveExctnC(0:p%WaveField%NStepWave2 ,6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -978,20 +976,20 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF if (p%ExctnDisp > 0 ) then - ALLOCATE ( WaveExctnCGrid(0:InitInp%NStepWave2 ,p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3),6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( WaveExctnCGrid(0:p%WaveField%NStepWave2 ,p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3),6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF - ALLOCATE ( p%WaveExctnGrid (0:InitInp%NStepWave,p%WaveField%SeaSt_Interp_p%n(2),p%WaveField%SeaSt_Interp_p%n(3), 6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave,p%WaveField%SeaSt_Interp_p%n(2),p%WaveField%SeaSt_Interp_p%n(3), 6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF else - ALLOCATE ( p%WaveExctn (0:InitInp%NStepWave,6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctn (0:p%WaveField%NStepWave,6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -1070,7 +1068,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the positive-frequency components (including zero) of the discrete ! Fourier transform of the wave excitation force: - DO I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + DO I = 0,p%WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform ! Compute the frequency of this component: @@ -1098,7 +1096,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! 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 InitFFT ( p%WaveField%NStepWave, FFT_Data, .TRUE., ErrStat2 ) CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -1106,7 +1104,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments - CALL ApplyFFT_cx ( p%WaveExctn(0:InitInp%NStepWave-1,J), WaveExctnC(:,J), FFT_Data, ErrStat2 ) + CALL ApplyFFT_cx ( p%WaveExctn(0:p%WaveField%NStepWave-1,J), WaveExctnC(:,J), FFT_Data, ErrStat2 ) CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -1114,7 +1112,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF ! Append first datpoint as the last as aid for repeated wave data - p%WaveExctn(InitInp%NStepWave,J) = p%WaveExctn(0,J) + p%WaveExctn(p%WaveField%NStepWave,J) = p%WaveExctn(0,J) END DO ! J - All wave excitation forces and moments CALL ExitFFT(FFT_Data, ErrStat2) @@ -1125,7 +1123,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF else - DO I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + DO I = 0,p%WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform ! Compute the frequency of this component: @@ -1152,7 +1150,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! 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 InitFFT ( p%WaveField%NStepWave, FFT_Data, .TRUE., ErrStat2 ) CALL SetErrStat( ErrStat2, 'Error in call to InitFFT.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -1163,14 +1161,14 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) iX = mod(iGrid-1, p%WaveField%SeaSt_Interp_p%n(2)) + 1 ! 1st n index is time iY = (iGrid-1) / p%WaveField%SeaSt_Interp_p%n(2) + 1 - CALL ApplyFFT_cx ( p%WaveExctnGrid(0:InitInp%NStepWave-1,iX,iY,J), WaveExctnCGrid(:,iGrid,J), FFT_Data, ErrStat2 ) + CALL ApplyFFT_cx ( p%WaveExctnGrid(0:p%WaveField%NStepWave-1,iX,iY,J), WaveExctnCGrid(:,iGrid,J), FFT_Data, ErrStat2 ) CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF ! Append first datpoint as the last as aid for repeated wave data - p%WaveExctnGrid(InitInp%NStepWave,iX,iY,J) = p%WaveExctnGrid(0,iX,iY,J) + p%WaveExctnGrid(p%WaveField%NStepWave,iX,iY,J) = p%WaveExctnGrid(0,iX,iY,J) end do END DO ! J - All wave excitation forces and moments @@ -1188,7 +1186,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS else if ( p%ExctnMod == 2 ) then Interval_Sub = InitInp%Conv_Rdtn%RdtnDT SS_Exctn_InitInp%InputFile = InitInp%WAMITFile - SS_Exctn_InitInp%NStepWave = p%NStepWave SS_Exctn_InitInp%NBody = InitInp%NBody SS_Exctn_InitInp%PtfmRefztRot = InitInp%PtfmRefztRot SS_Exctn_InitInp%ExctnDisp = InitInp%ExctnDisp @@ -1210,7 +1207,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Now apply the phase shift in the frequency space do J = 1, NInpWvDir - do I = 0,InitInp%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + do I = 0,p%WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform ! Compute the frequency of this component: @@ -1231,7 +1228,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! Compute the inverse discrete Fourier transforms to find the time-domain ! representations of the wave kinematics without stretching: - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .TRUE., ErrStat2 ) + CALL InitFFT ( p%WaveField%NStepWave, FFT_Data, .TRUE., ErrStat2 ) CALL SetErrStat(ErrStat2,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1240,7 +1237,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS ! We'll need the following for wave stretching once we implement it. ! NOTE THIS IS OVERWRITING THE WAVEFIELD WaveElev0 PARAMETER DATA - CALL ApplyFFT_cx ( SS_Exctn_InitInp%WaveField%WaveElev0(0:InitInp%NStepWave-1), tmpComplexArr(: ), FFT_Data, ErrStat2 ) + CALL ApplyFFT_cx ( SS_Exctn_InitInp%WaveField%WaveElev0(0:p%WaveField%NStepWave-1), tmpComplexArr(: ), FFT_Data, ErrStat2 ) CALL SetErrStat(ErrStat2,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1827,7 +1824,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E DO I = 1,6*p%NBody ! Loop through all wave excitation forces and moments m%F_Waves1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), WaveTime(:), p%WaveExctn(:,I), & - m%LastIndWave, p%NStepWave + 1 ) + m%LastIndWave, p%WaveField%NStepWave + 1 ) END DO ! I - All wave excitation forces and moments else ! p%ExctnDisp > 0 IF ( .NOT. allocated ( p%WaveExctnGrid ) ) THEN diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index aa7f7a287f..51c0294603 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -38,8 +38,6 @@ typedef ^ ^ ReKi typedef ^ ^ DbKi RdtnTMax - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - -typedef ^ ^ INTEGER NStepWave - - - "" - -typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # @@ -113,7 +111,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi ExctnFiltConst - - - "Low-pass time filter constant computed from ExctnCutOff" typedef ^ ^ SiKi WaveExctn {:}{:} - - "" - typedef ^ ^ SiKi WaveExctnGrid {:}{:}{:}{:} - - "WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for eac WAMIT Body" - -typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ Conv_Rdtn_ParameterType Conv_Rdtn - - - "" - typedef ^ ^ SS_Rad_ParameterType SS_Rdtn - - - "" - typedef ^ ^ SS_Exc_ParameterType SS_Exctn - - - "" - diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index d525565638..f0090ac458 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -1137,13 +1137,13 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS END IF - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! NOTE: since the Mean Drift only returns a static time independent average value for the drift force, we do not ! need to account for any offset in the location of the WAMIT body (this term vanishes). ! First get the wave amplitude -- must be reconstructed from the WaveElevC0 array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 to remove the built in normalization in WaveElevC0. - aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 + aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%WaveField%NStepWave2 ! Calculate the frequency Omega1 = J * InitInp%WaveField%WaveDOmega @@ -1614,19 +1614,19 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Setup the arrays holding the Newman terms, both the complex frequency domain and real time domain pieces - ALLOCATE( NewmanTerm1t( 0:InitInp%NStepWave ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm1t( 0:InitInp%WaveField%NStepWave ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the first term of the Newmans '// & 'approximation in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanTerm2t( 0:InitInp%NStepWave ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm2t( 0:InitInp%WaveField%NStepWave ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the second term of the Newmans '// & 'approximation in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanTerm1C( 0:InitInp%NStepWave2, 6 ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm1C( 0:InitInp%WaveField%NStepWave2, 6 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the first term of the Newmans '// & 'approximation in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanTerm2C( 0:InitInp%NStepWave2, 6 ), STAT=ErrStatTmp ) + ALLOCATE( NewmanTerm2C( 0:InitInp%WaveField%NStepWave2, 6 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for calculating the second term of the Newmans '// & 'approximation in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( NewmanAppForce( 0:InitInp%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( NewmanAppForce( 0:InitInp%WaveField%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the resulting Newmans '// & 'approximation of the 2nd order force.',ErrStat, ErrMsg, RoutineName) @@ -1650,7 +1650,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Initialize the FFT library - CALL InitCFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! Complex result FFT initialize + CALL InitCFFT ( InitInp%WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! Complex result FFT initialize CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF (ALLOCATED(TmpData3D)) DEALLOCATE(TmpData3D,STAT=ErrStatTmp) @@ -1708,11 +1708,11 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg END IF - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! First get the wave amplitude -- must be reconstructed from the WaveElevC array. First index is the real (1) or ! imaginary (2) part. Divide by NStepWave2 so that the wave amplitude is of the same form as the paper. - aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%NStepWave2 + aWaveElevC = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi) / InitInp%WaveField%NStepWave2 ! Calculate the frequency Omega1 = J * InitInp%WaveField%WaveDOmega @@ -1795,7 +1795,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ENDIF - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 ENDIF ! Load component to calculate @@ -1812,7 +1812,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) ! Loop through all the frequencies - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Frequency Omega1 = J * InitInp%WaveField%WaveDOmega @@ -1846,7 +1846,7 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg NewmanTerm2C(J,1:2) = MATMUL(RotateZMatrixT, NewmanTerm2C(J,1:2)) NewmanTerm2C(J,4:5) = MATMUL(RotateZMatrixT, NewmanTerm2C(J,4:5)) - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 @@ -1888,12 +1888,12 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg ! Now square the real part of the resulting time domain pieces and add them together to get the final force time series. - DO J=0,InitInp%NStepWave-1 + DO J=0,InitInp%WaveField%NStepWave-1 NewmanAppForce(J,Idx) = (abs(NewmanTerm1t(J)))**2 - (abs(NewmanTerm2t(J)))**2 ENDDO ! Copy the last first term to the last so that it is cyclic - NewmanAppForce(InitInp%NStepWave,Idx) = NewmanAppForce(0,Idx) + NewmanAppForce(InitInp%WaveField%NStepWave,Idx) = NewmanAppForce(0,Idx) ENDDO ! ThisDim -- index to current dimension @@ -2155,13 +2155,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Setup the arrays holding the DiffQTF terms, both the complex frequency domain and real time domain pieces - ALLOCATE( TmpDiffQTFForce( 0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE( TmpDiffQTFForce( 0:InitInp%WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for one load component of the full difference '// & 'QTF 2nd order force time series.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( TmpComplexArr( 0:InitInp%NStepWave2, 6), STAT=ErrStatTmp ) + ALLOCATE( TmpComplexArr( 0:InitInp%WaveField%NStepWave2, 6), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for one load component of the full difference '// & 'QTF 2nd order force in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( DiffQTFForce( 0:InitInp%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( DiffQTFForce( 0:InitInp%WaveField%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the full difference '// & 'QTF 2nd order force time series.',ErrStat, ErrMsg, RoutineName) @@ -2177,7 +2177,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Initialize the FFT library. Do not apply normalization. - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL InitFFT ( InitInp%WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN call cleanup() @@ -2244,7 +2244,7 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS TmpData4D = DiffQTFData%Data4D%DataSet(:,:,:,:,Idx) ! Outer loop to create the TmpComplexArr - DO J=1,InitInp%NStepWave2-1 + DO J=1,InitInp%WaveField%NStepWave2-1 ! Calculate the frequency -- This is the difference frequency. OmegaDiff = J * InitInp%WaveField%WaveDOmega @@ -2258,15 +2258,15 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Do the sum over H^- - DO K=1,InitInp%NStepWave2-J ! note the funny upper limit. This is because we are doing a summation on a triangular area. + DO K=1,InitInp%WaveField%NStepWave2-J ! note the funny upper limit. This is because we are doing a summation on a triangular area. ! set the two frequencies that the difference frequency comes from Omega1 = (J + K) * InitInp%WaveField%WaveDOmega ! the mth frequency -- \mu^- + n = m Omega2 = K * InitInp%WaveField%WaveDOmega ! the nth frequency ! Find the Wave amplitudes 1 and 2 - aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J+K), InitInp%WaveField%WaveElevC0(2,J+K), SiKi) / InitInp%NStepWave2 - aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,K), InitInp%WaveField%WaveElevC0(2,K), SiKi) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J+K), InitInp%WaveField%WaveElevC0(2,J+K), SiKi) / InitInp%WaveField%NStepWave2 + aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,K), InitInp%WaveField%WaveElevC0(2,K), SiKi) / InitInp%WaveField%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveField%WaveDirArr(J+K), InitInp%WaveField%WaveDirArr(K) /) @@ -2339,13 +2339,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) ! Loop through all the frequencies - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Apply the rotation to get back to global frame TmpComplexArr(J,1:2) = MATMUL(RotateZMatrixT, TmpComplexArr(J,1:2)) TmpComplexArr(J,4:5) = MATMUL(RotateZMatrixT, TmpComplexArr(J,4:5)) - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 @@ -2368,13 +2368,13 @@ SUBROUTINE DiffQTF_InitCalc( InitInp, p, DiffQTFData, DiffQTFForce, ErrMsg, ErrS ! Now we multiply the result by 2 and save it to the DiffQTFForce array and add the MnDrift term ! NOTE: phase shift and orientations on the MnDriftForce term have already been applied - ! NOTE: the "-1" since TmpDiffQTFForce(InitInp%NStepWave) is not set and DiffQTFForce(InitInp%NStepWave,Idx) gets overwritten - DO K=0,InitInp%NStepWave-1 + ! NOTE: the "-1" since TmpDiffQTFForce(InitInp%WaveField%NStepWave) is not set and DiffQTFForce(InitInp%WaveField%NStepWave,Idx) gets overwritten + DO K=0,InitInp%WaveField%NStepWave-1 DiffQTFForce(K,Idx) = 2.0_SiKi * TmpDiffQTFForce(K) + MnDriftForce(Idx) ENDDO ! Copy the last first term to the first so that it is cyclic - DiffQTFForce(InitInp%NStepWave,Idx) = DiffQTFForce(0,Idx) + DiffQTFForce(InitInp%WaveField%NStepWave,Idx) = DiffQTFForce(0,Idx) ENDDO ! ThisDim -- The current dimension ENDDO ! IBody -- This WAMIT body @@ -2661,19 +2661,19 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Setup the arrays holding the SumQTF terms, both the complex frequency domain and real time domain pieces - ALLOCATE( Term1ArrayC( 0:InitInp%NStepWave2, 6), STAT=ErrStatTmp ) + ALLOCATE( Term1ArrayC( 0:InitInp%WaveField%NStepWave2, 6), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the first term of one load component of the full sum '// & 'QTF 2nd order force in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( Term2ArrayC( 0:InitInp%NStepWave2, 6), STAT=ErrStatTmp ) + ALLOCATE( Term2ArrayC( 0:InitInp%WaveField%NStepWave2, 6), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the second term of one load component of the full sum '// & 'QTF 2nd order force in the frequency domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( Term1Array( 0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE( Term1Array( 0:InitInp%WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the first term of one load component of the full sum '// & 'QTF 2nd order force in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( Term2Array( 0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE( Term2Array( 0:InitInp%WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the second term of one load component of the full sum '// & 'QTF 2nd order force in the time domain.',ErrStat, ErrMsg, RoutineName) - ALLOCATE( SumQTFForce( 0:InitInp%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) + ALLOCATE( SumQTFForce( 0:InitInp%WaveField%NStepWave, 6*p%NBody), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,' Cannot allocate array for the full difference '// & 'QTF 2nd order force time series.',ErrStat, ErrMsg, RoutineName) @@ -2693,7 +2693,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Initialize the FFT library. Normalization not required in this formulation. - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! FIXME: + CALL InitFFT ( InitInp%WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) ! FIXME: CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF (ALLOCATED(TmpData4D)) DEALLOCATE(TmpData4D,STAT=ErrStatTmp) @@ -2748,7 +2748,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! The limits look a little funny. But remember we are placing the value in the 2*J location, ! so we cannot overun the end of the array, and the highest frequency must be zero. The ! floor function is just in case (NStepWave2 - 1) is an odd number - DO J=1,FLOOR(REAL(InitInp%NStepWave2-1)/2.0_SiKi) + DO J=1,FLOOR(REAL(InitInp%WaveField%NStepWave2-1)/2.0_SiKi) ! The frequency Omega1 = REAL(J,ReKi) * InitInp%WaveField%WaveDOmega @@ -2759,7 +2759,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Find the wave amplitude at frequency omega - aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi ) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1,J), InitInp%WaveField%WaveElevC0(2,J), SiKi ) / InitInp%WaveField%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega1,SiKi), InitInp%WaveField%WaveDirArr(J), InitInp%WaveField%WaveDirArr(J) /) @@ -2831,11 +2831,11 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! so, we don't need a really small WaveDT !This section has been removed since it is kind of annoying. - ! IF ( InitInp%WvHiCOffS > InitInp%NStepWave2*InitInp%WaveField%WaveDOmega ) THEN + ! IF ( InitInp%WvHiCOffS > InitInp%WaveField%NStepWave2*InitInp%WaveField%WaveDOmega ) THEN ! CALL SetErrStat( ErrID_Warn,' The high frequency cutoff for second order wave forces, WvHiCOffS, '// & ! 'is larger than the Nyquist frequency for the given time step of WaveDT. The Nyquist frequency '// & ! '(highest frequency) that can be computed is OmegaMax = PI/WaveDT = '// & - ! TRIM(Num2LStr(InitInp%NStepWave2*InitInp%WaveField%WaveDOmega))// & + ! TRIM(Num2LStr(InitInp%WaveField%NStepWave2*InitInp%WaveField%WaveDOmega))// & ! ' radians/second. If you need those frequencies, decrease WaveDT. For reference, 2*PI '// & ! 'radians/second corresponds to a wavelength of ~1 meter.',& ! ErrStat,ErrMsg,RoutineName) @@ -2844,7 +2844,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ! Outer loop to create the Term2ArrayC. This is stepwise through the sum frequencies. - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Calculate the frequency -- This is the sum frequency. OmegaSum = J * InitInp%WaveField%WaveDOmega @@ -2872,8 +2872,8 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat Omega2 = (J-K) * InitInp%WaveField%WaveDOmega ! Find the wave amplitude at frequency omega. Remove the NStepWave2 normalization built into WaveElevC0 from Waves module - aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1, K), InitInp%WaveField%WaveElevC0(2, K), SiKi ) / InitInp%NStepWave2 - aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,J-K), InitInp%WaveField%WaveElevC0(2,J-K), SiKi ) / InitInp%NStepWave2 + aWaveElevC1 = CMPLX( InitInp%WaveField%WaveElevC0(1, K), InitInp%WaveField%WaveElevC0(2, K), SiKi ) / InitInp%WaveField%NStepWave2 + aWaveElevC2 = CMPLX( InitInp%WaveField%WaveElevC0(1,J-K), InitInp%WaveField%WaveElevC0(2,J-K), SiKi ) / InitInp%WaveField%NStepWave2 ! Set the (omega1,omega2,beta1,beta2) point we are looking for. Coord4 = (/ REAL(Omega1,SiKi), REAL(Omega2,SiKi), InitInp%WaveField%WaveDirArr(K), InitInp%WaveField%WaveDirArr(J-K) /) @@ -2939,7 +2939,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat RotateZMatrixT(:,2) = (/ sin(InitInp%PtfmRefztRot(IBody)), cos(InitInp%PtfmRefztRot(IBody)) /) ! Loop through all the frequencies - DO J=1,InitInp%NStepWave2 + DO J=1,InitInp%WaveField%NStepWave2 ! Apply the rotation to get back to global frame -- term 1 Term1ArrayC(J,1:2) = MATMUL(RotateZMatrixT, Term1ArrayC(J,1:2)) @@ -2949,7 +2949,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat Term2ArrayC(J,1:2) = MATMUL(RotateZMatrixT, Term2ArrayC(J,1:2)) Term2ArrayC(J,4:5) = MATMUL(RotateZMatrixT, Term2ArrayC(J,4:5)) - ENDDO ! J=1,InitInp%NStepWave2 + ENDDO ! J=1,InitInp%WaveField%NStepWave2 @@ -2979,12 +2979,12 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ENDIF ! Now we add the two terms together. The 0.5 multiplier on is because the double sided FFT was used. - DO J=0,InitInp%NStepWave-1 !bjj: Term1Array and Term2Array don't set the last element, so we can get over-flow errors here. SumQTFForce(InitInp%NStepWave,Idx) gets overwritten later, so Idx'm setting the array bounds to be -1. + DO J=0,InitInp%WaveField%NStepWave-1 !bjj: Term1Array and Term2Array don't set the last element, so we can get over-flow errors here. SumQTFForce(InitInp%WaveField%NStepWave,Idx) gets overwritten later, so Idx'm setting the array bounds to be -1. SumQTFForce(J,Idx) = 0.5_SiKi*(REAL(Term1Array(J) + 2*Term2Array(J), SiKi)) ENDDO ! Copy the last first term to the first so that it is cyclic - SumQTFForce(InitInp%NStepWave,Idx) = SumQTFForce(0,Idx) + SumQTFForce(InitInp%WaveField%NStepWave,Idx) = SumQTFForce(0,Idx) ENDDO ! ThisDim -- current dimension @@ -3285,9 +3285,9 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, !> 1. Check that WaveElevC0 is a 2x(NStepWave2+1) sized array (0 index start) - IF ( SIZE( InitInp%WaveField%WaveElevC0, 2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( InitInp%WaveField%WaveElevC0, 2 ) /= (InitInp%WaveField%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to WAMIT2_Init:'//NewLine// & - ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%NStepWave2 + 1))// & + ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%WaveField%NStepWave2 + 1))// & ' (2x(NStepWave2+1)), but instead received array of size '// & TRIM(Num2LStr(SIZE(InitInp%WaveField%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(InitInp%WaveField%WaveElevC0,2)))//'.', ErrStat, ErrMsg, RoutineName) RETURN @@ -3299,13 +3299,9 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, !-------------------------------------------------------------------------------- !> ### Now copy over things to parameters... !-------------------------------------------------------------------------------- - !> 1. Wave information we need to keep - !-------------------------------------------------------------------------------- - p%NStepWave = InitInp%NStepWave - !-------------------------------------------------------------------------------- - !> 3. WAMIT body related information + !> WAMIT body related information !-------------------------------------------------------------------------------- p%NBody = InitInp%NBody ! Number of bodies WAMIT2 sees @@ -3422,7 +3418,7 @@ SUBROUTINE CheckInitInput( InitInp, p, MnDriftData, NewmanAppData, DiffQTFData, !-------------------------------------------------------------------------------- ! Allocate array for the WaveExtcn2. - ALLOCATE( p%WaveExctn2(0:InitInp%NStepWave,6*p%NBody), STAT=ErrStatTmp) + ALLOCATE( p%WaveExctn2(0:InitInp%WaveField%NStepWave,6*p%NBody), STAT=ErrStatTmp) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array p%WaveExctn2 to store '// & 'the 2nd order force data.', ErrStat,ErrMsg,'CheckInitInp') IF (ErrStat >= AbortErrLev ) RETURN @@ -5363,11 +5359,11 @@ END SUBROUTINE ReadRealNumber !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE WAMIT2_CalcOutput( Time, WaveTime, p, y, m, ErrStat, ErrMsg ) +SUBROUTINE WAMIT2_CalcOutput( Time, WaveField, p, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - real(SiKi), intent(in ) :: WaveTime(:) !< Array of wave kinematic time samples, (sec) + TYPE(SeaSt_WaveFieldType), INTENT(IN ) :: WaveField !< Wave data TYPE(WAMIT2_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh !! connectivity information does not have to be recalculated) @@ -5389,28 +5385,17 @@ SUBROUTINE WAMIT2_CalcOutput( Time, WaveTime, p, y, m, ErrStat, ErrMsg ) ErrMsg = "" - - - ! Abort if the wave excitation loads have not been computed yet: - - IF ( .NOT. ALLOCATED ( p%WaveExctn2 ) ) THEN - CALL SetErrStat(ErrID_Fatal,' Routine WAMIT2_Init() must be called before routine WAMIT2_CalcOutput().',ErrStat,ErrMsg,'WAMIT2_CalcOutput') - RETURN - END IF - - ! Compute the 2nd order load contribution from incident waves: do iBody = 1, p%NBody indxStart = (iBody-1)*6 DO I = 1,6 ! Loop through all wave excitation forces and moments - m%F_Waves2(indxStart+I) = InterpWrappedStpReal ( REAL(Time, SiKi), WaveTime(:), p%WaveExctn2(:,indxStart+I), & - m%LastIndWave(IBody), p%NStepWave + 1 ) + m%F_Waves2(indxStart+I) = InterpWrappedStpReal ( REAL(Time, SiKi), WaveField%WaveTime, p%WaveExctn2(:,indxStart+I), & + m%LastIndWave(IBody), WaveField%NStepWave + 1 ) END DO ! I - All wave excitation forces and moments - ! Copy results to the output point mesh DO I=1,3 y%Mesh%Force(I,IBody) = m%F_Waves2(indxStart+I) diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 4ce1646217..4461144d7e 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -28,8 +28,6 @@ typedef ^ ^ ReKi PtfmRefzt typedef ^ ^ R8Ki PtfmRefztRot {:} - - "The rotation about zt of the body reference frame(s) from xt/yt" radians typedef ^ ^ ReKi WAMITULEN - - - "WAMIT unit length scale" - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" (m/s^2) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" @@ -59,8 +57,7 @@ typedef ^ ^ ReKi F_Waves2 # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: # -typedef ^ ParameterType IntKi NStepWave - - - "Number of wave time steps" - -typedef ^ ^ INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - +typedef ^ ParameterType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - typedef ^ ^ INTEGER NBodyMod - - - "Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1]" - #The 2nd order force time series diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index f2becc27f6..603be0c1d1 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -46,8 +46,6 @@ MODULE WAMIT2_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< WAMIT unit length scale [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] @@ -68,7 +66,6 @@ MODULE WAMIT2_Types ! ======================= ! ========= WAMIT2_ParameterType ======= TYPE, PUBLIC :: WAMIT2_ParameterType - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of wave time steps [-] INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn2 !< Time series of the resulting 2nd order force (first index is timestep, second index is load component) [(N)] @@ -154,8 +151,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%MnDrift = SrcInitInputData%MnDrift @@ -223,8 +218,6 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%PtfmRefztRot) end if call RegPack(Buf, InData%WAMITULEN) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%Gravity) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then @@ -320,10 +313,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) end if call RegUnpack(Buf, OutData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) @@ -483,7 +472,6 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' ErrStat = ErrID_None ErrMsg = '' - DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%WaveExctn2)) then @@ -525,7 +513,6 @@ subroutine WAMIT2_PackParam(Buf, Indata) type(WAMIT2_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackParam' if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NBody) call RegPack(Buf, InData%NBodyMod) call RegPack(Buf, allocated(InData%WaveExctn2)) @@ -552,8 +539,6 @@ subroutine WAMIT2_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NBodyMod) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 96d096c199..5ec3700014 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -57,8 +57,6 @@ MODULE WAMIT_Types REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] - INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE WAMIT_InitInputType ! ======================= @@ -124,7 +122,6 @@ MODULE WAMIT_Types REAL(ReKi) :: ExctnFiltConst = 0.0_ReKi !< Low-pass time filter constant computed from ExctnCutOff [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn !< [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveExctnGrid !< WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for eac WAMIT Body [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] TYPE(Conv_Rdtn_ParameterType) :: Conv_Rdtn !< [-] TYPE(SS_Rad_ParameterType) :: SS_Rdtn !< [-] TYPE(SS_Exc_ParameterType) :: SS_Exctn !< [-] @@ -254,8 +251,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err call Conv_Rdtn_CopyInitInput(SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 DstInitInputData%WaveField => SrcInitInputData%WaveField end subroutine @@ -347,8 +342,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%RdtnTMax) call RegPack(Buf, InData%WAMITFile) call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -490,10 +483,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1126,7 +1115,6 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid end if - DstParamData%NStepWave = SrcParamData%NStepWave call Conv_Rdtn_CopyParam(SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1211,7 +1199,6 @@ subroutine WAMIT_PackParam(Buf, Indata) call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid), ubound(InData%WaveExctnGrid)) call RegPack(Buf, InData%WaveExctnGrid) end if - call RegPack(Buf, InData%NStepWave) call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) call SS_Rad_PackParam(Buf, InData%SS_Rdtn) call SS_Exc_PackParam(Buf, InData%SS_Exctn) @@ -1320,8 +1307,6 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveExctnGrid) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_UnpackParam(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn call SS_Rad_UnpackParam(Buf, OutData%SS_Rdtn) ! SS_Rdtn call SS_Exc_UnpackParam(Buf, OutData%SS_Exctn) ! SS_Exctn diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c76c10b6dd..c7b44503a3 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -855,10 +855,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true - Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave - Init%InData_HD%NStepWave2 = Init%OutData_SeaSt%NStepWave2 Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - Init%InData_HD%WaveField => Init%OutData_SeaSt%WaveField ! end if diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 55febd4d8c..9d5c659752 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -55,3 +55,6 @@ typedef ^ ^ SiKi WvLowCOffS typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters." - + +typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - +typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 4456bbb8f4..a6d6262c06 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -82,6 +82,8 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS @@ -300,6 +302,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WvHiCOffS = SrcSeaSt_WaveFieldTypeData%WvHiCOffS DstSeaSt_WaveFieldTypeData%WaveDOmega = SrcSeaSt_WaveFieldTypeData%WaveDOmega DstSeaSt_WaveFieldTypeData%WaveMod = SrcSeaSt_WaveFieldTypeData%WaveMod + DstSeaSt_WaveFieldTypeData%NStepWave = SrcSeaSt_WaveFieldTypeData%NStepWave + DstSeaSt_WaveFieldTypeData%NStepWave2 = SrcSeaSt_WaveFieldTypeData%NStepWave2 end subroutine subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) @@ -460,6 +464,8 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%WaveMod) + call RegPack(Buf, InData%NStepWave) + call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -720,6 +726,10 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 929b1f8eaa..074cfcc6a9 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -223,7 +223,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END IF ! Copy Waves initialization output into the initialization input type for the WAMIT module - p%NStepWave = Waves_InitOut%NStepWave p%WaveDT = InputFileData%Waves%WaveDT ! Store user-requested wave elevation locations @@ -267,9 +266,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN CALL Waves2_Init(InputFileData%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) - InputFileData%Waves2%NStepWave = Waves_InitOut%NStepWave - InputFileData%Waves2%NStepWave2 = Waves_InitOut%NStepWave2 - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -346,8 +342,8 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init - ! Setup the 4D grid information for the Interpolatin Module - SeaSt_Interp_InitInp%n = (/p%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) + ! Setup the 4D grid information for the Interpolation Module + SeaSt_Interp_InitInp%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) SeaSt_Interp_InitInp%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) SeaSt_Interp_InitInp%pZero(1) = 0.0 !Time SeaSt_Interp_InitInp%pZero(2) = -InputFileData%X_HalfWidth @@ -362,13 +358,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init DEALLOCATE ( InitOut%WriteOutputHdr ) END IF - ! Copy Waves InitOut data to SeaState InitOut - - ! non-pointer data: - - InitOut%NStepWave = Waves_InitOut%NStepWave ! For WAMIT, WAMIT2, SS_Excitation, Morison - InitOut%NStepWave2 = Waves_InitOut%NStepWave2 ! For WAMIT and WAMIT2, FIT - InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: @@ -380,11 +369,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Write Wave Kinematics? if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then if ( InitInp%WrWvKinMod == 2 ) then - call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%NStepWave, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & + call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & p%Z_Depth, p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else if ( InitInp%WrWvKinMod == 1 ) then - call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%NStepWave, & + call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%WaveField%NStepWave, & p%NGrid, p%WaveField%WaveElev1, p%WaveField%WaveElev2, & p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -397,7 +386,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init IF (ALLOCATED(InitInp%WaveElevXY)) THEN ! maybe instead of getting these requested points, we just output the grid that SeaState is generated on? - ALLOCATE(InitOut%WaveElevSeries( 0:InitOut%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)),STAT=ErrStat2) + ALLOCATE(InitOut%WaveElevSeries( 0:p%WaveField%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)),STAT=ErrStat2) if (ErrStat2 /= 0) then CALL SetErrStat(ErrID_Fatal,"Error allocating InitOut%WaveElevSeries.",ErrStat,ErrMsg,RoutineName) CALL CleanUp() diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index f1b5a89c22..0c3609d85f 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -88,12 +88,10 @@ typedef ^ ^ Logical Lin # typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "The is the list of all HD-related output channel header strings (includes all sub-module channels)" - typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - -typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - -typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -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 ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" +typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) +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 ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" # # # ..... States .................................................................................................................... @@ -115,10 +113,10 @@ typedef ^ OtherStateType R8Ki Unu # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - -typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - +typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - +typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - +typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: @@ -131,7 +129,6 @@ typedef ^ ^ ReKi del typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m typedef ^ ^ ReKi Z_Depth - - - "Depth of the domain the Z direction" m -typedef ^ ^ INTEGER NStepWave - - - "Number of user-requested data points in the wave kinematics arrays" - typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index a3d9c5175e..4998fe0216 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -232,14 +232,13 @@ MODULE SeaState_Output CONTAINS !==================================================================================================== -SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, WaveDT, X_HalfWidth, Y_HalfWidth, & +SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_HalfWidth, Y_HalfWidth, & Z_Depth, deltaGrid, NGrid, ErrStat, ErrMsg ) ! Passed variables CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. TYPE(ProgDesc), INTENT( IN ) :: SeaSt_Prog ! the name/version/date of the SeaState program TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField !< WaveFieldType - INTEGER, INTENT( IN ) :: NStepWave ! Number of time steps for the wave kinematics arrays real(DbKi), intent( in ) :: WaveDT real(ReKi), intent( in ) :: X_HalfWidth real(ReKi), intent( in ) :: Y_HalfWidth @@ -291,7 +290,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, call WriteWvKinHeader( UnWv, iFile, Delim, SeaSt_Prog, waveDT, -z_gridPts(1), NGrid, deltaGrid ) - DO m= 0,NStepWave + DO m= 0,WaveField%NStepWave DO k = 1, NGrid(3) do j = 1, NGrid(2) do i = 1, NGrid(1) @@ -344,7 +343,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, NStepWave, call WriteWvKinHeader( UnWv, 8, Delim, SeaSt_Prog, waveDT, -z_gridPts(1), NGrid, deltaGrid ) - DO m= 0,NStepWave + DO m= 0,WaveField%NStepWave do j = 1, NGrid(2) do i = 1, NGrid(1) if ( allocated(WaveField%WaveElev2) ) then @@ -1096,7 +1095,7 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrS ' (-) ', ' (1/m) ', ' (rad/s) ', ' (deg) ', ' (m) ',' (m) ' ! Write the data - DO I = -1*Waves_InitOut%NStepWave2+1,Waves_InitOut%NStepWave2 + DO I = -1*p%WaveField%NStepWave2+1, p%WaveField%NStepWave2 WaveNmbr = WaveNumber ( I*p%WaveField%WaveDOmega, InitInp%Gravity, p%WaveField%EffWtrDpth ) WRITE( UnSum, '(1X,I10,2X,ES14.5,2X,ES14.5,2X,ES14.5,2X,ES14.5,7X,ES14.5)' ) I, WaveNmbr, I*p%WaveField%WaveDOmega, & p%WaveField%WaveDirArr(ABS(I)), p%WaveField%WaveElevC0( 1,ABS(I ) ) , p%WaveField%WaveElevC0( 2, ABS(I ) )*SIGN(1,I) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index faa14e00ed..f5762d5d25 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -109,8 +109,6 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] 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(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] @@ -153,7 +151,6 @@ MODULE SeaState_Types REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of user-requested data points in the wave kinematics arrays [-] INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] @@ -764,8 +761,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn if (allocated(SrcInitOutputData%WaveElevSeries)) then LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) @@ -822,8 +817,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then @@ -879,10 +872,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) @@ -1155,7 +1144,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth DstParamData%Z_Depth = SrcParamData%Z_Depth - DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%NWaveElev = SrcParamData%NWaveElev if (allocated(SrcParamData%WaveElevxi)) then LB(1:1) = lbound(SrcParamData%WaveElevxi) @@ -1314,7 +1302,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%X_HalfWidth) call RegPack(Buf, InData%Y_HalfWidth) call RegPack(Buf, InData%Z_Depth) - call RegPack(Buf, InData%NStepWave) call RegPack(Buf, InData%NWaveElev) call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then @@ -1394,8 +1381,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 4c0d83bfe6..0b724c8cd0 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -56,18 +56,18 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ErrMsg = "" ! Allocatable arrays: - ALLOCATE ( WaveField%WaveElev0 ( 0:InitOut%NStepWave ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev0.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( WaveField%WaveElevC (2, 0:InitOut%NStepWave2, InitInp%NGrid(1)*InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveElev0 ( 0:WaveField%NStepWave ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev0.', ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveElevC (2, 0:WaveField%NStepWave2, InitInp%NGrid(1)*InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC.', ErrStat,ErrMsg,RoutineName) ! Allocatable arrays in WaveField: - ALLOCATE ( WaveField%WaveTime ( 0:InitOut%NStepWave ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveTime.', ErrStat, ErrMsg, RoutineName) - ALLOCATE ( WaveField%WaveElevC0 (2, 0:InitOut%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC0.',ErrStat, ErrMsg, RoutineName) - ALLOCATE ( WaveField%WaveDirArr ( 0:InitOut%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDirArr.',ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveTime ( 0:WaveField%NStepWave ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveTime.', ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveElevC0 (2, 0:WaveField%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElevC0.',ErrStat, ErrMsg, RoutineName) + ALLOCATE ( WaveField%WaveDirArr ( 0:WaveField%NStepWave2 ) , STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDirArr.',ErrStat, ErrMsg, RoutineName) - ALLOCATE ( WaveField%WaveElev1(0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%WaveDynP (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDynP.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%WaveVel (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveVel.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%WaveAcc (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAcc.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveElev1(0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev1.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveDynP (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveDynP.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveVel (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveVel.', ErrStat,ErrMsg,RoutineName) + ALLOCATE ( WaveField%WaveAcc (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStat2 ); IF (ErrStat2 /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAcc.', ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return @@ -79,7 +79,7 @@ SUBROUTINE Initial_InitOut_Arrays(InitOut, WaveField, InitInp, WaveDT, ErrStat, ! Calculate the array of simulation times at which the instantaneous ! elevation of, velocity of, acceleration of, and loads associated with ! the incident waves are to be determined: - DO I = 0,InitOut%NStepWave ! Loop through all time steps + DO I = 0,WaveField%NStepWave ! Loop through all time steps WaveField%WaveTime(I) = I * WaveDT END DO ! I - All time steps @@ -324,16 +324,16 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs RETURN END IF - !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 5 + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 5 ! Set new value for NStepWave so that the FFT algorithms are efficient. We will use the values passed in rather than what is read from the file ! NOTE: This method is what is used in the VariousWaves_Init routine in Waves.f90 - InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer - IF ( MOD(InitOut%NStepWave,2) == 1 ) InitOut%NStepWave = InitOut%NStepWave + 1 ! larger or equal to WaveTMax/WaveDT. - InitOut%NStepWave2 = MAX( InitOut%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is - InitOut%NStepWave = 2*PSF ( InitOut%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. - InitOut%NStepWave2 = InitOut%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. - InitOut%WaveTMax = InitOut%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer + IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! larger or equal to WaveTMax/WaveDT. + WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + WaveField%NStepWave = 2*PSF ( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! Compute the frequency step for incident wave calculations. ! >>> Allocate and initialize (set to 0) InitOut arrays call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -341,14 +341,14 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs ! Give warning if the number of timesteps changed - IF ( WaveElevData%NStepWave /= InitOut%NStepWave ) THEN + IF ( WaveElevData%NStepWave /= WaveField%NStepWave ) THEN CALL SetErrStat(ErrID_Warn, ' Changed number of timesteps from '//TRIM(Num2LStr(WaveElevData%NStepWave))//' to '// & - TRIM(Num2LStr(InitOut%NStepWave))//' in order to calculate the frequency information from the wave elevations. '// & + TRIM(Num2LStr(WaveField%NStepWave))//' in order to calculate the frequency information from the wave elevations. '// & 'Wave elevations during additional time are padded with zero wave elevation.',ErrStat,ErrMsg,RoutineName) ENDIF ! Allocate array to hold the wave elevations for calculation of FFT. - ALLOCATE ( TmpFFTWaveElev( 0:InitOut%NStepWave-1 ), STAT=ErrStatTmp ) + ALLOCATE ( TmpFFTWaveElev( 0:WaveField%NStepWave-1 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFFTWaveElev.',ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -361,12 +361,12 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs TmpFFTWaveElev = 0.0_SiKi ! Copy values over - DO I=0,MIN(WaveElevData%NStepWave,InitOut%NStepWave-1) + DO I=0,MIN(WaveElevData%NStepWave,WaveField%NStepWave-1) TmpFFTWaveElev(I) = WaveElevData%WaveElev(I) ENDDO ! Initialize the FFT - CALL InitFFT ( InitOut%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -382,11 +382,11 @@ SUBROUTINE UserWaveElevations_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs END IF ! Copy the resulting TmpFFTWaveElev(:) data over to the InitOut%WaveElevC0 array - DO I=1,InitOut%NStepWave2-1 + DO I=1,WaveField%NStepWave2-1 WaveField%WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) WaveField%WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) ENDDO - WaveField%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi + WaveField%WaveElevC0(:,WaveField%NStepWave2) = 0.0_SiKi CALL ExitFFT(FFT_Data, ErrStatTmp) CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) @@ -454,18 +454,18 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) - !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 6 + !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 6 ! Perform some initialization computations including calculating the ! total number of time steps in the incident wave and ALLOCATing the ! arrays; initialize the unneeded values to zero: - InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer - IF (.NOT. (EqualRealNos( REAL(InitInp%WaveTMax, SiKi) - REAL(InitOut%NStepWave*InitInp%WaveDT, SiKi), 0.0_SiKi ) ) ) THEN + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer + IF (.NOT. (EqualRealNos( REAL(InitInp%WaveTMax, SiKi) - REAL(WaveField%NStepWave*InitInp%WaveDT, SiKi), 0.0_SiKi ) ) ) THEN ErrMsg = 'For WaveMod = 5 or 6, WaveTMax must be a multiple of WaveDT' ErrStat = ErrID_Fatal RETURN END IF - InitOut%NStepWave2 = InitOut%NStepWave/2 + WaveField%NStepWave2 = WaveField%NStepWave/2 InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! bjj added this @@ -512,7 +512,7 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END IF end do - DO m = 0,InitOut%NStepWave + DO m = 0,WaveField%NStepWave icount = 1 do k = 1, InitInp%NGrid(3) do j = 1, InitInp%NGrid(2) @@ -572,7 +572,7 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END IF end do - DO m = 0,InitOut%NStepWave + DO m = 0,WaveField%NStepWave do j = 1, InitInp%NGrid(2) ! Extract fields from current line IF (.not. ExtractFields(UnWv, WaveDataStr(:), InitInp%NGrid(1))) THEN @@ -614,7 +614,7 @@ FUNCTION ExtractFields(FU, s, n) result(OK) READ(FU, FMT='(A)', IOSTAT=ErrStat) TextLine IF (ErrStat/=0) THEN ErrStat = ErrID_Fatal - WRITE(ErrMsg,'(A,I0,A,I0,A)') 'Failed to read line ',I+2,' (out of ',InitOut%NStepWave+1,' expected lines) in file '//TRIM(FileName)//& + WRITE(ErrMsg,'(A,I0,A,I0,A)') 'Failed to read line ',I+2,' (out of ',WaveField%NStepWave+1,' expected lines) in file '//TRIM(FileName)//& & '. Check that the number of lines (without header) is equal to WaveTMax/WaveDT. ' OK=.FALSE. RETURN @@ -907,14 +907,14 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs RETURN END IF - !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 7 + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 7 MaxWaveAngFreq = MAXVAL(WaveCompData%WaveAngFreq) ! NStepWave2 should be large enough to accommodate the highest user frequency component and ! produce a time step no larger than the user WaveDT. - InitOut%NStepWave2 = MAX( NINT(MaxWaveAngFreq / WaveField%WaveDOmega) + 1_IntKi, & + WaveField%NStepWave2 = MAX( NINT(MaxWaveAngFreq / WaveField%WaveDOmega) + 1_IntKi, & CEILING(TwoPi/(InitInp%WaveDt*WaveField%WaveDOmega)) ) - InitOut%NStepWave2 = PSF ( InitOut%NStepWave2, 9 ) ! Make sure NStepWave2 is a product of small factors (PSF) greater or equal to what's required by the user input - InitOut%NStepWave = InitOut%NStepWave2 * 2_IntKi ! NStepWave is guaranteed to be even + WaveField%NStepWave2 = PSF ( WaveField%NStepWave2, 9 ) ! Make sure NStepWave2 is a product of small factors (PSF) greater or equal to what's required by the user input + WaveField%NStepWave = WaveField%NStepWave2 * 2_IntKi ! NStepWave is guaranteed to be even InitOut%WaveTMax = InitInp%WaveTMax ! Copy over WaveTMax. ! Note that InitOut%WaveDOmega is computed in WaveComp_ReadFile: @@ -922,7 +922,7 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs !BJJ: Note that this is changing an InitInp value. This seems dangerous... check that this isn't an issue elsewhere - InitInp%WaveDT = InitOut%WaveTMax / InitOut%NStepWave ! Update the value of WaveDT based on the value needed for NStepWave. + InitInp%WaveDT = InitOut%WaveTMax / WaveField%NStepWave ! Update the value of WaveDT based on the value needed for NStepWave. CALL WrScr1 (' Setting WaveDT to ' // TRIM(Num2Lstr(InitInp%WaveDt)) // ' sec.') @@ -930,7 +930,7 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - ALLOCATE ( IsSpecified( 0:InitOut%NStepWave2 ), STAT = ErrStatTmp) + ALLOCATE ( IsSpecified( 0:WaveField%NStepWave2 ), STAT = ErrStatTmp) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array IsSpecified.',ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -947,8 +947,8 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs J = NINT(WaveCompData%WaveAngFreq(I)/WaveField%WaveDOmega) IF ( .NOT. IsSpecified(J) ) THEN IsSpecified(J) = .TRUE. - WaveField%WaveElevC0(1,J) = WaveCompData%WaveAmp(I) * COS(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 - WaveField%WaveElevC0(2,J) = WaveCompData%WaveAmp(I) * SIN(WaveCompData%WavePhase(I)) * InitOut%NStepWave2 + WaveField%WaveElevC0(1,J) = WaveCompData%WaveAmp(I) * COS(WaveCompData%WavePhase(I)) * WaveField%NStepWave2 + WaveField%WaveElevC0(2,J) = WaveCompData%WaveAmp(I) * SIN(WaveCompData%WavePhase(I)) * WaveField%NStepWave2 WaveField%WaveDirArr(J) = WaveCompData%WaveDir(I) ELSE CALL SetErrStat(ErrID_Fatal,'Wave component with angular frequency ' //TRIM( Num2Lstr( WaveCompData%WaveAngFreq(I) ) )// & @@ -959,7 +959,7 @@ SUBROUTINE UserWaveComponents_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMs END DO ! Make sure the DC and Nyquist components are zero - should be redundant WaveField%WaveElevC0(:,0 ) = 0.0_SiKi - WaveField%WaveElevC0(:,InitOut%NStepWave2) = 0.0_SiKi + WaveField%WaveElevC0(:,WaveField%NStepWave2) = 0.0_SiKi CALL CleanUp() diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 5566e1986c..3c8c9381a2 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -570,9 +570,9 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Initialize everything to zero: - !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) - InitOut%NStepWave = 2 ! We must have at least two elements in order to interpolate later on - InitOut%NStepWave2 = 1 + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) + WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on + WaveField%NStepWave2 = 1 InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this... I don't think it was set anywhere for this wavemod. WaveField%WaveDOmega = 0.0 @@ -770,20 +770,20 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine ! will need to be updated. - !>>>>>> COMPUTE INITOUT SCALARS InitOut%NStepWave, InitOut%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine ! using file information (an FFT was performed there, so the information was needed before now). ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. ! Need to make sure the wave-direction in formation is not overwritten later. IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN - InitOut%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... - IF ( MOD(InitOut%NStepWave,2) == 1 ) InitOut%NStepWave = InitOut%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... + IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. - InitOut%NStepWave2 = MAX( InitOut%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is - InitOut%NStepWave = 2 * PSF( InitOut%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + WaveField%NStepWave = 2 * PSF( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. - InitOut%NStepWave2 = InitOut%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. - InitOut%WaveTMax = InitOut%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. ! >>> Allocate and initialize (set to 0) InitOut arrays @@ -793,152 +793,152 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Allocate all the arrays we need. - ALLOCATE ( tmpComplexArr(0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) + ALLOCATE ( tmpComplexArr(0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array tmpComplexArr.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynPC0 (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynPC0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVelC0Hxi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveVelC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hxi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVelC0Hyi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveVelC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hyi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVelC0V (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveVelC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0V.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0Hxi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAccC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hxi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0Hyi (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAccC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hyi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0V (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAccC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0V.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP0B (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP0B (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP0B.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel0Hxi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hxi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel0Hyi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hyi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel0V (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0V.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0Hxi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hxi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0Hyi (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hyi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0V (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0V.', ErrStat,ErrMsg,RoutineName) IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model - ALLOCATE ( WaveAccC0HxiMCF(0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HxiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0HyiMCF(0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAccC0HyiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HyiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0VMCF (0:InitOut%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAccC0VMCF (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0VMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0HxiMCF (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc0HxiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0HxiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0HyiMCF (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc0HyiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0HyiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0VMCF (0:InitOut%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc0VMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0VMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%WaveAccMCF (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + ALLOCATE ( WaveField%WaveAccMCF (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAccMCF.', ErrStat,ErrMsg,RoutineName) END IF IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - ALLOCATE ( PWaveDynPC0BPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveDynPC0BPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynPC0BPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveVelC0HxiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveVelC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HxiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveVelC0HyiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveVelC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HyiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveVelC0VPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveVelC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0VPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAccC0HxiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAccC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAccC0HyiPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAccC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAccC0VPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAccC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveDynP0BPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveDynP0BPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynP0BPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveVel0HxiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveVel0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HxiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveVel0HyiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveVel0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HyiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveVel0VPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveVel0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0Pz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0HxiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAcc0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0HyiPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAcc0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0VPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAcc0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%PWaveDynP0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ) + ALLOCATE ( WaveField%PWaveDynP0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveDynP0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%PWaveVel0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) + ALLOCATE ( WaveField%PWaveVel0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveVel0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%PWaveAcc0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) + ALLOCATE ( WaveField%PWaveAcc0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAcc0.', ErrStat,ErrMsg,RoutineName) IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model - ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAccC0VMCFPz0 (0:InitOut%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAccC0VMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0VMCFPz0 (0:InitOut%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) + ALLOCATE ( PWaveAcc0VMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveField%PWaveAccMCF0 (0:InitOut%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) + ALLOCATE ( WaveField%PWaveAccMCF0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAccMCF0.', ErrStat,ErrMsg,RoutineName) END IF @@ -949,18 +949,18 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. - ALLOCATE ( CosWaveDir( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) + ALLOCATE ( CosWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array CosWaveDir.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( SinWaveDir( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) + ALLOCATE ( SinWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array SinWaveDir.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( OmegaArr( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) + ALLOCATE ( OmegaArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array OmegaArr.', ErrStat,ErrMsg,RoutineName) ! Arrays for the constrained wave - ALLOCATE ( WaveS1SddArr( 0:InitOut%NStepWave2 ), STAT=ErrStatTmp ) + ALLOCATE ( WaveS1SddArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveS1SddArr.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -973,7 +973,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Compute the positive-frequency components (including zero) of the discrete ! Fourier transforms of the wave kinematics: - DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms OmegaArr(I) = I*WaveField%WaveDOmega END DO @@ -999,7 +999,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! make sure this is called before calling ConstrainedNewWaves - CALL InitFFT ( InitOut%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1031,7 +1031,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) - DO I = 0,InitOut%NStepWave2 + DO I = 0,WaveField%NStepWave2 tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) @@ -1055,7 +1055,7 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !! incident waves at each desired point on the still water level plane !! where it can be output: - DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms ! Set tmpComplex to the Ith element of the WAveElevC0 array @@ -1146,19 +1146,19 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Calculate the array of simulation times at which the instantaneous ! elevation of, velocity of, acceleration of, and loads associated with ! the incident waves are to be determined: - DO I = 0,InitOut%NStepWave ! Loop through all time steps + DO I = 0,WaveField%NStepWave ! Loop through all time steps WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) END DO ! I - All time steps - DO I = 0,InitOut%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) END DO ! Compute the inverse discrete Fourier transforms to find the time-domain ! representations of the wave kinematics without stretcing: - CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -1363,13 +1363,13 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ELSE ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) - WaveField%WaveDynP(0:InitOut%NStepWave-1,i,j,k ) = WaveDynP0B( 0:InitOut%NStepWave-1,primeCount) - WaveField%WaveVel (0:InitOut%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:InitOut%NStepWave-1,primeCount) - WaveField%WaveVel (0:InitOut%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:InitOut%NStepWave-1,primeCount) - WaveField%WaveVel (0:InitOut%NStepWave-1,i,j,k,3) = WaveVel0V( 0:InitOut%NStepWave-1,primeCount) - WaveField%WaveAcc (0:InitOut%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:InitOut%NStepWave-1,primeCount) - WaveField%WaveAcc (0:InitOut%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:InitOut%NStepWave-1,primeCount) - WaveField%WaveAcc (0:InitOut%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:InitOut%NStepWave-1,primeCount) + WaveField%WaveDynP(0:WaveField%NStepWave-1,i,j,k ) = WaveDynP0B( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,3) = WaveVel0V( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END IF count = count + 1 @@ -1390,9 +1390,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) WaveField%WaveAccMCF(:,i,j,k,:) = 0.0 ELSE ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) - WaveField%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:InitOut%NStepWave-1,primeCount) - WaveField%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:InitOut%NStepWave-1,primeCount) - WaveField%WaveAccMCF (0:InitOut%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:InitOut%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END IF count = count + 1 @@ -1406,13 +1406,13 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) primeCount = 1 DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed DO i = 1, InitInp%NGrid(1) - WaveField%PWaveDynP0(0:InitOut%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:InitOut%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:InitOut%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:InitOut%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:InitOut%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveDynP0(0:WaveField%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END DO END DO @@ -1421,9 +1421,9 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) primeCount = 1 DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed DO i = 1, InitInp%NGrid(1) - WaveField%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:InitOut%NStepWave-1,primeCount) - WaveField%PWaveAccMCF0 (0:InitOut%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:InitOut%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END DO END DO @@ -1481,20 +1481,20 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! ENDSELECT ! Set the ending timestep to the same as the first timestep - WaveField%WaveElev0 (InitOut%NStepWave) = WaveField%WaveElev0 (0 ) - WaveField%WaveDynP (InitOut%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) - WaveField%WaveVel (InitOut%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) - WaveField%WaveAcc (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) + WaveField%WaveElev0 (WaveField%NStepWave) = WaveField%WaveElev0 (0 ) + WaveField%WaveDynP (WaveField%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) + WaveField%WaveVel (WaveField%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) + WaveField%WaveAcc (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveField%WaveAccMCF (InitOut%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) + WaveField%WaveAccMCF (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) END IF IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - WaveField%PWaveDynP0(InitOut%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) - WaveField%PWaveVel0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) - WaveField%PWaveAcc0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) + WaveField%PWaveDynP0(WaveField%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) + WaveField%PWaveVel0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) + WaveField%PWaveAcc0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveField%PWaveAccMCF0 (InitOut%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) + WaveField%PWaveAccMCF0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) END IF END IF @@ -1508,9 +1508,9 @@ SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tm REAL(SiKi), INTENT(IN ) :: Xcoord REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevAtXY(0:InitOut%NStepWave) - real(SiKi), INTENT( OUT) :: WaveElevCAtXY(2,0:InitOut%NStepWave2) - COMPLEX(SiKi), INTENT(INOUT) :: tmpComplexArr(0:InitOut%NStepWave2) ! A temporary array (0:NStepWave2-1) for FFT use. + REAL(SiKi), INTENT( OUT) :: WaveElevAtXY(0:WaveField%NStepWave) + real(SiKi), INTENT( OUT) :: WaveElevCAtXY(2,0:WaveField%NStepWave2) + COMPLEX(SiKi), INTENT(INOUT) :: tmpComplexArr(0:WaveField%NStepWave2) ! A temporary array (0:NStepWave2-1) for FFT use. INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl CHARACTER(*), INTENT( OUT) :: ErrMsgLcl @@ -1526,7 +1526,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tm tmpComplexArr = CMPLX(0.0_SiKi,0.0_SiKi) ! Loop through the positive frequency components (including zero). - DO I = 0,InitOut%NStepWave2 + DO I = 0,WaveField%NStepWave2 WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) tmpComplexArr(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) * & @@ -1534,14 +1534,14 @@ SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tm Ycoord*SinWaveDir(I) ) ) ENDDO - CALL ApplyFFT_cx ( WaveElevAtXY(0:InitOut%NStepWave-1), tmpComplexArr, FFT_Data, ErrStatLcl2 ) + CALL ApplyFFT_cx ( WaveElevAtXY(0:WaveField%NStepWave-1), tmpComplexArr, FFT_Data, ErrStatLcl2 ) CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT.',ErrStatLcl,ErrMsgLcl,'WaveElevTimeSeriesAtXY') WaveElevCAtXY( 1,: ) = REAL(tmpComplexArr(:)) WaveElevCAtXY( 2,: ) = AIMAG(tmpComplexArr(:)) ! Append first datpoint as the last as aid for repeated wave data - WaveElevAtXY(InitOut%NStepWave) = WaveElevAtXY(0) + WaveElevAtXY(WaveField%NStepWave) = WaveElevAtXY(0) END SUBROUTINE WaveElevTimeSeriesAtXY @@ -1786,9 +1786,10 @@ FUNCTION WheelerStretching ( zOrzPrime, Zeta, h, ForwardOrBackward, ErrStat, Err END FUNCTION WheelerStretching !------------------------------------------------------------------------------------------------------------------------ -SUBROUTINE CalculateWaveNDir(InitInp, InitOut, ErrStat, ErrMsg) +SUBROUTINE CalculateWaveNDir(InitInp, InitOut, WaveField, ErrStat, ErrMsg) TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data + TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -1828,7 +1829,7 @@ SUBROUTINE CalculateWaveNDir(InitInp, InitOut, ErrStat, ErrMsg) ErrStatTmp = ErrID_None ErrMsgTmp = "" - DO WHILE ( .NOT. EqualRealNos( REAL(InitOut%NStepWave2/InitOut%WaveNDir), REAL(InitOut%NStepWave2)/REAL(InitOut%WaveNDir) )) + DO WHILE ( .NOT. EqualRealNos( REAL(WaveField%NStepWave2/InitOut%WaveNDir), REAL(WaveField%NStepWave2)/REAL(InitOut%WaveNDir) )) IF (InitOut%WaveNDir > WaveNDirMax ) THEN ErrMsgTmp = 'Could not find value for WaveNDir between '//TRIM(Num2LStr(InitInp%WaveNDir))//' and '// & @@ -1862,9 +1863,9 @@ SUBROUTINE CalculateWaveNDir(InitInp, InitOut, ErrStat, ErrMsg) ! Now check for the possible values of WaveNDir (up to I=5) so that we can tell the user about it. I = 0 ErrMsgTmp = 'The next values of WaveNDir that work with the selected values for WaveTMax and WaveDT:' - DO WHILE ( InitOut%WaveNDir <= INT(InitOut%NStepWave2/4.0) ) - IF ( EqualRealNos(REAL(InitOut%NStepWave2/InitOut%WaveNDir), & - REAL(InitOut%NStepWave2)/REAL(InitOut%WaveNDir) )) THEN + DO WHILE ( InitOut%WaveNDir <= INT(WaveField%NStepWave2/4.0) ) + IF ( EqualRealNos(REAL(WaveField%NStepWave2/InitOut%WaveNDir), & + REAL(WaveField%NStepWave2)/REAL(InitOut%WaveNDir) )) THEN ErrMsgTmp = TRIM(ErrMsgTmp)//" "//TRIM(Num2LStr(InitOut%WaveNDir)) I = I + 1 IF (I >= 5) EXIT ! limit the number of choices for WaveNDir that are printed @@ -1876,7 +1877,7 @@ SUBROUTINE CalculateWaveNDir(InitInp, InitOut, ErrStat, ErrMsg) ! If there were no additional values for WaveNDir found, I will be 0, so we rewrite the error message. IF ( I == 0 ) THEN ErrMsgTmp = 'There are no values for WaveNDir between '//TRIM(Num2LStr(WaveNDirMax))//' and '// & - TRIM(Num2LStr(INT(InitOut%NStepWave2/4.0)))//' (4 frequencies per wave direction)'// & + TRIM(Num2LStr(INT(WaveField%NStepWave2/4.0)))//' (4 frequencies per wave direction)'// & ' that will work with the selected values for WaveTMax ('//TRIM(Num2Lstr(InitOut%WaveTMax))// & ') and WaveDT ('//TRIM(Num2LStr(InitInp%WaveDT))//'). Change either WaveTMax or WaveDT.' ELSE @@ -1957,7 +1958,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !! of smallish numbers. ! this sets InitOut%WaveNDir: - call CalculateWaveNDir(InitInp, InitOut, ErrStatTmp, ErrMsgTmp) + call CalculateWaveNDir(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp) call SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then call Cleanup() @@ -2001,7 +2002,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! K should be exactly NStepWave2 when done assigning directions. The the Omega = 0 has ! no amplitude, but gets a direction anyhow (to simplify the calculation of WaveNDir). - WvSpreadFreqPerDir = (InitOut%NStepWave2)/InitOut%WaveNDir + WvSpreadFreqPerDir = (WaveField%NStepWave2)/InitOut%WaveNDir K = 0 ! Work through the frequencies in groups of directions. DO I = 1,WvSpreadFreqPerDir @@ -2033,7 +2034,7 @@ SUBROUTINE CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Perform a quick sanity check. We should have assigned all wave frequencies a direction, so K should be ! K = NStepWave2 (K is incrimented afterwards). - IF ( K /= (InitOut%NStepWave2 ) ) THEN + IF ( K /= (WaveField%NStepWave2 ) ) THEN CALL SetErrStat(ErrID_Fatal, 'Something went wrong while assigning wave directions.',ErrStat,ErrMsg,RoutineName) CALL CleanUp() RETURN @@ -2215,10 +2216,10 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField - REAL(SiKi), INTENT(IN ) :: OmegaArr(0:InitOut%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) - REAL(SiKi), INTENT( OUT) :: WaveS1SddArr(0:InitOut%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) + REAL(SiKi), INTENT(IN ) :: OmegaArr(0:WaveField%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) + REAL(SiKi), INTENT( OUT) :: WaveS1SddArr(0:WaveField%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) - COMPLEX(SiKi) :: WGNC(0:InitOut%NStepWave2) ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) + COMPLEX(SiKi) :: WGNC(0:WaveField%NStepWave2) ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) INTEGER :: I ! Loop counter INTEGER :: I_WaveTp ! The index of the frequency component nearest to WaveTp REAL(SiKi) :: SQRTNStepWave2 ! SQRT( NStepWave/2 ) @@ -2228,7 +2229,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS IF ( WaveField%WaveMod == WaveMod_ExtElev .OR. WaveField%WaveMod == WaveMod_UserFreq) THEN ! Wave elevation or frequency component data read in (5 or 7) - DO I = 0,InitOut%NStepWave2 + DO I = 0,WaveField%NStepWave2 ! Apply limits to the existing WaveElevC0 arrays if outside frequency range IF ( OmegaArr(I) < WaveField%WvLowCOff .OR. OmegaArr(I) > WaveField%WvHiCOff ) THEN @@ -2255,18 +2256,18 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS ! OmegaArr(I) == 0.0 and OmegaArr(I) == NStepWave2*WaveDOmega (= WaveOmegaMax) ! must be zero. !--------------------------------- - ! I == 1 or InitOut%NStepWave2 if ( OmegaArr(I) == 0.0 ) or ( OmegaArr(I) == NStepWave2*WaveDOmega (= WaveOmegaMax) ) + ! I == 1 or WaveField%NStepWave2 if ( OmegaArr(I) == 0.0 ) or ( OmegaArr(I) == NStepWave2*WaveDOmega (= WaveOmegaMax) ) WGNC(1) = (0.0,0.0) - WGNC(InitOut%NStepWave2) = (0.0,0.0) + WGNC(WaveField%NStepWave2) = (0.0,0.0) IF ( WaveField%WaveMod == WaveMod_RegularUsrPh ) THEN ! .TRUE. for plane progressive (regular) waves with a specified phase - DO I = 0,InitOut%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + DO I = 0,WaveField%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms IF (I==1) CYCLE WGNC(I) = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp, InitInp%WavePhase ) END DO ELSE ! All other OmegaArr(I) - DO I = 0,InitOut%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + DO I = 0,WaveField%NStepWave2-1 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms IF (I==1) CYCLE WGNC(I) = BoxMuller ( InitInp%RNG%pRNG, InitInp%WaveNDAmp ) @@ -2280,7 +2281,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS IF (WaveField%WaveMod == WaveMod_RegularUsrPh .or. WaveField%WaveMod == WaveMod_Regular) THEN !10 or 1 WaveS1SddArr = 0.0 - IF (I_WaveTp < InitOut%NStepWave2 .and. (I_WaveTp > 1 .or. I_WaveTp == 0) ) THEN + IF (I_WaveTp < WaveField%NStepWave2 .and. (I_WaveTp > 1 .or. I_WaveTp == 0) ) THEN ! This scaling of WGNC is used to ensure that the Box-Muller method is only providing a random phase, ! not a magnitude change, at the frequency of the plane progressive wave. The SQRT(2.0) is used to @@ -2296,7 +2297,7 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS END IF ELSE - DO I = 0,InitOut%NStepWave2 + DO I = 0,WaveField%NStepWave2 IF ( OmegaArr(I) < WaveField%WvLowCOff .OR. OmegaArr(I) > WaveField%WvHiCOff ) THEN ! .TRUE. if OmegaArr(I) is above or below the cut-off frequency ! Zero-out the wave spectrum above the cut-off frequency. We must cut-off the frequency in order to @@ -2329,9 +2330,9 @@ SUBROUTINE Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS ! Compute the one-sided power spectral density of the wave spectrum per unit ! time; zero-out the wave spectrum above the cut-off frequency: !--------------------------------- - SQRTNStepWave2 = SQRT( REAL( InitOut%NStepWave2, SiKi ) ) ! Compute SQRT( NStepWave/2 ). + SQRTNStepWave2 = SQRT( REAL( WaveField%NStepWave2, SiKi ) ) ! Compute SQRT( NStepWave/2 ). - DO I = 0,InitOut%NStepWave2 + DO I = 0,WaveField%NStepWave2 ! Compute the two-sided power spectral density of the wave spectrum per unit ! time: @@ -2353,10 +2354,10 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA TYPE(Waves_InitInputType), INTENT(IN ) :: InitInp ! Input data for initialization routine TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOut ! Output data TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField - REAL(SiKi), INTENT(IN ) :: OmegaArr(0:InitOut%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) - REAL(SiKi), INTENT(IN ) :: WaveS1SddArr(0:InitOut%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) - REAL(SiKi), INTENT(IN ) :: CosWaveDir(0:InitOut%NStepWave2) !< COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction - REAL(SiKi), INTENT(IN ) :: SinWaveDir(0:InitOut%NStepWave2) !< SIN( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction + REAL(SiKi), INTENT(IN ) :: OmegaArr(0:WaveField%NStepWave2) !< Array of all non-negative angular frequencies (rad/s) + REAL(SiKi), INTENT(IN ) :: WaveS1SddArr(0:WaveField%NStepWave2) !< One-sided power spectral density of the wave spectrum at all non-negative frequencies (m^2/(rad/s)) + REAL(SiKi), INTENT(IN ) :: CosWaveDir(0:WaveField%NStepWave2) !< COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction + REAL(SiKi), INTENT(IN ) :: SinWaveDir(0:WaveField%NStepWave2) !< SIN( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction TYPE(FFT_DataType), INTENT(IN ) :: FFT_Data !< data for FFT computations, already initialized INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error level/status CHARACTER(ErrMsgLen), INTENT( OUT) :: ErrMsg !< error message @@ -2381,8 +2382,8 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA INTEGER(IntKi) :: Iter !< Number of iterations when trying to meet the prescribed crest height (-) INTEGER(IntKi) :: MaxCrestIter = 20 !< Maximum number of iterations when trying to meet the prescribed crest height (-) - REAL(SiKi) :: tmpArr(0:InitOut%NStepWave2) !< A temporary array of real numbers of constrained wave (-) - COMPLEX(SiKi) :: tmpComplexArr(0:InitOut%NStepWave2) !< A temporary array for FFT use + REAL(SiKi) :: tmpArr(0:WaveField%NStepWave2) !< A temporary array of real numbers of constrained wave (-) + COMPLEX(SiKi) :: tmpComplexArr(0:WaveField%NStepWave2) !< A temporary array for FFT use COMPLEX(SiKi) :: tmpComplex ! A temporary varible to hold the complex value of the wave elevation before storing it into a REAL array @@ -2407,7 +2408,7 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA WaveField%WaveElevC0(2,:) = WaveField%WaveElevC0(2,:) - WaveElevC0ImOmegaSum * OmegaArr * WaveS1SddArr * WaveField%WaveDOmega Crest = 0.5_SiKi * InitInp%CrestHmax ! Set crest elevation to half of crest height - tmpArr = InitOut%NStepWave2/m0 * WaveField%WaveDOmega * WaveS1SddArr + tmpArr = WaveField%NStepWave2/m0 * WaveField%WaveDOmega * WaveS1SddArr IF (InitInp%ConstWaveMod == 1) THEN ! Crest elevation prescribed @@ -2426,13 +2427,13 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ! Compute the crest height based on the current guess of crest elevation tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + Crest * tmpArr, & WaveField%WaveElevC0(2,:)) - CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN ! Find the preceding or following trough, whichever is lower - Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,InitOut%NStepWave-1))), & - MINVAL(WaveField%WaveElev0(MAX(InitOut%NStepWave-NStepTp,0):InitOut%NStepWave-1))) + Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,WaveField%NStepWave-1))), & + MINVAL(WaveField%WaveElev0(MAX(WaveField%NStepWave-NStepTp,0):WaveField%NStepWave-1))) CrestHeight = Crest-Trough CrestHeightError = ABS(CrestHeight - InitInp%CrestHmax) ! print *, CrestHeight @@ -2441,14 +2442,14 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ! Compute the crest height based on a slightly nudged crest elevation tmpComplexArr = CMPLX( WaveField%WaveElevC0(1,:) + (Crest+CrestHeightTol) * tmpArr, & WaveField%WaveElevC0(2,:)) - CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:InitOut%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) RETURN ! Find the preceding or following trough, whichever is lower - Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,InitOut%NStepWave-1))), & - MINVAL(WaveField%WaveElev0(MAX(InitOut%NStepWave-NStepTp,0):InitOut%NStepWave-1))) + Trough = MIN(MINVAL(WaveField%WaveElev0(1:MIN(NStepTp,WaveField%NStepWave-1))), & + MINVAL(WaveField%WaveElev0(MAX(WaveField%NStepWave-NStepTp,0):WaveField%NStepWave-1))) CrestHeight1 = Crest+CrestHeightTol-Trough ! Update crest elevation with Newton-Raphson Method Crest = Crest - (CrestHeight-InitInp%CrestHmax)*CrestHeightTol/(CrestHeight1-CrestHeight) @@ -2460,7 +2461,7 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA ENDIF ! Modify the wave phase so that the crest shows up at the right place and the right time - DO I = 1,InitOut%NStepWave2-1 + DO I = 1,WaveField%NStepWave2-1 WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) ConstWavePhase = WaveNmbr*(CosWaveDir(I)*InitInp%CrestXi + & SinWaveDir(I)*InitInp%CrestYi) - & diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index 5bde178eb0..c562f3b699 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -57,6 +57,4 @@ typedef ^ ^ ReKi PtfmLocatio # typedef ^ InitOutputType INTEGER WaveNDir - - - "Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module]" (-) typedef ^ InitOutputType DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) -typedef ^ InitOutputType INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ InitOutputType INTEGER NStepWave2 - - - "NStepWave / 2" - diff --git a/modules/seastate/src/Waves2.f90 b/modules/seastate/src/Waves2.f90 index f5a94414d8..f7edb77883 100644 --- a/modules/seastate/src/Waves2.f90 +++ b/modules/seastate/src/Waves2.f90 @@ -204,9 +204,9 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Check that WaveElevC0 is a 2x(NStepWave2+1) sized array (0 index start) - IF ( SIZE( WaveField%WaveElevC0, DIM=2 ) /= (InitInp%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( WaveField%WaveElevC0, DIM=2 ) /= (WaveField%NStepWave2 + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to Waves2_Init:'//NewLine// & - ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(InitInp%NStepWave2 + 1))// & + ' --> Expected array for WaveElevC0 to be of size 2x'//TRIM(Num2LStr(WaveField%NStepWave2 + 1))// & ' (2x(NStepWave2+1)), but instead received array of size '// & TRIM(Num2LStr(SIZE(WaveField%WaveElevC0,1)))//'x'//TRIM(Num2LStr(SIZE(WaveField%WaveElevC0,2)))//'.', & ErrStat, ErrMsg, RoutineName) @@ -217,9 +217,9 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Check that WaveTime is of size (NStepWave+1) - IF ( SIZE( WaveField%WaveTime ) /= (InitInp%NStepWave + 1) ) THEN ! Expect a 2x(0:NStepWave2) array + IF ( SIZE( WaveField%WaveTime ) /= (WaveField%NStepWave + 1) ) THEN ! Expect a 2x(0:NStepWave2) array CALL SetErrStat( ErrID_Fatal, ' Programming error in call to Waves2_Init:'//NewLine// & - ' --> Expected array for WaveTime to be of size '//TRIM(Num2LStr(InitInp%NStepWave + 1))// & + ' --> Expected array for WaveTime to be of size '//TRIM(Num2LStr(WaveField%NStepWave + 1))// & ' (NStepWave+1), but instead received array of size '// & TRIM(Num2LStr(SIZE(WaveField%WaveTime)))//'.', & ErrStat, ErrMsg, RoutineName) @@ -233,15 +233,15 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- ! The wave elevation information in frequency space -- we need to normalize this by NStepWave2 - ALLOCATE ( WaveElevC0Norm(0:InitInp%NStepWave2) , STAT=ErrStatTmp ) + ALLOCATE ( WaveElevC0Norm(0:WaveField%NStepWave2) , STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) then CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElevC0Norm.',ErrStat,ErrMsg,RoutineName) CALL CleanUp() RETURN END IF - DO I=0,InitInp%NStepWave2 - WaveElevC0Norm(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I), SiKi ) / REAL(InitInp%NStepWave2,SiKi) + DO I=0,WaveField%NStepWave2 + WaveElevC0Norm(I) = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I), SiKi ) / REAL(WaveField%NStepWave2,SiKi) ENDDO !-------------------------------------------------------------------------------- @@ -334,25 +334,25 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- ! Setup the output arrays !-------------------------------------------------------------------------------- - ALLOCATE ( WaveField%WaveElev2 (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ) , STAT=ErrStatTmp ) + ALLOCATE ( WaveField%WaveElev2 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ) , STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveElev2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveVel2D (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveVel2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2D.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveAcc2D (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveAcc2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2D.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveDynP2D (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveDynP2D (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2D.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveVel2S (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveVel2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveVel2S.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveAcc2S (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveAcc2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveAcc2S.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( InitOut%WaveDynP2S (0:InitInp%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) + ALLOCATE ( InitOut%WaveDynP2S (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3) ), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveDynP2S.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -374,14 +374,14 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! For calculating the 2nd-order wave elevation corrections, we need a temporary array to hold the information. - ALLOCATE ( TmpTimeSeries(0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( TmpTimeSeries(0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpTimeSeries.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( TmpTimeSeries2(0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( TmpTimeSeries2(0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpTimeSeries2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( TmpFreqSeries(0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( TmpFreqSeries(0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFreqSeries.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( TmpFreqSeries2(0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( TmpFreqSeries2(0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFreqSeries2.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -394,7 +394,7 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Setup the FFT working arrays !-------------------------------------------------------------------------------- - CALL InitFFT ( InitInp%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .FALSE., ErrStatTmp ) CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() @@ -430,21 +430,21 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Frequency space arrays: - ALLOCATE ( WaveVel2xCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2xCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2yCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2zCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2xCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2yCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zCDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2zCDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2CDiff (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP2CDiff (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CDiff.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -455,21 +455,21 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Time domain arrays: - ALLOCATE ( WaveVel2xDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2xDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2yDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2zDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2xDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2yDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zDiff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2zDiff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zDiff.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2Diff (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP2Diff (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2Diff.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -526,7 +526,7 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! \f$ \mu^- \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^-} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^- = n -m \f$ - DO mu_minus=1,InitInp%NStepWave2-1 + DO mu_minus=1,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^- = \mu^- \Delta \omega \f$ @@ -535,7 +535,7 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. - DO m=1,InitInp%NStepWave2-mu_minus + DO m=1,WaveField%NStepWave2-mu_minus ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_minus + m Omega_n = n * WaveField%WaveDOmega @@ -681,15 +681,15 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Copy the first point to the last to make it easier. ! TODO: Why don't these have the 2.0 multipler?? GJH 9/8/21 - InitOut%WaveVel2D(InitInp%NStepWave,ii,jj,kk,1) = WaveVel2xDiff(0) - InitOut%WaveVel2D(InitInp%NStepWave,ii,jj,kk,2) = WaveVel2yDiff(0) - InitOut%WaveVel2D(InitInp%NStepWave,ii,jj,kk,3) = WaveVel2zDiff(0) + InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,1) = WaveVel2xDiff(0) + InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,2) = WaveVel2yDiff(0) + InitOut%WaveVel2D(WaveField%NStepWave,ii,jj,kk,3) = WaveVel2zDiff(0) - InitOut%WaveAcc2D(InitInp%NStepWave,ii,jj,kk,1) = WaveAcc2xDiff(0) - InitOut%WaveAcc2D(InitInp%NStepWave,ii,jj,kk,2) = WaveAcc2yDiff(0) - InitOut%WaveAcc2D(InitInp%NStepWave,ii,jj,kk,3) = WaveAcc2zDiff(0) + InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,1) = WaveAcc2xDiff(0) + InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,2) = WaveAcc2yDiff(0) + InitOut%WaveAcc2D(WaveField%NStepWave,ii,jj,kk,3) = WaveAcc2zDiff(0) - InitOut%WaveDynP2D(InitInp%NStepWave,ii,jj,kk) = WaveDynP2Diff(0) + InitOut%WaveDynP2D(WaveField%NStepWave,ii,jj,kk) = WaveDynP2Diff(0) ENDDO ! I=1,NWaveKin0Prime loop end @@ -755,39 +755,39 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Frequency space arrays: Term 1 (n=m term) - ALLOCATE ( WaveVel2xCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2xCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2yCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2zCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2xCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2yCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zCSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2zCSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2CSumT1 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP2CSumT1 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT1.', ErrStat,ErrMsg,RoutineName) ! Term 2 (n/=m term) - ALLOCATE ( WaveVel2xCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2xCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2yCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2yCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2yCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2zCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2xCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2yCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2yCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2yCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zCSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2zCSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zCSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2CSumT2 (0:InitInp%NStepWave2), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP2CSumT2 (0:WaveField%NStepWave2), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2CSumT2.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -799,39 +799,39 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Time domain arrays: Term 1 (n=m term) - ALLOCATE ( WaveVel2xSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2xSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2ySumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2ySumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2zSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2xSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2ySumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2ySumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zSumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2zSumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT1.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2SumT1 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP2SumT1 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT1.', ErrStat,ErrMsg,RoutineName) ! Term 2 (n/=m term) - ALLOCATE ( WaveVel2xSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2xSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2xSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2ySumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2ySumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2ySumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveVel2zSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveVel2zSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel2zSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2xSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2xSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2xSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2ySumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2ySumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2ySumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc2zSumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveAcc2zSumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc2zSumT2.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveDynP2SumT2 (0:InitInp%NStepWave), STAT=ErrStatTmp ) + ALLOCATE ( WaveDynP2SumT2 (0:WaveField%NStepWave), STAT=ErrStatTmp ) IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP2SumT2.', ErrStat,ErrMsg,RoutineName) ! Now check if all the allocations worked properly @@ -906,7 +906,7 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! The limits look a little funny. But remember we are placing the value in the 2*J location, ! so we cannot overun the end of the array. The floor function is just in case NStepWave2 is ! an odd number - DO n=1,FLOOR( REAL(InitInp%NStepWave2-1) / 2.0_SiKi ) ! Only + DO n=1,FLOOR( REAL(WaveField%NStepWave2-1) / 2.0_SiKi ) ! Only Omega_n = n * WaveField%WaveDOmega @@ -1004,7 +1004,7 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^+ = n + m \f$ - DO mu_plus=2,InitInp%NStepWave2-1 + DO mu_plus=2,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ @@ -1180,9 +1180,9 @@ SUBROUTINE Waves2_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Copy the first point to the last to make it easier. - InitOut%WaveVel2S(InitInp%NStepWave,ii,jj,kk,:) = InitOut%WaveVel2S(0,ii,jj,kk,:) - InitOut%WaveAcc2S(InitInp%NStepWave,ii,jj,kk,:) = InitOut%WaveAcc2S(0,ii,jj,kk,:) - InitOut%WaveDynP2S(InitInp%NStepWave,ii,jj,kk) = InitOut%WaveDynP2S(0,ii,jj,kk) + InitOut%WaveVel2S(WaveField%NStepWave,ii,jj,kk,:) = InitOut%WaveVel2S(0,ii,jj,kk,:) + InitOut%WaveAcc2S(WaveField%NStepWave,ii,jj,kk,:) = InitOut%WaveAcc2S(0,ii,jj,kk,:) + InitOut%WaveDynP2S(WaveField%NStepWave,ii,jj,kk) = InitOut%WaveDynP2S(0,ii,jj,kk) ENDDO ! I=1,NWaveKin0Prime loop end @@ -1274,7 +1274,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta REAL(SiKi), INTENT(IN ) :: Xcoord REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:InitInp%NStepWave) + REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:WaveField%NStepWave) INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl INTEGER(IntKi) :: ErrStatLcl2 CHARACTER(*), INTENT( OUT) :: ErrMsgLcl @@ -1302,7 +1302,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta ! \f$ \mu^- \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^-} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^- = n -m \f$ - DO mu_minus=1,InitInp%NStepWave2-1 + DO mu_minus=1,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^- = \mu^- \Delta \omega \f$ @@ -1311,7 +1311,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta IF ( Omega_minus >= WaveField%WvLowCOffD .AND. Omega_minus <= WaveField%WvHiCOffD ) THEN ! The inner \f$ m \f$ loop for calculating the \f$ H_{\mu^-} \f$ terms at each frequency. - DO m=1,InitInp%NStepWave2-mu_minus + DO m=1,WaveField%NStepWave2-mu_minus ! Calculate the value of the n index from \f$ \mu^- = n - m \f$. Calculate corresponding wavenumbers and frequencies. n = mu_minus + m Omega_n = n * WaveField%WaveDOmega @@ -1379,7 +1379,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Diff(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrSta CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Diff') ! Append first datapoint as the last as aid for repeated wave data - WaveElevSeriesAtXY(InitInp%NStepWave) = WaveElevSeriesAtXY(0) + WaveElevSeriesAtXY(WaveField%NStepWave) = WaveElevSeriesAtXY(0) END SUBROUTINE WaveElevTimeSeriesAtXY_Diff @@ -1401,7 +1401,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat REAL(SiKi), INTENT(IN ) :: Xcoord REAL(SiKi), INTENT(IN ) :: Ycoord - REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:InitInp%NStepWave) + REAL(SiKi), INTENT( OUT) :: WaveElevSeriesAtXY(0:WaveField%NStepWave) INTEGER(IntKi), INTENT( OUT) :: ErrStatLcl INTEGER(IntKi) :: ErrStatLcl2 CHARACTER(*), INTENT( OUT) :: ErrMsgLcl @@ -1433,7 +1433,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat !> ## First term ## ! First term results are stored in TmpFreqSeries. - DO n=1,FLOOR( REAL(InitInp%NStepWave2-1) / 2.0_SiKi ) ! Only + DO n=1,FLOOR( REAL(WaveField%NStepWave2-1) / 2.0_SiKi ) ! Only Omega_n = n * WaveField%WaveDOmega @@ -1495,7 +1495,7 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat ! \f$ \mu^+ \f$ loop. This loop is used to construct the full set of \f$ H_{\mu^+} \f$ terms used in the IFFT to find the timeseries. !> * \f$ \mu^+ = n + m \f$ - DO mu_plus=2,InitInp%NStepWave2-1 + DO mu_plus=2,WaveField%NStepWave2-1 ! The frequency we are dealing with !> * \f$ \omega^+ = \mu^+ \Delta \omega \f$ @@ -1568,12 +1568,12 @@ SUBROUTINE WaveElevTimeSeriesAtXY_Sum(Xcoord,Ycoord, WaveElevSeriesAtXY, ErrStat CALL SetErrStat(ErrStatLcl2,'Error occured while applying the FFT on WaveElevSeriesAtXY.',ErrStatLcl,ErrMsgLcl,'WaveElevSeriesAtXY_Sum') ! Add the two terms together - DO Ctr=0,InitInp%NStepWave + DO Ctr=0,WaveField%NStepWave WaveElevSeriesAtXY(Ctr) = WaveElevSeriesAtXY(Ctr) + 2.0_SiKi * TmpTimeSeries2(Ctr) ENDDO ! Append first datapoint as the last as aid for repeated wave data - WaveElevSeriesAtXY(InitInp%NStepWave) = WaveElevSeriesAtXY(0) + WaveElevSeriesAtXY(WaveField%NStepWave) = WaveElevSeriesAtXY(0) END SUBROUTINE WaveElevTimeSeriesAtXY_Sum diff --git a/modules/seastate/src/Waves2.txt b/modules/seastate/src/Waves2.txt index cd8c1dfeb9..0437fbe7f2 100644 --- a/modules/seastate/src/Waves2.txt +++ b/modules/seastate/src/Waves2.txt @@ -19,12 +19,6 @@ include Registry_NWTC_Library.txt # e.g., the name of the input file, the file root name,etc. # typedef Waves2/Waves2 InitInputType ReKi Gravity - - - "Gravitational acceleration" (m/s^2) - -typedef ^ ^ INTEGER NStepWave - - - "Total number of frequency components = total number of time steps in the incident wave" - -typedef ^ ^ INTEGER NStepWave2 - - - "NStepWave / 2" - - -typedef ^ ^ LOGICAL WaveMultiDir - - - "Indicates the waves are multidirectional -- set by HydroDyn_Input" - - typedef ^ ^ integer nGrid 3 - - "Grid dimensions" typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations can be output" - typedef ^ ^ INTEGER NWaveKinGrid - - - "Number of grid points where the incident wave kinematics will be computed" - diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index a8bca43538..ee5d2ba6c1 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -36,9 +36,6 @@ MODULE Waves2_Types ! ========= Waves2_InitInputType ======= TYPE, PUBLIC :: Waves2_InitInputType REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] - LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] @@ -73,9 +70,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er ErrStat = ErrID_None ErrMsg = '' DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir DstInitInputData%nGrid = SrcInitInputData%nGrid DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid @@ -143,9 +137,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves2_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) - call RegPack(Buf, InData%WaveMultiDir) call RegPack(Buf, InData%nGrid) call RegPack(Buf, InData%NWaveElevGrid) call RegPack(Buf, InData%NWaveKinGrid) @@ -179,12 +170,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElevGrid) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 996e0f75ff..62aa9bc023 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -75,8 +75,6 @@ MODULE Waves_Types TYPE, PUBLIC :: Waves_InitOutputType INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE Waves_InitOutputType ! ======================= CONTAINS @@ -424,8 +422,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrMsg = '' DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 end subroutine subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -444,8 +440,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WaveNDir) call RegPack(Buf, InData%WaveTMax) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -458,10 +452,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return end subroutine END MODULE Waves_Types !ENDOFREGISTRYGENERATEDFILE From 5f68c3160c7cc6b1450f27d866cccdb6ff5c91f2 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 8 Nov 2023 12:49:09 -0700 Subject: [PATCH 052/232] HD/SeaSt: remove unused variables --- modules/hydrodyn/src/Morison.f90 | 8 +++----- modules/seastate/src/SeaState.f90 | 2 +- modules/seastate/src/SeaState_Output.f90 | 3 +-- 3 files changed, 5 insertions(+), 8 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index e843896dc3..9a5e4722c2 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1903,7 +1903,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In character(*), parameter :: RoutineName = 'Morison_Init' TYPE(Morison_MemberType) :: member ! the current member - INTEGER :: i, j, k + INTEGER :: i, j REAL(ReKi) :: v2D(3,1), pos(3) real(ReKi) :: An(3), An_drag(3), Vn(3), I_n(3), sgn, Amag, Amag_drag, Vmag, Imag, Ir_MG_end, Il_MG_end, R_I(3,3), IRl_mat(3,3), tMG, MGdens integer(IntKi) :: MemberEndIndx @@ -2516,7 +2516,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, character(*), parameter :: RoutineName = 'Morison_CalcOutput' REAL(ReKi) :: vmag, vmagf - INTEGER :: I, J, K + INTEGER :: I, J REAL(ReKi) :: qdotdot(6) ! The structural acceleration of a mesh node TYPE(Morison_MemberType) :: mem ! the current member @@ -2543,7 +2543,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, REAL(ReKi) :: g ! gravity constant REAL(ReKi) :: k_hat(3), k_hat1(3), k_hat2(3) ! Elemental unit vector pointing from 1st node to 2nd node of the element REAL(ReKi) :: n_hat(3) - REAL(ReKi) :: alpha ! final load distribution factor for element REAL(ReKi) :: Fr !radial component of buoyant force REAL(ReKi) :: Fl !axial component of buoyant force REAL(ReKi) :: Moment !moment induced about the center of the cylinder's bottom face @@ -2554,7 +2553,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, REAL(ReKi) :: a_s2(3) REAL(ReKi) :: alpha_s2(3) REAL(ReKi) :: omega_s2(3) - REAL(ReKi) :: pos1(3), pos2(3), positionXY(2) + REAL(ReKi) :: pos1(3), pos2(3) REAL(ReKi) :: Imat(3,3) REAL(ReKi) :: iArm(3), iTerm(3), Ioffset, h_c, dRdl_p, dRdl_pp, f_hydro(3), Am(3,3), lstar, deltal, deltalLeft, deltalRight REAL(ReKi) :: h, h_c_AM, deltal_AM @@ -2582,7 +2581,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, REAL(ReKi) :: FAFSInt(3) REAL(ReKi) :: FDynPFSInt REAL(ReKi) :: vrelFSInt(3) - REAL(ReKi) :: pos1Prime(3) REAL(ReKi) :: FAMCFFSInt(3) INTEGER(IntKi) :: MemSubStat, NumFSX REAL(DbKi) :: theta1, theta2 diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 074cfcc6a9..4e799e4f96 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -337,7 +337,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init !=============================================== - CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrStat2, ErrMsg2) + CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 4998fe0216..83ab1c2e7c 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -982,11 +982,10 @@ SUBROUTINE SeaStOut_CloseOutput ( p, ErrStat, ErrMsg ) END SUBROUTINE SeaStOut_CloseOutput !==================================================================================================== -SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, Waves_InitOut, ErrStat, ErrMsg ) +SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat, ErrMsg ) TYPE(SeaSt_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine. TYPE(SeaSt_InputFile) , INTENT(IN ) :: InputFileData !< Data from input file TYPE(SeaSt_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(Waves_InitOutputType), INTENT(IN ) :: Waves_InitOut !< Initialization Outputs from the Waves submodule initialization INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None From 76202a1f92b99f2212d4c7f1f4174e28a3af0396 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 8 Nov 2023 13:06:21 -0700 Subject: [PATCH 053/232] SeaSt: remove extra copy of `Z_Depth` --- modules/seastate/src/SeaState.f90 | 4 ++-- modules/seastate/src/SeaState.txt | 1 - modules/seastate/src/SeaState_Input.f90 | 1 - modules/seastate/src/SeaState_Interp.txt | 8 ++++---- modules/seastate/src/SeaState_Output.f90 | 5 ++--- modules/seastate/src/SeaState_Types.f90 | 5 ----- 6 files changed, 8 insertions(+), 16 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 4e799e4f96..00901adbcf 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -349,7 +349,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init SeaSt_Interp_InitInp%pZero(2) = -InputFileData%X_HalfWidth SeaSt_Interp_InitInp%pZero(3) = -InputFileData%Y_HalfWidth SeaSt_Interp_InitInp%pZero(4) = -InputFileData%Z_Depth ! zi - SeaSt_Interp_InitInp%Z_Depth = InputFileData%Z_Depth + SeaSt_Interp_InitInp%Z_Depth = InputFileData%Z_Depth call SeaSt_Interp_Init(SeaSt_Interp_InitInp, p%WaveField%seast_interp_p, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -370,7 +370,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then if ( InitInp%WrWvKinMod == 2 ) then call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & - p%Z_Depth, p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) + p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%WaveField%NStepWave, & diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 0c3609d85f..f15f46c454 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -128,7 +128,6 @@ typedef ^ ^ INTEGER NGr typedef ^ ^ ReKi deltaGrid 3 - - "delta between grid points in x, y, and theta (for z)" m,m,rad typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m -typedef ^ ^ ReKi Z_Depth - - - "Depth of the domain the Z direction" m typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index a521e613a5..4ef4375592 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -1125,7 +1125,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! Generate grid points p%X_HalfWidth = InputFileData%X_HalfWidth p%Y_HalfWidth = InputFileData%Y_HalfWidth - p%Z_Depth = InputFileData%Z_Depth p%deltaGrid(1) = InputFileData%X_HalfWidth/(InputFileData%NX-1) p%deltaGrid(2)= InputFileData%Y_HalfWidth/(InputFileData%NY-1) p%deltaGrid(3) = PI / ( 2*(InputFileData%NZ-1) ) diff --git a/modules/seastate/src/SeaState_Interp.txt b/modules/seastate/src/SeaState_Interp.txt index 36ed7f9b51..5f12cd5a6a 100644 --- a/modules/seastate/src/SeaState_Interp.txt +++ b/modules/seastate/src/SeaState_Interp.txt @@ -12,10 +12,10 @@ include Registry_NWTC_Library.txt ######################### -typedef SeaState_Interp/SeaSt_Interp InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - -typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" -typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m +typedef SeaState_Interp/SeaSt_Interp InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - +typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" +typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m # Init Output typedef ^ InitOutputType ProgDesc Ver - - - "Version information of this submodule" - diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 83ab1c2e7c..b18e2c2726 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -233,7 +233,7 @@ MODULE SeaState_Output !==================================================================================================== SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_HalfWidth, Y_HalfWidth, & - Z_Depth, deltaGrid, NGrid, ErrStat, ErrMsg ) + deltaGrid, NGrid, ErrStat, ErrMsg ) ! Passed variables CHARACTER(*), INTENT( IN ) :: Rootname ! filename including full path, minus any file extension. @@ -242,7 +242,6 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_ real(DbKi), intent( in ) :: WaveDT real(ReKi), intent( in ) :: X_HalfWidth real(ReKi), intent( in ) :: Y_HalfWidth - real(ReKi), intent( in ) :: Z_Depth real(ReKi), intent( in ) :: deltaGrid(3) INTEGER, INTENT( IN ) :: NGrid(3) ! Number of grid points for the wave kinematics arrays INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs @@ -274,7 +273,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_ y_gridPts(i+1) = -Y_HalfWidth + deltaGrid(2)*i end do do i = 0, NGrid(3)-1 - z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * Z_Depth + z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%SeaSt_Interp_p%Z_Depth end do ! Write the increments from [0, NStepWave] even though for OpenFAST data, NStepWave = 0, but for arbitrary user data this may not be true. diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f5762d5d25..415b58ba7f 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -150,7 +150,6 @@ MODULE SeaState_Types REAL(ReKi) , DIMENSION(1:3) :: deltaGrid = 0.0_ReKi !< delta between grid points in x, y, and theta (for z) [m,m,rad] REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] @@ -1143,7 +1142,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%deltaGrid = SrcParamData%deltaGrid DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth - DstParamData%Z_Depth = SrcParamData%Z_Depth DstParamData%NWaveElev = SrcParamData%NWaveElev if (allocated(SrcParamData%WaveElevxi)) then LB(1:1) = lbound(SrcParamData%WaveElevxi) @@ -1301,7 +1299,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%deltaGrid) call RegPack(Buf, InData%X_HalfWidth) call RegPack(Buf, InData%Y_HalfWidth) - call RegPack(Buf, InData%Z_Depth) call RegPack(Buf, InData%NWaveElev) call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then @@ -1379,8 +1376,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%Y_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) From a16dae5b9f637b6a25a8867d690b758a98f97be8 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 8 Nov 2023 14:32:58 -0700 Subject: [PATCH 054/232] SeaSt: fix bug in SeaSt driver from dca516 --- modules/seastate/src/SeaState_DriverCode.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index 8821f86522..276352fbd3 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -652,8 +652,8 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## It is arranged as blocks of X,Y,Elevation at each timestep' write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '## Each block is separated by two blank lines for use in gnuplot' write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' - write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# WaveTMax = '//TRIM(Num2LStr(SeaState_p%WaveField%WaveTime(SeaState_P%NStepWave))) - write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# NStepWave = '//TRIM(Num2LStr(SeaState_p%NStepWave)) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# WaveTMax = '//TRIM(Num2LStr(SeaState_p%WaveField%WaveTime(SeaState_p%WaveField%NStepWave))) + write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# NStepWave = '//TRIM(Num2LStr(SeaState_p%WaveField%NStepWave)) write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridXPoints = '//TRIM(Num2LStr(SeaState_p%NGrid(1))) write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridYPoints = '//TRIM(Num2LStr(SeaState_p%NGrid(2))) write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# GridDX = '//TRIM(Num2LStr(SeaState_p%deltaGrid(1))) @@ -663,7 +663,7 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) '# ' ! Timestep looping - do i = 0,SeaState_p%NStepWave + do i = 0,SeaState_p%WaveField%NStepWave write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) NewLine write (WaveElevFileUn,'(A8,F10.3)', IOSTAT=ErrStatTmp ) '# Time: ',SeaState_p%WaveField%WaveTime(I) ! Now output the X,Y, Elev info for this timestep From df658dcb0cf304ead14df011dd47a5c915830ae5 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 9 Nov 2023 09:26:40 -0700 Subject: [PATCH 055/232] SeaSt: remove extra HalfWidth parameters --- modules/seastate/src/SeaState.f90 | 6 +++--- modules/seastate/src/SeaState.txt | 2 -- modules/seastate/src/SeaState_Input.f90 | 2 -- modules/seastate/src/SeaState_Types.f90 | 10 ---------- 4 files changed, 3 insertions(+), 17 deletions(-) diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 00901adbcf..a3a35cb0f0 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -240,11 +240,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! add some warnings about requesting WriteOutput outside the SeaState domain: do i=1,p%NWaveKin - if (abs(p%WaveKinxi(i)) > p%X_HalfWidth) then + if (abs(p%WaveKinxi(i)) > InputFileData%X_HalfWidth) then CALL SetErrStat(ErrID_Warn,'Requested WaveKinxi is outside the SeaState spatial domain.', ErrStat, ErrMsg, RoutineName) exit end if - if (abs(p%WaveKinyi(i)) > p%Y_HalfWidth) then + if (abs(p%WaveKinyi(i)) > InputFileData%Y_HalfWidth) then CALL SetErrStat(ErrID_Warn,'Requested WaveKinyi is outside the SeaState spatial domain.', ErrStat, ErrMsg, RoutineName) exit end if @@ -369,7 +369,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Write Wave Kinematics? if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then if ( InitInp%WrWvKinMod == 2 ) then - call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, p%X_HalfWidth, p%Y_HalfWidth, & + call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, InputFileData%X_HalfWidth, InputFileData%Y_HalfWidth, & p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else if ( InitInp%WrWvKinMod == 1 ) then diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index f15f46c454..89a106fdb0 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -126,8 +126,6 @@ typedef ^ ParameterType DbKi Wav typedef ^ ^ INTEGER NGridPts - - - "Number of data points in the wave kinematics grid" - typedef ^ ^ INTEGER NGrid 3 - - "Number of grid entries in x, y, and z" typedef ^ ^ ReKi deltaGrid 3 - - "delta between grid points in x, y, and theta (for z)" m,m,rad -typedef ^ ^ ReKi X_HalfWidth - - - "Half-width of the domain in the X direction" m -typedef ^ ^ ReKi Y_HalfWidth - - - "Half-width of the domain in the Y direction" m typedef ^ ^ INTEGER NWaveElev - - - "Number of wave elevation outputs" - typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 4ef4375592..ac7a5d0b3a 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -1123,8 +1123,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er if ( ErrStat >= AbortErrLev ) return ! Generate grid points - p%X_HalfWidth = InputFileData%X_HalfWidth - p%Y_HalfWidth = InputFileData%Y_HalfWidth p%deltaGrid(1) = InputFileData%X_HalfWidth/(InputFileData%NX-1) p%deltaGrid(2)= InputFileData%Y_HalfWidth/(InputFileData%NY-1) p%deltaGrid(3) = PI / ( 2*(InputFileData%NZ-1) ) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 415b58ba7f..8d0eaa5ee7 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -148,8 +148,6 @@ MODULE SeaState_Types INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] REAL(ReKi) , DIMENSION(1:3) :: deltaGrid = 0.0_ReKi !< delta between grid points in x, y, and theta (for z) [m,m,rad] - REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] - REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] @@ -1140,8 +1138,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%NGridPts = SrcParamData%NGridPts DstParamData%NGrid = SrcParamData%NGrid DstParamData%deltaGrid = SrcParamData%deltaGrid - DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth - DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth DstParamData%NWaveElev = SrcParamData%NWaveElev if (allocated(SrcParamData%WaveElevxi)) then LB(1:1) = lbound(SrcParamData%WaveElevxi) @@ -1297,8 +1293,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%NGridPts) call RegPack(Buf, InData%NGrid) call RegPack(Buf, InData%deltaGrid) - call RegPack(Buf, InData%X_HalfWidth) - call RegPack(Buf, InData%Y_HalfWidth) call RegPack(Buf, InData%NWaveElev) call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then @@ -1372,10 +1366,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%deltaGrid) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Y_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) From ff7a7b90fa5c95c8c9e6e56508da9419bcb396ce Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 9 Nov 2023 11:44:04 -0700 Subject: [PATCH 056/232] SeaSt: cleanup file read of WavePkShp and WaveMod --- modules/seastate/src/SeaState.txt | 1 - modules/seastate/src/SeaState_Input.f90 | 100 +++++++++--------------- modules/seastate/src/SeaState_Types.f90 | 5 -- modules/seastate/src/Waves.f90 | 41 +++++++--- modules/seastate/src/Waves.txt | 1 - modules/seastate/src/Waves_Types.f90 | 5 -- 6 files changed, 64 insertions(+), 89 deletions(-) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 89a106fdb0..316578415e 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -62,7 +62,6 @@ typedef ^ ^ SiKi WvLowCO typedef ^ ^ SiKi WvHiCOffS - - - "Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0]" (rad/s) typedef ^ ^ SiKi WaveDOmega - - - "Frequency step for incident wave calculations" (rad/s) typedef ^ ^ INTEGER WaveMod - - - "Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters." - -typedef ^ ^ CHARACTER(80) WaveModChr - - - "String to temporarially hold the value of the wave kinematics input line" typedef SeaState/SeaSt InitInputType CHARACTER(1024) InputFile - - - "Supplied by Driver: full path and filename for the SeaState module" - diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index ac7a5d0b3a..05a25e54f1 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -54,9 +54,10 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, real(ReKi), allocatable :: tmpReArray(:) ! Temporary array storage of the joint output list character(1) :: Line1 ! The first character of an input line integer(IntKi) :: CurLine !< Current entry in FileInfo_In%Lines array + integer(IntKi) :: IOS integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_ParaseInput' + character(*), parameter :: RoutineName = 'SeaSt_ParseInput' ! Initialize local data UnEc = -1 @@ -142,9 +143,33 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if ( InputFileData%Echo ) write(UnEc, '(A)') trim(FileInfo_In%Lines(CurLine)) ! Write section break to echo CurLine = CurLine + 1 - ! WaveMod - Wave kinematics model switch. - call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%WaveModChr, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + ! WaveMod - Wave kinematics model switch. and WavePhase (as appropriate) + InputFileData%Waves%WavePhase = 0.0 + call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%WaveMod, ErrStat2, ErrMsg2, UnEc ) + if ( ErrStat2 >= AbortErrLev ) then + ! try to read the line that just failed, as a string this time to see if it's "1P" + CurLine = CurLine - 1 + call ParseVar( FileInfo_In, CurLine, 'WaveMod', Line, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return + + call Conv2UC( Line ) ! Convert Line to upper case. + if ( Line(1:2) == '1P' ) then ! The user wants to specify the phase in place of a random phase + + InputFileData%WaveMod = WaveMod_RegularUsrPh ! Internally define WaveMod = 10 to mean regular waves with a specified (nonrandom) phase + + read (Line(3:),*,IOSTAT=IOS ) InputFileData%Waves%WavePhase + call CheckIOS ( IOS, "", 'WavePhase', NumType, ErrStat2, ErrMsg2 ) + if (Failed()) return + + InputFileData%Waves%WavePhase = InputFileData%Waves%WavePhase*D2R ! Convert the phase from degrees to radians + + else ! The user must have specified WaveMod incorrectly. + ErrStat2 = ErrID_Fatal + ErrMsg2 = 'WaveMod incorrectly specified in SeaState input file.' + if (Failed()) return + end if + + end if ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. call ParseVar( FileInfo_In, CurLine, 'WaveStMod', InputFileData%WaveStMod, ErrStat2, ErrMsg2, UnEc ) @@ -167,9 +192,11 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! WavePkShp - Peak shape parameter. - call ParseVar( FileInfo_In, CurLine, 'WavePkShp', InputFileData%Waves%WavePkShpChr, ErrStat2, ErrMsg2, UnEc ) + call ParseVarWDefault(FileInfo_In, CurLine, 'WavePkShp', InputFileData%Waves%WavePkShp, & + WavePkShpDefault( InputFileData%WaveMod, InputFileData%Waves%WaveHs, InputFileData%Waves%WaveTp), ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; + ! WvLowCOff - Low Cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s). call ParseVar( FileInfo_In, CurLine, 'WvLowCOff', InputFileData%WvLowCOff, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; @@ -556,36 +583,6 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveMod - Wave kinematics model switch. - InputFileData%Waves%WavePhase = 0.0 - - if ( LEN_TRIM(InputFileData%WaveModChr) > 1 ) then - call Conv2UC( InputFileData%WaveModChr ) ! Convert Line to upper case. - - if ( InputFileData%WaveModChr(1:2) == '1P' ) then ! The user wants to specify the phase in place of a random phase - - InputFileData%WaveMod = WaveMod_RegularUsrPh ! Internally define WaveMod = 10 to mean regular waves with a specified (nonrandom) phase - - read (InputFileData%WaveModChr(3:),*,IOSTAT=IOS ) InputFileData%Waves%WavePhase - call CheckIOS ( IOS, "", 'WavePhase', NumType, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) return - - InputFileData%Waves%WavePhase = InputFileData%Waves%WavePhase*D2R ! Convert the phase from degrees to radians - - else ! The user must have specified WaveMod incorrectly. - call SetErrStat( ErrID_Fatal,'WaveMod incorrectly specified',ErrStat,ErrMsg,RoutineName) - return - end if - - else - ! The line below only works for 1 digit reads - read( InputFileData%WaveModChr, *, IOSTAT=IOS ) InputFileData%WaveMod - call CheckIOS ( IOS, "", 'WaveMod', NumType, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) return - - end if ! LEN_TRIM(InputFileData%Waves%WaveModChr) - SELECT CASE(InputFileData%WaveMod) CASE(WaveMod_None) CASE(WaveMod_Regular) @@ -686,37 +683,12 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er return end if - - - - ! WavePkShp - Peak shape parameter. - - call Conv2UC( InputFileData%Waves%WavePkShpChr ) ! Convert Line to upper case. - - if ( InputFileData%WaveMod == WaveMod_JONSWAP ) then ! .TRUE if we have JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, but not GH Bladed wave data. - - if ( TRIM(InputFileData%Waves%WavePkShpChr) == 'DEFAULT' ) then ! .TRUE. when one wants to use the default value of the peak shape parameter, conditioned on significant wave height and peak spectral period. - InputFileData%Waves%WavePkShp = WavePkShpDefault ( InputFileData%Waves%WaveHs, InputFileData%Waves%WaveTp ) - - else ! The input must have been specified numerically. - - read (InputFileData%Waves%WavePkShpChr,*,IOSTAT=IOS) InputFileData%Waves%WavePkShp - call CheckIOS ( IOS, "", 'WavePkShp', NumType, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) return - - if ( ( InputFileData%Waves%WavePkShp < 1.0 ) .OR. ( InputFileData%Waves%WavePkShp > 7.0 ) ) then - call SetErrStat( ErrID_Fatal,'WavePkShp must be greater than or equal to 1 and less than or equal to 7.',ErrStat,ErrMsg,RoutineName) - return - end if - - end if - - else - - InputFileData%Waves%WavePkShp = 1.0 + ! WavePkShp - Peak shape parameter + if ( ( InputFileData%Waves%WavePkShp < 1.0 ) .OR. ( InputFileData%Waves%WavePkShp > 7.0 ) ) then + call SetErrStat( ErrID_Fatal,'WavePkShp must be greater than or equal to 1 and less than or equal to 7.',ErrStat,ErrMsg,RoutineName) + return end if diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 8d0eaa5ee7..3762a06604 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -81,7 +81,6 @@ MODULE SeaState_Types REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model: See valid values in SeaSt_WaveField module parameters. [-] - CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= @@ -304,7 +303,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WvHiCOffS = SrcInputFileData%WvHiCOffS DstInputFileData%WaveDOmega = SrcInputFileData%WaveDOmega DstInputFileData%WaveMod = SrcInputFileData%WaveMod - DstInputFileData%WaveModChr = SrcInputFileData%WaveModChr end subroutine subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) @@ -412,7 +410,6 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%WvHiCOffS) call RegPack(Buf, InData%WaveDOmega) call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%WaveModChr) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -575,8 +572,6 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveModChr) - if (RegCheckErr(Buf, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 3c8c9381a2..ffd29a4b76 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -56,7 +56,7 @@ MODULE Waves !======================================================================= - FUNCTION WavePkShpDefault ( Hs, Tp ) + FUNCTION WavePkShpDefault ( WaveMod, Hs, Tp ) ! This FUNCTION is used to return the default value of the peak shape @@ -73,10 +73,10 @@ FUNCTION WavePkShpDefault ( Hs, Tp ) ! Passed Variables: - - REAL(SiKi), INTENT(IN ) :: Hs ! Significant wave height (meters) - REAL(SiKi), INTENT(IN ) :: Tp ! Peak spectral period (sec) - REAL(SiKi) :: WavePkShpDefault ! This function = default value of the peak shape parameter of the incident wave spectrum conditioned on significant wave height and peak spectral period (-) + INTEGER(IntKi), INTENT(IN ) :: WaveMod + REAL(SiKi), INTENT(IN ) :: Hs ! Significant wave height (meters) + REAL(SiKi), INTENT(IN ) :: Tp ! Peak spectral period (sec) + REAL(SiKi) :: WavePkShpDefault ! This function = default value of the peak shape parameter of the incident wave spectrum conditioned on significant wave height and peak spectral period (-) ! Local Variables: @@ -87,17 +87,32 @@ FUNCTION WavePkShpDefault ( Hs, Tp ) ! Compute the default peak shape parameter of the incident wave spectrum, ! conditioned on significant wave height and peak spectral period: + + if ( WaveMod == WaveMod_JONSWAP ) then + + if ( Hs <= 0.0_SiKi ) then + + WavePkShpDefault = 1.0 + + else - TpOvrSqrtHs = Tp/SQRT(Hs) + TpOvrSqrtHs = Tp/SQRT(Hs) - IF ( TpOvrSqrtHs <= 3.6 ) THEN - WavePkShpDefault = 5.0 - ELSEIF ( TpOvrSqrtHs >= 5.0 ) THEN - WavePkShpDefault = 1.0 - ELSE - WavePkShpDefault = EXP( 5.75 - 1.15*TpOvrSqrtHs ) - END IF + IF ( TpOvrSqrtHs <= 3.6 ) THEN + WavePkShpDefault = 5.0 + ELSEIF ( TpOvrSqrtHs >= 5.0 ) THEN + WavePkShpDefault = 1.0 + ELSE + WavePkShpDefault = EXP( 5.75 - 1.15*TpOvrSqrtHs ) + END IF + end if + else + + WavePkShpDefault = 1.0 + + end if + RETURN diff --git a/modules/seastate/src/Waves.txt b/modules/seastate/src/Waves.txt index c562f3b699..262c5dc74c 100644 --- a/modules/seastate/src/Waves.txt +++ b/modules/seastate/src/Waves.txt @@ -31,7 +31,6 @@ typedef ^ ^ SiKi WaveHs typedef ^ ^ LOGICAL WaveNDAmp - - - "Flag for normally-distributed amplitudes in incident waves spectrum [flag]" - typedef ^ ^ SiKi WavePhase - - - "Specified phase for regular waves" (radians) typedef ^ ^ SiKi WavePkShp - - - "Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz]" - -typedef ^ ^ CHARACTER(80) WavePkShpChr - - - "String to temporarially hold value of peak shape parameter input line" - typedef ^ ^ DbKi WaveTMax - - - "Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT" (sec) typedef ^ ^ SiKi WaveTp - - - "Peak spectral period of incident waves" (sec) typedef ^ ^ INTEGER NWaveElevGrid - - - "Number of grid points where the incident wave elevations are computed (the XY grid point locations)" - diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 62aa9bc023..00cfd710db 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -48,7 +48,6 @@ MODULE Waves_Types LOGICAL :: WaveNDAmp = .false. !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] - CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] @@ -104,7 +103,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp DstInitInputData%WavePhase = SrcInitInputData%WavePhase DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp - DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax DstInitInputData%WaveTp = SrcInitInputData%WaveTp DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid @@ -230,7 +228,6 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveNDAmp) call RegPack(Buf, InData%WavePhase) call RegPack(Buf, InData%WavePkShp) - call RegPack(Buf, InData%WavePkShpChr) call RegPack(Buf, InData%WaveTMax) call RegPack(Buf, InData%WaveTp) call RegPack(Buf, InData%NWaveElevGrid) @@ -308,8 +305,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WavePkShp) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WavePkShpChr) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WaveTp) From 09bdd38db28b04036b6c86f68de63d6e4603d022 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 9 Nov 2023 11:56:56 -0700 Subject: [PATCH 057/232] HD/SeaSt: cleanup unused variables - `LastIndWave` in HD - `DT` in SeaSt --- modules/hydrodyn/src/HydroDyn.f90 | 8 ++------ modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_Types.f90 | 5 ----- modules/hydrodyn/src/Morison.f90 | 1 - modules/hydrodyn/src/Morison.txt | 1 - modules/hydrodyn/src/Morison_Types.f90 | 5 ----- modules/hydrodyn/src/WAMIT.f90 | 5 ++--- modules/seastate/src/SeaState.f90 | 2 -- modules/seastate/src/SeaState.txt | 1 - modules/seastate/src/SeaState_Types.f90 | 5 ----- 10 files changed, 4 insertions(+), 30 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index ccfe24f358..ad4c590a39 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -268,10 +268,6 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data - - - m%LastIndWave = 1 - ! Is there a WAMIT body? @@ -1251,7 +1247,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) if ( ErrStat >= AbortErrLev ) return - call WAMIT_CalcOutput( Time, p%WaveField%WaveTime, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & + call WAMIT_CalcOutput( Time, m%u_WAMIT(1), p%WAMIT(1), x%WAMIT(1), xd%WAMIT(1), & z%WAMIT, OtherState%WAMIT(1), y%WAMIT(1), m%WAMIT(1), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) do iBody=1,p%NBody @@ -1272,7 +1268,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, m%u_WAMIT(iBody)%Mesh%TranslationAcc (:,1) = u%WAMITMesh%TranslationAcc (:,iBody) m%u_WAMIT(iBody)%Mesh%RotationAcc (:,1) = u%WAMITMesh%RotationAcc (:,iBody) - call WAMIT_CalcOutput( Time, p%WaveField%WaveTime, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & + call WAMIT_CalcOutput( Time, m%u_WAMIT(iBody), p%WAMIT(iBody), x%WAMIT(iBody), xd%WAMIT(iBody), & z%WAMIT, OtherState%WAMIT(iBody), y%WAMIT(iBody), m%WAMIT(iBody), ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'HydroDyn_CalcOutput' ) y%WAMITMesh%Force (:,iBody) = y%WAMITMesh%Force (:,iBody) + y%WAMIT(iBody)%Mesh%Force (:,1) diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index be9ab3a78b..7d2b9c0766 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -125,7 +125,6 @@ typedef ^ MiscVarType MeshType typedef ^ ^ HD_ModuleMapType HD_MeshMap - - - typedef ^ ^ INTEGER Decimate - - - "The output decimation counter" - typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - -typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - typedef ^ ^ ReKi F_PtfmAdd {:} - - "The total forces and moments due to additional pre-load, stiffness, and damping" - typedef ^ ^ ReKi F_Hydro {6} - - "The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point" - typedef ^ ^ ReKi F_Waves {:} - - "The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules)" - diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 4bfc1c2dbe..6e5e13a26c 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -144,7 +144,6 @@ MODULE HydroDyn_Types TYPE(HD_ModuleMapType) :: HD_MeshMap INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] @@ -1704,7 +1703,6 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return DstMiscData%Decimate = SrcMiscData%Decimate DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave if (allocated(SrcMiscData%F_PtfmAdd)) then LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) @@ -1846,7 +1844,6 @@ subroutine HydroDyn_PackMisc(Buf, Indata) call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) call RegPack(Buf, InData%Decimate) call RegPack(Buf, InData%LastOutTime) - call RegPack(Buf, InData%LastIndWave) call RegPack(Buf, allocated(InData%F_PtfmAdd)) if (allocated(InData%F_PtfmAdd)) then call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd), ubound(InData%F_PtfmAdd)) @@ -1904,8 +1901,6 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%F_PtfmAdd)) deallocate(OutData%F_PtfmAdd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 9a5e4722c2..8c7b63bf44 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2083,7 +2083,6 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In z%DummyConstrState = 0 OtherState%DummyOtherState = 0 - m%LastIndWave = 1 ! allocate and initialize joint-specific arrays diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 41fef50552..7b4b426647 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -322,7 +322,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi F_BF_End {:}{:} - - "" - typedef ^ ^ ReKi V_rel_n {:} - - "Normal relative flow velocity at joints" m/s typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s -typedef ^ ^ INTEGER LastIndWave - - - "Last time index used in the wave kinematics arrays" - typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 0a60529f37..5bff26944f 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -385,7 +385,6 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_BF_End !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n !< Normal relative flow velocity at joints [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] - INTEGER(IntKi) :: LastIndWave = 0_IntKi !< Last time index used in the wave kinematics arrays [-] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] END TYPE Morison_MiscVarType @@ -4857,7 +4856,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass end if - DstMiscData%LastIndWave = SrcMiscData%LastIndWave call NWTC_Library_CopyMeshMapType(SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -5060,7 +5058,6 @@ subroutine Morison_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass), ubound(InData%V_rel_n_HiPass)) call RegPack(Buf, InData%V_rel_n_HiPass) end if - call RegPack(Buf, InData%LastIndWave) call NWTC_Library_PackMeshMapType(Buf, InData%VisMeshMap) call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return @@ -5356,8 +5353,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%V_rel_n_HiPass) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_UnpackMeshMapType(Buf, OutData%VisMeshMap) ! VisMeshMap call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 9d89726b96..94d669bc3b 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -1764,11 +1764,10 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState END SUBROUTINE WAMIT_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - real(SiKi), intent(in ) :: WaveTime(:) !< Array of wave kinematic time samples, (sec) TYPE(WAMIT_InputType), INTENT(IN ) :: u !< Inputs at Time TYPE(WAMIT_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(WAMIT_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time @@ -1823,7 +1822,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, WaveTime, u, p, x, xd, z, OtherState, y, m, E END IF DO I = 1,6*p%NBody ! Loop through all wave excitation forces and moments - m%F_Waves1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), WaveTime(:), p%WaveExctn(:,I), & + m%F_Waves1(I) = InterpWrappedStpReal ( REAL(Time, SiKi), p%WaveField%WaveTime, p%WaveExctn(:,I), & m%LastIndWave, p%WaveField%NStepWave + 1 ) END DO ! I - All wave excitation forces and moments else ! p%ExctnDisp > 0 diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index a3a35cb0f0..ad790d0c02 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -178,8 +178,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init RETURN END IF - p%DT = Interval - ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 316578415e..03e659fac1 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -132,7 +132,6 @@ typedef ^ ^ INTEGER NWa typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinzi {:} - - "zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level" (meters) -typedef ^ ^ DbKi DT - - - "Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states" - typedef ^ ^ OutParmType OutParam {:} - - "" - typedef ^ ^ INTEGER NumOuts - - - "Number of SeaState module-level outputs (not the total number including sub-modules" - typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files]" - diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 3762a06604..f0a1d2bf70 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -154,7 +154,6 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] - REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] @@ -1195,7 +1194,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%WaveKinzi = SrcParamData%WaveKinzi end if - DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) UB(1:1) = ubound(SrcParamData%OutParam) @@ -1315,7 +1313,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) call RegPack(Buf, InData%WaveKinzi) end if - call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -1435,8 +1432,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinzi) if (RegCheckErr(Buf, RoutineName)) return end if - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 5c34683a0772ae92629f64f44a987b90e954c4e2 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 9 Nov 2023 12:11:05 -0700 Subject: [PATCH 058/232] HD: fix potential memory issue if no outputs were requested --- modules/hydrodyn/src/HydroDyn_Output.f90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 95f1693bc7..1823f1e565 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -1006,9 +1006,10 @@ SUBROUTINE HDOUT_Init( HydroDyn_ProgDesc, OutRootName, InputFileData, y, p, m, ! Check that the variables in OutList are valid !------------------------------------------------------------------------------------------------- - - CALL SetOutParam(InputFileData%OutList, p, ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) RETURN + if (allocated(InputFileData%OutList)) then + CALL SetOutParam(InputFileData%OutList, p, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) RETURN + end if ! Aggregate the sub-module initialization outputs for the glue code From e1c1c4ea684f83b7f01684383ef5b885aff4a730 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 9 Nov 2023 12:30:42 -0700 Subject: [PATCH 059/232] HD: fix bug in ff7a7b --- modules/seastate/src/SeaState_Input.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index e5ee1165bc..932bd28ce9 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -148,7 +148,6 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, call ParseVar( FileInfo_In, CurLine, 'WaveMod', InputFileData%WaveMod, ErrStat2, ErrMsg2, UnEc ) if ( ErrStat2 >= AbortErrLev ) then ! try to read the line that just failed, as a string this time to see if it's "1P" - CurLine = CurLine - 1 call ParseVar( FileInfo_In, CurLine, 'WaveMod', Line, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return From 624b7a0425d48b279dff11cb3115d6bd0b633ba4 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 10 Nov 2023 16:41:18 -0700 Subject: [PATCH 060/232] IfW: check that uniform wind file time vector is always increasing --- modules/inflowwind/src/InflowWind_IO.f90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index 6f4a62c9a2..6a2954e14e 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -256,6 +256,7 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM call SetErrStat(ErrID_Fatal, TmpErrMsg, ErrStat, ErrMsg, RoutineName) end if end do + if (ErrStat >= AbortErrLev) return !---------------------------------------------------------------------------- ! Find out information on the timesteps and range @@ -277,6 +278,24 @@ subroutine IfW_UniformWind_Init(InitInp, SumFileUnit, UF, FileDat, ErrStat, ErrM WindFileDT = 0.0_ReKi end if + !---------------------------------------------------------------------------- + ! Check that time is always increasing + !---------------------------------------------------------------------------- + + ! Check that last timestep is always increasing + if (UF%DataSize > 2) then + do I = 2, UF%DataSize + if (UF%Time(I)<=UF%Time(I-1)) then + TmpErrMsg = ' Time vector must always increase in the uniform wind file. Error around wind step ' & + //TRIM(Num2LStr(I))//' at time '//TRIM(Num2LStr(UF%Time(I)))//' in wind file ' & + //TRIM(InitInp%WindFileName)//'.' + call SetErrStat(ErrID_Fatal, TmpErrMsg, ErrStat, ErrMsg, RoutineName) + exit + endif + end do + if (ErrStat >= AbortErrLev) return + endif + !---------------------------------------------------------------------------- ! Store wind file metadata !---------------------------------------------------------------------------- From f1116d7051226c1245b288e84ae60bf233324974 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 13 Nov 2023 11:11:33 -0700 Subject: [PATCH 061/232] Fix segfault in HD when 0 outputs specified This commit fixes a bug where HydroDyn would segfault if no outputs were specified in the input file. --- modules/hydrodyn/src/HydroDyn_Input.f90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index fcbac6fa6c..a9fe940189 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -3105,7 +3105,18 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS IF (ErrStat >= AbortErrLev ) RETURN DEALLOCATE(foundMask) - + + ELSE + + ! Set number of outputs to zero + InputFileData%NumOuts = 0 + InputFileData%Waves2%NumOuts = 0 + InputFileData%Morison%NumOuts = 0 + + ! Allocate outlist with zero length + call AllocAry(InputFileData%OutList, 0, "InputFileData%OutList", ErrStat2, ErrMsg2); + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! Now that we have the sub-lists organized, lets do some additional validation. From 67c77c46f8e5eabb46752653d7c4cb67083b73ed Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 16 Nov 2023 14:31:34 -0700 Subject: [PATCH 062/232] HD/SeaSt: Address review comments - removed a bunch of `bjj` comments in the code - simplified some of the checks based on WaveMod (made them easier to read by specifying exactly which models the checks apply to) - updated default z depth using entered water depth instead of the default water depth - removed override of `Hs` when it's not used - override WvHiCOff and WvLowCOff in the cases where they are not supposed to be used; the code DOES actually use them, so they need to be set to allow all frequencies in the cases where they are not supposed to be used. - put check on valid values of WaveStMod from HydroDyn into SeaState (and removed the conflicting SeaState check) --- modules/hydrodyn/src/Conv_Radiation.f90 | 3 +- modules/hydrodyn/src/HydroDyn.f90 | 2 +- modules/hydrodyn/src/HydroDyn_Input.f90 | 31 -------- modules/hydrodyn/src/Morison.f90 | 2 +- modules/hydrodyn/src/WAMIT.f90 | 9 +-- modules/hydrodyn/src/WAMIT2.f90 | 6 +- modules/nwtc-library/src/ranlux/RANLUX.f90 | 87 ---------------------- modules/seastate/src/SeaState.f90 | 8 +- modules/seastate/src/SeaState_Input.f90 | 42 ++++++----- modules/seastate/src/UserWaves.f90 | 4 +- modules/seastate/src/Waves.f90 | 2 +- 11 files changed, 39 insertions(+), 157 deletions(-) diff --git a/modules/hydrodyn/src/Conv_Radiation.f90 b/modules/hydrodyn/src/Conv_Radiation.f90 index ed3a595f4b..59842ddd2c 100644 --- a/modules/hydrodyn/src/Conv_Radiation.f90 +++ b/modules/hydrodyn/src/Conv_Radiation.f90 @@ -340,7 +340,7 @@ SUBROUTINE Conv_Rdtn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, InitOut, E m%LastIndRdtn = 0 OtherState%IndRdtn = 0 - ! bjj: these initializations don't matter, but I don't like seeing the compilation warning in IVF: + ! bjj: these initializations don't matter, but I don't like seeing the compilation warning in Intel Fortran: x%DummyContState = 0.0 z%DummyConstrState = 0.0 y%F_Rdtn = 0.0 @@ -632,7 +632,6 @@ SUBROUTINE Conv_Rdtn_UpdateDiscState( Time, n, u, p, x, xd, z, OtherState, m, Er ! with the newest values: ! NOTE: When IndRdtn > LastIndRdtn, IndRdtn will equal LastIndRdtn + 1 if DT <= RdtnDT; ! When IndRdtn > LastIndRdtn, IndRdtn will be greater than LastIndRdtn + 1 if DT > RdtnDT. - !BJJ: this needs a better check so that it is ALWAYS done (MATLAB/Simulink could possibly avoid this step by starting at Time>0, OR there may be some numerical issues where this is NOT EXACTLY zero) IF ( OtherState%IndRdtn < (p%NStepRdtn) ) THEN DO J = 1,6*p%NBody ! Loop through all platform DOFs diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index ad4c590a39..459277e42c 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -142,7 +142,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ErrStat = ErrID_None ErrMsg = "" - p%UnOutFile = -1 !bjj: this was being written to the screen when I had an error in my HD input file, so I'm going to initialize here. + p%UnOutFile = -1 p%WaveField => InitInp%WaveField diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 64f6115894..fd0c1d92c0 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -228,16 +228,6 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi if (Failed()) return; -!bjj: should we add this? -!test for numerical stability -! IF ( FP_InitData%RdtnDT <= FP_InitData%RdtnTMax*EPSILON(FP_InitData%RdtnDT) ) THEN ! Test RdtnDT and RdtnTMax to ensure numerical stability -- HINT: see the use of OnePlusEps." -! ErrStat = ErrID_Fatal -! ErrMsg2 = ' RdtnDT must be greater than '//TRIM ( Num2LStr( RdtnTMax*EPSILON(RdtnDT) ) )//' seconds.' -! if (Failed()) return; -! END IF - - - !------------------------------------------------------------------------------------------------- ! Data section for 2nd order WAMIT forces !------------------------------------------------------------------------------------------------- @@ -1162,27 +1152,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! (InputFileData%WAMIT2%SumQTF /= 0 ) ) then ! !end if - - - ! WaveStMod - Model switch for stretching incident wave kinematics to instantaneous free surface. - IF ( InitInp%WaveField%WaveMod /= WaveMod_None .AND. InputFileData%Morison%NMembers > 0 ) THEN - IF ( InitInp%WaveField%WaveMod /= WaveMod_ExtFull ) THEN - IF ( ( InitInp%WaveField%WaveStMod /= 0 ) .AND. ( InitInp%WaveField%WaveStMod /= 1 ) .AND. & - ( InitInp%WaveField%WaveStMod /= 2 ) .AND. ( InitInp%WaveField%WaveStMod /= 3 ) ) THEN - ErrMsg = ' WaveStMod must be 0, 1, 2, or 3.' - ErrStat = ErrID_Fatal - RETURN - END IF - ELSE - IF ( ( InitInp%WaveField%WaveStMod /= 0 ) .AND. ( InitInp%WaveField%WaveStMod /= 1 ) .AND. & - ( InitInp%WaveField%WaveStMod /= 3 ) ) THEN - ErrMsg = ' WaveStMod must be 0, 1, or 3 when WaveMod = 6.' - ErrStat = ErrID_Fatal - RETURN - END IF - END IF - END IF - ! PotFile - Root name of potential flow files diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 8c7b63bf44..38e1d23a4f 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2117,7 +2117,7 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In tMG = -999.0 An_drag = 0.0 - IF ( (InitInp%InpJoints(i)%Position(3)-p%WaveField%MSL2SWL) >= -InitInp%WaveField%EffWtrDpth ) THEN !bjj: ask Lu if this is correct. I wonder if this check is supposed to be against WtrDpth + IF ( InitInp%InpJoints(i)%Position(3) >= -InitInp%WaveField%WtrDpth ) THEN ! loop through each member attached to the joint, getting the radius of its appropriate end DO J = 1, InitInp%InpJoints(I)%NConnections diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 94d669bc3b..b740b6cd35 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -901,7 +901,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS else ! Initialize the variables associated with the incident wave: - SELECT CASE ( InitInp%WaveField%WaveMod ) ! Which incident wave kinematics model are we using? + SELECT CASE ( p%WaveField%WaveMod ) ! Which incident wave kinematics model are we using? CASE ( WaveMod_None ) ! No waves, NOTE: for this case we are forcing ExctnDisp = 0, so only p%WaveExctn needs to be allocated, not p%WaveExctnGrid if ( p%ExctnMod == 1 ) then @@ -1029,7 +1029,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS do J = 1, NInpWvDir do I = 1, NInpFreq ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) - WaveNmbr = WaveNumber ( HdroFreq(I), InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) + WaveNmbr = WaveNumber ( HdroFreq(I), InitInp%Gravity, p%WaveField%EffWtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) TmpRe = cos(tmpAngle) TmpIm = -sin(tmpAngle) @@ -1213,7 +1213,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS Omega = I*p%WaveField%WaveDOmega ! Fxy = exp(-j * k(w) * ( X*cos(Beta(w)) + Y*sin(Beta(w)) ) - WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WaveField%EffWtrDpth ) + WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, p%WaveField%EffWtrDpth ) tmpAngle = WaveNmbr * ( InitInp%PtfmRefxt(1)*cos(HdroWvDir(J)*D2R) + InitInp%PtfmRefyt(1)*sin(HdroWvDir(J)*D2R) ) TmpRe = cos(tmpAngle) TmpIm = -sin(tmpAngle) @@ -1301,9 +1301,6 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS end if ! Set Initialization data for the Conv_Rdtn submodule - ! Would be nice if there were a copy InitInput function in the *_Types file - ! BJJ 6/25/2014: There is a copy InitInput function.... ??? - CALL MOVE_ALLOC( HdroFreq, Conv_Rdtn_InitInp%HdroFreq ) CALL MOVE_ALLOC( HdroAddMs, Conv_Rdtn_InitInp%HdroAddMs ) CALL MOVE_ALLOC( HdroDmpng, Conv_Rdtn_InitInp%HdroDmpng ) diff --git a/modules/hydrodyn/src/WAMIT2.f90 b/modules/hydrodyn/src/WAMIT2.f90 index f0090ac458..21c4f18ffc 100644 --- a/modules/hydrodyn/src/WAMIT2.f90 +++ b/modules/hydrodyn/src/WAMIT2.f90 @@ -1152,9 +1152,6 @@ SUBROUTINE MnDrift_InitCalc( InitInp, p, MnDriftData, MnDriftForce, ErrMsg, ErrS ! Only get a QTF value if within the range of frequencies we have wave amplitudes for (first order cutoffs). This ! is done only for efficiency. - !BJJ: If WaveMod==1, this could result in zeroing out the wrong values... - !InitInp%WvLowCOff and InitInp%WvHiCOff are not used in SeaState when WaveMod = 0,1, or 6 (WaveMod_ExtFull) - ! Probably could just remove this IF statement???? IF ( (Omega1 >= InitInp%WaveField%WvLowCOff) .AND. (Omega1 <= InitInp%WaveField%WvHiCOff) ) THEN ! Now get the QTF value that corresponds to this frequency and wavedirection pair. @@ -1352,7 +1349,6 @@ SUBROUTINE NewmanApp_InitCalc( InitInp, p, NewmanAppData, NewmanAppForce, ErrMsg !> 1. Check the data to see if the wave frequencies are present in the QTF data. Since Newman's approximation only uses !! frequencies where \f$ \omega_1=\omega_2 \f$, the data read in from the files must contain the full range of frequencies !! present in the waves. -!bjj: InitInp%WvLowCOff and InitInp%WvHiCOff aren't supposed to be used when WaveMod=0, 1, or 6, but they are used here regardless of those conditions. IF ( NewmanAppData%DataIs3D ) THEN ! Check the low frequency cutoff @@ -2979,7 +2975,7 @@ SUBROUTINE SumQTF_InitCalc( InitInp, p, SumQTFData, SumQTFForce, ErrMsg, ErrStat ENDIF ! Now we add the two terms together. The 0.5 multiplier on is because the double sided FFT was used. - DO J=0,InitInp%WaveField%NStepWave-1 !bjj: Term1Array and Term2Array don't set the last element, so we can get over-flow errors here. SumQTFForce(InitInp%WaveField%NStepWave,Idx) gets overwritten later, so Idx'm setting the array bounds to be -1. + DO J=0,InitInp%WaveField%NStepWave-1 !bjj: Term1Array and Term2Array don't set the last element, so we can get overflow errors here. SumQTFForce(InitInp%WaveField%NStepWave,Idx) gets overwritten later, so I'm setting the array bounds to be InitInp%WaveField%NStepWave-1. SumQTFForce(J,Idx) = 0.5_SiKi*(REAL(Term1Array(J) + 2*Term2Array(J), SiKi)) ENDDO diff --git a/modules/nwtc-library/src/ranlux/RANLUX.f90 b/modules/nwtc-library/src/ranlux/RANLUX.f90 index a9ae2063ff..e58830d546 100644 --- a/modules/nwtc-library/src/ranlux/RANLUX.f90 +++ b/modules/nwtc-library/src/ranlux/RANLUX.f90 @@ -36,9 +36,6 @@ Module Ran_Lux_Mod ! 1 1.5 2 3 5 on fast mainframe ! ! NotYet is .TRUE. if no initialization has been performed yet. -!Start bjj: We want to write to the screen instead of "print *" -! use NWTC_IO -!End bjj: use precision implicit none @@ -78,22 +75,12 @@ subroutine RanLux (RVec) NotYet = .FALSE. JSeed = JSDFlt InSeed = JSeed -!begin bjj -! print *, " RanLux default initialization: ", JSeed -! write( RanLux_str, '(I12)' ) JSeed -! CALL WrScr( " RanLux default initialization: "//TRIM( ADJUSTL( RanLux_str ) ) ) -!end bjj LuxLev = LxDflt NSkip = NDSkip(LuxLev) LP = NSkip + NSeeds - 1 In24 = 0 Kount = 0 MKount = 0 -!begin bjj -! print *, " RanLux default luxury level = ", LuxLev, " p = ", LP -! write( RanLux_str, '(A,I5,A,I12)' ) " RanLux default luxury level = ", LuxLev, " p = ", LP -! CALL WrScr( TRIM( RanLux_str ) ) -!end bjj TwoM24 = 1.0 do I = 1, NSeeds - 1 @@ -129,14 +116,8 @@ subroutine RanLux (RVec) ! "Pad" small numbers (with less than 12 "significant" bits) and eliminate zero values (in case someone takes a logarithm) if ( RVec(IVec) < TwoM12 ) RVec(IVec) = RVec(IVec) + tmpTwoM24Seed if ( Rvec(IVec) == 0.0 ) RVec(IVec) = tmpTwoM24 - !bjj end of modifications end do - !bjj removed to eliminate crashing in SNwind - ! "Pad" small numbers (with less than 12 "significant" bits) and eliminate zero values (in case someone takes a logarithm) - !where (RVec < TwoM12) RVec = RVec + TwoM24 * Seeds(J24) - !where (Rvec == 0.0) RVec = TwoM24 * TwoM24 - !bjj end of modifications Kount = Kount + LEnv if (Kount >= IGiga) then @@ -152,21 +133,12 @@ subroutine RLuxIn (ISDext) integer :: I, ISD ! start subroutine RLuxIn if (Size(ISDext) /= NSeeds) then -!begin bjj -! print *, " Array size for RLuxIn must be ", NSeeds -! write( RanLux_str, '(I5)' ) NSeeds -! CALL WrScr( " Array size for RLuxIn must be "//TRIM( ADJUSTL(RanLux_str) ) ) -!end bjj return end if ! The following IF block added by Phillip Helbig, based on conversation with Fred James; ! an equivalent correction has been published by James. if (NotYet) then -!begin bjj -! print *, " Proper results only with initialisation from 25 integers obtained with RLuxUt" -! CALL WrScr( " Proper results only with initialisation from 25 integers obtained with RLuxUt" ) -!end bjj NotYet = .FALSE. end if TwoM24 = 1.0 @@ -174,13 +146,6 @@ subroutine RLuxIn (ISDext) TwoM24 = TwoM24 * 0.5 end do TwoM12 = TwoM24 * 4096.0 -!Start bjj -! print *, " Full initialization of RanLux with 25 integers:" -! print *, ISDext -! CALL WrScr ( " Full initialization of RanLux with 25 integers:" ) -! write( RanLux_str, '(25(I11,1x))' ) ISDext -! CALL WrScr ( TRIM( RanLux_str ) ) -!End bjj Seeds = Real (ISDext(: NSeeds - 1)) * TwoM24 Carry = 0.0 if (ISDext(NSeeds) < 0) Carry = TwoM24 @@ -199,22 +164,10 @@ subroutine RLuxIn (ISDext) if (LuxLev <= MaxLev) then NSkip = NDSkip(LuxLev) -!start bjj -! print *, " RanLux luxury level set by RLuxIn to: ", LuxLev\ -! CALL WrScr( " RanLux luxury level set by RLuxIn to: "//TRIM(ADJUSTL(RanLux_str) )) -!end bjj else if (LuxLev >= NSeeds - 1) then NSkip = LuxLev - NSeeds + 1 -!start bjj -! print *, " RanLux p-value set by RLuxIn to:", LuxLev -! CALL WrScr( " RanLux p-value set by RLuxIn to: "//TRIM(ADJUSTL(RanLux_str) )) -!end bjj else NSkip = NDSkip(MaxLev) -!start bjj -! print *, " RanLux illegal luxury RLuxIn: ", LuxLev -! CALL WrScr( " RanLux illegal luxury RLuxIn: "//TRIM(ADJUSTL(RanLux_str) )) -!end bjj LuxLev = MaxLev end if InSeed = - 1 @@ -227,11 +180,6 @@ subroutine RLuxUt (ISDext) ! start subroutine RLuxUt if (Size(ISDext) /= NSeeds) then ISDext = 0 -!start bjj -! print *, " Array size for RLuxUt must be ", NSeeds -! write( RanLux_str, '(I20)' ) NSeeds -! CALL WrScr( " Array size for RLuxUt must be "//TRIM( ADJUSTL(RanLux_str ))) -!end bjj return end if ISDext(: NSeeds - 1) = Int (Seeds * TwoP12 * TwoP12) @@ -261,11 +209,6 @@ subroutine RLuxGo (Lux, Int, K1, K2) LuxLev = Lux else if (Lux < NSeeds - 1 .or. Lux > 2000) then LuxLev = MaxLev -!start bjj -! print *, " RanLux illegal luxury level in RLuxGo: ", Lux -! write( RanLux_str, '(I20)' ) Lux -! Call WrScr( " RanLux illegal luxury level in RLuxGo: "//TRIM( ADJUSTL(RanLux_str ) )) -!end bjj else LuxLev = Lux do ILx = 0, MaxLev @@ -276,39 +219,15 @@ subroutine RLuxGo (Lux, Int, K1, K2) end if if (LuxLev <= MaxLev) then NSkip = NDSkip(LuxLev) -!start bjj -! print *, " RanLux luxury level set by RLuxGo :", LuxLev, " p = ", NSkip + NSeeds - 1 -! write (RanLux_str, '(A,I5)') " RanLux luxury level set by RLuxGo :", LuxLev -! write (RanLux_str, '(A,I12)') TRIM(RanLux_str)//" p = ", NSkip + NSeeds - 1 -! CALL WrScr( TRIM(RanLux_str) ) -!end bjj else NSkip = LuxLev - 24 -!start bjj -! print *, " RanLux p-value set by RLuxGo to:", LuxLev -! write( RanLux_str, '(I20)' ) LuxLev -! CALL WrScr( " RanLux p-value set by RLuxGo to: "//TRIM( ADJUSTL(RanLux_str ) )) -!end bjj end if In24 = 0 if (Int < 0) then -!start bjj -! print *, " Illegal initialization by RLuxGo, negative input seed" -! CALL WrScr( " Illegal initialization by RLuxGo, negative input seed" ) -!end bjj else if (Int > 0) then JSeed = Int -!start bjj -! print *, " RanLux initialized by RLuxGo from Seeds", JSeed, K1, K2 -! write( RanLux_str, '(3(I12))' ) JSeed, K1, K2 -! CALL WrScr( " RanLux initialized by RLuxGo from Seeds"//TRIM( RanLux_str ) ) -!end bjj else JSeed = JSDFlt -!start bjj -! print *, " RanLux initialized by RLuxGo from default seed" -! CALL WrScr( " RanLux initialized by RLuxGo from default seed" ) -!end bjj end if InSeed = JSeed NotYet = .FALSE. @@ -343,12 +262,6 @@ subroutine RLuxGo (Lux, Int, K1, K2) end if ! Now IN24 had better be between zero and 23 inclusive if ((In24 < 1) .or. (In24 >= NSeeds - 1)) then -!start bjj -! print *, " Error in restarting with RLuxGo: the values", Int, K1, K2, " cannot occur at luxury level", LuxLev -! write( RanLux_str, '(A,3(I12),A,I5)' ) " Error in restarting with RLuxGo: the values ", Int, K1, K2, & -! " cannot occur at luxury level ", LuxLev -! CALL WrScr( TRIM(RanLux_str ) ) -!end bjj In24 = 0 end if end if diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index ad790d0c02..9d56069af5 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -116,7 +116,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ErrStat = ErrID_None ErrMsg = "" - p%UnOutFile = -1 !bjj: this was being written to the screen when I had an error in my HD input file, so I'm going to initialize here. + p%UnOutFile = -1 u%DummyInput = 0 ! initialize dummy variable to make the compiler warnings go away z%UnusedStates = 0.0 @@ -359,10 +359,10 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: - InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & !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 ) + InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & !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 ) InputFileData%WaveDirMod /= WaveDirMod_None .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) - InputFileData%Waves2%WvDiffQTFF .or. & !call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) - InputFileData%Waves2%WvSumQTFF !call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + InputFileData%Waves2%WvDiffQTFF .or. & !call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + InputFileData%Waves2%WvSumQTFF !call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) ! Write Wave Kinematics? if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index 932bd28ce9..a3c27756a4 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -122,7 +122,7 @@ subroutine SeaSt_ParseInput( InputFileName, OutRootName, defWtrDens, defWtrDpth, if (Failed()) return; ! Z_Depth - Depth of the domain the Z direction. - call ParseVarWDefault ( FileInfo_In, CurLine, 'Z_Depth', InputFileData%Z_Depth, defWtrDpth+InputFileData%MSL2SWL, ErrStat2, ErrMsg2, UnEc ) !bjj: wouldn't the default be better with InputFileData%WtrDpth + InputFileData%MSL2SWL since we may have specified a WtrDpth already? + call ParseVarWDefault ( FileInfo_In, CurLine, 'Z_Depth', InputFileData%Z_Depth, InputFileData%WtrDpth+InputFileData%MSL2SWL, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; ! NX - Number of nodes in half of the X-direction domain. @@ -600,18 +600,20 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! 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 - ! All three methods of wave stretching tentatively implemented. - - IF ( InputFileData%WaveMod /= WaveMod_None .AND. InputFileData%WaveMod /= WaveMod_ExtFull ) THEN + IF ( InputFileData%WaveMod == WaveMod_None ) THEN + InputFileData%WaveStMod = 0_IntKi + ELSEIF ( InputFileData%WaveMod == WaveMod_ExtFull ) THEN + IF ( (InputFileData%WaveStMod /= 0) .AND. (InputFileData%WaveStMod /= 1) .AND. & + (InputFileData%WaveStMod /= 3) ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0, 1, or 3 when WaveMod = 6.',ErrStat,ErrMsg,RoutineName) + RETURN + END IF + ELSE IF ( (InputFileData%WaveStMod /= 0) .AND. (InputFileData%WaveStMod /= 1) .AND. & (InputFileData%WaveStMod /= 2) .AND. (InputFileData%WaveStMod /= 3) ) THEN CALL SetErrStat( ErrID_Fatal,'WaveStMod must be 0, 1, 2, or 3.',ErrStat,ErrMsg,RoutineName) RETURN END IF - ELSE ! Wave stretching is not supported when WaveMod = 0 (WaveMod_None) or 6 (WaveMod_ExtFull). - InputFileData%WaveStMod = 0_IntKi END IF @@ -661,18 +663,16 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er ! WaveHs - Significant wave height - !bjj: is this check still appropriate? do we need to add something for WaveMod 6 or 7? Otherwise, fix the comment on the next line - if ( ( InputFileData%WaveMod /= WaveMod_None ) .AND. ( InputFileData%WaveMod /= WaveMod_UserSpctrm ) .AND. ( InputFileData%WaveMod /= WaveMod_ExtElev ) ) then ! .TRUE. (when WaveMod = 1, 2, 3, or 10) if we have plane progressive (regular), JONSWAP/Pierson-Moskowitz spectrum (irregular) waves, or white-noise waves, but not user-defined or GH Bladed wave data. + if ( InputFileData%WaveMod == WaveMod_Regular .OR. & + InputFileData%WaveMod == WaveMod_RegularUsrPh .OR. & + InputFileData%WaveMod == WaveMod_JONSWAP .OR. & + InputFileData%WaveMod == WaveMod_WhiteNoise ) then if ( InputFileData%Waves%WaveHs <= 0.0 ) then call SetErrStat( ErrID_Fatal,'WaveHs must be greater than zero.',ErrStat,ErrMsg,RoutineName) return end if - - else - - InputFileData%Waves%WaveHs = 0.0 - + end if @@ -709,12 +709,20 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er end if end if - !bjj: do we even need this check on WaveMod? Even if it's not being used, we can check that low < Hi, right? - if (InputFileData%WaveMod > WaveMod_JONSWAP .and. InputFileData%WaveMod /= WaveMod_ExtFull) then + if (InputFileData%WaveMod == WaveMod_JONSWAP .or. & + InputFileData%WaveMod == WaveMod_WhiteNoise .or. & + InputFileData%WaveMod == WaveMod_UserSpctrm .or. & + InputFileData%WaveMod == WaveMod_ExtElev .or. & + InputFileData%WaveMod == WaveMod_UserFreq ) then + if ( InputFileData%WvLowCOff >= InputFileData%WvHiCOff ) then call SetErrSTat( ErrID_Fatal,'WvLowCOff must be less than WvHiCOff.',ErrStat,ErrMsg,RoutineName) return end if + else + ! overwrite these so that ALL frequencies are allowed (otherwise we might exclude frequencies with WaveMod = WaveMod_Regular or WaveMod_RegularUsrPh) + InputFileData%WvLowCOff = -HUGE(InputFileData%WvLowCOff) + InputFileData%WvHiCOff = HUGE(InputFileData%WvHiCOff ) end if ! WaveDir - Wave heading direction. diff --git a/modules/seastate/src/UserWaves.f90 b/modules/seastate/src/UserWaves.f90 index 0b724c8cd0..68dce44c76 100644 --- a/modules/seastate/src/UserWaves.f90 +++ b/modules/seastate/src/UserWaves.f90 @@ -466,8 +466,8 @@ SUBROUTINE UserWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) END IF WaveField%NStepWave2 = WaveField%NStepWave/2 - InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this - WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! bjj added this + InitOut%WaveTMax = InitInp%WaveTMax + WaveField%WaveDOmega = TwoPi/InitInp%WaveTMax ! >>> Allocate and initialize (set to 0) InitOut arrays call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index ffd29a4b76..fd1efff906 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -588,7 +588,7 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on WaveField%NStepWave2 = 1 - InitOut%WaveTMax = InitInp%WaveTMax ! bjj added this... I don't think it was set anywhere for this wavemod. + InitOut%WaveTMax = InitInp%WaveTMax WaveField%WaveDOmega = 0.0 ! >>> Allocate and initialize (set to 0) InitOut arrays From 77f6d67d84291a0ead3d3cb71a8f97ed8c3a1a52 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Fri, 17 Nov 2023 11:39:51 +0100 Subject: [PATCH 063/232] 6x6 spring element stiffness (symmetric) --- modules/subdyn/src/FEM.f90 | 161 +++++++++++++++++++++++++++++++++++++ 1 file changed, 161 insertions(+) diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index 0fe0376f29..5c68ddbd03 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -1157,6 +1157,167 @@ SUBROUTINE ElemK_Cable(A, L, E, T0, DirCos, K) K = MATMUL( MATMUL(DC, K), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed END SUBROUTINE ElemK_Cable !------------------------------------------------------------------------------------------------------ +!> Element stiffness matrix for spring +!! The spring element can include diagnal and cross-coupling positions. +!! Assuming that the stiffness is symmetric (21 stiffness coefficients). The stiffness matrix could also be non-symmetric, if desired. +SUBROUTINE ElemK_Spring(k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, DirCos, K) + REAL(ReKi), INTENT( IN) :: k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66 + REAL(FEKi), INTENT( IN) :: DirCos(3,3) !< From element to global: xg = DC.xe, Kg = DC.Ke.DC^t + REAL(FEKi), INTENT(OUT) :: K(12, 12) + ! Local variables + REAL(FEKi) :: DC(12, 12) + + K(1:12,1:12) = 0.0_FEKi + + K( 1, 1) = k11 + K( 1, 7) = -K(1,1) + K( 7, 1) = -K(1,1) + K( 7, 7) = K(1,1) + + K( 1, 2) = k12 + K( 1, 8) = -K(1,2) + K( 7, 2) = -K(1,2) + K( 7, 8) = K(1,2) + + K( 1, 3) = k13 + K( 1, 9) = -K(1,3) + K( 7, 3) = -K(1,3) + K( 7, 9) = K(1,3) + + K( 1, 4) = k14 + K( 1, 10) = -K(1,4) + K( 7, 4) = -K(1,4) + K( 7, 10) = K(1,4) + + K( 1, 5) = k15 + K( 1, 11) = -K(1,5) + K( 7, 5) = -K(1,5) + K( 7, 11) = K(1,5) + + K( 1, 6) = k16 + K( 1, 12) = -K(1,6) + K( 7, 6) = -K(1,6) + K( 7, 12) = K(1,6) + + K( 2, 2) = k22 + K( 2, 8) = -K(2,2) + K( 8, 2) = -K(2,2) + K( 8, 8) = K(2,2) + + K( 2, 3) = k23 + K( 2, 9) = -K(2,3) + K( 8, 3) = -K(2,3) + K( 8, 9) = K(2,3) + + K( 2, 4) = k24 + K( 2, 10) = -K(2,4) + K( 8, 4) = -K(2,4) + K( 8, 10) = K(2,4) + + K( 2, 5) = k25 + K( 2, 11) = -K(2,5) + K( 8, 5) = -K(2,5) + K( 8, 11) = K(2,5) + + K( 2, 6) = k26 + K( 2, 12) = -K(2,6) + K( 8, 6) = -K(2,6) + K( 8, 12) = K(2,6) + + K( 3, 3) = k33 + K( 3, 9) = -K(3,3) + K( 9, 3) = -K(3,3) + K( 9, 9) = K(3,3) + + K( 3, 4) = k34 + K( 3, 10) = -K(3,4) + K( 9, 4) = -K(3,4) + K( 9, 10) = K(3,4) + + K( 3, 5) = k35 + K( 3, 11) = -K(3,5) + K( 9, 5) = -K(3,5) + K( 9, 11) = K(3,5) + + K( 3, 6) = k36 + K( 3, 12) = -K(3,6) + K( 9, 6) = -K(3,6) + K( 9, 12) = K(3,6) + + K( 4, 4) = k44 + K( 4, 10) = -K(4,4) + K(10, 4) = -K(4,4) + K(10, 10) = K(4,4) + + K( 4, 5) = k45 + K( 4, 11) = -K(4,5) + K(10, 5) = -K(4,5) + K(10, 11) = K(4,5) + + K( 4, 6) = k46 + K( 4, 12) = -K(4,6) + K(10, 6) = -K(4,6) + K(10, 12) = K(4,6) + + K( 5, 5) = k55 + K( 5, 11) = -K(5,5) + K(11, 5) = -K(5,5) + K(11, 11) = K(5,5) + + K( 5, 6) = k56 + K( 5, 12) = -K(5,6) + K(11, 6) = -K(5,6) + K(11, 12) = K(5,6) + + K( 6, 6) = k66 + K( 6, 12) = -K(6,6) + K(12, 6) = -K(6,6) + K(12, 12) = K(6,6) + + ! Stiffness matrix symmetry: + K(2:6, 1) = K(1,2:6) + K(2:6, 7) = K(1,8:12) + K(8:12, 1) = K(7,2:6) + K(8:12, 7) = K(7,8:12) + + K(3:6, 2) = K(2,3:6) + K(3:6, 8) = K(2,9:12) + K(9:12, 2) = K(8,3:6) + K(9:12, 8) = K(8,9:12) + + K(4:6, 3) = K(3,4:6) + K(4:6, 9) = K(3,10:12) + K(10:12, 3) = K(9,4:6) + K(10:12, 9) = K(9,10:12) + + K(5:6, 4) = K(4,5:6) + K(5:6, 10) = K(4,11:12) + K(11:12, 4) = K(10,5:6) + K(11:12, 10) = K(10,11:12) + + K(6, 5) = K(5,6) + K(6, 11) = K(5,12) + K(12, 5) = K(11,6) + K(12, 11) = K(11,12) + + ! Temporary check. Looking at the spring element matrix (local coordinate system). + print*,'Spring element stiffness (local coordinate system)' + print*, K + + DC = 0.0_FEKi + DC( 1: 3, 1: 3) = DirCos + DC( 4: 6, 4: 6) = DirCos + DC( 7: 9, 7: 9) = DirCos + DC(10:12, 10:12) = DirCos + + K = MATMUL( MATMUL(DC, K), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed + + ! Temporary check. Looking at the spring element matrix (global coordinate system). + print*,'Spring element stiffness (global coordinate system)' + print*, K + +END SUBROUTINE ElemK_Spring +!------------------------------------------------------------------------------------------------------ !> Element mass matrix for classical beam elements SUBROUTINE ElemM_Beam(A, L, Ixx, Iyy, Jzz, rho, DirCos, M) REAL(ReKi), INTENT( IN) :: A, L, Ixx, Iyy, Jzz, rho From 2781cfc697bc3862096cc949a30dc870eb234cc9 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Fri, 17 Nov 2023 11:49:14 +0100 Subject: [PATCH 064/232] SubDyn Registry with spring element --- modules/subdyn/src/SubDyn_Registry.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 0287f2ab96..064bb8cf06 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -81,6 +81,7 @@ typedef ^ SD_InitType INTEGER NPropSetsX - - - "Number of typedef ^ SD_InitType INTEGER NPropSetsB - - - "Number of property sets for beams" typedef ^ SD_InitType INTEGER NPropSetsC - - - "Number of property sets for cables" typedef ^ SD_InitType INTEGER NPropSetsR - - - "Number of property sets for rigid links" +typedef ^ SD_InitType INTEGER NPropSetsS - - - "Number of property sets for spring elements" typedef ^ SD_InitType INTEGER NCMass - - - "Number of joints with concentrated mass" typedef ^ SD_InitType INTEGER NCOSMs - - - "Number of independent cosine matrices" typedef ^ SD_InitType INTEGER FEMMod - - - "FEM switch element model in the FEM" @@ -90,6 +91,7 @@ typedef ^ SD_InitType ReKi Joints {:}{:} - - "Joints nu typedef ^ SD_InitType ReKi PropSetsB {:}{:} - - "Property sets number and values" typedef ^ SD_InitType ReKi PropSetsC {:}{:} - - "Property ID and values for cables" typedef ^ SD_InitType ReKi PropSetsR {:}{:} - - "Property ID and values for rigid link" +typedef ^ SD_InitType ReKi PropSetsS {:}{:} - - "Property ID and values for spring element" typedef ^ SD_InitType ReKi PropSetsX {:}{:} - - "Extended property sets" typedef ^ SD_InitType R8Ki COSMs {:}{:} - - "Independent direction cosine matrices" typedef ^ SD_InitType ReKi CMass {:}{:} - - "Concentrated mass information" @@ -111,10 +113,12 @@ typedef ^ SD_InitType INTEGER NElem - - - "Total num typedef ^ SD_InitType INTEGER NPropB - - - "Total number of property sets for Beams" typedef ^ SD_InitType INTEGER NPropC - - - "Total number of property sets for Cable" typedef ^ SD_InitType INTEGER NPropR - - - "Total number of property sets for Rigid" +typedef ^ SD_InitType INTEGER NPropS - - - "Total number of property sets for Spring" typedef ^ SD_InitType ReKi Nodes {:}{:} - - "Nodes number and coordinates " typedef ^ SD_InitType ReKi PropsB {:}{:} - - "Property sets and values for Beams " typedef ^ SD_InitType ReKi PropsC {:}{:} - - "Property sets and values for Cable " typedef ^ SD_InitType ReKi PropsR {:}{:} - - "Property sets and values for Rigid link" +typedef ^ SD_InitType ReKi PropsS {:}{:} - - "Property sets and values for Spring " typedef ^ SD_InitType R8Ki K {:}{:} - - "System stiffness matrix " typedef ^ SD_InitType R8Ki M {:}{:} - - "System mass matrix " typedef ^ SD_InitType ReKi ElemProps {:}{:} - - "Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) )" From 81cb349b40eb3b4a0158bbf9d60c59c29ff7ee08 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Fri, 17 Nov 2023 12:52:34 +0100 Subject: [PATCH 065/232] Spring element --- modules/subdyn/src/SD_FEM.f90 | 69 +++++++++++++++++++++++++++++------ modules/subdyn/src/SubDyn.f90 | 22 ++++++++++- 2 files changed, 77 insertions(+), 14 deletions(-) diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 7d300e83bb..992f9f20d2 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -37,6 +37,7 @@ MODULE SD_FEM INTEGER(IntKi), PARAMETER :: PropSetsXCol = 10 ! Number of columns in XPropSets (PropSetID,YoungE,ShearG,MatDens,XsecA,XsecAsx,XsecAsy,XsecJxx,XsecJyy,XsecJ0) INTEGER(IntKi), PARAMETER :: PropSetsCCol = 5 ! Number of columns in CablePropSet (PropSetID, EA, MatDens, T0) INTEGER(IntKi), PARAMETER :: PropSetsRCol = 2 ! Number of columns in RigidPropSet (PropSetID, MatDens) + INTEGER(IntKi), PARAMETER :: PropSetsSCol = 22 ! Number of columns in SpringPropSet (PropSetID, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, COSMID) INTEGER(IntKi), PARAMETER :: COSMsCol = 10 ! Number of columns in (cosine matrices) COSMs (COSMID,COSM11,COSM12,COSM13,COSM21,COSM22,COSM23,COSM31,COSM32,COSM33) INTEGER(IntKi), PARAMETER :: CMassCol = 11 ! Number of columns in Concentrated Mass (CMJointID,JMass,JMXX,JMYY,JMZZ, Optional:JMXY,JMXZ,JMYZ,CGX,CGY,CGZ) ! Indices in Members table @@ -60,6 +61,7 @@ MODULE SD_FEM INTEGER(IntKi), PARAMETER :: idMemberCable = 2 INTEGER(IntKi), PARAMETER :: idMemberRigid = 3 INTEGER(IntKi), PARAMETER :: idMemberBeamArb = 4 + INTEGER(IntKi), PARAMETER :: idMemberSpring = 5 ! Types of Boundary Conditions INTEGER(IntKi), PARAMETER :: idBC_Fixed = 11 ! Fixed BC @@ -374,7 +376,7 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) ! Check that rigid links are not connected to the interface iInterf = FINDLOCI(p%Nodes_I(:,1), iJoint ) if (iInterf>=1) then - CALL WrScr('[WARNING] There might be a bug when rigid links are connected to the interface nodes (mostly if cables are involved). The problematic member is MemberID='//TRIM(Num2LStr(mID))//' (which is a rigid link) involving joint JointID='// TRIM(Num2LStr(JointID))// ' (which is in an interface joint).') + CALL WrScr('[WARNING] There might be a bug when one beam and one rigid link are connected to the interface nodes. The problematic member might be MemberID='//TRIM(Num2LStr(mID))//' (which is a rigid link) involving joint JointID='// TRIM(Num2LStr(JointID))// ' (which is in an interface joint).') endif endif enddo @@ -394,6 +396,9 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) else if (mType==idMemberBeamArb) then sType='Member arbitrary cross-section property' p%Elems(iMem,n) = FINDLOCI(Init%PropSetsX(:,1), Init%Members(iMem, n) ) + else if (mType==idMemberSpring) then + sType='Spring property' + p%Elems(iMem,n) = FINDLOCI(Init%PropSetsS(:,1), Init%Members(iMem, n) ) else ! Should not happen print*,'Element type unknown',mType @@ -403,7 +408,7 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) if (mType/=idMemberBeamCirc) then if (Init%Members(iMem, iMProp)/=Init%Members(iMem, iMProp+1)) then ! NOTE: for non circular beams, we could just check that E, rho, G are the same for both properties - call Fatal('Property IDs should be the same at both joints for arbitrary beams, rigid links, and cables. Check member with ID: '//TRIM(Num2LStr(Init%Members(iMem,1)))) + call Fatal('Property IDs should be the same at both joints for arbitrary beams, rigid links, cables, and springs. Check member with ID: '//TRIM(Num2LStr(Init%Members(iMem,1)))) return endif endif @@ -454,7 +459,7 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) INTEGER :: iDirCos REAL(ReKi) :: x1, y1, z1, x2, y2, z2, dx, dy, dz, dd, dt, d1, d2, t1, t2 LOGICAL :: CreateNewProp - INTEGER(IntKi) :: nMemberCable, nMemberRigid, nMemberBeamCirc, nMemberBeamArb !< Number of memebers per type + INTEGER(IntKi) :: nMemberCable, nMemberRigid, nMemberSpring, nMemberBeamCirc, nMemberBeamArb !< Number of members per type INTEGER(IntKi) :: eType !< Element Type INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -473,9 +478,10 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) nMemberCable = count(Init%Members(:,iMType) == idMemberCable) nMemberRigid = count(Init%Members(:,iMType) == idMemberRigid) nMemberBeamArb = count(Init%Members(:,iMType) == idMemberBeamArb) - Init%NElem = (nMemberBeamCirc + nMemberBeamArb)*Init%NDiv + nMemberCable + nMemberRigid ! NOTE: only Beams are divided - IF ( (nMemberBeamCirc+nMemberRigid+nMemberCable+nMemberBeamArb) /= size(Init%Members,1)) then - CALL Fatal(' Member list contains an element which is not a beam, a cable or a rigid link'); return + nMemberSpring = count(Init%Members(:,iMType) == idMemberSpring) + Init%NElem = (nMemberBeamCirc + nMemberBeamArb)*Init%NDiv + nMemberCable + nMemberRigid + nMemberSpring ! NOTE: only Beams are divided + IF ( (nMemberBeamCirc+nMemberRigid+nMemberCable+nMemberBeamArb+nMemberSpring) /= size(Init%Members,1)) then + CALL Fatal(' Member list contains an element which is not a beam, a cable, a rigid link or a spring'); return ENDIF ! Total number of nodes - Depends on division and number of nodes per element @@ -569,8 +575,8 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) eType = TempMembers(I, iMType ) iDirCos = TempMembers(I, iMDirCosID) - if (eType==idMemberRigid .OR. eType==idMemberCable) then - ! --- Cables and rigid links are not subdivided and have same prop at nodes + if (eType==idMemberRigid .OR. eType==idMemberCable .OR. eType==idMemberSpring) then + ! --- Cables, rigid links and springs are not subdivided and have same prop at nodes ! No need to create new properties or new nodes Init%MemberNodes(I, 1) = Node1 Init%MemberNodes(I, 2) = Node2 @@ -681,14 +687,17 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) Init%PropsB(1:Init%NPropB, 1:PropSetsBCol) = TempProps(1:Init%NPropB, 1:PropSetsBCol) endif - ! --- Cables and rigid link properties (these cannot be subdivided, so direct copy of inputs) + ! --- Cables, rigid link and spring properties (these cannot be subdivided, so direct copy of inputs) Init%NPropC = Init%NPropSetsC Init%NPropR = Init%NPropSetsR + Init%NPropS = Init%NPropSetsS CALL AllocAry(Init%PropsC, Init%NPropC, PropSetsCCol, 'Init%PropsCable', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropsR, Init%NPropR, PropSetsRCol, 'Init%PropsRigid', ErrStat2, ErrMsg2); if(Failed()) return - Init%PropsC(1:Init%NPropC, 1:PropSetsCCol) = Init%PropSetsC(1:Init%NPropC, 1:PropSetsCCol) + CALL AllocAry(Init%PropsS, Init%NPropS, PropSetsSCol, 'Init%PropsSpring', ErrStat2, ErrMsg2); if(Failed()) return + Init%PropsC(1:Init%NPropC, 1:PropSetsCCol) = Init%PropSetsC(1:Init%NPropC, 1:PropSetsCCol) Init%PropsR(1:Init%NPropR, 1:PropSetsRCol) = Init%PropSetsR(1:Init%NPropR, 1:PropSetsRCol) - + Init%PropsS(1:Init%NPropS, 1:PropSetsSCol) = Init%PropSetsS(1:Init%NPropS, 1:PropSetsSCol) + CALL CleanUp_Discrt() CONTAINS @@ -982,6 +991,32 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) p%ElemProps(i)%Rho = Init%PropsR(P1, 2) p%ElemProps(i)%D = min(sqrt(1/Pi)*4, L*0.05) ! For plotting only + else if (eType==idMemberSpring) then + if (DEV_VERSION) then + print*,'Member',I,'is a spring element' + endif + p%ElemProps(i)%k11 = Init%PropsS(P1, 2) + p%ElemProps(i)%k12 = Init%PropsS(P1, 3) + p%ElemProps(i)%k13 = Init%PropsS(P1, 4) + p%ElemProps(i)%k14 = Init%PropsS(P1, 5) + p%ElemProps(i)%k15 = Init%PropsS(P1, 6) + p%ElemProps(i)%k16 = Init%PropsS(P1, 7) + p%ElemProps(i)%k22 = Init%PropsS(P1, 8) + p%ElemProps(i)%k23 = Init%PropsS(P1, 9) + p%ElemProps(i)%k24 = Init%PropsS(P1,10) + p%ElemProps(i)%k25 = Init%PropsS(P1,11) + p%ElemProps(i)%k26 = Init%PropsS(P1,12) + p%ElemProps(i)%k33 = Init%PropsS(P1,13) + p%ElemProps(i)%k34 = Init%PropsS(P1,14) + p%ElemProps(i)%k35 = Init%PropsS(P1,15) + p%ElemProps(i)%k36 = Init%PropsS(P1,16) + p%ElemProps(i)%k44 = Init%PropsS(P1,17) + p%ElemProps(i)%k45 = Init%PropsS(P1,18) + p%ElemProps(i)%k46 = Init%PropsS(P1,19) + p%ElemProps(i)%k55 = Init%PropsS(P1,20) + p%ElemProps(i)%k56 = Init%PropsS(P1,21) + p%ElemProps(i)%k66 = Init%PropsS(P1,22) + else ! Should not happen print*,'Element type unknown',eType @@ -2283,7 +2318,11 @@ SUBROUTINE ElemM(ep, Me) CALL ElemM_Cable(ep%Area, real(ep%Length,FEKi), ep%rho, ep%DirCos, Me) !CALL ElemM_(A, L, rho, DirCos, Me) endif - endif + + else if (ep%eType==idMemberSpring) then + Me=0.0_FEKi ! Spring element has no mass associated. Consider using a lumped mass at JointID, if desired. + endif + END SUBROUTINE ElemM SUBROUTINE ElemK(ep, Ke) @@ -2298,6 +2337,10 @@ SUBROUTINE ElemK(ep, Ke) else if (ep%eType==idMemberRigid) then Ke = 0.0_FEKi + + else if (ep%eType==idMemberSpring) then + CALL ElemK_Spring(eP%k11, eP%k12, eP%k13, eP%k14, eP%k15, eP%k16, eP%k22, eP%k23, eP%k24, eP%k25, eP%k26, eP%k33, eP%k34, eP%k35, eP%k36, eP%k44, eP%k45, eP%k46, eP%k55, eP%k56, eP%k66, Ke) + endif END SUBROUTINE ElemK @@ -2312,6 +2355,8 @@ SUBROUTINE ElemF(ep, gravity, Fg, Fo) CALL ElemF_Cable(ep%T0, ep%DirCos, Fo) else if (ep%eType==idMemberRigid) then Fo(1:12)=0.0_FEKi + else if (ep%eType==idMemberSpring) then + Fo(1:12)=0.0_FEKi endif CALL ElemG( eP%Area, eP%Length, eP%rho, eP%DirCos, Fg, gravity ) END SUBROUTINE ElemF diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 1258379d05..855cce8d49 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -222,7 +222,7 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! %RefOrientation is the identity matrix (3,3,N) ! %Position is the reference position (3,N) ! Maybe some logic to make sure these points correspond roughly to nodes -- though this may not be true for a long pile into the soil with multiple connection points - ! Note: F = -kx whre k is the relevant 6x6 matrix from SoilStiffness + ! Note: F = -kx where k is the relevant 6x6 matrix from SoilStiffness call AllocAry(Init%Soil_K, 6,6, size(InitInput%SoilStiffness,3), 'Soil_K', ErrStat2, ErrMsg2); call AllocAry(Init%Soil_Points, 3, InitInput%SoilMesh%NNodes, 'Soil_Points', ErrStat2, ErrMsg2); call AllocAry(Init%Soil_Nodes, InitInput%SoilMesh%NNodes, 'Soil_Nodes' , ErrStat2, ErrMsg2); @@ -1173,7 +1173,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL ReadCAryFromStr ( Line, StrArray, nColumns, 'Members', 'First line of members array', ErrStat2, ErrMsg2 ); if(Failed()) return call LegacyWarning('Member table contains 6 columns instead of 7, using default member directional cosines ID (-1) for all members. & &The directional cosines will be computed based on the member nodes for all members.') - Init%Members(:,7) = -1 + Init%Members(:,7) = -1 ! For the spring element, we need the direction cosine from the user. Both JointIDs are coincident, the direction cosine cannot be determined. endif ! Extract fields from first line DO I = 1, nColumns @@ -1250,11 +1250,23 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL ReadAry( UnIn, SDInputFile, Init%PropSetsR(I,:), PropSetsRCol, 'RigidPropSets', 'RigidPropSets ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return ENDDO IF (Check( Init%NPropSetsR < 0, 'NPropSetsRigid must be >=0')) return + !----------------------- SPRING ELEMENT PROPERTIES -------------------------------- + CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsS, 'NPropSetsS', 'Number of spring properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'SpringPropSets', ErrStat2, ErrMsg2); if(Failed()) return + DO I = 1, Init%NPropSetsS + CALL ReadAry( UnIn, SDInputFile, Init%PropSetsS(I,:), PropSetsSCol, 'SpringPropSets', 'SpringPropSets ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + ENDDO + IF (Check( Init%NPropSetsS < 0, 'NPropSetsSpring must be >=0')) return else Init%NPropSetsC=0 Init%NPropSetsR=0 + Init%NPropSetsS=0 CALL AllocAry(Init%PropSetsC, Init%NPropSetsC, PropSetsCCol, 'PropSetsC', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropSetsR, Init%NPropSetsR, PropSetsRCol, 'RigidPropSets', ErrStat2, ErrMsg2); if(Failed()) return + CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'SpringPropSets', ErrStat2, ErrMsg2); if(Failed()) return endif !---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------ @@ -3789,6 +3801,12 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E mMass= Init%PropSetsR(iProp(1),2) * mLength ! rho [kg/m] * L WRITE(UnSum, '("#",I9,I10,I10,I10,I10,ES15.6E2,ES15.6E2, A3,2(I6),A)') Init%Members(i,1:3),propIDs(1),propIDs(2),& mMass,mLength,' ',(Init%MemberNodes(i, j), j = 1, 2), ' # Rigid link' + else if (mType==idMemberSpring) then + iProp(1) = FINDLOCI(Init%PropSetsS(:,1), propIDs(1)) + mMass= 0.0 ! Spring element has no mass + mLength = 0.0 ! Spring element has no length. Both JointIDs must be coincident. + WRITE(UnSum, '("#",I9,I10,I10,I10,I10,ES15.6E2,ES15.6E2, A3,2(I6),A)') Init%Members(i,1:3),propIDs(1),propIDs(2),& + mMass,mLength,' ',(Init%MemberNodes(i, j), j = 1, 2), ' # Spring element' else if (mType==idMemberBeamArb) then iProp(1) = FINDLOCI(Init%PropSetsX(:,1), propIDs(1)) iProp(2) = FINDLOCI(Init%PropSetsX(:,1), propIDs(2)) From 4cdcfeb34009f93a44cd78104e9a731e08e50c71 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Fri, 17 Nov 2023 12:55:43 +0100 Subject: [PATCH 066/232] Fix typo --- modules/subdyn/src/SD_FEM.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 992f9f20d2..24d1aa0c2c 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -37,7 +37,7 @@ MODULE SD_FEM INTEGER(IntKi), PARAMETER :: PropSetsXCol = 10 ! Number of columns in XPropSets (PropSetID,YoungE,ShearG,MatDens,XsecA,XsecAsx,XsecAsy,XsecJxx,XsecJyy,XsecJ0) INTEGER(IntKi), PARAMETER :: PropSetsCCol = 5 ! Number of columns in CablePropSet (PropSetID, EA, MatDens, T0) INTEGER(IntKi), PARAMETER :: PropSetsRCol = 2 ! Number of columns in RigidPropSet (PropSetID, MatDens) - INTEGER(IntKi), PARAMETER :: PropSetsSCol = 22 ! Number of columns in SpringPropSet (PropSetID, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66, COSMID) + INTEGER(IntKi), PARAMETER :: PropSetsSCol = 22 ! Number of columns in SpringPropSet (PropSetID, k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66) INTEGER(IntKi), PARAMETER :: COSMsCol = 10 ! Number of columns in (cosine matrices) COSMs (COSMID,COSM11,COSM12,COSM13,COSM21,COSM22,COSM23,COSM31,COSM32,COSM33) INTEGER(IntKi), PARAMETER :: CMassCol = 11 ! Number of columns in Concentrated Mass (CMJointID,JMass,JMXX,JMYY,JMZZ, Optional:JMXY,JMXZ,JMYZ,CGX,CGY,CGZ) ! Indices in Members table From 0ea0a77daf7ff3fc31ac5752e0596030b735e484 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Fri, 17 Nov 2023 17:41:54 -0700 Subject: [PATCH 067/232] HD: Remove extra copy of `WaveStMod` from Morison --- modules/hydrodyn/src/Morison.f90 | 31 +++++++++++++------------- modules/hydrodyn/src/Morison.txt | 1 - modules/hydrodyn/src/Morison_Types.f90 | 5 ----- 3 files changed, 16 insertions(+), 21 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 38e1d23a4f..57bb88f075 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1927,14 +1927,15 @@ SUBROUTINE Morison_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, In p%AMMod = InitInp%AMMod p%VisMeshes = InitInp%VisMeshes ! visualization mesh for morison elements + ! Pointer to SeaState WaveField + p%WaveField => InitInp%WaveField + ! Only compute added-mass force up to the free surface if wave stretching is enabled - IF ( p%WaveStMod .EQ. 0_IntKi ) THEN + IF ( p%WaveField%WaveStMod .EQ. 0_IntKi ) THEN ! Setting AMMod to zero just in case. Probably redundant. p%AMMod = 0_IntKi END IF - ! Pointer to SeaState WaveField - p%WaveField => InitInp%WaveField ALLOCATE ( p%MOutLst(p%NMOutputs), STAT = errStat2 ) IF ( errStat2 /= 0 ) THEN @@ -2636,7 +2637,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, m%memberLoads(im)%F_If = 0.0_ReKi ! Determine member submergence status - IF ( p%WaveStMod .EQ. 0_IntKi ) THEN ! No wave stretching - Only need to check the two ends + IF ( p%WaveField%WaveStMod .EQ. 0_IntKi ) THEN ! No wave stretching - Only need to check the two ends IF ( m%nodeInWater(mem%NodeIndx(1)) .NE. m%nodeInWater(mem%NodeIndx(N+1)) ) THEN MemSubStat = 1_IntKi ! Member centerline crosses the SWL once ELSE IF ( m%nodeInWater(mem%NodeIndx(1)) .EQ. 0_IntKi ) THEN @@ -2644,7 +2645,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ELSE MemSubStat = 0_IntKi ! Member centerline fully submerged END IF - ELSE IF ( p%WaveStMod > 0_IntKi ) THEN ! Has wave stretching - Need to check every node + ELSE IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! Has wave stretching - Need to check every node NumFSX = 0_IntKi ! Number of free-surface crossing DO i = 1, N ! loop through member elements IF ( m%nodeInWater(mem%NodeIndx(i)) .NE. m%nodeInWater(mem%NodeIndx(i+1)) ) THEN @@ -2745,7 +2746,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! ------------------- buoyancy loads: sides: Sections 3.1 and 3.2 ------------------------ IF (mem%MHstLMod == 1) THEN - IF ( p%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute buoyancy up to free surface + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute buoyancy up to free surface CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2772,7 +2773,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Get free surface elevation and normal at the element midpoint (both assumed constant over the element) posMid = 0.5 * (pos1+pos2) rMidb = 0.5 * (r1b +r2b ) - IF (p%WaveStMod > 0) THEN + IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, posMid, ZetaMid, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetFreeSurfaceNormal( Time, posMid, rMidb, n_hat, ErrStat2, ErrMsg2 ) @@ -2912,7 +2913,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !-----------------------------------------------------------------------------------------------------! ! External Hydrodynamic Side Loads - Start ! !-----------------------------------------------------------------------------------------------------! - IF ( p%WaveStMod > 0 .AND. MemSubStat == 1 .AND. (m%NodeInWater(mem%NodeIndx(N+1)).EQ.0_IntKi) ) THEN + IF ( p%WaveField%WaveStMod > 0 .AND. MemSubStat == 1 .AND. (m%NodeInWater(mem%NodeIndx(N+1)).EQ.0_IntKi) ) THEN !----------------------------Apply load smoothing----------------------------! ! only when: ! 1. wave stretching is enabled @@ -3199,7 +3200,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, deltalLeft = 0.5_ReKi * mem%dl ELSE ! Element i-1 crosses the free surface z2 = m%DispNodePosHdn(3, mem%NodeIndx(i-1)) - IF ( p%WaveStMod > 0_IntKi ) THEN ! Wave stretching enabled + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! Wave stretching enabled zeta1 = m%WaveElev(mem%NodeIndx(i )) zeta2 = m%WaveElev(mem%NodeIndx(i-1)) ELSE @@ -3218,7 +3219,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, deltalRight = 0.5_ReKi * mem%dl ELSE ! Element i crosses the free surface z2 = m%DispNodePosHdn(3, mem%NodeIndx(i+1)) - IF ( p%WaveStMod > 0_IntKi ) THEN ! Wave stretching enabled + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! Wave stretching enabled zeta1 = m%WaveElev(mem%NodeIndx(i )) zeta2 = m%WaveElev(mem%NodeIndx(i+1)) ELSE @@ -3390,7 +3391,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, r2 = mem%RMGB(N+1) if (mem%i_floor == 0) then ! both ends above or at seabed ! Compute loads on the end plate of node 1 - IF (p%WaveStMod > 0) THEN + IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetFreeSurfaceNormal( Time, pos1, r1, n_hat, ErrStat2, ErrMsg2 ) @@ -3411,7 +3412,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF END IF ! Compute loads on the end plate of node N+1 - IF (p%WaveStMod > 0) THEN + IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetFreeSurfaceNormal( Time, pos2, r2, n_hat, ErrStat2, ErrMsg2 ) @@ -3433,7 +3434,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF elseif ( mem%doEndBuoyancy ) then ! The member crosses the seabed line so only the upper end potentially have hydrostatic load ! Only compute the loads on the end plate of node N+1 - IF (p%WaveStMod > 0) THEN + IF (p%WaveField%WaveStMod > 0) THEN CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL GetFreeSurfaceNormal( Time, pos2, r2, n_hat, ErrStat2, ErrMsg2 ) @@ -3558,7 +3559,7 @@ SUBROUTINE GetDisplacedNodePosition( forceDisplaced, pos ) ! Use displaced X and Y position pos(1,:) = pos(1,:) + u%Mesh%TranslationDisp(1,:) pos(2,:) = pos(2,:) + u%Mesh%TranslationDisp(2,:) - IF ( (p%WaveStMod > 0) .OR. forceDisplaced ) THEN + IF ( (p%WaveField%WaveStMod > 0) .OR. forceDisplaced ) THEN ! Use displaced Z position only when wave stretching is enabled pos(3,:) = pos(3,:) + u%Mesh%TranslationDisp(3,:) END IF @@ -4204,7 +4205,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat pos(1) = u%Mesh%TranslationDisp(1,J) + u%Mesh%Position(1,J) pos(2) = u%Mesh%TranslationDisp(2,J) + u%Mesh%Position(2,J) END IF - IF (p%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled + IF (p%WaveField%WaveStMod > 0 .AND. p%WaveDisp /= 0) THEN ! Wave stretching enabled pos(3) = u%Mesh%Position(3,J) + u%Mesh%TranslationDisp(3,J) - p%WaveField%MSL2SWL ! Use the current Z location. ELSE ! Wave stretching disabled pos(3) = u%Mesh%Position(3,J) - p%WaveField%MSL2SWL ! We are intentionally using the undisplaced Z position of the node. diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 7b4b426647..e47b40c867 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -353,7 +353,6 @@ typedef ^ ^ INTEGER typedef ^ ^ Morison_JOutput JOutLst {:} - - "" - typedef ^ ^ OutParmType OutParam {:} - - "" - typedef ^ ^ INTEGER NumOuts - - - "" - -typedef ^ ^ INTEGER WaveStMod - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "SeaState wave field" - typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - # diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 5bff26944f..0a37e81083 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -415,7 +415,6 @@ MODULE Morison_Types TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] - INTEGER(IntKi) :: WaveStMod = 0_IntKi !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< SeaState wave field [-] LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] END TYPE Morison_ParameterType @@ -5564,7 +5563,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%WaveStMod = SrcParamData%WaveStMod DstParamData%WaveField => SrcParamData%WaveField DstParamData%VisMeshes = SrcParamData%VisMeshes end subroutine @@ -5753,7 +5751,6 @@ subroutine Morison_PackParam(Buf, Indata) end do end if call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%WaveStMod) call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -5996,8 +5993,6 @@ subroutine Morison_UnPackParam(Buf, OutData) end if call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 30e736823c9d9465abb2d4a71f2902f19f9e8c97 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 20 Nov 2023 22:12:40 +0100 Subject: [PATCH 068/232] Update spring element --- modules/subdyn/src/SD_FEM.f90 | 70 +++++++++++++++++++++++------------ 1 file changed, 47 insertions(+), 23 deletions(-) diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 24d1aa0c2c..fa5f217692 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -827,6 +827,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) REAL(FEKi) :: DirCos(3, 3) ! direction cosine matrices REAL(ReKi) :: L ! length of the element REAL(ReKi) :: r1, r2, t, Iyy, Jzz, Ixx, A, kappa, kappa_x, kappa_y, nu, ratioSq, D_inner, D_outer + REAL(ReKi) :: k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k33, k34, k35, k36, k44, k45, k46, k55, k56, k66 LOGICAL :: shear INTEGER(IntKi) :: eType !< Member type REAL(ReKi) :: Point1(3), Point2(3) ! (x,y,z) positions of two nodes making up an element @@ -887,7 +888,28 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) p%ElemProps(i)%Area = -9.99e+36 p%ElemProps(i)%Rho = -9.99e+36 p%ElemProps(i)%T0 = -9.99e+36 - + p%ElemProps(i)%k11 = -9.99e+36 + p%ElemProps(i)%k12 = -9.99e+36 + p%ElemProps(i)%k13 = -9.99e+36 + p%ElemProps(i)%k14 = -9.99e+36 + p%ElemProps(i)%k15 = -9.99e+36 + p%ElemProps(i)%k16 = -9.99e+36 + p%ElemProps(i)%k22 = -9.99e+36 + p%ElemProps(i)%k23 = -9.99e+36 + p%ElemProps(i)%k24 = -9.99e+36 + p%ElemProps(i)%k25 = -9.99e+36 + p%ElemProps(i)%k26 = -9.99e+36 + p%ElemProps(i)%k33 = -9.99e+36 + p%ElemProps(i)%k34 = -9.99e+36 + p%ElemProps(i)%k35 = -9.99e+36 + p%ElemProps(i)%k36 = -9.99e+36 + p%ElemProps(i)%k44 = -9.99e+36 + p%ElemProps(i)%k45 = -9.99e+36 + p%ElemProps(i)%k46 = -9.99e+36 + p%ElemProps(i)%k55 = -9.99e+36 + p%ElemProps(i)%k56 = -9.99e+36 + p%ElemProps(i)%k66 = -9.99e+36 + ! --- Properties that are specific to some elements if (eType==idMemberBeamCirc) then E = Init%PropsB(P1, 2) ! TODO E2 @@ -995,27 +1017,29 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) if (DEV_VERSION) then print*,'Member',I,'is a spring element' endif - p%ElemProps(i)%k11 = Init%PropsS(P1, 2) - p%ElemProps(i)%k12 = Init%PropsS(P1, 3) - p%ElemProps(i)%k13 = Init%PropsS(P1, 4) - p%ElemProps(i)%k14 = Init%PropsS(P1, 5) - p%ElemProps(i)%k15 = Init%PropsS(P1, 6) - p%ElemProps(i)%k16 = Init%PropsS(P1, 7) - p%ElemProps(i)%k22 = Init%PropsS(P1, 8) - p%ElemProps(i)%k23 = Init%PropsS(P1, 9) - p%ElemProps(i)%k24 = Init%PropsS(P1,10) - p%ElemProps(i)%k25 = Init%PropsS(P1,11) - p%ElemProps(i)%k26 = Init%PropsS(P1,12) - p%ElemProps(i)%k33 = Init%PropsS(P1,13) - p%ElemProps(i)%k34 = Init%PropsS(P1,14) - p%ElemProps(i)%k35 = Init%PropsS(P1,15) - p%ElemProps(i)%k36 = Init%PropsS(P1,16) - p%ElemProps(i)%k44 = Init%PropsS(P1,17) - p%ElemProps(i)%k45 = Init%PropsS(P1,18) - p%ElemProps(i)%k46 = Init%PropsS(P1,19) - p%ElemProps(i)%k55 = Init%PropsS(P1,20) - p%ElemProps(i)%k56 = Init%PropsS(P1,21) - p%ElemProps(i)%k66 = Init%PropsS(P1,22) + p%ElemProps(i)%Area = 0 ! Spring elements have no area + p%ElemProps(i)%Rho = 0 ! Spring elements have no mass + p%ElemProps(i)%k11 = Init%PropsS(P1, 2) + p%ElemProps(i)%k12 = Init%PropsS(P1, 3) + p%ElemProps(i)%k13 = Init%PropsS(P1, 4) + p%ElemProps(i)%k14 = Init%PropsS(P1, 5) + p%ElemProps(i)%k15 = Init%PropsS(P1, 6) + p%ElemProps(i)%k16 = Init%PropsS(P1, 7) + p%ElemProps(i)%k22 = Init%PropsS(P1, 8) + p%ElemProps(i)%k23 = Init%PropsS(P1, 9) + p%ElemProps(i)%k24 = Init%PropsS(P1,10) + p%ElemProps(i)%k25 = Init%PropsS(P1,11) + p%ElemProps(i)%k26 = Init%PropsS(P1,12) + p%ElemProps(i)%k33 = Init%PropsS(P1,13) + p%ElemProps(i)%k34 = Init%PropsS(P1,14) + p%ElemProps(i)%k35 = Init%PropsS(P1,15) + p%ElemProps(i)%k36 = Init%PropsS(P1,16) + p%ElemProps(i)%k44 = Init%PropsS(P1,17) + p%ElemProps(i)%k45 = Init%PropsS(P1,18) + p%ElemProps(i)%k46 = Init%PropsS(P1,19) + p%ElemProps(i)%k55 = Init%PropsS(P1,20) + p%ElemProps(i)%k56 = Init%PropsS(P1,21) + p%ElemProps(i)%k66 = Init%PropsS(P1,22) else ! Should not happen @@ -2339,7 +2363,7 @@ SUBROUTINE ElemK(ep, Ke) Ke = 0.0_FEKi else if (ep%eType==idMemberSpring) then - CALL ElemK_Spring(eP%k11, eP%k12, eP%k13, eP%k14, eP%k15, eP%k16, eP%k22, eP%k23, eP%k24, eP%k25, eP%k26, eP%k33, eP%k34, eP%k35, eP%k36, eP%k44, eP%k45, eP%k46, eP%k55, eP%k56, eP%k66, Ke) + CALL ElemK_Spring(eP%k11, eP%k12, eP%k13, eP%k14, eP%k15, eP%k16, eP%k22, eP%k23, eP%k24, eP%k25, eP%k26, eP%k33, eP%k34, eP%k35, eP%k36, eP%k44, eP%k45, eP%k46, eP%k55, eP%k56, eP%k66, eP%DirCos, Ke) endif END SUBROUTINE ElemK From 434f8f7c462e7fab5d93a6ba592e1847ab12b57b Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 20 Nov 2023 22:33:28 +0100 Subject: [PATCH 069/232] Update spring element --- modules/subdyn/src/SubDyn.f90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 855cce8d49..133555ca92 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -1255,18 +1255,24 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsS, 'NPropSetsS', 'Number of spring properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties Header' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return CALL ReadCom ( UnIn, SDInputFile, 'Spring element properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'SpringPropSets', ErrStat2, ErrMsg2); if(Failed()) return + IF (Check( Init%NPropSetsS < 0, 'NPropSetsSpring must be >=0')) return + CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'PropSetsS', ErrStat2, ErrMsg2); if(Failed()) return DO I = 1, Init%NPropSetsS - CALL ReadAry( UnIn, SDInputFile, Init%PropSetsS(I,:), PropSetsSCol, 'SpringPropSets', 'SpringPropSets ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return + READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading spring property line'; if (Failed()) return + call ReadFAryFromStr(Line, Init%PropSetsS(I,:), PropSetsSCol, nColValid, nColNumeric); + if ((nColValid/=nColNumeric).or.((nColNumeric/=22).and.(nColNumeric/=PropSetsSCol)) ) then + CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Spring property line must consist of 22 numerical values. Problematic line: "'//trim(Line)//'"') + return + endif ENDDO - IF (Check( Init%NPropSetsS < 0, 'NPropSetsSpring must be >=0')) return + else Init%NPropSetsC=0 Init%NPropSetsR=0 Init%NPropSetsS=0 CALL AllocAry(Init%PropSetsC, Init%NPropSetsC, PropSetsCCol, 'PropSetsC', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropSetsR, Init%NPropSetsR, PropSetsRCol, 'RigidPropSets', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'SpringPropSets', ErrStat2, ErrMsg2); if(Failed()) return + CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'PropSetsS', ErrStat2, ErrMsg2); if(Failed()) return endif !---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------ From 95be02fb85e9e5ba7b5a5214e3bc15b930650c9a Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 20 Nov 2023 23:06:00 +0100 Subject: [PATCH 070/232] Update SubDyn registry for springs --- modules/subdyn/src/SubDyn_Registry.txt | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 064bb8cf06..ecc7a0f1bd 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -42,6 +42,27 @@ typedef ^ ElemPropType ReKi D {2} - - "Diameter at node 1 and 2, f typedef ^ ElemPropType ReKi Area - - - "Area of an element" m^2 typedef ^ ElemPropType ReKi Rho - - - "Density" kg/m^3 typedef ^ ElemPropType ReKi T0 - - - "Pretension " N +typedef ^ ElemPropType ReKi k11 - - - "Spring translational stiffness" N/m +typedef ^ ElemPropType ReKi k12 - - - "Spring cross-coupling stiffness" N/m +typedef ^ ElemPropType ReKi k13 - - - "Spring cross-coupling stiffness" N/m +typedef ^ ElemPropType ReKi k14 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k15 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k16 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k22 - - - "Spring translational stiffness" N/m +typedef ^ ElemPropType ReKi k23 - - - "Spring cross-coupling stiffness" N/m +typedef ^ ElemPropType ReKi k24 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k25 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k26 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k33 - - - "Spring translational stiffness" N/m +typedef ^ ElemPropType ReKi k34 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k35 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k36 - - - "Spring cross-coupling stiffness" N/rad +typedef ^ ElemPropType ReKi k44 - - - "Spring rotational stiffness" Nm/rad +typedef ^ ElemPropType ReKi k45 - - - "Spring cross-coupling stiffness" Nm/rad +typedef ^ ElemPropType ReKi k46 - - - "Spring cross-coupling stiffness" Nm/rad +typedef ^ ElemPropType ReKi k55 - - - "Spring rotational stiffness" Nm/rad +typedef ^ ElemPropType ReKi k56 - - - "Spring cross-coupling stiffness" Nm/rad +typedef ^ ElemPropType ReKi k66 - - - "Spring rotational stiffness" Nm/rad typedef ^ ElemPropType R8Ki DirCos {3}{3} - - "Element direction cosine matrix" # ============================== Input Initialization (from glue code) ============================================================================================================================================ From fc8b31b5b10972c3fe3bb01f41a8db6a42024d74 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Tue, 21 Nov 2023 00:00:46 +0100 Subject: [PATCH 071/232] Update spring element --- modules/subdyn/src/SubDyn_Types.f90 | 293 ++++++++++++++++++++++++++++ 1 file changed, 293 insertions(+) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index b6dfcc095e..8beeee9dc8 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -77,6 +77,27 @@ MODULE SubDyn_Types REAL(ReKi) :: Area !< Area of an element [m^2] REAL(ReKi) :: Rho !< Density [kg/m^3] REAL(ReKi) :: T0 !< Pretension [N] + REAL(ReKi) :: k11 !< Spring translational stiffness [N/m] + REAL(ReKi) :: k12 !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k13 !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k14 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k15 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k16 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k22 !< Spring translational stiffness [N/m] + REAL(ReKi) :: k23 !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k24 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k25 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k26 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k33 !< Spring translational stiffness [N/m] + REAL(ReKi) :: k34 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k35 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k36 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k44 !< Spring rotational stiffness [Nm/rad] + REAL(ReKi) :: k45 !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k46 !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k55 !< Spring rotational stiffness [Nm/rad] + REAL(ReKi) :: k56 !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k66 !< Spring rotational stiffness [Nm/rad] REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< Element direction cosine matrix [-] END TYPE ElemPropType ! ======================= @@ -121,6 +142,7 @@ MODULE SubDyn_Types INTEGER(IntKi) :: NPropSetsB !< Number of property sets for beams [-] INTEGER(IntKi) :: NPropSetsC !< Number of property sets for cables [-] INTEGER(IntKi) :: NPropSetsR !< Number of property sets for rigid links [-] + INTEGER(IntKi) :: NPropSetsS !< Number of property sets for spring elements [-] INTEGER(IntKi) :: NCMass !< Number of joints with concentrated mass [-] INTEGER(IntKi) :: NCOSMs !< Number of independent cosine matrices [-] INTEGER(IntKi) :: FEMMod !< FEM switch element model in the FEM [-] @@ -130,6 +152,7 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsB !< Property sets number and values [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsC !< Property ID and values for cables [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsR !< Property ID and values for rigid link [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsS !< Property ID and values for spring elements [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsX !< Extended property sets [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: COSMs !< Independent direction cosine matrices [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMass !< Concentrated mass information [-] @@ -151,10 +174,12 @@ MODULE SubDyn_Types INTEGER(IntKi) :: NPropB !< Total number of property sets for Beams [-] INTEGER(IntKi) :: NPropC !< Total number of property sets for Cable [-] INTEGER(IntKi) :: NPropR !< Total number of property sets for Rigid [-] + INTEGER(IntKi) :: NPropS !< Total number of property sets for Spring [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes !< Nodes number and coordinates [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsB !< Property sets and values for Beams [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsC !< Property sets and values for Cable [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsR !< Property sets and values for Rigid link [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsS !< Property sets and values for Spring [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: K !< System stiffness matrix [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: M !< System mass matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ElemProps !< Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) ) [-] @@ -1719,6 +1744,27 @@ SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCo DstElemPropTypeData%Area = SrcElemPropTypeData%Area DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 + DstElemPropTypeData%k11 = SrcElemPropTypeData%k11 + DstElemPropTypeData%k12 = SrcElemPropTypeData%k12 + DstElemPropTypeData%k13 = SrcElemPropTypeData%k13 + DstElemPropTypeData%k14 = SrcElemPropTypeData%k14 + DstElemPropTypeData%k15 = SrcElemPropTypeData%k15 + DstElemPropTypeData%k16 = SrcElemPropTypeData%k16 + DstElemPropTypeData%k22 = SrcElemPropTypeData%k22 + DstElemPropTypeData%k23 = SrcElemPropTypeData%k23 + DstElemPropTypeData%k24 = SrcElemPropTypeData%k24 + DstElemPropTypeData%k25 = SrcElemPropTypeData%k25 + DstElemPropTypeData%k26 = SrcElemPropTypeData%k26 + DstElemPropTypeData%k33 = SrcElemPropTypeData%k33 + DstElemPropTypeData%k34 = SrcElemPropTypeData%k34 + DstElemPropTypeData%k35 = SrcElemPropTypeData%k35 + DstElemPropTypeData%k36 = SrcElemPropTypeData%k36 + DstElemPropTypeData%k44 = SrcElemPropTypeData%k44 + DstElemPropTypeData%k45 = SrcElemPropTypeData%k45 + DstElemPropTypeData%k46 = SrcElemPropTypeData%k46 + DstElemPropTypeData%k55 = SrcElemPropTypeData%k55 + DstElemPropTypeData%k56 = SrcElemPropTypeData%k56 + DstElemPropTypeData%k66 = SrcElemPropTypeData%k66 DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos END SUBROUTINE SD_CopyElemPropType @@ -1794,6 +1840,27 @@ SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_BufSz = Re_BufSz + 1 ! Area Re_BufSz = Re_BufSz + 1 ! Rho Re_BufSz = Re_BufSz + 1 ! T0 + Re_BufSz = Re_BufSz + 1 ! k11 + Re_BufSz = Re_BufSz + 1 ! k12 + Re_BufSz = Re_BufSz + 1 ! k13 + Re_BufSz = Re_BufSz + 1 ! k14 + Re_BufSz = Re_BufSz + 1 ! k15 + Re_BufSz = Re_BufSz + 1 ! k16 + Re_BufSz = Re_BufSz + 1 ! k22 + Re_BufSz = Re_BufSz + 1 ! k23 + Re_BufSz = Re_BufSz + 1 ! k24 + Re_BufSz = Re_BufSz + 1 ! k25 + Re_BufSz = Re_BufSz + 1 ! k26 + Re_BufSz = Re_BufSz + 1 ! k33 + Re_BufSz = Re_BufSz + 1 ! k34 + Re_BufSz = Re_BufSz + 1 ! k35 + Re_BufSz = Re_BufSz + 1 ! k36 + Re_BufSz = Re_BufSz + 1 ! k44 + Re_BufSz = Re_BufSz + 1 ! k45 + Re_BufSz = Re_BufSz + 1 ! k46 + Re_BufSz = Re_BufSz + 1 ! k55 + Re_BufSz = Re_BufSz + 1 ! k56 + Re_BufSz = Re_BufSz + 1 ! k66 Db_BufSz = Db_BufSz + SIZE(InData%DirCos) ! DirCos IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -1852,6 +1919,48 @@ SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%T0 Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k11 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k12 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k13 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k14 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k15 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k16 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k22 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k23 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k24 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k25 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k26 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k33 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k34 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k35 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k36 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k44 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k45 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k46 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k55 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k56 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k66 + Re_Xferred = Re_Xferred + 1 DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) DbKiBuf(Db_Xferred) = InData%DirCos(i1,i2) @@ -1920,6 +2029,48 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 OutData%T0 = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + OutData%k11 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k12 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k13 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k14 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k15 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k16 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k22 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k23 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k24 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k25 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k26 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k33 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k34 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k35 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k36 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k44 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k45 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k46 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k55 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k56 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k66 = 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) @@ -3147,6 +3298,7 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR + DstInitTypeData%NPropSetsS = SrcInitTypeData%NPropSetsS DstInitTypeData%NCMass = SrcInitTypeData%NCMass DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod @@ -3208,6 +3360,20 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, END IF DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR ENDIF +IF (ALLOCATED(SrcInitTypeData%PropSetsS)) THEN + i1_l = LBOUND(SrcInitTypeData%PropSetsS,1) + i1_u = UBOUND(SrcInitTypeData%PropSetsS,1) + i2_l = LBOUND(SrcInitTypeData%PropSetsS,2) + i2_u = UBOUND(SrcInitTypeData%PropSetsS,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsS)) THEN + ALLOCATE(DstInitTypeData%PropSetsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropSetsS = SrcInitTypeData%PropSetsS +ENDIF IF (ALLOCATED(SrcInitTypeData%PropSetsX)) THEN i1_l = LBOUND(SrcInitTypeData%PropSetsX,1) i1_u = UBOUND(SrcInitTypeData%PropSetsX,1) @@ -3379,6 +3545,7 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NPropB = SrcInitTypeData%NPropB DstInitTypeData%NPropC = SrcInitTypeData%NPropC DstInitTypeData%NPropR = SrcInitTypeData%NPropR + DstInitTypeData%NPropS = SrcInitTypeData%NPropS IF (ALLOCATED(SrcInitTypeData%Nodes)) THEN i1_l = LBOUND(SrcInitTypeData%Nodes,1) i1_u = UBOUND(SrcInitTypeData%Nodes,1) @@ -3435,6 +3602,20 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, END IF DstInitTypeData%PropsR = SrcInitTypeData%PropsR ENDIF +IF (ALLOCATED(SrcInitTypeData%PropsS)) THEN + i1_l = LBOUND(SrcInitTypeData%PropsR,1) + i1_u = UBOUND(SrcInitTypeData%PropsR,1) + i2_l = LBOUND(SrcInitTypeData%PropsR,2) + i2_u = UBOUND(SrcInitTypeData%PropsR,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropsS)) THEN + ALLOCATE(DstInitTypeData%PropsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropsS = SrcInitTypeData%PropsS +ENDIF IF (ALLOCATED(SrcInitTypeData%K)) THEN i1_l = LBOUND(SrcInitTypeData%K,1) i1_u = UBOUND(SrcInitTypeData%K,1) @@ -3555,6 +3736,9 @@ SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers IF (ALLOCATED(InitTypeData%PropSetsR)) THEN DEALLOCATE(InitTypeData%PropSetsR) ENDIF +IF (ALLOCATED(InitTypeData%PropSetsS)) THEN + DEALLOCATE(InitTypeData%PropSetsS) +ENDIF IF (ALLOCATED(InitTypeData%PropSetsX)) THEN DEALLOCATE(InitTypeData%PropSetsX) ENDIF @@ -3603,6 +3787,9 @@ SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers IF (ALLOCATED(InitTypeData%PropsR)) THEN DEALLOCATE(InitTypeData%PropsR) ENDIF +IF (ALLOCATED(InitTypeData%PropsS)) THEN + DEALLOCATE(InitTypeData%PropsS) +ENDIF IF (ALLOCATED(InitTypeData%K)) THEN DEALLOCATE(InitTypeData%K) ENDIF @@ -3668,6 +3855,7 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! NPropSetsB Int_BufSz = Int_BufSz + 1 ! NPropSetsC Int_BufSz = Int_BufSz + 1 ! NPropSetsR + Int_BufSz = Int_BufSz + 1 ! NPropSetsS Int_BufSz = Int_BufSz + 1 ! NCMass Int_BufSz = Int_BufSz + 1 ! NCOSMs Int_BufSz = Int_BufSz + 1 ! FEMMod @@ -3693,6 +3881,11 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*2 ! PropSetsR upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PropSetsR) ! PropSetsR END IF + Int_BufSz = Int_BufSz + 1 ! PropSetsS allocated yes/no + IF ( ALLOCATED(InData%PropSetsS) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropSetsS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropSetsS) ! PropSetsS + END IF Int_BufSz = Int_BufSz + 1 ! PropSetsX allocated yes/no IF ( ALLOCATED(InData%PropSetsX) ) THEN Int_BufSz = Int_BufSz + 2*2 ! PropSetsX upper/lower bounds for each dimension @@ -3762,6 +3955,7 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! NPropB Int_BufSz = Int_BufSz + 1 ! NPropC Int_BufSz = Int_BufSz + 1 ! NPropR + Int_BufSz = Int_BufSz + 1 ! NPropS Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no IF ( ALLOCATED(InData%Nodes) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Nodes upper/lower bounds for each dimension @@ -3782,6 +3976,11 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*2 ! PropsR upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PropsR) ! PropsR END IF + Int_BufSz = Int_BufSz + 1 ! PropsS allocated yes/no + IF ( ALLOCATED(InData%PropsS) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropsS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropsS) ! PropsS + END IF Int_BufSz = Int_BufSz + 1 ! K allocated yes/no IF ( ALLOCATED(InData%K) ) THEN Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension @@ -3864,6 +4063,8 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NPropSetsR Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSetsS + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NCMass Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NCOSMs @@ -3954,6 +4155,26 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%PropSetsS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsS,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsS,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsS,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropSetsS,2), UBOUND(InData%PropSetsS,2) + DO i1 = LBOUND(InData%PropSetsS,1), UBOUND(InData%PropSetsS,1) + ReKiBuf(Re_Xferred) = InData%PropSetsS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%PropSetsX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4207,6 +4428,8 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NPropR Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropS + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4287,6 +4510,26 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%PropsS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsS,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsS,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsS,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropsS,2), UBOUND(InData%PropsS,2) + DO i1 = LBOUND(InData%PropsS,1), UBOUND(InData%PropsS,1) + ReKiBuf(Re_Xferred) = InData%PropsS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%K) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4466,6 +4709,8 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 OutData%NPropSetsR = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%NPropSetsS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%NCMass = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%NCOSMs = IntKiBuf(Int_Xferred) @@ -4568,6 +4813,29 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropSetsS)) DEALLOCATE(OutData%PropSetsS) + ALLOCATE(OutData%PropSetsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropSetsS,2), UBOUND(OutData%PropSetsS,2) + DO i1 = LBOUND(OutData%PropSetsS,1), UBOUND(OutData%PropSetsS,1) + OutData%PropSetsS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4863,6 +5131,8 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 OutData%NPropR = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%NPropS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4955,6 +5225,29 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropsS)) DEALLOCATE(OutData%PropsS) + ALLOCATE(OutData%PropsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropsS,2), UBOUND(OutData%PropsS,2) + DO i1 = LBOUND(OutData%PropsS,1), UBOUND(OutData%PropsS,1) + OutData%PropsS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated Int_Xferred = Int_Xferred + 1 ELSE From b48c9b22ac1f7fd782d67839108f13a1f4aba99f Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 20 Nov 2023 16:18:28 -0700 Subject: [PATCH 072/232] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index b81574809d..db771e5f3b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit b81574809dc4733c1da7d35aa86fb25d72bf2fe1 +Subproject commit db771e5f3b0d21ef999fa6b5374e9bc4914aecce From b97952506a89a465f880713dc302517faecd24b4 Mon Sep 17 00:00:00 2001 From: Hannah Ross Date: Mon, 20 Nov 2023 17:43:16 -0700 Subject: [PATCH 073/232] Update r-tests --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index db771e5f3b..58ced27ad1 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit db771e5f3b0d21ef999fa6b5374e9bc4914aecce +Subproject commit 58ced27ad1e6ca167ba174046891c63185b18901 From 0cebc49748ed4e239a73692e973ad4420c1da78d Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Wed, 22 Nov 2023 15:08:19 -0800 Subject: [PATCH 074/232] Correction to force output --- modules/moordyn/src/MoorDyn_Body.f90 | 14 ++++++++------ modules/moordyn/src/MoorDyn_Driver.f90 | 12 ++++++------ modules/moordyn/src/MoorDyn_Rod.f90 | 9 +++++---- 3 files changed, 19 insertions(+), 16 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index 27bde873c7..f520265fae 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -221,7 +221,7 @@ SUBROUTINE Body_SetKinematics(Body, r6_in, v6_in, a6_in, t, m) Type(MD_Body), INTENT(INOUT) :: Body ! the Body object Real(DbKi), INTENT(IN ) :: r6_in(6) ! 6-DOF position Real(DbKi), INTENT(IN ) :: v6_in(6) ! 6-DOF velocity - Real(DbKi), INTENT(IN ) :: a6_in(6) ! 6-DOF acceleration (only used for coupled rods) + Real(DbKi), INTENT(IN ) :: a6_in(6) ! 6-DOF acceleration Real(DbKi), INTENT(IN ) :: t ! instantaneous time TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Points) @@ -386,7 +386,7 @@ SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) ! store accelerations in case they're useful as output Body%a6 = acc - ELSE ! Pinned Body, 6 states (rotational only) + ELSE ! Pinned Body, 3 states (rotational only) ! Account for moment response due to inertial coupling Fnet = Body%F6net @@ -523,13 +523,15 @@ SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) if (Body%typeNum == -1) then F6_iner = -MATMUL(Body%M, Body%a6) ! <<<<<<<< why does including F6_iner cause instability??? - Fnet_out = Body%F6net + F6_iner ! add inertial loads + Body%F6net = Body%F6net + F6_iner ! add inertial loads + Fnet_out = Body%F6net else if (Body%typeNum == 2) then ! pinned coupled body ! inertial loads ... from input translational ... and solved rotational ... acceleration - F6_iner(1:3) = -MATMUL(Body%M6net(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M6net(1:3,4:6), Body%a6(4:6)) - Fnet_out(1:3) = Body%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads - Fnet_out(4:6) = 0.0_DbKi + F6_iner(1:3) = -MATMUL(Body%M(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M(1:3,4:6), Body%a6(4:6)) + Body%F6net(1:3) = Body%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads + Body%F6net(4:6) = 0.0_DbKi + Fnet_out = Body%F6net else print *, "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!" diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 5902736cd5..219dfe0f2a 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -90,7 +90,7 @@ PROGRAM MoorDyn_Driver INTEGER(IntKi) :: nt ! number of coupling time steps to use in simulation REAL(DbKi) :: t ! current time (s) - REAL(DbKi) :: tMax ! sim end time (s) + REAL(DbKi) :: TMax ! sim end time (s) REAL(DbKi) :: dtC ! fixed/constant global time step REAL(DbKi) :: frac ! fraction used in interpolation @@ -304,7 +304,7 @@ PROGRAM MoorDyn_Driver ! specify stepping details - nt = tMax/dtC - 1 ! number of coupling time steps + nt = TMax/dtC - 1 ! number of coupling time steps ! allocate space for processed motion array @@ -451,11 +451,11 @@ PROGRAM MoorDyn_Driver else - nt = tMax/dtC - 1 ! number of coupling time steps + nt = TMax/dtC - 1 ! number of coupling time steps end if CALL WrScr(" ") - call WrScr("Tmax - "//trim(Num2LStr(tMax))//" and nt="//trim(Num2LStr(nt))) + call WrScr("Tmax - "//trim(Num2LStr(TMax))//" and nt="//trim(Num2LStr(nt))) CALL WrScr(" ") @@ -569,7 +569,7 @@ PROGRAM MoorDyn_Driver call WrScr("Doing time marching now...") - CALL SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, SimStrtCPU, t, tMax ) + CALL SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, SimStrtCPU, t, TMax ) DO i = 1,nt @@ -579,7 +579,7 @@ PROGRAM MoorDyn_Driver if ( MOD( i, 20 ) == 0 ) THEN - CALL SimStatus( PrevSimTime, PrevClockTime, t, tMax ) + CALL SimStatus( PrevSimTime, PrevClockTime, t, TMax ) end if ! shift older inputs back in the buffer diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index e0e9d7cb2c..7302214f9d 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -1016,14 +1016,15 @@ SUBROUTINE Rod_GetCoupledForce(Rod, Fnet_out, m, p) if (Rod%typeNum == -2) then F6_iner = -MATMUL(Rod%M6net, Rod%a6) ! inertial loads - Fnet_out = Rod%F6net + F6_iner ! add inertial loads - + Rod%F6net = Rod%F6net + F6_iner ! add inertial loads + Fnet_out = Rod%F6net ! pinned coupled rod else if (Rod%typeNum == -1) then ! inertial loads ... from input translational ... and solved rotational ... acceleration F6_iner(1:3) = -MATMUL(Rod%M6net(1:3,1:3), Rod%a6(1:3)) - MATMUL(Rod%M6net(1:3,4:6), Rod%a6(4:6)) - Fnet_out(1:3) = Rod%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads - Fnet_out(4:6) = 0.0_DbKi + Rod%F6net(1:3) = Rod%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads + Rod%F6net(4:6) = 0.0_DbKi + Fnet_out = Rod%F6net else print *, "ERROR, Rod_GetCoupledForce called for wrong (non-coupled) rod type!" end if From 4c32cb0b8481110acef9313414f2954489c2edad Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Thu, 23 Nov 2023 00:41:55 +0100 Subject: [PATCH 075/232] Two nodes with the same location for springs --- modules/subdyn/src/FEM.f90 | 17 +- modules/subdyn/src/SD_FEM.f90 | 4 +- modules/subdyn/src/SubDyn.f90 | 12 +- modules/subdyn/src/SubDyn_Tests.f90 | 3 +- modules/subdyn/src/SubDyn_Types.f90 | 26808 +++++++++++++------------- 5 files changed, 13429 insertions(+), 13415 deletions(-) diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index 5c68ddbd03..07ffce5f49 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -951,8 +951,9 @@ END SUBROUTINE GetRigidTransformation !! !! bjj: note that this is the transpose of what is normally considered the Direction Cosine Matrix !! in the FAST framework. -SUBROUTINE GetDirCos(P1, P2, DirCos, L_out, ErrStat, ErrMsg) +SUBROUTINE GetDirCos(P1, P2, eType, DirCos, L_out, ErrStat, ErrMsg) REAL(ReKi) , INTENT(IN ) :: P1(3), P2(3) ! (x,y,z) global positions of two nodes making up an element + INTEGER(IntKi), INTENT(IN ) :: eType ! element type (1:beam circ., 2:cable, 3:rigid, 4:beam arb., 5:spring) REAL(FEKi) , INTENT( OUT) :: DirCos(3, 3) ! calculated direction cosine matrix REAL(ReKi) , INTENT( OUT) :: L_out ! length of element INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation @@ -966,9 +967,16 @@ SUBROUTINE GetDirCos(P1, P2, DirCos, L_out, ErrStat, ErrMsg) Dz=P2(3)-P1(3) Dxy = sqrt( Dx**2 + Dy**2 ) L = sqrt( Dx**2 + Dy**2 + Dz**2) + + ! The spring element should have the same starting and ending location. P1 and P2 must be coincident (L must be 0). + IF ( .not. EqualRealNos(L, 0.0_FEKi) .and. eType == 5) THEN + ErrMsg = ' Spring(s) must be defined with the same starting and ending locations in the element.' + ErrStat = ErrID_Fatal + RETURN + ENDIF - IF ( EqualRealNos(L, 0.0_FEKi) ) THEN - ErrMsg = ' Same starting and ending location in the element.' + IF ( EqualRealNos(L, 0.0_FEKi) .and. eType/= 5) THEN + ErrMsg = ' Same starting and ending location in a beam, cable or rigid element.' ErrStat = ErrID_Fatal RETURN ENDIF @@ -1303,6 +1311,9 @@ SUBROUTINE ElemK_Spring(k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k ! Temporary check. Looking at the spring element matrix (local coordinate system). print*,'Spring element stiffness (local coordinate system)' print*, K + + ! Temporary check. Looking at direction cosine matrix. + print*,'Direction cosine',DirCos DC = 0.0_FEKi DC( 1: 3, 1: 3) = DirCos diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index fa5f217692..bc75a39cb4 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -854,7 +854,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) Point2 = Init%Nodes(N2,2:4) if (iDirCos/=-1) then - CALL GetDirCos(Point1, Point2, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! sets L + CALL GetDirCos(Point1, Point2, eType, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! sets L ! overwrites direction cosines DirCos(1, 1) = Init%COSMs(iDirCos, 2) @@ -868,7 +868,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) DirCos(3, 3) = Init%COSMs(iDirCos, 10) else - CALL GetDirCos(Point1, Point2, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! L and DirCos + CALL GetDirCos(Point1, Point2, eType, DirCos, L, ErrStat2, ErrMsg2); if(Failed()) return ! L and DirCos endif diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 133555ca92..33a920e792 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -3786,8 +3786,10 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E !Calculate member mass here; this should really be done somewhere else, yet it is not used anywhere else !IT WILL HAVE TO BE MODIFIED FOR OTHER THAN CIRCULAR PIPE ELEMENTS propIDs=Init%Members(i,iMProp:iMProp+1) - mLength=MemberLength(Init%Members(i,1),Init,ErrStat,ErrMsg) ! TODO double check mass and length - IF (ErrStat .EQ. ErrID_None) THEN + if (Init%Members(I, iMType)/=idMemberSpring) then ! This check only applies for members different than springs (springs have no mass and no length) + mLength=MemberLength(Init%Members(i,1),Init,ErrStat,ErrMsg) ! TODO double check mass and length + endif + IF (ErrStat .EQ. ErrID_None) THEN mType = Init%Members(I, iMType) ! if (mType==idMemberBeamCirc) then iProp(1) = FINDLOCI(Init%PropSetsB(:,1), propIDs(1)) @@ -3837,7 +3839,7 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E iNode2 = FINDLOCI(Init%Joints(:,1), Init%Members(i,3)) ! index of joint 2 of member i XYZ1 = Init%Joints(iNode1,2:4) XYZ2 = Init%Joints(iNode2,2:4) - CALL GetDirCos(XYZ1(1:3), XYZ2(1:3), DirCos, mLength, ErrStat, ErrMsg) + CALL GetDirCos(XYZ1(1:3), XYZ2(1:3), mType, DirCos, mLength, ErrStat, ErrMsg) DirCos=TRANSPOSE(DirCos) !This is now global to local WRITE(UnSum, '("#",I9,9(ES28.18E2))') Init%Members(i,1), ((DirCos(k,j),j=1,3),k=1,3) ENDDO @@ -4084,7 +4086,7 @@ END SUBROUTINE StateMatrices FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) TYPE(SD_InitType), INTENT(IN) :: Init !< Input data for initialization routine, this structure contains many variables needed for summary file INTEGER(IntKi), INTENT(IN) :: MemberID !< Member ID # - REAL(ReKi) :: MemberLength !< Member Length + REAL(ReKi) :: MemberLength !< Member Length INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None !Locals @@ -4108,7 +4110,7 @@ FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) xyz1= Init%Joints(Joint1,2:4) xyz2= Init%Joints(Joint2,2:4) MemberLength=SQRT( SUM((xyz2-xyz1)**2.) ) - if ( EqualRealNos(MemberLength, 0.0_ReKi) ) then + if ( EqualRealNos(MemberLength, 0.0_ReKi) ) then call SetErrStat(ErrID_Fatal,' Member with ID '//trim(Num2LStr(MemberID))//' has zero length!', ErrStat,ErrMsg,RoutineName); return endif diff --git a/modules/subdyn/src/SubDyn_Tests.f90 b/modules/subdyn/src/SubDyn_Tests.f90 index 138435f85f..dd822f52e5 100644 --- a/modules/subdyn/src/SubDyn_Tests.f90 +++ b/modules/subdyn/src/SubDyn_Tests.f90 @@ -323,6 +323,7 @@ subroutine Test_Transformations(ErrStat,ErrMsg) character(ErrMsgLen), intent(out) :: ErrMsg real(ReKi), dimension(3) :: P1, P2, e1, e2, e3 + integer(IntKi) :: eType real(FEKi), dimension(3,3) :: DirCos, Ref real(ReKi), dimension(6,6) :: T, Tref real(ReKi) :: L @@ -332,7 +333,7 @@ subroutine Test_Transformations(ErrStat,ErrMsg) ! --- DirCos P1=(/0,0,0/) P2=(/2,0,0/) - call GetDirCos(P1, P2, DirCos, L, ErrStat, ErrMsg) + call GetDirCos(P1, P2, eType, DirCos, L, ErrStat, ErrMsg) Ref = reshape( (/0_FEKi,-1_FEKi,0_FEKi, 0_FEKi, 0_FEKi, -1_FEKi, 1_FEKi, 0_FEKi, 0_FEKi/) , (/3,3/)) call test_almost_equal('DirCos',Ref,DirCos,1e-8_FEKi,.true.,.true.) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 8beeee9dc8..7bc008b309 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -1,13404 +1,13404 @@ -!STARTOFREGISTRYGENERATEDFILE 'SubDyn_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* -! SubDyn_Types -!................................................................................................................................. -! This file is part of SubDyn. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in SubDyn. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE SubDyn_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= IList ======= - TYPE, PUBLIC :: IList - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: List !< List of integers [-] - END TYPE IList -! ======================= -! ========= MeshAuxDataType ======= - TYPE, PUBLIC :: MeshAuxDataType - INTEGER(IntKi) :: MemberID !< Member ID for Output [-] - INTEGER(IntKi) :: NOutCnt !< Number of Nodes for the output member [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeCnt !< Node ordinal numbers for the output member [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIDs !< Node IDs associated with ordinal numbers for the output member [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmIDs !< Element IDs connected to each NodeIDs; max 10 elements [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmNds !< Flag to indicate 1st or 2nd node of element for each ElmIDs [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Me !< Mass matrix connected to each joint element for outAll output [-] - REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Ke !< Mass matrix connected to each joint element for outAll output [-] - REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fg !< Gravity load vector connected to each joint element for requested member output [-] - END TYPE MeshAuxDataType -! ======================= -! ========= CB_MatArrays ======= - TYPE, PUBLIC :: CB_MatArrays - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: MBB !< FULL MBB ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: MBM !< FULL MBM ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: KBB !< FULL KBB ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: PhiL !< Retained CB modes, possibly allPhiL(nDOFL,nDOFL), or PhiL(nDOFL,nDOFM) [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: PhiR !< FULL PhiR ( no constraints applied) [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: OmegaL !< Eigenvalues of retained CB modes, possibly all (nDOFL or nDOFM) [-] - END TYPE CB_MatArrays -! ======================= -! ========= ElemPropType ======= - TYPE, PUBLIC :: ElemPropType - INTEGER(IntKi) :: eType !< Element Type [-] - REAL(ReKi) :: Length !< Length of an element [-] - REAL(ReKi) :: Ixx !< Moment of inertia of an element [-] - REAL(ReKi) :: Iyy !< Moment of inertia of an element [-] - REAL(ReKi) :: Jzz !< Moment of inertia of an element [-] - LOGICAL :: Shear !< Use timoshenko (true) E-B (false) [-] - REAL(ReKi) :: Kappa_x !< Shear coefficient [-] - REAL(ReKi) :: Kappa_y !< Shear coefficient [-] - REAL(ReKi) :: YoungE !< Young's modulus [-] - REAL(ReKi) :: ShearG !< Shear modulus [N/m^2] - REAL(ReKi) , DIMENSION(1:2) :: D !< Diameter at node 1 and 2, for visualization only [m] - REAL(ReKi) :: Area !< Area of an element [m^2] - REAL(ReKi) :: Rho !< Density [kg/m^3] - REAL(ReKi) :: T0 !< Pretension [N] - REAL(ReKi) :: k11 !< Spring translational stiffness [N/m] - REAL(ReKi) :: k12 !< Spring cross-coupling stiffness [N/m] - REAL(ReKi) :: k13 !< Spring cross-coupling stiffness [N/m] - REAL(ReKi) :: k14 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k15 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k16 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k22 !< Spring translational stiffness [N/m] - REAL(ReKi) :: k23 !< Spring cross-coupling stiffness [N/m] - REAL(ReKi) :: k24 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k25 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k26 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k33 !< Spring translational stiffness [N/m] - REAL(ReKi) :: k34 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k35 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k36 !< Spring cross-coupling stiffness [N/rad] - REAL(ReKi) :: k44 !< Spring rotational stiffness [Nm/rad] - REAL(ReKi) :: k45 !< Spring cross-coupling stiffness [Nm/rad] - REAL(ReKi) :: k46 !< Spring cross-coupling stiffness [Nm/rad] - REAL(ReKi) :: k55 !< Spring rotational stiffness [Nm/rad] - REAL(ReKi) :: k56 !< Spring cross-coupling stiffness [Nm/rad] - REAL(ReKi) :: k66 !< Spring rotational stiffness [Nm/rad] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< Element direction cosine matrix [-] - END TYPE ElemPropType -! ======================= -! ========= SD_InitInputType ======= - TYPE, PUBLIC :: SD_InitInputType - CHARACTER(1024) :: SDInputFile !< Name of the input file [-] - CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(ReKi) :: WtrDpth !< Water Depth (positive valued) [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SoilStiffness !< Soil stiffness matrices from SoilDyn ['(N/m,] - TYPE(MeshType) :: SoilMesh !< Mesh for soil stiffness locations [-] - LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - END TYPE SD_InitInputType -! ======================= -! ========= SD_InitOutputType ======= - TYPE, PUBLIC :: SD_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] - CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: CableCChanRqst !< flag indicating control channel for active cable tensioning is requested [-] - END TYPE SD_InitOutputType -! ======================= -! ========= SD_InitType ======= - TYPE, PUBLIC :: SD_InitType - CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(DbKi) :: DT !< Time step from Glue Code [seconds] - INTEGER(IntKi) :: NJoints !< Number of joints of the sub structure [-] - INTEGER(IntKi) :: NPropSetsX !< Number of extended property sets [-] - INTEGER(IntKi) :: NPropSetsB !< Number of property sets for beams [-] - INTEGER(IntKi) :: NPropSetsC !< Number of property sets for cables [-] - INTEGER(IntKi) :: NPropSetsR !< Number of property sets for rigid links [-] - INTEGER(IntKi) :: NPropSetsS !< Number of property sets for spring elements [-] - INTEGER(IntKi) :: NCMass !< Number of joints with concentrated mass [-] - INTEGER(IntKi) :: NCOSMs !< Number of independent cosine matrices [-] - INTEGER(IntKi) :: FEMMod !< FEM switch element model in the FEM [-] - INTEGER(IntKi) :: NDiv !< Number of divisions for each member [-] - LOGICAL :: CBMod !< Perform C-B flag [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Joints !< Joints number and coordinate values [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsB !< Property sets number and values [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsC !< Property ID and values for cables [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsR !< Property ID and values for rigid link [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsS !< Property ID and values for spring elements [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsX !< Extended property sets [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: COSMs !< Independent direction cosine matrices [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMass !< Concentrated mass information [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] - INTEGER(IntKi) :: GuyanDampMod !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] - REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] - REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat !< Guyan Damping Matrix, see also CBB [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] - LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] - LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIK !< SSI stiffness packed matrix elements (21 of them), for each reaction joint [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIM !< SSI mass packed matrix elements (21 of them), for each reaction joint [-] - CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SSIfile !< Soil Structure Interaction (SSI) files to associate with each reaction node [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Soil_K !< Soil stiffness (at passed at Init, not in input file) 6x6xn [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Soil_Points !< Node positions where soil stiffness will be added [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Soil_Nodes !< Node indices where soil stiffness will be added [-] - INTEGER(IntKi) :: NElem !< Total number of elements [-] - INTEGER(IntKi) :: NPropB !< Total number of property sets for Beams [-] - INTEGER(IntKi) :: NPropC !< Total number of property sets for Cable [-] - INTEGER(IntKi) :: NPropR !< Total number of property sets for Rigid [-] - INTEGER(IntKi) :: NPropS !< Total number of property sets for Spring [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes !< Nodes number and coordinates [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsB !< Property sets and values for Beams [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsC !< Property sets and values for Cable [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsR !< Property sets and values for Rigid link [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsS !< Property sets and values for Spring [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: K !< System stiffness matrix [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: M !< System mass matrix [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ElemProps !< Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) ) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: MemberNodes !< Member number and list of nodes making up a member (>2 if subdivided) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnN !< Nodes that connect to a common node [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnE !< Elements that connect to a common node [-] - LOGICAL :: SSSum !< SubDyn Summary File Flag [-] - END TYPE SD_InitType -! ======================= -! ========= SD_ContinuousStateType ======= - TYPE, PUBLIC :: SD_ContinuousStateType - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: qm !< Virtual states, Nmod elements [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: qmdot !< Derivative of states, Nmod elements [-] - END TYPE SD_ContinuousStateType -! ======================= -! ========= SD_DiscreteStateType ======= - TYPE, PUBLIC :: SD_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE SD_DiscreteStateType -! ======================= -! ========= SD_ConstraintStateType ======= - TYPE, PUBLIC :: SD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE SD_ConstraintStateType -! ======================= -! ========= SD_OtherStateType ======= - TYPE, PUBLIC :: SD_OtherStateType - TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated last [-] - END TYPE SD_OtherStateType -! ======================= -! ========= SD_MiscVarType ======= - TYPE, PUBLIC :: SD_MiscVarType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP - REAL(ReKi) , DIMENSION(1:6) :: udot_TP - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat !< Current output decimation counter [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] - END TYPE SD_MiscVarType -! ======================= -! ========= SD_ParameterType ======= - TYPE, PUBLIC :: SD_ParameterType - REAL(DbKi) :: SDDeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1/2/3)Length of y2 array [-] - INTEGER(IntKi) :: nDOF !< Total degree of freedom [-] - INTEGER(IntKi) :: nDOF_red !< Total degree of freedom after constraint reduction [-] - INTEGER(IntKi) :: Nmembers !< Number of members of the sub structure [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] - TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] - LOGICAL :: reduced !< True if system has been reduced to account for constraints [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] - TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOF !< DOF indices of each nodes in unconstrained assembled system [-] - TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOFred !< DOF indices of each nodes in constrained assembled system [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElemsDOF !< 12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: DOFred2Nodes !< nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1 [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CtrlElem2Channel !< nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index [-] - INTEGER(IntKi) :: nDOFM !< retained degrees of freedom (modes) [-] - INTEGER(IntKi) :: SttcSolve !< Solve dynamics about static equilibrium point (flag) [-] - LOGICAL :: GuyanLoadCorrection !< Add Extra lever arm contribution to interface reaction outputs [-] - LOGICAL :: Floating !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: KMMDiag !< Diagonal coefficients of Kmm (OmegaM squared) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMMDiag !< Diagonal coefficients of Cmm (~2 Zeta OmegaM)) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MMB !< Matrix after C-B reduction (transpose of MBM [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBmmB !< MBm * MmB, used for Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_11 !< Coefficient of x in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_12 !< Coefficient of x in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_141 !< MBm PhiM^T [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_142 !< TI^T PhiR^T [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiM !< Coefficient of x in Y2 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_61 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_62 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiRb_TI !< Coefficient of u in Y2 (Phi_R bar * TI) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_63 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_64 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBB !< Guyan Mass Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KBB !< Guyan Stiffness Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CBB !< Guyan Damping Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMM !< CB damping matrix [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBM !< Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiL_T !< Transpose of Matrix of C-B modes [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiLInvOmgL2 !< Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KLLm1 !< KLL^{-1}, inverse of matrix KLL, for static solve only [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AM2Jac !< Jacobian (factored) for Adams-Boulton 2nd order Integration [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AM2JacPiv !< Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI !< Matrix to calculate TP reference point reaction at top of structure [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIreact !< Matrix to calculate single point reaction at base of structure [-] - INTEGER(IntKi) :: nNodes !< Total number of nodes [-] - INTEGER(IntKi) :: nNodes_I !< Number of Interface nodes [-] - INTEGER(IntKi) :: nNodes_L !< Number of Internal nodes [-] - INTEGER(IntKi) :: nNodes_C !< Number of joints with reactions [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_I !< Interface degree of freedoms [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_L !< Internal nodes (not interface nor reaction) [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_C !< React degree of freedoms [-] - INTEGER(IntKi) :: nDOFI__ !< Size of IDI__ [-] - INTEGER(IntKi) :: nDOFI_Rb !< Size of IDI_Rb [-] - INTEGER(IntKi) :: nDOFI_F !< Size of IDI_F [-] - INTEGER(IntKi) :: nDOFL_L !< Size of IDL_L [-] - INTEGER(IntKi) :: nDOFC__ !< Size of IDC__ [-] - INTEGER(IntKi) :: nDOFC_Rb !< Size of IDC_Rb [-] - INTEGER(IntKi) :: nDOFC_L !< Size of IDC_L [-] - INTEGER(IntKi) :: nDOFC_F !< Size of IDC_F [-] - INTEGER(IntKi) :: nDOFR__ !< Size of IDR__ [-] - INTEGER(IntKi) :: nDOF__Rb !< Size of ID__Rb [-] - INTEGER(IntKi) :: nDOF__L !< Size of ID__L [-] - INTEGER(IntKi) :: nDOF__F !< Size of ID__F [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI__ !< Index of all Interface DOFs [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_Rb !< Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_F !< Index array of the interface (nodes connect to TP) dofs that are fixed DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDL_L !< Index array of the internal dofs coming from internal nodes [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC__ !< Index of all bottom DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_Rb !< Index array of the contraint dofs that are retained/master/follower DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_L !< Index array of the contraint dofs that are follower/internal DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_F !< Index array of the contraint dofs that are fixd DOF [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDR__ !< Index array of the interface and restraint dofs [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__Rb !< Index array of all the retained/leader/master dofs (from any nodes of the structure) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__L !< Index array of all the follower/internal dofs (from any nodes of the structure) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__F !< Index array of the DOF that are fixed (from any nodes of the structure) [-] - INTEGER(IntKi) :: NMOutputs !< Number of members whose output is written [-] - INTEGER(IntKi) :: NumOuts !< Number of output channels read from input file [-] - INTEGER(IntKi) :: OutSwtch !< Output Requested Channels to local or global output file [1/2/3] [-] - INTEGER(IntKi) :: UnJckF !< Unit of SD ouput file [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - CHARACTER(20) :: OutFmt !< Format for Output [-] - CHARACTER(20) :: OutSFmt !< Format for Output Headers [-] - TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst !< List of user requested members and nodes [-] - TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst2 !< List of all member joint nodes and elements for output [-] - TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst3 !< List of all member joint nodes and elements for output [-] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. logical [-] - LOGICAL :: OutAll !< Flag to output or not all joint forces [-] - INTEGER(IntKi) :: OutCBModes !< Flag to output CB and Guyan modes to a given format [-] - INTEGER(IntKi) :: OutFEMModes !< Flag to output FEM modes to a given format [-] - LOGICAL :: OutReact !< Flag to check whether reactions are requested [-] - INTEGER(IntKi) :: OutAllInt !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutAllDims !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutDec !< Output Decimation for Requested Channels [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:2) :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] - END TYPE SD_ParameterType -! ======================= -! ========= SD_InputType ======= - TYPE, PUBLIC :: SD_InputType - TYPE(MeshType) :: TPMesh !< Transition piece inputs on a point mesh [-] - TYPE(MeshType) :: LMesh !< Point mesh for interior node inputs [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< Cable tension, control input [-] - END TYPE SD_InputType -! ======================= -! ========= SD_OutputType ======= - TYPE, PUBLIC :: SD_OutputType - TYPE(MeshType) :: Y1Mesh !< Transition piece outputs on a point mesh [-] - TYPE(MeshType) :: Y2Mesh !< Interior+Interface nodes rigid body displacements + elastic velocities and accelerations on a point mesh [-] - TYPE(MeshType) :: Y3Mesh !< Interior+Interface nodes full elastic displacements/velocities and accelerations on a point mesh [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file [-] - END TYPE SD_OutputType -! ======================= -CONTAINS - SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IList), INTENT(IN) :: SrcIListData - TYPE(IList), INTENT(INOUT) :: DstIListData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyIList' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIListData%List)) THEN - i1_l = LBOUND(SrcIListData%List,1) - i1_u = UBOUND(SrcIListData%List,1) - IF (.NOT. ALLOCATED(DstIListData%List)) THEN - ALLOCATE(DstIListData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIListData%List = SrcIListData%List -ENDIF - END SUBROUTINE SD_CopyIList - - SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(IList), INTENT(INOUT) :: IListData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(IListData%List)) THEN - DEALLOCATE(IListData%List) -ENDIF - END SUBROUTINE SD_DestroyIList - - SUBROUTINE SD_PackIList( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IList), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackIList' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! List allocated yes/no - IF ( ALLOCATED(InData%List) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! List upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%List) ! List - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%List) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%List,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%List,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%List,1), UBOUND(InData%List,1) - IntKiBuf(Int_Xferred) = InData%List(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackIList - - SUBROUTINE SD_UnPackIList( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IList), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackIList' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! List not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%List)) DEALLOCATE(OutData%List) - ALLOCATE(OutData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%List,1), UBOUND(OutData%List,1) - OutData%List(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackIList - - SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData - TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMeshAuxDataType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID - DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeCnt)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeCnt)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmNds)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmNds)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Me)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Me,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Me,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Me,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Me,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Me,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Me,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Me,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Me,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Me)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Ke)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Ke,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Ke,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Ke,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Ke,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Ke,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Ke,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Ke,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Ke,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Ke)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Fg)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Fg,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Fg,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Fg,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Fg,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Fg,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Fg,3) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Fg)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg -ENDIF - END SUBROUTINE SD_CopyMeshAuxDataType - - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeCnt) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%NodeIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmNds)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmNds) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Me)) THEN - DEALLOCATE(MeshAuxDataTypeData%Me) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Ke)) THEN - DEALLOCATE(MeshAuxDataTypeData%Ke) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Fg)) THEN - DEALLOCATE(MeshAuxDataTypeData%Fg) -ENDIF - END SUBROUTINE SD_DestroyMeshAuxDataType - - SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MeshAuxDataType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMeshAuxDataType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NOutCnt - Int_BufSz = Int_BufSz + 1 ! NodeCnt allocated yes/no - IF ( ALLOCATED(InData%NodeCnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeCnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeCnt) ! NodeCnt - END IF - Int_BufSz = Int_BufSz + 1 ! NodeIDs allocated yes/no - IF ( ALLOCATED(InData%NodeIDs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIDs) ! NodeIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmIDs allocated yes/no - IF ( ALLOCATED(InData%ElmIDs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmIDs) ! ElmIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmNds allocated yes/no - IF ( ALLOCATED(InData%ElmNds) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmNds upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmNds) ! ElmNds - END IF - Int_BufSz = Int_BufSz + 1 ! Me allocated yes/no - IF ( ALLOCATED(InData%Me) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Me upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Me) ! Me - END IF - Int_BufSz = Int_BufSz + 1 ! Ke allocated yes/no - IF ( ALLOCATED(InData%Ke) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ke upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ke) ! Ke - END IF - Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no - IF ( ALLOCATED(InData%Fg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeCnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) - IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeIDs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) - IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmIDs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) - DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) - IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmNds) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) - DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) - IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Me) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) - DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) - DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) - DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) - DbKiBuf(Db_Xferred) = InData%Me(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ke) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) - DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) - DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) - DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) - DbKiBuf(Db_Xferred) = InData%Ke(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) - DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) - DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) - DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_PackMeshAuxDataType - - SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MeshAuxDataType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMeshAuxDataType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutCnt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeCnt)) DEALLOCATE(OutData%NodeCnt) - ALLOCATE(OutData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) - OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeIDs)) DEALLOCATE(OutData%NodeIDs) - ALLOCATE(OutData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) - OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElmIDs)) DEALLOCATE(OutData%ElmIDs) - ALLOCATE(OutData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) - DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) - OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElmNds)) DEALLOCATE(OutData%ElmNds) - ALLOCATE(OutData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) - DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) - OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Me)) DEALLOCATE(OutData%Me) - ALLOCATE(OutData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) - DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) - DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) - DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) - OutData%Me(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ke)) DEALLOCATE(OutData%Ke) - ALLOCATE(OutData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) - DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) - DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) - DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) - OutData%Ke(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fg)) DEALLOCATE(OutData%Fg) - ALLOCATE(OutData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) - DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) - DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) - OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_UnPackMeshAuxDataType - - SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(IN) :: SrcCB_MatArraysData - TYPE(CB_MatArrays), INTENT(INOUT) :: DstCB_MatArraysData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyCB_MatArrays' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCB_MatArraysData%MBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBB)) THEN - ALLOCATE(DstCB_MatArraysData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%MBM)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBM,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBM,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBM,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBM,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBM)) THEN - ALLOCATE(DstCB_MatArraysData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%KBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%KBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%KBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%KBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%KBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%KBB)) THEN - ALLOCATE(DstCB_MatArraysData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiL,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiL,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiL,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiL,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiL)) THEN - ALLOCATE(DstCB_MatArraysData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiR)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiR,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiR,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiR,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiR,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiR)) THEN - ALLOCATE(DstCB_MatArraysData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%OmegaL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%OmegaL,1) - i1_u = UBOUND(SrcCB_MatArraysData%OmegaL,1) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%OmegaL)) THEN - ALLOCATE(DstCB_MatArraysData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL -ENDIF - END SUBROUTINE SD_CopyCB_MatArrays - - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(CB_MatArraysData%MBB)) THEN - DEALLOCATE(CB_MatArraysData%MBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%MBM)) THEN - DEALLOCATE(CB_MatArraysData%MBM) -ENDIF -IF (ALLOCATED(CB_MatArraysData%KBB)) THEN - DEALLOCATE(CB_MatArraysData%KBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN - DEALLOCATE(CB_MatArraysData%PhiL) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN - DEALLOCATE(CB_MatArraysData%PhiR) -ENDIF -IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN - DEALLOCATE(CB_MatArraysData%OmegaL) -ENDIF - END SUBROUTINE SD_DestroyCB_MatArrays - - SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(CB_MatArrays), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackCB_MatArrays' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL allocated yes/no - IF ( ALLOCATED(InData%PhiL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiL) ! PhiL - END IF - Int_BufSz = Int_BufSz + 1 ! PhiR allocated yes/no - IF ( ALLOCATED(InData%PhiR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiR upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiR) ! PhiR - END IF - Int_BufSz = Int_BufSz + 1 ! OmegaL allocated yes/no - IF ( ALLOCATED(InData%OmegaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OmegaL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%OmegaL) ! OmegaL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - DbKiBuf(Db_Xferred) = InData%MBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - DbKiBuf(Db_Xferred) = InData%MBM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - DbKiBuf(Db_Xferred) = InData%KBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) - DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) - DbKiBuf(Db_Xferred) = InData%PhiL(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) - DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) - DbKiBuf(Db_Xferred) = InData%PhiR(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OmegaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) - DbKiBuf(Db_Xferred) = InData%OmegaL(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackCB_MatArrays - - SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(CB_MatArrays), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackCB_MatArrays' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL)) DEALLOCATE(OutData%PhiL) - ALLOCATE(OutData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) - DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) - OutData%PhiL(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiR)) DEALLOCATE(OutData%PhiR) - ALLOCATE(OutData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) - DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) - OutData%PhiR(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OmegaL)) DEALLOCATE(OutData%OmegaL) - ALLOCATE(OutData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) - OutData%OmegaL(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackCB_MatArrays - - SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(IN) :: SrcElemPropTypeData - TYPE(ElemPropType), INTENT(INOUT) :: DstElemPropTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyElemPropType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElemPropTypeData%eType = SrcElemPropTypeData%eType - DstElemPropTypeData%Length = SrcElemPropTypeData%Length - DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx - DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy - DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz - DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear - DstElemPropTypeData%Kappa_x = SrcElemPropTypeData%Kappa_x - DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y - DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE - DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG - DstElemPropTypeData%D = SrcElemPropTypeData%D - DstElemPropTypeData%Area = SrcElemPropTypeData%Area - DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho - DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 - DstElemPropTypeData%k11 = SrcElemPropTypeData%k11 - DstElemPropTypeData%k12 = SrcElemPropTypeData%k12 - DstElemPropTypeData%k13 = SrcElemPropTypeData%k13 - DstElemPropTypeData%k14 = SrcElemPropTypeData%k14 - DstElemPropTypeData%k15 = SrcElemPropTypeData%k15 - DstElemPropTypeData%k16 = SrcElemPropTypeData%k16 - DstElemPropTypeData%k22 = SrcElemPropTypeData%k22 - DstElemPropTypeData%k23 = SrcElemPropTypeData%k23 - DstElemPropTypeData%k24 = SrcElemPropTypeData%k24 - DstElemPropTypeData%k25 = SrcElemPropTypeData%k25 - DstElemPropTypeData%k26 = SrcElemPropTypeData%k26 - DstElemPropTypeData%k33 = SrcElemPropTypeData%k33 - DstElemPropTypeData%k34 = SrcElemPropTypeData%k34 - DstElemPropTypeData%k35 = SrcElemPropTypeData%k35 - DstElemPropTypeData%k36 = SrcElemPropTypeData%k36 - DstElemPropTypeData%k44 = SrcElemPropTypeData%k44 - DstElemPropTypeData%k45 = SrcElemPropTypeData%k45 - DstElemPropTypeData%k46 = SrcElemPropTypeData%k46 - DstElemPropTypeData%k55 = SrcElemPropTypeData%k55 - DstElemPropTypeData%k56 = SrcElemPropTypeData%k56 - DstElemPropTypeData%k66 = SrcElemPropTypeData%k66 - DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos - END SUBROUTINE SD_CopyElemPropType - - SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SD_DestroyElemPropType - - SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElemPropType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackElemPropType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! eType - Re_BufSz = Re_BufSz + 1 ! Length - Re_BufSz = Re_BufSz + 1 ! Ixx - Re_BufSz = Re_BufSz + 1 ! Iyy - Re_BufSz = Re_BufSz + 1 ! Jzz - Int_BufSz = Int_BufSz + 1 ! Shear - Re_BufSz = Re_BufSz + 1 ! Kappa_x - Re_BufSz = Re_BufSz + 1 ! Kappa_y - Re_BufSz = Re_BufSz + 1 ! YoungE - Re_BufSz = Re_BufSz + 1 ! ShearG - Re_BufSz = Re_BufSz + SIZE(InData%D) ! D - Re_BufSz = Re_BufSz + 1 ! Area - Re_BufSz = Re_BufSz + 1 ! Rho - Re_BufSz = Re_BufSz + 1 ! T0 - Re_BufSz = Re_BufSz + 1 ! k11 - Re_BufSz = Re_BufSz + 1 ! k12 - Re_BufSz = Re_BufSz + 1 ! k13 - Re_BufSz = Re_BufSz + 1 ! k14 - Re_BufSz = Re_BufSz + 1 ! k15 - Re_BufSz = Re_BufSz + 1 ! k16 - Re_BufSz = Re_BufSz + 1 ! k22 - Re_BufSz = Re_BufSz + 1 ! k23 - Re_BufSz = Re_BufSz + 1 ! k24 - Re_BufSz = Re_BufSz + 1 ! k25 - Re_BufSz = Re_BufSz + 1 ! k26 - Re_BufSz = Re_BufSz + 1 ! k33 - Re_BufSz = Re_BufSz + 1 ! k34 - Re_BufSz = Re_BufSz + 1 ! k35 - Re_BufSz = Re_BufSz + 1 ! k36 - Re_BufSz = Re_BufSz + 1 ! k44 - Re_BufSz = Re_BufSz + 1 ! k45 - Re_BufSz = Re_BufSz + 1 ! k46 - Re_BufSz = Re_BufSz + 1 ! k55 - Re_BufSz = Re_BufSz + 1 ! k56 - Re_BufSz = Re_BufSz + 1 ! k66 - Db_BufSz = Db_BufSz + SIZE(InData%DirCos) ! DirCos - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%eType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - ReKiBuf(Re_Xferred) = InData%D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k11 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k12 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k13 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k14 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k15 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k16 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k22 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k23 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k24 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k25 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k26 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k33 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k34 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k35 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k36 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k44 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k45 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k46 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k55 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k56 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k66 - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) - DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) - DbKiBuf(Db_Xferred) = InData%DirCos(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_PackElemPropType - - SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElemPropType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackElemPropType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%eType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ixx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Iyy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Jzz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) - Int_Xferred = Int_Xferred + 1 - OutData%Kappa_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kappa_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YoungE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%D,1) - i1_u = UBOUND(OutData%D,1) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Area = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k11 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k12 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k13 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k14 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k15 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k16 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k22 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k23 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k24 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k25 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k26 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k33 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k34 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k35 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k36 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k44 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k45 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k46 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k55 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k56 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k66 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%DirCos,1) - i1_u = UBOUND(OutData%DirCos,1) - i2_l = LBOUND(OutData%DirCos,2) - i2_u = UBOUND(OutData%DirCos,2) - DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) - DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) - OutData%DirCos(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_UnPackElemPropType - - SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(SD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint - DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ -IF (ALLOCATED(SrcInitInputData%SoilStiffness)) THEN - i1_l = LBOUND(SrcInitInputData%SoilStiffness,1) - i1_u = UBOUND(SrcInitInputData%SoilStiffness,1) - i2_l = LBOUND(SrcInitInputData%SoilStiffness,2) - i2_u = UBOUND(SrcInitInputData%SoilStiffness,2) - i3_l = LBOUND(SrcInitInputData%SoilStiffness,3) - i3_u = UBOUND(SrcInitInputData%SoilStiffness,3) - IF (.NOT. ALLOCATED(DstInitInputData%SoilStiffness)) THEN - ALLOCATE(DstInitInputData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness -ENDIF - CALL MeshCopy( SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE SD_CopyInitInput - - SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitInputData%SoilStiffness)) THEN - DEALLOCATE(InitInputData%SoilStiffness) -ENDIF - CALL MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SD_DestroyInitInput - - SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%SDInputFile) ! SDInputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Int_BufSz = Int_BufSz + 1 ! SoilStiffness allocated yes/no - IF ( ALLOCATED(InData%SoilStiffness) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SoilStiffness upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SoilStiffness) ! SoilStiffness - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%SDInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SoilStiffness) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SoilStiffness,3), UBOUND(InData%SoilStiffness,3) - DO i2 = LBOUND(InData%SoilStiffness,2), UBOUND(InData%SoilStiffness,2) - DO i1 = LBOUND(InData%SoilStiffness,1), UBOUND(InData%SoilStiffness,1) - ReKiBuf(Re_Xferred) = InData%SoilStiffness(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitInput - - SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%SDInputFile) - OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SoilStiffness not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SoilStiffness)) DEALLOCATE(OutData%SoilStiffness) - ALLOCATE(OutData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SoilStiffness,3), UBOUND(OutData%SoilStiffness,3) - DO i2 = LBOUND(OutData%SoilStiffness,2), UBOUND(OutData%SoilStiffness,2) - DO i1 = LBOUND(OutData%SoilStiffness,1), UBOUND(OutData%SoilStiffness,1) - OutData%SoilStiffness(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitInput - - SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF - END SUBROUTINE SD_CopyInitOutput - - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -ENDIF - END SUBROUTINE SD_DestroyInitOutput - - SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInitOutput - - SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInitOutput - - SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData - TYPE(SD_InitType), INTENT(INOUT) :: DstInitTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitTypeData%RootName = SrcInitTypeData%RootName - DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint - DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ - DstInitTypeData%g = SrcInitTypeData%g - DstInitTypeData%DT = SrcInitTypeData%DT - DstInitTypeData%NJoints = SrcInitTypeData%NJoints - DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX - DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB - DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC - DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR - DstInitTypeData%NPropSetsS = SrcInitTypeData%NPropSetsS - DstInitTypeData%NCMass = SrcInitTypeData%NCMass - DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs - DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod - DstInitTypeData%NDiv = SrcInitTypeData%NDiv - DstInitTypeData%CBMod = SrcInitTypeData%CBMod -IF (ALLOCATED(SrcInitTypeData%Joints)) THEN - i1_l = LBOUND(SrcInitTypeData%Joints,1) - i1_u = UBOUND(SrcInitTypeData%Joints,1) - i2_l = LBOUND(SrcInitTypeData%Joints,2) - i2_u = UBOUND(SrcInitTypeData%Joints,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Joints)) THEN - ALLOCATE(DstInitTypeData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Joints = SrcInitTypeData%Joints -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsB,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsB,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsB,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsB)) THEN - ALLOCATE(DstInitTypeData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsC,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsC,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsC,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsC)) THEN - ALLOCATE(DstInitTypeData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsR,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsR,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsR,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsR)) THEN - ALLOCATE(DstInitTypeData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsS)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsS,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsS,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsS,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsS,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsS)) THEN - ALLOCATE(DstInitTypeData%PropSetsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsS = SrcInitTypeData%PropSetsS -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsX)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsX,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsX,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsX,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsX,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsX)) THEN - ALLOCATE(DstInitTypeData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX -ENDIF -IF (ALLOCATED(SrcInitTypeData%COSMs)) THEN - i1_l = LBOUND(SrcInitTypeData%COSMs,1) - i1_u = UBOUND(SrcInitTypeData%COSMs,1) - i2_l = LBOUND(SrcInitTypeData%COSMs,2) - i2_u = UBOUND(SrcInitTypeData%COSMs,2) - IF (.NOT. ALLOCATED(DstInitTypeData%COSMs)) THEN - ALLOCATE(DstInitTypeData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%COSMs = SrcInitTypeData%COSMs -ENDIF -IF (ALLOCATED(SrcInitTypeData%CMass)) THEN - i1_l = LBOUND(SrcInitTypeData%CMass,1) - i1_u = UBOUND(SrcInitTypeData%CMass,1) - i2_l = LBOUND(SrcInitTypeData%CMass,2) - i2_u = UBOUND(SrcInitTypeData%CMass,2) - IF (.NOT. ALLOCATED(DstInitTypeData%CMass)) THEN - ALLOCATE(DstInitTypeData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%CMass = SrcInitTypeData%CMass -ENDIF -IF (ALLOCATED(SrcInitTypeData%JDampings)) THEN - i1_l = LBOUND(SrcInitTypeData%JDampings,1) - i1_u = UBOUND(SrcInitTypeData%JDampings,1) - IF (.NOT. ALLOCATED(DstInitTypeData%JDampings)) THEN - ALLOCATE(DstInitTypeData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%JDampings = SrcInitTypeData%JDampings -ENDIF - DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod - DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp - DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat -IF (ALLOCATED(SrcInitTypeData%Members)) THEN - i1_l = LBOUND(SrcInitTypeData%Members,1) - i1_u = UBOUND(SrcInitTypeData%Members,1) - i2_l = LBOUND(SrcInitTypeData%Members,2) - i2_u = UBOUND(SrcInitTypeData%Members,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Members)) THEN - ALLOCATE(DstInitTypeData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Members = SrcInitTypeData%Members -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSOutList)) THEN - i1_l = LBOUND(SrcInitTypeData%SSOutList,1) - i1_u = UBOUND(SrcInitTypeData%SSOutList,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSOutList)) THEN - ALLOCATE(DstInitTypeData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList -ENDIF - DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM - DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim -IF (ALLOCATED(SrcInitTypeData%SSIK)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIK,1) - i1_u = UBOUND(SrcInitTypeData%SSIK,1) - i2_l = LBOUND(SrcInitTypeData%SSIK,2) - i2_u = UBOUND(SrcInitTypeData%SSIK,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIK)) THEN - ALLOCATE(DstInitTypeData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIK = SrcInitTypeData%SSIK -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIM)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIM,1) - i1_u = UBOUND(SrcInitTypeData%SSIM,1) - i2_l = LBOUND(SrcInitTypeData%SSIM,2) - i2_u = UBOUND(SrcInitTypeData%SSIM,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIM)) THEN - ALLOCATE(DstInitTypeData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIM = SrcInitTypeData%SSIM -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIfile)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIfile,1) - i1_u = UBOUND(SrcInitTypeData%SSIfile,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIfile)) THEN - ALLOCATE(DstInitTypeData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_K)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_K,1) - i1_u = UBOUND(SrcInitTypeData%Soil_K,1) - i2_l = LBOUND(SrcInitTypeData%Soil_K,2) - i2_u = UBOUND(SrcInitTypeData%Soil_K,2) - i3_l = LBOUND(SrcInitTypeData%Soil_K,3) - i3_u = UBOUND(SrcInitTypeData%Soil_K,3) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_K)) THEN - ALLOCATE(DstInitTypeData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Points)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Points,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Points,1) - i2_l = LBOUND(SrcInitTypeData%Soil_Points,2) - i2_u = UBOUND(SrcInitTypeData%Soil_Points,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Points)) THEN - ALLOCATE(DstInitTypeData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Nodes,1) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Nodes)) THEN - ALLOCATE(DstInitTypeData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes -ENDIF - DstInitTypeData%NElem = SrcInitTypeData%NElem - DstInitTypeData%NPropB = SrcInitTypeData%NPropB - DstInitTypeData%NPropC = SrcInitTypeData%NPropC - DstInitTypeData%NPropR = SrcInitTypeData%NPropR - DstInitTypeData%NPropS = SrcInitTypeData%NPropS -IF (ALLOCATED(SrcInitTypeData%Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Nodes,1) - i2_l = LBOUND(SrcInitTypeData%Nodes,2) - i2_u = UBOUND(SrcInitTypeData%Nodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Nodes)) THEN - ALLOCATE(DstInitTypeData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Nodes = SrcInitTypeData%Nodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsB,1) - i1_u = UBOUND(SrcInitTypeData%PropsB,1) - i2_l = LBOUND(SrcInitTypeData%PropsB,2) - i2_u = UBOUND(SrcInitTypeData%PropsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsB)) THEN - ALLOCATE(DstInitTypeData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsB = SrcInitTypeData%PropsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsC,1) - i1_u = UBOUND(SrcInitTypeData%PropsC,1) - i2_l = LBOUND(SrcInitTypeData%PropsC,2) - i2_u = UBOUND(SrcInitTypeData%PropsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsC)) THEN - ALLOCATE(DstInitTypeData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsC = SrcInitTypeData%PropsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsR,1) - i1_u = UBOUND(SrcInitTypeData%PropsR,1) - i2_l = LBOUND(SrcInitTypeData%PropsR,2) - i2_u = UBOUND(SrcInitTypeData%PropsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsR)) THEN - ALLOCATE(DstInitTypeData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsR = SrcInitTypeData%PropsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsS)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsR,1) - i1_u = UBOUND(SrcInitTypeData%PropsR,1) - i2_l = LBOUND(SrcInitTypeData%PropsR,2) - i2_u = UBOUND(SrcInitTypeData%PropsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsS)) THEN - ALLOCATE(DstInitTypeData%PropsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsS = SrcInitTypeData%PropsS -ENDIF -IF (ALLOCATED(SrcInitTypeData%K)) THEN - i1_l = LBOUND(SrcInitTypeData%K,1) - i1_u = UBOUND(SrcInitTypeData%K,1) - i2_l = LBOUND(SrcInitTypeData%K,2) - i2_u = UBOUND(SrcInitTypeData%K,2) - IF (.NOT. ALLOCATED(DstInitTypeData%K)) THEN - ALLOCATE(DstInitTypeData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%K = SrcInitTypeData%K -ENDIF -IF (ALLOCATED(SrcInitTypeData%M)) THEN - i1_l = LBOUND(SrcInitTypeData%M,1) - i1_u = UBOUND(SrcInitTypeData%M,1) - i2_l = LBOUND(SrcInitTypeData%M,2) - i2_u = UBOUND(SrcInitTypeData%M,2) - IF (.NOT. ALLOCATED(DstInitTypeData%M)) THEN - ALLOCATE(DstInitTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%M = SrcInitTypeData%M -ENDIF -IF (ALLOCATED(SrcInitTypeData%ElemProps)) THEN - i1_l = LBOUND(SrcInitTypeData%ElemProps,1) - i1_u = UBOUND(SrcInitTypeData%ElemProps,1) - i2_l = LBOUND(SrcInitTypeData%ElemProps,2) - i2_u = UBOUND(SrcInitTypeData%ElemProps,2) - IF (.NOT. ALLOCATED(DstInitTypeData%ElemProps)) THEN - ALLOCATE(DstInitTypeData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps -ENDIF -IF (ALLOCATED(SrcInitTypeData%MemberNodes)) THEN - i1_l = LBOUND(SrcInitTypeData%MemberNodes,1) - i1_u = UBOUND(SrcInitTypeData%MemberNodes,1) - i2_l = LBOUND(SrcInitTypeData%MemberNodes,2) - i2_u = UBOUND(SrcInitTypeData%MemberNodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%MemberNodes)) THEN - ALLOCATE(DstInitTypeData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnN)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnN,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnN,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnN,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnN,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnN)) THEN - ALLOCATE(DstInitTypeData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnE)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnE,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnE,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnE,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnE,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnE)) THEN - ALLOCATE(DstInitTypeData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE -ENDIF - DstInitTypeData%SSSum = SrcInitTypeData%SSSum - END SUBROUTINE SD_CopyInitType - - SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(InitTypeData%Joints)) THEN - DEALLOCATE(InitTypeData%Joints) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsB)) THEN - DEALLOCATE(InitTypeData%PropSetsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsC)) THEN - DEALLOCATE(InitTypeData%PropSetsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsR)) THEN - DEALLOCATE(InitTypeData%PropSetsR) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsS)) THEN - DEALLOCATE(InitTypeData%PropSetsS) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsX)) THEN - DEALLOCATE(InitTypeData%PropSetsX) -ENDIF -IF (ALLOCATED(InitTypeData%COSMs)) THEN - DEALLOCATE(InitTypeData%COSMs) -ENDIF -IF (ALLOCATED(InitTypeData%CMass)) THEN - DEALLOCATE(InitTypeData%CMass) -ENDIF -IF (ALLOCATED(InitTypeData%JDampings)) THEN - DEALLOCATE(InitTypeData%JDampings) -ENDIF -IF (ALLOCATED(InitTypeData%Members)) THEN - DEALLOCATE(InitTypeData%Members) -ENDIF -IF (ALLOCATED(InitTypeData%SSOutList)) THEN - DEALLOCATE(InitTypeData%SSOutList) -ENDIF -IF (ALLOCATED(InitTypeData%SSIK)) THEN - DEALLOCATE(InitTypeData%SSIK) -ENDIF -IF (ALLOCATED(InitTypeData%SSIM)) THEN - DEALLOCATE(InitTypeData%SSIM) -ENDIF -IF (ALLOCATED(InitTypeData%SSIfile)) THEN - DEALLOCATE(InitTypeData%SSIfile) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_K)) THEN - DEALLOCATE(InitTypeData%Soil_K) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Points)) THEN - DEALLOCATE(InitTypeData%Soil_Points) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Nodes)) THEN - DEALLOCATE(InitTypeData%Soil_Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%Nodes)) THEN - DEALLOCATE(InitTypeData%Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%PropsB)) THEN - DEALLOCATE(InitTypeData%PropsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropsC)) THEN - DEALLOCATE(InitTypeData%PropsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropsR)) THEN - DEALLOCATE(InitTypeData%PropsR) -ENDIF -IF (ALLOCATED(InitTypeData%PropsS)) THEN - DEALLOCATE(InitTypeData%PropsS) -ENDIF -IF (ALLOCATED(InitTypeData%K)) THEN - DEALLOCATE(InitTypeData%K) -ENDIF -IF (ALLOCATED(InitTypeData%M)) THEN - DEALLOCATE(InitTypeData%M) -ENDIF -IF (ALLOCATED(InitTypeData%ElemProps)) THEN - DEALLOCATE(InitTypeData%ElemProps) -ENDIF -IF (ALLOCATED(InitTypeData%MemberNodes)) THEN - DEALLOCATE(InitTypeData%MemberNodes) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnN)) THEN - DEALLOCATE(InitTypeData%NodesConnN) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnE)) THEN - DEALLOCATE(InitTypeData%NodesConnE) -ENDIF - END SUBROUTINE SD_DestroyInitType - - SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Re_BufSz = Re_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NPropSetsX - Int_BufSz = Int_BufSz + 1 ! NPropSetsB - Int_BufSz = Int_BufSz + 1 ! NPropSetsC - Int_BufSz = Int_BufSz + 1 ! NPropSetsR - Int_BufSz = Int_BufSz + 1 ! NPropSetsS - Int_BufSz = Int_BufSz + 1 ! NCMass - Int_BufSz = Int_BufSz + 1 ! NCOSMs - Int_BufSz = Int_BufSz + 1 ! FEMMod - Int_BufSz = Int_BufSz + 1 ! NDiv - Int_BufSz = Int_BufSz + 1 ! CBMod - Int_BufSz = Int_BufSz + 1 ! Joints allocated yes/no - IF ( ALLOCATED(InData%Joints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Joints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Joints) ! Joints - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsB allocated yes/no - IF ( ALLOCATED(InData%PropSetsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsB) ! PropSetsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsC allocated yes/no - IF ( ALLOCATED(InData%PropSetsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsC) ! PropSetsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsR allocated yes/no - IF ( ALLOCATED(InData%PropSetsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsR) ! PropSetsR - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsS allocated yes/no - IF ( ALLOCATED(InData%PropSetsS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsS) ! PropSetsS - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsX allocated yes/no - IF ( ALLOCATED(InData%PropSetsX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsX) ! PropSetsX - END IF - Int_BufSz = Int_BufSz + 1 ! COSMs allocated yes/no - IF ( ALLOCATED(InData%COSMs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! COSMs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%COSMs) ! COSMs - END IF - Int_BufSz = Int_BufSz + 1 ! CMass allocated yes/no - IF ( ALLOCATED(InData%CMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMass) ! CMass - END IF - Int_BufSz = Int_BufSz + 1 ! JDampings allocated yes/no - IF ( ALLOCATED(InData%JDampings) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JDampings upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%JDampings) ! JDampings - END IF - Int_BufSz = Int_BufSz + 1 ! GuyanDampMod - Re_BufSz = Re_BufSz + SIZE(InData%RayleighDamp) ! RayleighDamp - Re_BufSz = Re_BufSz + SIZE(InData%GuyanDampMat) ! GuyanDampMat - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Members upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Members) ! Members - END IF - Int_BufSz = Int_BufSz + 1 ! SSOutList allocated yes/no - IF ( ALLOCATED(InData%SSOutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSOutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSOutList)*LEN(InData%SSOutList) ! SSOutList - END IF - Int_BufSz = Int_BufSz + 1 ! OutCOSM - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1 ! SSIK allocated yes/no - IF ( ALLOCATED(InData%SSIK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIK) ! SSIK - END IF - Int_BufSz = Int_BufSz + 1 ! SSIM allocated yes/no - IF ( ALLOCATED(InData%SSIM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIM) ! SSIM - END IF - Int_BufSz = Int_BufSz + 1 ! SSIfile allocated yes/no - IF ( ALLOCATED(InData%SSIfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSIfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSIfile)*LEN(InData%SSIfile) ! SSIfile - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_K allocated yes/no - IF ( ALLOCATED(InData%Soil_K) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Soil_K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_K) ! Soil_K - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Points allocated yes/no - IF ( ALLOCATED(InData%Soil_Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Soil_Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_Points) ! Soil_Points - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Nodes allocated yes/no - IF ( ALLOCATED(InData%Soil_Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Soil_Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Soil_Nodes) ! Soil_Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! NElem - Int_BufSz = Int_BufSz + 1 ! NPropB - Int_BufSz = Int_BufSz + 1 ! NPropC - Int_BufSz = Int_BufSz + 1 ! NPropR - Int_BufSz = Int_BufSz + 1 ! NPropS - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nodes) ! Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! PropsB allocated yes/no - IF ( ALLOCATED(InData%PropsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsB) ! PropsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropsC allocated yes/no - IF ( ALLOCATED(InData%PropsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsC) ! PropsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropsR allocated yes/no - IF ( ALLOCATED(InData%PropsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsR) ! PropsR - END IF - Int_BufSz = Int_BufSz + 1 ! PropsS allocated yes/no - IF ( ALLOCATED(InData%PropsS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsS) ! PropsS - END IF - Int_BufSz = Int_BufSz + 1 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%K) ! K - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemProps upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElemProps) ! ElemProps - END IF - Int_BufSz = Int_BufSz + 1 ! MemberNodes allocated yes/no - IF ( ALLOCATED(InData%MemberNodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MemberNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberNodes) ! MemberNodes - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnN allocated yes/no - IF ( ALLOCATED(InData%NodesConnN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnN) ! NodesConnN - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnE allocated yes/no - IF ( ALLOCATED(InData%NodesConnE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnE) ! NodesConnE - END IF - Int_BufSz = Int_BufSz + 1 ! SSSum - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsX - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsR - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsS - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Joints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) - DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) - ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsB,2), UBOUND(InData%PropSetsB,2) - DO i1 = LBOUND(InData%PropSetsB,1), UBOUND(InData%PropSetsB,1) - ReKiBuf(Re_Xferred) = InData%PropSetsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsC,2), UBOUND(InData%PropSetsC,2) - DO i1 = LBOUND(InData%PropSetsC,1), UBOUND(InData%PropSetsC,1) - ReKiBuf(Re_Xferred) = InData%PropSetsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsR,2), UBOUND(InData%PropSetsR,2) - DO i1 = LBOUND(InData%PropSetsR,1), UBOUND(InData%PropSetsR,1) - ReKiBuf(Re_Xferred) = InData%PropSetsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsS,2), UBOUND(InData%PropSetsS,2) - DO i1 = LBOUND(InData%PropSetsS,1), UBOUND(InData%PropSetsS,1) - ReKiBuf(Re_Xferred) = InData%PropSetsS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsX,2), UBOUND(InData%PropSetsX,2) - DO i1 = LBOUND(InData%PropSetsX,1), UBOUND(InData%PropSetsX,1) - ReKiBuf(Re_Xferred) = InData%PropSetsX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) - DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) - DbKiBuf(Db_Xferred) = InData%COSMs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) - DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) - ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JDampings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) - ReKiBuf(Re_Xferred) = InData%JDampings(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%GuyanDampMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RayleighDamp,1), UBOUND(InData%RayleighDamp,1) - ReKiBuf(Re_Xferred) = InData%RayleighDamp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GuyanDampMat,2), UBOUND(InData%GuyanDampMat,2) - DO i1 = LBOUND(InData%GuyanDampMat,1), UBOUND(InData%GuyanDampMat,1) - ReKiBuf(Re_Xferred) = InData%GuyanDampMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%Members) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - IntKiBuf(Int_Xferred) = InData%Members(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSOutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) - DO I = 1, LEN(InData%SSOutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SSIK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIK,2), UBOUND(InData%SSIK,2) - DO i1 = LBOUND(InData%SSIK,1), UBOUND(InData%SSIK,1) - DbKiBuf(Db_Xferred) = InData%SSIK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIM,2), UBOUND(InData%SSIM,2) - DO i1 = LBOUND(InData%SSIM,1), UBOUND(InData%SSIM,1) - DbKiBuf(Db_Xferred) = InData%SSIM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIfile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSIfile,1), UBOUND(InData%SSIfile,1) - DO I = 1, LEN(InData%SSIfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSIfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Soil_K,3), UBOUND(InData%Soil_K,3) - DO i2 = LBOUND(InData%Soil_K,2), UBOUND(InData%Soil_K,2) - DO i1 = LBOUND(InData%Soil_K,1), UBOUND(InData%Soil_K,1) - ReKiBuf(Re_Xferred) = InData%Soil_K(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Points) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Soil_Points,2), UBOUND(InData%Soil_Points,2) - DO i1 = LBOUND(InData%Soil_Points,1), UBOUND(InData%Soil_Points,1) - ReKiBuf(Re_Xferred) = InData%Soil_Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Nodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Soil_Nodes,1), UBOUND(InData%Soil_Nodes,1) - IntKiBuf(Int_Xferred) = InData%Soil_Nodes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropR - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropS - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsB,2), UBOUND(InData%PropsB,2) - DO i1 = LBOUND(InData%PropsB,1), UBOUND(InData%PropsB,1) - ReKiBuf(Re_Xferred) = InData%PropsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsC,2), UBOUND(InData%PropsC,2) - DO i1 = LBOUND(InData%PropsC,1), UBOUND(InData%PropsC,1) - ReKiBuf(Re_Xferred) = InData%PropsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsR,2), UBOUND(InData%PropsR,2) - DO i1 = LBOUND(InData%PropsR,1), UBOUND(InData%PropsR,1) - ReKiBuf(Re_Xferred) = InData%PropsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsS,2), UBOUND(InData%PropsS,2) - DO i1 = LBOUND(InData%PropsS,1), UBOUND(InData%PropsS,1) - ReKiBuf(Re_Xferred) = InData%PropsS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) - DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) - DbKiBuf(Db_Xferred) = InData%K(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) - DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) - IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) - DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) - IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) - DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) - IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitType - - SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsX = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsS = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Joints)) DEALLOCATE(OutData%Joints) - ALLOCATE(OutData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) - DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) - OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsB)) DEALLOCATE(OutData%PropSetsB) - ALLOCATE(OutData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsB,2), UBOUND(OutData%PropSetsB,2) - DO i1 = LBOUND(OutData%PropSetsB,1), UBOUND(OutData%PropSetsB,1) - OutData%PropSetsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsC)) DEALLOCATE(OutData%PropSetsC) - ALLOCATE(OutData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsC,2), UBOUND(OutData%PropSetsC,2) - DO i1 = LBOUND(OutData%PropSetsC,1), UBOUND(OutData%PropSetsC,1) - OutData%PropSetsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsR)) DEALLOCATE(OutData%PropSetsR) - ALLOCATE(OutData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsR,2), UBOUND(OutData%PropSetsR,2) - DO i1 = LBOUND(OutData%PropSetsR,1), UBOUND(OutData%PropSetsR,1) - OutData%PropSetsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsS)) DEALLOCATE(OutData%PropSetsS) - ALLOCATE(OutData%PropSetsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsS,2), UBOUND(OutData%PropSetsS,2) - DO i1 = LBOUND(OutData%PropSetsS,1), UBOUND(OutData%PropSetsS,1) - OutData%PropSetsS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsX)) DEALLOCATE(OutData%PropSetsX) - ALLOCATE(OutData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsX,2), UBOUND(OutData%PropSetsX,2) - DO i1 = LBOUND(OutData%PropSetsX,1), UBOUND(OutData%PropSetsX,1) - OutData%PropSetsX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%COSMs)) DEALLOCATE(OutData%COSMs) - ALLOCATE(OutData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) - DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) - OutData%COSMs(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMass)) DEALLOCATE(OutData%CMass) - ALLOCATE(OutData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) - DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) - OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%JDampings)) DEALLOCATE(OutData%JDampings) - ALLOCATE(OutData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) - OutData%JDampings(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GuyanDampMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RayleighDamp,1) - i1_u = UBOUND(OutData%RayleighDamp,1) - DO i1 = LBOUND(OutData%RayleighDamp,1), UBOUND(OutData%RayleighDamp,1) - OutData%RayleighDamp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GuyanDampMat,1) - i1_u = UBOUND(OutData%GuyanDampMat,1) - i2_l = LBOUND(OutData%GuyanDampMat,2) - i2_u = UBOUND(OutData%GuyanDampMat,2) - DO i2 = LBOUND(OutData%GuyanDampMat,2), UBOUND(OutData%GuyanDampMat,2) - DO i1 = LBOUND(OutData%GuyanDampMat,1), UBOUND(OutData%GuyanDampMat,1) - OutData%GuyanDampMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) - OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSOutList)) DEALLOCATE(OutData%SSOutList) - ALLOCATE(OutData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) - DO I = 1, LEN(OutData%SSOutList) - OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIK not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIK)) DEALLOCATE(OutData%SSIK) - ALLOCATE(OutData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIK,2), UBOUND(OutData%SSIK,2) - DO i1 = LBOUND(OutData%SSIK,1), UBOUND(OutData%SSIK,1) - OutData%SSIK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIM)) DEALLOCATE(OutData%SSIM) - ALLOCATE(OutData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIM,2), UBOUND(OutData%SSIM,2) - DO i1 = LBOUND(OutData%SSIM,1), UBOUND(OutData%SSIM,1) - OutData%SSIM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIfile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIfile)) DEALLOCATE(OutData%SSIfile) - ALLOCATE(OutData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSIfile,1), UBOUND(OutData%SSIfile,1) - DO I = 1, LEN(OutData%SSIfile) - OutData%SSIfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_K)) DEALLOCATE(OutData%Soil_K) - ALLOCATE(OutData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Soil_K,3), UBOUND(OutData%Soil_K,3) - DO i2 = LBOUND(OutData%Soil_K,2), UBOUND(OutData%Soil_K,2) - DO i1 = LBOUND(OutData%Soil_K,1), UBOUND(OutData%Soil_K,1) - OutData%Soil_K(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Points not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_Points)) DEALLOCATE(OutData%Soil_Points) - ALLOCATE(OutData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Soil_Points,2), UBOUND(OutData%Soil_Points,2) - DO i1 = LBOUND(OutData%Soil_Points,1), UBOUND(OutData%Soil_Points,1) - OutData%Soil_Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_Nodes)) DEALLOCATE(OutData%Soil_Nodes) - ALLOCATE(OutData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Soil_Nodes,1), UBOUND(OutData%Soil_Nodes,1) - OutData%Soil_Nodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropS = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) - OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsB)) DEALLOCATE(OutData%PropsB) - ALLOCATE(OutData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsB,2), UBOUND(OutData%PropsB,2) - DO i1 = LBOUND(OutData%PropsB,1), UBOUND(OutData%PropsB,1) - OutData%PropsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsC)) DEALLOCATE(OutData%PropsC) - ALLOCATE(OutData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsC,2), UBOUND(OutData%PropsC,2) - DO i1 = LBOUND(OutData%PropsC,1), UBOUND(OutData%PropsC,1) - OutData%PropsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsR)) DEALLOCATE(OutData%PropsR) - ALLOCATE(OutData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsR,2), UBOUND(OutData%PropsR,2) - DO i1 = LBOUND(OutData%PropsR,1), UBOUND(OutData%PropsR,1) - OutData%PropsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsS)) DEALLOCATE(OutData%PropsS) - ALLOCATE(OutData%PropsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsS,2), UBOUND(OutData%PropsS,2) - DO i1 = LBOUND(OutData%PropsS,1), UBOUND(OutData%PropsS,1) - OutData%PropsS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K)) DEALLOCATE(OutData%K) - ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) - DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) - OutData%K(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MemberNodes)) DEALLOCATE(OutData%MemberNodes) - ALLOCATE(OutData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) - DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) - OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesConnN)) DEALLOCATE(OutData%NodesConnN) - ALLOCATE(OutData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) - DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) - OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesConnE)) DEALLOCATE(OutData%NodesConnE) - ALLOCATE(OutData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) - DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) - OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitType - - SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%qm)) THEN - i1_l = LBOUND(SrcContStateData%qm,1) - i1_u = UBOUND(SrcContStateData%qm,1) - IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN - ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qm = SrcContStateData%qm -ENDIF -IF (ALLOCATED(SrcContStateData%qmdot)) THEN - i1_l = LBOUND(SrcContStateData%qmdot,1) - i1_u = UBOUND(SrcContStateData%qmdot,1) - IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN - ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qmdot = SrcContStateData%qmdot -ENDIF - END SUBROUTINE SD_CopyContState - - SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE SD_DestroyContState - - SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no - IF ( ALLOCATED(InData%qm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qm) ! qm - END IF - Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no - IF ( ALLOCATED(InData%qmdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qmdot) ! qmdot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) - DbKiBuf(Db_Xferred) = InData%qm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) - DbKiBuf(Db_Xferred) = InData%qmdot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackContState - - SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qm)) DEALLOCATE(OutData%qm) - ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) - OutData%qm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdot)) DEALLOCATE(OutData%qmdot) - ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) - OutData%qmdot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackContState - - SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SD_CopyDiscState - - SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SD_DestroyDiscState - - SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_PackDiscState - - SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackDiscState - - SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SD_CopyConstrState - - SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - END SUBROUTINE SD_DestroyConstrState - - SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_PackConstrState - - SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackConstrState - - SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE SD_CopyOtherState - - SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE SD_DestroyOtherState - - SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackOtherState - - SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackOtherState - - SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%qmdotdot)) THEN - i1_l = LBOUND(SrcMiscData%qmdotdot,1) - i1_u = UBOUND(SrcMiscData%qmdotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%qmdotdot)) THEN - ALLOCATE(DstMiscData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%qmdotdot = SrcMiscData%qmdotdot -ENDIF - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP -IF (ALLOCATED(SrcMiscData%F_L)) THEN - i1_l = LBOUND(SrcMiscData%F_L,1) - i1_u = UBOUND(SrcMiscData%F_L,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L)) THEN - ALLOCATE(DstMiscData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L = SrcMiscData%F_L -ENDIF -IF (ALLOCATED(SrcMiscData%F_L2)) THEN - i1_l = LBOUND(SrcMiscData%F_L2,1) - i1_u = UBOUND(SrcMiscData%F_L2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L2)) THEN - ALLOCATE(DstMiscData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L2 = SrcMiscData%F_L2 -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar,1) - i1_u = UBOUND(SrcMiscData%UR_bar,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar)) THEN - ALLOCATE(DstMiscData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar = SrcMiscData%UR_bar -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dot)) THEN - ALLOCATE(DstMiscData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dotdot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dotdot)) THEN - ALLOCATE(DstMiscData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%UL)) THEN - i1_l = LBOUND(SrcMiscData%UL,1) - i1_u = UBOUND(SrcMiscData%UL,1) - IF (.NOT. ALLOCATED(DstMiscData%UL)) THEN - ALLOCATE(DstMiscData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL = SrcMiscData%UL -ENDIF -IF (ALLOCATED(SrcMiscData%UL_NS)) THEN - i1_l = LBOUND(SrcMiscData%UL_NS,1) - i1_u = UBOUND(SrcMiscData%UL_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_NS)) THEN - ALLOCATE(DstMiscData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_NS = SrcMiscData%UL_NS -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dot,1) - i1_u = UBOUND(SrcMiscData%UL_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dot)) THEN - ALLOCATE(DstMiscData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dot = SrcMiscData%UL_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dotdot,1) - i1_u = UBOUND(SrcMiscData%UL_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dotdot)) THEN - ALLOCATE(DstMiscData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%DU_full)) THEN - i1_l = LBOUND(SrcMiscData%DU_full,1) - i1_u = UBOUND(SrcMiscData%DU_full,1) - IF (.NOT. ALLOCATED(DstMiscData%DU_full)) THEN - ALLOCATE(DstMiscData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DU_full = SrcMiscData%DU_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full)) THEN - i1_l = LBOUND(SrcMiscData%U_full,1) - i1_u = UBOUND(SrcMiscData%U_full,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full)) THEN - ALLOCATE(DstMiscData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full = SrcMiscData%U_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_NS)) THEN - i1_l = LBOUND(SrcMiscData%U_full_NS,1) - i1_u = UBOUND(SrcMiscData%U_full_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_NS)) THEN - ALLOCATE(DstMiscData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_NS = SrcMiscData%U_full_NS -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dot,1) - i1_u = UBOUND(SrcMiscData%U_full_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dot)) THEN - ALLOCATE(DstMiscData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dot = SrcMiscData%U_full_dot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dotdot,1) - i1_u = UBOUND(SrcMiscData%U_full_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dotdot)) THEN - ALLOCATE(DstMiscData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_elast)) THEN - i1_l = LBOUND(SrcMiscData%U_full_elast,1) - i1_u = UBOUND(SrcMiscData%U_full_elast,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_elast)) THEN - ALLOCATE(DstMiscData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_elast = SrcMiscData%U_full_elast -ENDIF -IF (ALLOCATED(SrcMiscData%U_red)) THEN - i1_l = LBOUND(SrcMiscData%U_red,1) - i1_u = UBOUND(SrcMiscData%U_red,1) - IF (.NOT. ALLOCATED(DstMiscData%U_red)) THEN - ALLOCATE(DstMiscData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_red = SrcMiscData%U_red -ENDIF -IF (ALLOCATED(SrcMiscData%FC_unit)) THEN - i1_l = LBOUND(SrcMiscData%FC_unit,1) - i1_u = UBOUND(SrcMiscData%FC_unit,1) - IF (.NOT. ALLOCATED(DstMiscData%FC_unit)) THEN - ALLOCATE(DstMiscData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FC_unit = SrcMiscData%FC_unit -ENDIF -IF (ALLOCATED(SrcMiscData%SDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%SDWrOutput,1) - i1_u = UBOUND(SrcMiscData%SDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%SDWrOutput)) THEN - ALLOCATE(DstMiscData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput -ENDIF -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat -IF (ALLOCATED(SrcMiscData%Fext)) THEN - i1_l = LBOUND(SrcMiscData%Fext,1) - i1_u = UBOUND(SrcMiscData%Fext,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext)) THEN - ALLOCATE(DstMiscData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext = SrcMiscData%Fext -ENDIF -IF (ALLOCATED(SrcMiscData%Fext_red)) THEN - i1_l = LBOUND(SrcMiscData%Fext_red,1) - i1_u = UBOUND(SrcMiscData%Fext_red,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext_red)) THEN - ALLOCATE(DstMiscData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext_red = SrcMiscData%Fext_red -ENDIF -IF (ALLOCATED(SrcMiscData%UL_SIM)) THEN - i1_l = LBOUND(SrcMiscData%UL_SIM,1) - i1_u = UBOUND(SrcMiscData%UL_SIM,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_SIM)) THEN - ALLOCATE(DstMiscData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_SIM = SrcMiscData%UL_SIM -ENDIF -IF (ALLOCATED(SrcMiscData%UL_0m)) THEN - i1_l = LBOUND(SrcMiscData%UL_0m,1) - i1_u = UBOUND(SrcMiscData%UL_0m,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_0m)) THEN - ALLOCATE(DstMiscData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_0m = SrcMiscData%UL_0m -ENDIF - END SUBROUTINE SD_CopyMisc - - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(MiscData%qmdotdot)) THEN - DEALLOCATE(MiscData%qmdotdot) -ENDIF -IF (ALLOCATED(MiscData%F_L)) THEN - DEALLOCATE(MiscData%F_L) -ENDIF -IF (ALLOCATED(MiscData%F_L2)) THEN - DEALLOCATE(MiscData%F_L2) -ENDIF -IF (ALLOCATED(MiscData%UR_bar)) THEN - DEALLOCATE(MiscData%UR_bar) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dot)) THEN - DEALLOCATE(MiscData%UR_bar_dot) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dotdot)) THEN - DEALLOCATE(MiscData%UR_bar_dotdot) -ENDIF -IF (ALLOCATED(MiscData%UL)) THEN - DEALLOCATE(MiscData%UL) -ENDIF -IF (ALLOCATED(MiscData%UL_NS)) THEN - DEALLOCATE(MiscData%UL_NS) -ENDIF -IF (ALLOCATED(MiscData%UL_dot)) THEN - DEALLOCATE(MiscData%UL_dot) -ENDIF -IF (ALLOCATED(MiscData%UL_dotdot)) THEN - DEALLOCATE(MiscData%UL_dotdot) -ENDIF -IF (ALLOCATED(MiscData%DU_full)) THEN - DEALLOCATE(MiscData%DU_full) -ENDIF -IF (ALLOCATED(MiscData%U_full)) THEN - DEALLOCATE(MiscData%U_full) -ENDIF -IF (ALLOCATED(MiscData%U_full_NS)) THEN - DEALLOCATE(MiscData%U_full_NS) -ENDIF -IF (ALLOCATED(MiscData%U_full_dot)) THEN - DEALLOCATE(MiscData%U_full_dot) -ENDIF -IF (ALLOCATED(MiscData%U_full_dotdot)) THEN - DEALLOCATE(MiscData%U_full_dotdot) -ENDIF -IF (ALLOCATED(MiscData%U_full_elast)) THEN - DEALLOCATE(MiscData%U_full_elast) -ENDIF -IF (ALLOCATED(MiscData%U_red)) THEN - DEALLOCATE(MiscData%U_red) -ENDIF -IF (ALLOCATED(MiscData%FC_unit)) THEN - DEALLOCATE(MiscData%FC_unit) -ENDIF -IF (ALLOCATED(MiscData%SDWrOutput)) THEN - DEALLOCATE(MiscData%SDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%Fext)) THEN - DEALLOCATE(MiscData%Fext) -ENDIF -IF (ALLOCATED(MiscData%Fext_red)) THEN - DEALLOCATE(MiscData%Fext_red) -ENDIF -IF (ALLOCATED(MiscData%UL_SIM)) THEN - DEALLOCATE(MiscData%UL_SIM) -ENDIF -IF (ALLOCATED(MiscData%UL_0m)) THEN - DEALLOCATE(MiscData%UL_0m) -ENDIF - END SUBROUTINE SD_DestroyMisc - - SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qmdotdot allocated yes/no - IF ( ALLOCATED(InData%qmdotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qmdotdot) ! qmdotdot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%u_TP) ! u_TP - Re_BufSz = Re_BufSz + SIZE(InData%udot_TP) ! udot_TP - Re_BufSz = Re_BufSz + SIZE(InData%udotdot_TP) ! udotdot_TP - Int_BufSz = Int_BufSz + 1 ! F_L allocated yes/no - IF ( ALLOCATED(InData%F_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L) ! F_L - END IF - Int_BufSz = Int_BufSz + 1 ! F_L2 allocated yes/no - IF ( ALLOCATED(InData%F_L2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L2) ! F_L2 - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar allocated yes/no - IF ( ALLOCATED(InData%UR_bar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar) ! UR_bar - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dot) ! UR_bar_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dotdot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dotdot) ! UR_bar_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! UL allocated yes/no - IF ( ALLOCATED(InData%UL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL) ! UL - END IF - Int_BufSz = Int_BufSz + 1 ! UL_NS allocated yes/no - IF ( ALLOCATED(InData%UL_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_NS) ! UL_NS - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dot allocated yes/no - IF ( ALLOCATED(InData%UL_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dot) ! UL_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dotdot allocated yes/no - IF ( ALLOCATED(InData%UL_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dotdot) ! UL_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! DU_full allocated yes/no - IF ( ALLOCATED(InData%DU_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DU_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DU_full) ! DU_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full allocated yes/no - IF ( ALLOCATED(InData%U_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full) ! U_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_NS allocated yes/no - IF ( ALLOCATED(InData%U_full_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_NS) ! U_full_NS - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dot allocated yes/no - IF ( ALLOCATED(InData%U_full_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dot) ! U_full_dot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dotdot allocated yes/no - IF ( ALLOCATED(InData%U_full_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dotdot) ! U_full_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_elast allocated yes/no - IF ( ALLOCATED(InData%U_full_elast) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_elast upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_elast) ! U_full_elast - END IF - Int_BufSz = Int_BufSz + 1 ! U_red allocated yes/no - IF ( ALLOCATED(InData%U_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_red) ! U_red - END IF - Int_BufSz = Int_BufSz + 1 ! FC_unit allocated yes/no - IF ( ALLOCATED(InData%FC_unit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FC_unit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FC_unit) ! FC_unit - END IF - Int_BufSz = Int_BufSz + 1 ! SDWrOutput allocated yes/no - IF ( ALLOCATED(InData%SDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDWrOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SDWrOutput) ! SDWrOutput - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! Decimat - Int_BufSz = Int_BufSz + 1 ! Fext allocated yes/no - IF ( ALLOCATED(InData%Fext) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext) ! Fext - END IF - Int_BufSz = Int_BufSz + 1 ! Fext_red allocated yes/no - IF ( ALLOCATED(InData%Fext_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext_red) ! Fext_red - END IF - Int_BufSz = Int_BufSz + 1 ! UL_SIM allocated yes/no - IF ( ALLOCATED(InData%UL_SIM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_SIM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_SIM) ! UL_SIM - END IF - Int_BufSz = Int_BufSz + 1 ! UL_0m allocated yes/no - IF ( ALLOCATED(InData%UL_0m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_0m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_0m) ! UL_0m - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qmdotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) - ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) - ReKiBuf(Re_Xferred) = InData%u_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) - ReKiBuf(Re_Xferred) = InData%udot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) - ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L,1), UBOUND(InData%F_L,1) - ReKiBuf(Re_Xferred) = InData%F_L(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_L2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L2,1), UBOUND(InData%F_L2,1) - ReKiBuf(Re_Xferred) = InData%F_L2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) - ReKiBuf(Re_Xferred) = InData%UR_bar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) - ReKiBuf(Re_Xferred) = InData%UL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_NS,1), UBOUND(InData%UL_NS,1) - ReKiBuf(Re_Xferred) = InData%UL_NS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) - ReKiBuf(Re_Xferred) = InData%UL_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DU_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DU_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DU_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DU_full,1), UBOUND(InData%DU_full,1) - ReKiBuf(Re_Xferred) = InData%DU_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full,1), UBOUND(InData%U_full,1) - ReKiBuf(Re_Xferred) = InData%U_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_NS,1), UBOUND(InData%U_full_NS,1) - ReKiBuf(Re_Xferred) = InData%U_full_NS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dot,1), UBOUND(InData%U_full_dot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dotdot,1), UBOUND(InData%U_full_dotdot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_elast) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_elast,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_elast,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_elast,1), UBOUND(InData%U_full_elast,1) - ReKiBuf(Re_Xferred) = InData%U_full_elast(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_red,1), UBOUND(InData%U_red,1) - ReKiBuf(Re_Xferred) = InData%U_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FC_unit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FC_unit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FC_unit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FC_unit,1), UBOUND(InData%FC_unit,1) - ReKiBuf(Re_Xferred) = InData%FC_unit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) - ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Decimat - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Fext) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext,1), UBOUND(InData%Fext,1) - ReKiBuf(Re_Xferred) = InData%Fext(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fext_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext_red,1), UBOUND(InData%Fext_red,1) - ReKiBuf(Re_Xferred) = InData%Fext_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_SIM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_SIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_SIM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_SIM,1), UBOUND(InData%UL_SIM,1) - ReKiBuf(Re_Xferred) = InData%UL_SIM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_0m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_0m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_0m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_0m,1), UBOUND(InData%UL_0m,1) - ReKiBuf(Re_Xferred) = InData%UL_0m(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackMisc - - SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdotdot)) DEALLOCATE(OutData%qmdotdot) - ALLOCATE(OutData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) - OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%u_TP,1) - i1_u = UBOUND(OutData%u_TP,1) - DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) - OutData%u_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udot_TP,1) - i1_u = UBOUND(OutData%udot_TP,1) - DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) - OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udotdot_TP,1) - i1_u = UBOUND(OutData%udotdot_TP,1) - DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) - OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_L)) DEALLOCATE(OutData%F_L) - ALLOCATE(OutData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L,1), UBOUND(OutData%F_L,1) - OutData%F_L(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_L2)) DEALLOCATE(OutData%F_L2) - ALLOCATE(OutData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L2,1), UBOUND(OutData%F_L2,1) - OutData%F_L2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar)) DEALLOCATE(OutData%UR_bar) - ALLOCATE(OutData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) - OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar_dot)) DEALLOCATE(OutData%UR_bar_dot) - ALLOCATE(OutData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) - OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar_dotdot)) DEALLOCATE(OutData%UR_bar_dotdot) - ALLOCATE(OutData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) - OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL)) DEALLOCATE(OutData%UL) - ALLOCATE(OutData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) - OutData%UL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_NS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_NS)) DEALLOCATE(OutData%UL_NS) - ALLOCATE(OutData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_NS,1), UBOUND(OutData%UL_NS,1) - OutData%UL_NS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_dot)) DEALLOCATE(OutData%UL_dot) - ALLOCATE(OutData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) - OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_dotdot)) DEALLOCATE(OutData%UL_dotdot) - ALLOCATE(OutData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) - OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DU_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DU_full)) DEALLOCATE(OutData%DU_full) - ALLOCATE(OutData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DU_full,1), UBOUND(OutData%DU_full,1) - OutData%DU_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full)) DEALLOCATE(OutData%U_full) - ALLOCATE(OutData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full,1), UBOUND(OutData%U_full,1) - OutData%U_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_NS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_NS)) DEALLOCATE(OutData%U_full_NS) - ALLOCATE(OutData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_NS,1), UBOUND(OutData%U_full_NS,1) - OutData%U_full_NS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_dot)) DEALLOCATE(OutData%U_full_dot) - ALLOCATE(OutData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dot,1), UBOUND(OutData%U_full_dot,1) - OutData%U_full_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_dotdot)) DEALLOCATE(OutData%U_full_dotdot) - ALLOCATE(OutData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dotdot,1), UBOUND(OutData%U_full_dotdot,1) - OutData%U_full_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_elast not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_elast)) DEALLOCATE(OutData%U_full_elast) - ALLOCATE(OutData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_elast,1), UBOUND(OutData%U_full_elast,1) - OutData%U_full_elast(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_red)) DEALLOCATE(OutData%U_red) - ALLOCATE(OutData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_red,1), UBOUND(OutData%U_red,1) - OutData%U_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FC_unit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FC_unit)) DEALLOCATE(OutData%FC_unit) - ALLOCATE(OutData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FC_unit,1), UBOUND(OutData%FC_unit,1) - OutData%FC_unit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SDWrOutput)) DEALLOCATE(OutData%SDWrOutput) - ALLOCATE(OutData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) - OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fext)) DEALLOCATE(OutData%Fext) - ALLOCATE(OutData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext,1), UBOUND(OutData%Fext,1) - OutData%Fext(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fext_red)) DEALLOCATE(OutData%Fext_red) - ALLOCATE(OutData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext_red,1), UBOUND(OutData%Fext_red,1) - OutData%Fext_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_SIM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_SIM)) DEALLOCATE(OutData%UL_SIM) - ALLOCATE(OutData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_SIM,1), UBOUND(OutData%UL_SIM,1) - OutData%UL_SIM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_0m not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_0m)) DEALLOCATE(OutData%UL_0m) - ALLOCATE(OutData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_0m,1), UBOUND(OutData%UL_0m,1) - OutData%UL_0m(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackMisc - - SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%SDDeltaT = SrcParamData%SDDeltaT - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%nDOF = SrcParamData%nDOF - DstParamData%nDOF_red = SrcParamData%nDOF_red - DstParamData%Nmembers = SrcParamData%Nmembers -IF (ALLOCATED(SrcParamData%Elems)) THEN - i1_l = LBOUND(SrcParamData%Elems,1) - i1_u = UBOUND(SrcParamData%Elems,1) - i2_l = LBOUND(SrcParamData%Elems,2) - i2_u = UBOUND(SrcParamData%Elems,2) - IF (.NOT. ALLOCATED(DstParamData%Elems)) THEN - ALLOCATE(DstParamData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elems = SrcParamData%Elems -ENDIF -IF (ALLOCATED(SrcParamData%ElemProps)) THEN - i1_l = LBOUND(SrcParamData%ElemProps,1) - i1_u = UBOUND(SrcParamData%ElemProps,1) - IF (.NOT. ALLOCATED(DstParamData%ElemProps)) THEN - ALLOCATE(DstParamData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%ElemProps,1), UBOUND(SrcParamData%ElemProps,1) - CALL SD_Copyelemproptype( SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%FG)) THEN - i1_l = LBOUND(SrcParamData%FG,1) - i1_u = UBOUND(SrcParamData%FG,1) - IF (.NOT. ALLOCATED(DstParamData%FG)) THEN - ALLOCATE(DstParamData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FG = SrcParamData%FG -ENDIF -IF (ALLOCATED(SrcParamData%DP0)) THEN - i1_l = LBOUND(SrcParamData%DP0,1) - i1_u = UBOUND(SrcParamData%DP0,1) - i2_l = LBOUND(SrcParamData%DP0,2) - i2_u = UBOUND(SrcParamData%DP0,2) - IF (.NOT. ALLOCATED(DstParamData%DP0)) THEN - ALLOCATE(DstParamData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP0 = SrcParamData%DP0 -ENDIF -IF (ALLOCATED(SrcParamData%NodeID2JointID)) THEN - i1_l = LBOUND(SrcParamData%NodeID2JointID,1) - i1_u = UBOUND(SrcParamData%NodeID2JointID,1) - IF (.NOT. ALLOCATED(DstParamData%NodeID2JointID)) THEN - ALLOCATE(DstParamData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID -ENDIF - DstParamData%reduced = SrcParamData%reduced -IF (ALLOCATED(SrcParamData%T_red)) THEN - i1_l = LBOUND(SrcParamData%T_red,1) - i1_u = UBOUND(SrcParamData%T_red,1) - i2_l = LBOUND(SrcParamData%T_red,2) - i2_u = UBOUND(SrcParamData%T_red,2) - IF (.NOT. ALLOCATED(DstParamData%T_red)) THEN - ALLOCATE(DstParamData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red = SrcParamData%T_red -ENDIF -IF (ALLOCATED(SrcParamData%T_red_T)) THEN - i1_l = LBOUND(SrcParamData%T_red_T,1) - i1_u = UBOUND(SrcParamData%T_red_T,1) - i2_l = LBOUND(SrcParamData%T_red_T,2) - i2_u = UBOUND(SrcParamData%T_red_T,2) - IF (.NOT. ALLOCATED(DstParamData%T_red_T)) THEN - ALLOCATE(DstParamData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red_T = SrcParamData%T_red_T -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOF)) THEN - i1_l = LBOUND(SrcParamData%NodesDOF,1) - i1_u = UBOUND(SrcParamData%NodesDOF,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOF)) THEN - ALLOCATE(DstParamData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOF,1), UBOUND(SrcParamData%NodesDOF,1) - CALL SD_Copyilist( SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOFred)) THEN - i1_l = LBOUND(SrcParamData%NodesDOFred,1) - i1_u = UBOUND(SrcParamData%NodesDOFred,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOFred)) THEN - ALLOCATE(DstParamData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOFred,1), UBOUND(SrcParamData%NodesDOFred,1) - CALL SD_Copyilist( SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%ElemsDOF)) THEN - i1_l = LBOUND(SrcParamData%ElemsDOF,1) - i1_u = UBOUND(SrcParamData%ElemsDOF,1) - i2_l = LBOUND(SrcParamData%ElemsDOF,2) - i2_u = UBOUND(SrcParamData%ElemsDOF,2) - IF (.NOT. ALLOCATED(DstParamData%ElemsDOF)) THEN - ALLOCATE(DstParamData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElemsDOF = SrcParamData%ElemsDOF -ENDIF -IF (ALLOCATED(SrcParamData%DOFred2Nodes)) THEN - i1_l = LBOUND(SrcParamData%DOFred2Nodes,1) - i1_u = UBOUND(SrcParamData%DOFred2Nodes,1) - i2_l = LBOUND(SrcParamData%DOFred2Nodes,2) - i2_u = UBOUND(SrcParamData%DOFred2Nodes,2) - IF (.NOT. ALLOCATED(DstParamData%DOFred2Nodes)) THEN - ALLOCATE(DstParamData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes -ENDIF -IF (ALLOCATED(SrcParamData%CtrlElem2Channel)) THEN - i1_l = LBOUND(SrcParamData%CtrlElem2Channel,1) - i1_u = UBOUND(SrcParamData%CtrlElem2Channel,1) - i2_l = LBOUND(SrcParamData%CtrlElem2Channel,2) - i2_u = UBOUND(SrcParamData%CtrlElem2Channel,2) - IF (.NOT. ALLOCATED(DstParamData%CtrlElem2Channel)) THEN - ALLOCATE(DstParamData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel -ENDIF - DstParamData%nDOFM = SrcParamData%nDOFM - DstParamData%SttcSolve = SrcParamData%SttcSolve - DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection - DstParamData%Floating = SrcParamData%Floating -IF (ALLOCATED(SrcParamData%KMMDiag)) THEN - i1_l = LBOUND(SrcParamData%KMMDiag,1) - i1_u = UBOUND(SrcParamData%KMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%KMMDiag)) THEN - ALLOCATE(DstParamData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KMMDiag = SrcParamData%KMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%CMMDiag)) THEN - i1_l = LBOUND(SrcParamData%CMMDiag,1) - i1_u = UBOUND(SrcParamData%CMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%CMMDiag)) THEN - ALLOCATE(DstParamData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMMDiag = SrcParamData%CMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%MMB)) THEN - i1_l = LBOUND(SrcParamData%MMB,1) - i1_u = UBOUND(SrcParamData%MMB,1) - i2_l = LBOUND(SrcParamData%MMB,2) - i2_u = UBOUND(SrcParamData%MMB,2) - IF (.NOT. ALLOCATED(DstParamData%MMB)) THEN - ALLOCATE(DstParamData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MMB = SrcParamData%MMB -ENDIF -IF (ALLOCATED(SrcParamData%MBmmB)) THEN - i1_l = LBOUND(SrcParamData%MBmmB,1) - i1_u = UBOUND(SrcParamData%MBmmB,1) - i2_l = LBOUND(SrcParamData%MBmmB,2) - i2_u = UBOUND(SrcParamData%MBmmB,2) - IF (.NOT. ALLOCATED(DstParamData%MBmmB)) THEN - ALLOCATE(DstParamData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBmmB = SrcParamData%MBmmB -ENDIF -IF (ALLOCATED(SrcParamData%C1_11)) THEN - i1_l = LBOUND(SrcParamData%C1_11,1) - i1_u = UBOUND(SrcParamData%C1_11,1) - i2_l = LBOUND(SrcParamData%C1_11,2) - i2_u = UBOUND(SrcParamData%C1_11,2) - IF (.NOT. ALLOCATED(DstParamData%C1_11)) THEN - ALLOCATE(DstParamData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_11 = SrcParamData%C1_11 -ENDIF -IF (ALLOCATED(SrcParamData%C1_12)) THEN - i1_l = LBOUND(SrcParamData%C1_12,1) - i1_u = UBOUND(SrcParamData%C1_12,1) - i2_l = LBOUND(SrcParamData%C1_12,2) - i2_u = UBOUND(SrcParamData%C1_12,2) - IF (.NOT. ALLOCATED(DstParamData%C1_12)) THEN - ALLOCATE(DstParamData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_12 = SrcParamData%C1_12 -ENDIF -IF (ALLOCATED(SrcParamData%D1_141)) THEN - i1_l = LBOUND(SrcParamData%D1_141,1) - i1_u = UBOUND(SrcParamData%D1_141,1) - i2_l = LBOUND(SrcParamData%D1_141,2) - i2_u = UBOUND(SrcParamData%D1_141,2) - IF (.NOT. ALLOCATED(DstParamData%D1_141)) THEN - ALLOCATE(DstParamData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_141 = SrcParamData%D1_141 -ENDIF -IF (ALLOCATED(SrcParamData%D1_142)) THEN - i1_l = LBOUND(SrcParamData%D1_142,1) - i1_u = UBOUND(SrcParamData%D1_142,1) - i2_l = LBOUND(SrcParamData%D1_142,2) - i2_u = UBOUND(SrcParamData%D1_142,2) - IF (.NOT. ALLOCATED(DstParamData%D1_142)) THEN - ALLOCATE(DstParamData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_142 = SrcParamData%D1_142 -ENDIF -IF (ALLOCATED(SrcParamData%PhiM)) THEN - i1_l = LBOUND(SrcParamData%PhiM,1) - i1_u = UBOUND(SrcParamData%PhiM,1) - i2_l = LBOUND(SrcParamData%PhiM,2) - i2_u = UBOUND(SrcParamData%PhiM,2) - IF (.NOT. ALLOCATED(DstParamData%PhiM)) THEN - ALLOCATE(DstParamData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiM = SrcParamData%PhiM -ENDIF -IF (ALLOCATED(SrcParamData%C2_61)) THEN - i1_l = LBOUND(SrcParamData%C2_61,1) - i1_u = UBOUND(SrcParamData%C2_61,1) - i2_l = LBOUND(SrcParamData%C2_61,2) - i2_u = UBOUND(SrcParamData%C2_61,2) - IF (.NOT. ALLOCATED(DstParamData%C2_61)) THEN - ALLOCATE(DstParamData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_61 = SrcParamData%C2_61 -ENDIF -IF (ALLOCATED(SrcParamData%C2_62)) THEN - i1_l = LBOUND(SrcParamData%C2_62,1) - i1_u = UBOUND(SrcParamData%C2_62,1) - i2_l = LBOUND(SrcParamData%C2_62,2) - i2_u = UBOUND(SrcParamData%C2_62,2) - IF (.NOT. ALLOCATED(DstParamData%C2_62)) THEN - ALLOCATE(DstParamData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_62 = SrcParamData%C2_62 -ENDIF -IF (ALLOCATED(SrcParamData%PhiRb_TI)) THEN - i1_l = LBOUND(SrcParamData%PhiRb_TI,1) - i1_u = UBOUND(SrcParamData%PhiRb_TI,1) - i2_l = LBOUND(SrcParamData%PhiRb_TI,2) - i2_u = UBOUND(SrcParamData%PhiRb_TI,2) - IF (.NOT. ALLOCATED(DstParamData%PhiRb_TI)) THEN - ALLOCATE(DstParamData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI -ENDIF -IF (ALLOCATED(SrcParamData%D2_63)) THEN - i1_l = LBOUND(SrcParamData%D2_63,1) - i1_u = UBOUND(SrcParamData%D2_63,1) - i2_l = LBOUND(SrcParamData%D2_63,2) - i2_u = UBOUND(SrcParamData%D2_63,2) - IF (.NOT. ALLOCATED(DstParamData%D2_63)) THEN - ALLOCATE(DstParamData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_63 = SrcParamData%D2_63 -ENDIF -IF (ALLOCATED(SrcParamData%D2_64)) THEN - i1_l = LBOUND(SrcParamData%D2_64,1) - i1_u = UBOUND(SrcParamData%D2_64,1) - i2_l = LBOUND(SrcParamData%D2_64,2) - i2_u = UBOUND(SrcParamData%D2_64,2) - IF (.NOT. ALLOCATED(DstParamData%D2_64)) THEN - ALLOCATE(DstParamData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_64 = SrcParamData%D2_64 -ENDIF -IF (ALLOCATED(SrcParamData%MBB)) THEN - i1_l = LBOUND(SrcParamData%MBB,1) - i1_u = UBOUND(SrcParamData%MBB,1) - i2_l = LBOUND(SrcParamData%MBB,2) - i2_u = UBOUND(SrcParamData%MBB,2) - IF (.NOT. ALLOCATED(DstParamData%MBB)) THEN - ALLOCATE(DstParamData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBB = SrcParamData%MBB -ENDIF -IF (ALLOCATED(SrcParamData%KBB)) THEN - i1_l = LBOUND(SrcParamData%KBB,1) - i1_u = UBOUND(SrcParamData%KBB,1) - i2_l = LBOUND(SrcParamData%KBB,2) - i2_u = UBOUND(SrcParamData%KBB,2) - IF (.NOT. ALLOCATED(DstParamData%KBB)) THEN - ALLOCATE(DstParamData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBB = SrcParamData%KBB -ENDIF -IF (ALLOCATED(SrcParamData%CBB)) THEN - i1_l = LBOUND(SrcParamData%CBB,1) - i1_u = UBOUND(SrcParamData%CBB,1) - i2_l = LBOUND(SrcParamData%CBB,2) - i2_u = UBOUND(SrcParamData%CBB,2) - IF (.NOT. ALLOCATED(DstParamData%CBB)) THEN - ALLOCATE(DstParamData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBB = SrcParamData%CBB -ENDIF -IF (ALLOCATED(SrcParamData%CMM)) THEN - i1_l = LBOUND(SrcParamData%CMM,1) - i1_u = UBOUND(SrcParamData%CMM,1) - i2_l = LBOUND(SrcParamData%CMM,2) - i2_u = UBOUND(SrcParamData%CMM,2) - IF (.NOT. ALLOCATED(DstParamData%CMM)) THEN - ALLOCATE(DstParamData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMM = SrcParamData%CMM -ENDIF -IF (ALLOCATED(SrcParamData%MBM)) THEN - i1_l = LBOUND(SrcParamData%MBM,1) - i1_u = UBOUND(SrcParamData%MBM,1) - i2_l = LBOUND(SrcParamData%MBM,2) - i2_u = UBOUND(SrcParamData%MBM,2) - IF (.NOT. ALLOCATED(DstParamData%MBM)) THEN - ALLOCATE(DstParamData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBM = SrcParamData%MBM -ENDIF -IF (ALLOCATED(SrcParamData%PhiL_T)) THEN - i1_l = LBOUND(SrcParamData%PhiL_T,1) - i1_u = UBOUND(SrcParamData%PhiL_T,1) - i2_l = LBOUND(SrcParamData%PhiL_T,2) - i2_u = UBOUND(SrcParamData%PhiL_T,2) - IF (.NOT. ALLOCATED(DstParamData%PhiL_T)) THEN - ALLOCATE(DstParamData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiL_T = SrcParamData%PhiL_T -ENDIF -IF (ALLOCATED(SrcParamData%PhiLInvOmgL2)) THEN - i1_l = LBOUND(SrcParamData%PhiLInvOmgL2,1) - i1_u = UBOUND(SrcParamData%PhiLInvOmgL2,1) - i2_l = LBOUND(SrcParamData%PhiLInvOmgL2,2) - i2_u = UBOUND(SrcParamData%PhiLInvOmgL2,2) - IF (.NOT. ALLOCATED(DstParamData%PhiLInvOmgL2)) THEN - ALLOCATE(DstParamData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 -ENDIF -IF (ALLOCATED(SrcParamData%KLLm1)) THEN - i1_l = LBOUND(SrcParamData%KLLm1,1) - i1_u = UBOUND(SrcParamData%KLLm1,1) - i2_l = LBOUND(SrcParamData%KLLm1,2) - i2_u = UBOUND(SrcParamData%KLLm1,2) - IF (.NOT. ALLOCATED(DstParamData%KLLm1)) THEN - ALLOCATE(DstParamData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KLLm1 = SrcParamData%KLLm1 -ENDIF -IF (ALLOCATED(SrcParamData%AM2Jac)) THEN - i1_l = LBOUND(SrcParamData%AM2Jac,1) - i1_u = UBOUND(SrcParamData%AM2Jac,1) - i2_l = LBOUND(SrcParamData%AM2Jac,2) - i2_u = UBOUND(SrcParamData%AM2Jac,2) - IF (.NOT. ALLOCATED(DstParamData%AM2Jac)) THEN - ALLOCATE(DstParamData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2Jac = SrcParamData%AM2Jac -ENDIF -IF (ALLOCATED(SrcParamData%AM2JacPiv)) THEN - i1_l = LBOUND(SrcParamData%AM2JacPiv,1) - i1_u = UBOUND(SrcParamData%AM2JacPiv,1) - IF (.NOT. ALLOCATED(DstParamData%AM2JacPiv)) THEN - ALLOCATE(DstParamData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv -ENDIF -IF (ALLOCATED(SrcParamData%TI)) THEN - i1_l = LBOUND(SrcParamData%TI,1) - i1_u = UBOUND(SrcParamData%TI,1) - i2_l = LBOUND(SrcParamData%TI,2) - i2_u = UBOUND(SrcParamData%TI,2) - IF (.NOT. ALLOCATED(DstParamData%TI)) THEN - ALLOCATE(DstParamData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI = SrcParamData%TI -ENDIF -IF (ALLOCATED(SrcParamData%TIreact)) THEN - i1_l = LBOUND(SrcParamData%TIreact,1) - i1_u = UBOUND(SrcParamData%TIreact,1) - i2_l = LBOUND(SrcParamData%TIreact,2) - i2_u = UBOUND(SrcParamData%TIreact,2) - IF (.NOT. ALLOCATED(DstParamData%TIreact)) THEN - ALLOCATE(DstParamData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TIreact = SrcParamData%TIreact -ENDIF - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C -IF (ALLOCATED(SrcParamData%Nodes_I)) THEN - i1_l = LBOUND(SrcParamData%Nodes_I,1) - i1_u = UBOUND(SrcParamData%Nodes_I,1) - i2_l = LBOUND(SrcParamData%Nodes_I,2) - i2_u = UBOUND(SrcParamData%Nodes_I,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_I)) THEN - ALLOCATE(DstParamData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_I = SrcParamData%Nodes_I -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_L)) THEN - i1_l = LBOUND(SrcParamData%Nodes_L,1) - i1_u = UBOUND(SrcParamData%Nodes_L,1) - i2_l = LBOUND(SrcParamData%Nodes_L,2) - i2_u = UBOUND(SrcParamData%Nodes_L,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_L)) THEN - ALLOCATE(DstParamData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_L = SrcParamData%Nodes_L -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_C)) THEN - i1_l = LBOUND(SrcParamData%Nodes_C,1) - i1_u = UBOUND(SrcParamData%Nodes_C,1) - i2_l = LBOUND(SrcParamData%Nodes_C,2) - i2_u = UBOUND(SrcParamData%Nodes_C,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_C)) THEN - ALLOCATE(DstParamData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_C = SrcParamData%Nodes_C -ENDIF - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F -IF (ALLOCATED(SrcParamData%IDI__)) THEN - i1_l = LBOUND(SrcParamData%IDI__,1) - i1_u = UBOUND(SrcParamData%IDI__,1) - IF (.NOT. ALLOCATED(DstParamData%IDI__)) THEN - ALLOCATE(DstParamData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI__ = SrcParamData%IDI__ -ENDIF -IF (ALLOCATED(SrcParamData%IDI_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDI_Rb,1) - i1_u = UBOUND(SrcParamData%IDI_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_Rb)) THEN - ALLOCATE(DstParamData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_Rb = SrcParamData%IDI_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDI_F)) THEN - i1_l = LBOUND(SrcParamData%IDI_F,1) - i1_u = UBOUND(SrcParamData%IDI_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_F)) THEN - ALLOCATE(DstParamData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_F = SrcParamData%IDI_F -ENDIF -IF (ALLOCATED(SrcParamData%IDL_L)) THEN - i1_l = LBOUND(SrcParamData%IDL_L,1) - i1_u = UBOUND(SrcParamData%IDL_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDL_L)) THEN - ALLOCATE(DstParamData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDL_L = SrcParamData%IDL_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC__)) THEN - i1_l = LBOUND(SrcParamData%IDC__,1) - i1_u = UBOUND(SrcParamData%IDC__,1) - IF (.NOT. ALLOCATED(DstParamData%IDC__)) THEN - ALLOCATE(DstParamData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC__ = SrcParamData%IDC__ -ENDIF -IF (ALLOCATED(SrcParamData%IDC_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDC_Rb,1) - i1_u = UBOUND(SrcParamData%IDC_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_Rb)) THEN - ALLOCATE(DstParamData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_Rb = SrcParamData%IDC_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDC_L)) THEN - i1_l = LBOUND(SrcParamData%IDC_L,1) - i1_u = UBOUND(SrcParamData%IDC_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_L)) THEN - ALLOCATE(DstParamData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_L = SrcParamData%IDC_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC_F)) THEN - i1_l = LBOUND(SrcParamData%IDC_F,1) - i1_u = UBOUND(SrcParamData%IDC_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_F)) THEN - ALLOCATE(DstParamData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_F = SrcParamData%IDC_F -ENDIF -IF (ALLOCATED(SrcParamData%IDR__)) THEN - i1_l = LBOUND(SrcParamData%IDR__,1) - i1_u = UBOUND(SrcParamData%IDR__,1) - IF (.NOT. ALLOCATED(DstParamData%IDR__)) THEN - ALLOCATE(DstParamData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDR__ = SrcParamData%IDR__ -ENDIF -IF (ALLOCATED(SrcParamData%ID__Rb)) THEN - i1_l = LBOUND(SrcParamData%ID__Rb,1) - i1_u = UBOUND(SrcParamData%ID__Rb,1) - IF (.NOT. ALLOCATED(DstParamData%ID__Rb)) THEN - ALLOCATE(DstParamData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__Rb = SrcParamData%ID__Rb -ENDIF -IF (ALLOCATED(SrcParamData%ID__L)) THEN - i1_l = LBOUND(SrcParamData%ID__L,1) - i1_u = UBOUND(SrcParamData%ID__L,1) - IF (.NOT. ALLOCATED(DstParamData%ID__L)) THEN - ALLOCATE(DstParamData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__L = SrcParamData%ID__L -ENDIF -IF (ALLOCATED(SrcParamData%ID__F)) THEN - i1_l = LBOUND(SrcParamData%ID__F,1) - i1_u = UBOUND(SrcParamData%ID__F,1) - IF (.NOT. ALLOCATED(DstParamData%ID__F)) THEN - ALLOCATE(DstParamData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__F = SrcParamData%ID__F -ENDIF - DstParamData%NMOutputs = SrcParamData%NMOutputs - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnJckF = SrcParamData%UnJckF - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt -IF (ALLOCATED(SrcParamData%MoutLst)) THEN - i1_l = LBOUND(SrcParamData%MoutLst,1) - i1_u = UBOUND(SrcParamData%MoutLst,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst)) THEN - ALLOCATE(DstParamData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst,1), UBOUND(SrcParamData%MoutLst,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst2)) THEN - i1_l = LBOUND(SrcParamData%MoutLst2,1) - i1_u = UBOUND(SrcParamData%MoutLst2,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst2)) THEN - ALLOCATE(DstParamData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst2,1), UBOUND(SrcParamData%MoutLst2,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst3)) THEN - i1_l = LBOUND(SrcParamData%MoutLst3,1) - i1_u = UBOUND(SrcParamData%MoutLst3,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst3)) THEN - ALLOCATE(DstParamData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst3,1), UBOUND(SrcParamData%MoutLst3,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%OutAll = SrcParamData%OutAll - DstParamData%OutCBModes = SrcParamData%OutCBModes - DstParamData%OutFEMModes = SrcParamData%OutFEMModes - DstParamData%OutReact = SrcParamData%OutReact - DstParamData%OutAllInt = SrcParamData%OutAllInt - DstParamData%OutAllDims = SrcParamData%OutAllDims - DstParamData%OutDec = SrcParamData%OutDec -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates - END SUBROUTINE SD_CopyParam - - SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - -IF (ALLOCATED(ParamData%Elems)) THEN - DEALLOCATE(ParamData%Elems) -ENDIF -IF (ALLOCATED(ParamData%ElemProps)) THEN -DO i1 = LBOUND(ParamData%ElemProps,1), UBOUND(ParamData%ElemProps,1) - CALL SD_Destroyelemproptype( ParamData%ElemProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%ElemProps) -ENDIF -IF (ALLOCATED(ParamData%FG)) THEN - DEALLOCATE(ParamData%FG) -ENDIF -IF (ALLOCATED(ParamData%DP0)) THEN - DEALLOCATE(ParamData%DP0) -ENDIF -IF (ALLOCATED(ParamData%NodeID2JointID)) THEN - DEALLOCATE(ParamData%NodeID2JointID) -ENDIF -IF (ALLOCATED(ParamData%T_red)) THEN - DEALLOCATE(ParamData%T_red) -ENDIF -IF (ALLOCATED(ParamData%T_red_T)) THEN - DEALLOCATE(ParamData%T_red_T) -ENDIF -IF (ALLOCATED(ParamData%NodesDOF)) THEN -DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) - CALL SD_Destroyilist( ParamData%NodesDOF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%NodesDOF) -ENDIF -IF (ALLOCATED(ParamData%NodesDOFred)) THEN -DO i1 = LBOUND(ParamData%NodesDOFred,1), UBOUND(ParamData%NodesDOFred,1) - CALL SD_Destroyilist( ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%NodesDOFred) -ENDIF -IF (ALLOCATED(ParamData%ElemsDOF)) THEN - DEALLOCATE(ParamData%ElemsDOF) -ENDIF -IF (ALLOCATED(ParamData%DOFred2Nodes)) THEN - DEALLOCATE(ParamData%DOFred2Nodes) -ENDIF -IF (ALLOCATED(ParamData%CtrlElem2Channel)) THEN - DEALLOCATE(ParamData%CtrlElem2Channel) -ENDIF -IF (ALLOCATED(ParamData%KMMDiag)) THEN - DEALLOCATE(ParamData%KMMDiag) -ENDIF -IF (ALLOCATED(ParamData%CMMDiag)) THEN - DEALLOCATE(ParamData%CMMDiag) -ENDIF -IF (ALLOCATED(ParamData%MMB)) THEN - DEALLOCATE(ParamData%MMB) -ENDIF -IF (ALLOCATED(ParamData%MBmmB)) THEN - DEALLOCATE(ParamData%MBmmB) -ENDIF -IF (ALLOCATED(ParamData%C1_11)) THEN - DEALLOCATE(ParamData%C1_11) -ENDIF -IF (ALLOCATED(ParamData%C1_12)) THEN - DEALLOCATE(ParamData%C1_12) -ENDIF -IF (ALLOCATED(ParamData%D1_141)) THEN - DEALLOCATE(ParamData%D1_141) -ENDIF -IF (ALLOCATED(ParamData%D1_142)) THEN - DEALLOCATE(ParamData%D1_142) -ENDIF -IF (ALLOCATED(ParamData%PhiM)) THEN - DEALLOCATE(ParamData%PhiM) -ENDIF -IF (ALLOCATED(ParamData%C2_61)) THEN - DEALLOCATE(ParamData%C2_61) -ENDIF -IF (ALLOCATED(ParamData%C2_62)) THEN - DEALLOCATE(ParamData%C2_62) -ENDIF -IF (ALLOCATED(ParamData%PhiRb_TI)) THEN - DEALLOCATE(ParamData%PhiRb_TI) -ENDIF -IF (ALLOCATED(ParamData%D2_63)) THEN - DEALLOCATE(ParamData%D2_63) -ENDIF -IF (ALLOCATED(ParamData%D2_64)) THEN - DEALLOCATE(ParamData%D2_64) -ENDIF -IF (ALLOCATED(ParamData%MBB)) THEN - DEALLOCATE(ParamData%MBB) -ENDIF -IF (ALLOCATED(ParamData%KBB)) THEN - DEALLOCATE(ParamData%KBB) -ENDIF -IF (ALLOCATED(ParamData%CBB)) THEN - DEALLOCATE(ParamData%CBB) -ENDIF -IF (ALLOCATED(ParamData%CMM)) THEN - DEALLOCATE(ParamData%CMM) -ENDIF -IF (ALLOCATED(ParamData%MBM)) THEN - DEALLOCATE(ParamData%MBM) -ENDIF -IF (ALLOCATED(ParamData%PhiL_T)) THEN - DEALLOCATE(ParamData%PhiL_T) -ENDIF -IF (ALLOCATED(ParamData%PhiLInvOmgL2)) THEN - DEALLOCATE(ParamData%PhiLInvOmgL2) -ENDIF -IF (ALLOCATED(ParamData%KLLm1)) THEN - DEALLOCATE(ParamData%KLLm1) -ENDIF -IF (ALLOCATED(ParamData%AM2Jac)) THEN - DEALLOCATE(ParamData%AM2Jac) -ENDIF -IF (ALLOCATED(ParamData%AM2JacPiv)) THEN - DEALLOCATE(ParamData%AM2JacPiv) -ENDIF -IF (ALLOCATED(ParamData%TI)) THEN - DEALLOCATE(ParamData%TI) -ENDIF -IF (ALLOCATED(ParamData%TIreact)) THEN - DEALLOCATE(ParamData%TIreact) -ENDIF -IF (ALLOCATED(ParamData%Nodes_I)) THEN - DEALLOCATE(ParamData%Nodes_I) -ENDIF -IF (ALLOCATED(ParamData%Nodes_L)) THEN - DEALLOCATE(ParamData%Nodes_L) -ENDIF -IF (ALLOCATED(ParamData%Nodes_C)) THEN - DEALLOCATE(ParamData%Nodes_C) -ENDIF -IF (ALLOCATED(ParamData%IDI__)) THEN - DEALLOCATE(ParamData%IDI__) -ENDIF -IF (ALLOCATED(ParamData%IDI_Rb)) THEN - DEALLOCATE(ParamData%IDI_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDI_F)) THEN - DEALLOCATE(ParamData%IDI_F) -ENDIF -IF (ALLOCATED(ParamData%IDL_L)) THEN - DEALLOCATE(ParamData%IDL_L) -ENDIF -IF (ALLOCATED(ParamData%IDC__)) THEN - DEALLOCATE(ParamData%IDC__) -ENDIF -IF (ALLOCATED(ParamData%IDC_Rb)) THEN - DEALLOCATE(ParamData%IDC_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDC_L)) THEN - DEALLOCATE(ParamData%IDC_L) -ENDIF -IF (ALLOCATED(ParamData%IDC_F)) THEN - DEALLOCATE(ParamData%IDC_F) -ENDIF -IF (ALLOCATED(ParamData%IDR__)) THEN - DEALLOCATE(ParamData%IDR__) -ENDIF -IF (ALLOCATED(ParamData%ID__Rb)) THEN - DEALLOCATE(ParamData%ID__Rb) -ENDIF -IF (ALLOCATED(ParamData%ID__L)) THEN - DEALLOCATE(ParamData%ID__L) -ENDIF -IF (ALLOCATED(ParamData%ID__F)) THEN - DEALLOCATE(ParamData%ID__F) -ENDIF -IF (ALLOCATED(ParamData%MoutLst)) THEN -DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MoutLst) -ENDIF -IF (ALLOCATED(ParamData%MoutLst2)) THEN -DO i1 = LBOUND(ParamData%MoutLst2,1), UBOUND(ParamData%MoutLst2,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MoutLst2) -ENDIF -IF (ALLOCATED(ParamData%MoutLst3)) THEN -DO i1 = LBOUND(ParamData%MoutLst3,1), UBOUND(ParamData%MoutLst3,1) - CALL SD_Destroymeshauxdatatype( ParamData%MoutLst3(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MoutLst3) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF - END SUBROUTINE SD_DestroyParam - - SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! SDDeltaT - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! nDOF - Int_BufSz = Int_BufSz + 1 ! nDOF_red - Int_BufSz = Int_BufSz + 1 ! Nmembers - Int_BufSz = Int_BufSz + 1 ! Elems allocated yes/no - IF ( ALLOCATED(InData%Elems) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Elems upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Elems) ! Elems - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElemProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - Int_BufSz = Int_BufSz + 3 ! ElemProps: size of buffers for each call to pack subtype - CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElemProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElemProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElemProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FG allocated yes/no - IF ( ALLOCATED(InData%FG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FG) ! FG - END IF - Int_BufSz = Int_BufSz + 1 ! DP0 allocated yes/no - IF ( ALLOCATED(InData%DP0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP0) ! DP0 - END IF - Int_BufSz = Int_BufSz + 1 ! NodeID2JointID allocated yes/no - IF ( ALLOCATED(InData%NodeID2JointID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeID2JointID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeID2JointID) ! NodeID2JointID - END IF - Int_BufSz = Int_BufSz + 1 ! reduced - Int_BufSz = Int_BufSz + 1 ! T_red allocated yes/no - IF ( ALLOCATED(InData%T_red) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red) ! T_red - END IF - Int_BufSz = Int_BufSz + 1 ! T_red_T allocated yes/no - IF ( ALLOCATED(InData%T_red_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red_T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red_T) ! T_red_T - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOF allocated yes/no - IF ( ALLOCATED(InData%NodesDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodesDOF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - Int_BufSz = Int_BufSz + 3 ! NodesDOF: size of buffers for each call to pack subtype - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOFred allocated yes/no - IF ( ALLOCATED(InData%NodesDOFred) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodesDOFred upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - Int_BufSz = Int_BufSz + 3 ! NodesDOFred: size of buffers for each call to pack subtype - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOFred - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOFred - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOFred - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ElemsDOF allocated yes/no - IF ( ALLOCATED(InData%ElemsDOF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemsDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElemsDOF) ! ElemsDOF - END IF - Int_BufSz = Int_BufSz + 1 ! DOFred2Nodes allocated yes/no - IF ( ALLOCATED(InData%DOFred2Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DOFred2Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOFred2Nodes) ! DOFred2Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! CtrlElem2Channel allocated yes/no - IF ( ALLOCATED(InData%CtrlElem2Channel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CtrlElem2Channel upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CtrlElem2Channel) ! CtrlElem2Channel - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFM - Int_BufSz = Int_BufSz + 1 ! SttcSolve - Int_BufSz = Int_BufSz + 1 ! GuyanLoadCorrection - Int_BufSz = Int_BufSz + 1 ! Floating - Int_BufSz = Int_BufSz + 1 ! KMMDiag allocated yes/no - IF ( ALLOCATED(InData%KMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! KMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KMMDiag) ! KMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! CMMDiag allocated yes/no - IF ( ALLOCATED(InData%CMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMMDiag) ! CMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! MMB allocated yes/no - IF ( ALLOCATED(InData%MMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMB) ! MMB - END IF - Int_BufSz = Int_BufSz + 1 ! MBmmB allocated yes/no - IF ( ALLOCATED(InData%MBmmB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBmmB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBmmB) ! MBmmB - END IF - Int_BufSz = Int_BufSz + 1 ! C1_11 allocated yes/no - IF ( ALLOCATED(InData%C1_11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_11) ! C1_11 - END IF - Int_BufSz = Int_BufSz + 1 ! C1_12 allocated yes/no - IF ( ALLOCATED(InData%C1_12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_12) ! C1_12 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_141 allocated yes/no - IF ( ALLOCATED(InData%D1_141) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_141 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_141) ! D1_141 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_142 allocated yes/no - IF ( ALLOCATED(InData%D1_142) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_142 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_142) ! D1_142 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiM allocated yes/no - IF ( ALLOCATED(InData%PhiM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiM) ! PhiM - END IF - Int_BufSz = Int_BufSz + 1 ! C2_61 allocated yes/no - IF ( ALLOCATED(InData%C2_61) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_61 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_61) ! C2_61 - END IF - Int_BufSz = Int_BufSz + 1 ! C2_62 allocated yes/no - IF ( ALLOCATED(InData%C2_62) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_62 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_62) ! C2_62 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiRb_TI allocated yes/no - IF ( ALLOCATED(InData%PhiRb_TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiRb_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiRb_TI) ! PhiRb_TI - END IF - Int_BufSz = Int_BufSz + 1 ! D2_63 allocated yes/no - IF ( ALLOCATED(InData%D2_63) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_63 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_63) ! D2_63 - END IF - Int_BufSz = Int_BufSz + 1 ! D2_64 allocated yes/no - IF ( ALLOCATED(InData%D2_64) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_64 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_64) ! D2_64 - END IF - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! CBB allocated yes/no - IF ( ALLOCATED(InData%CBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBB) ! CBB - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL_T allocated yes/no - IF ( ALLOCATED(InData%PhiL_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiL_T) ! PhiL_T - END IF - Int_BufSz = Int_BufSz + 1 ! PhiLInvOmgL2 allocated yes/no - IF ( ALLOCATED(InData%PhiLInvOmgL2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiLInvOmgL2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiLInvOmgL2) ! PhiLInvOmgL2 - END IF - Int_BufSz = Int_BufSz + 1 ! KLLm1 allocated yes/no - IF ( ALLOCATED(InData%KLLm1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KLLm1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KLLm1) ! KLLm1 - END IF - Int_BufSz = Int_BufSz + 1 ! AM2Jac allocated yes/no - IF ( ALLOCATED(InData%AM2Jac) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AM2Jac upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AM2Jac) ! AM2Jac - END IF - Int_BufSz = Int_BufSz + 1 ! AM2JacPiv allocated yes/no - IF ( ALLOCATED(InData%AM2JacPiv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AM2JacPiv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AM2JacPiv) ! AM2JacPiv - END IF - Int_BufSz = Int_BufSz + 1 ! TI allocated yes/no - IF ( ALLOCATED(InData%TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - END IF - Int_BufSz = Int_BufSz + 1 ! TIreact allocated yes/no - IF ( ALLOCATED(InData%TIreact) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIreact upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIreact) ! TIreact - END IF - Int_BufSz = Int_BufSz + 1 ! nNodes - Int_BufSz = Int_BufSz + 1 ! nNodes_I - Int_BufSz = Int_BufSz + 1 ! nNodes_L - Int_BufSz = Int_BufSz + 1 ! nNodes_C - Int_BufSz = Int_BufSz + 1 ! Nodes_I allocated yes/no - IF ( ALLOCATED(InData%Nodes_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_I upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_I) ! Nodes_I - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_L allocated yes/no - IF ( ALLOCATED(InData%Nodes_L) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_L) ! Nodes_L - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_C allocated yes/no - IF ( ALLOCATED(InData%Nodes_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_C upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_C) ! Nodes_C - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFI__ - Int_BufSz = Int_BufSz + 1 ! nDOFI_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFI_F - Int_BufSz = Int_BufSz + 1 ! nDOFL_L - Int_BufSz = Int_BufSz + 1 ! nDOFC__ - Int_BufSz = Int_BufSz + 1 ! nDOFC_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFC_L - Int_BufSz = Int_BufSz + 1 ! nDOFC_F - Int_BufSz = Int_BufSz + 1 ! nDOFR__ - Int_BufSz = Int_BufSz + 1 ! nDOF__Rb - Int_BufSz = Int_BufSz + 1 ! nDOF__L - Int_BufSz = Int_BufSz + 1 ! nDOF__F - Int_BufSz = Int_BufSz + 1 ! IDI__ allocated yes/no - IF ( ALLOCATED(InData%IDI__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI__) ! IDI__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_Rb allocated yes/no - IF ( ALLOCATED(InData%IDI_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_Rb) ! IDI_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_F allocated yes/no - IF ( ALLOCATED(InData%IDI_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_F) ! IDI_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDL_L allocated yes/no - IF ( ALLOCATED(InData%IDL_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDL_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDL_L) ! IDL_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC__ allocated yes/no - IF ( ALLOCATED(InData%IDC__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC__) ! IDC__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_Rb allocated yes/no - IF ( ALLOCATED(InData%IDC_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_Rb) ! IDC_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_L allocated yes/no - IF ( ALLOCATED(InData%IDC_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_L) ! IDC_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_F allocated yes/no - IF ( ALLOCATED(InData%IDC_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_F) ! IDC_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDR__ allocated yes/no - IF ( ALLOCATED(InData%IDR__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDR__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDR__) ! IDR__ - END IF - Int_BufSz = Int_BufSz + 1 ! ID__Rb allocated yes/no - IF ( ALLOCATED(InData%ID__Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__Rb) ! ID__Rb - END IF - Int_BufSz = Int_BufSz + 1 ! ID__L allocated yes/no - IF ( ALLOCATED(InData%ID__L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__L) ! ID__L - END IF - Int_BufSz = Int_BufSz + 1 ! ID__F allocated yes/no - IF ( ALLOCATED(InData%ID__F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__F) ! ID__F - END IF - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! UnJckF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1 ! MoutLst allocated yes/no - IF ( ALLOCATED(InData%MoutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst2 allocated yes/no - IF ( ALLOCATED(InData%MoutLst2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst2: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst3 allocated yes/no - IF ( ALLOCATED(InData%MoutLst3) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst3 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst3: size of buffers for each call to pack subtype - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst3 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst3 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst3 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! OutCBModes - Int_BufSz = Int_BufSz + 1 ! OutFEMModes - Int_BufSz = Int_BufSz + 1 ! OutReact - Int_BufSz = Int_BufSz + 1 ! OutAllInt - Int_BufSz = Int_BufSz + 1 ! OutAllDims - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! RotStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF_red - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Elems) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) - DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) - IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) - DbKiBuf(Db_Xferred) = InData%FG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP0,2), UBOUND(InData%DP0,2) - DO i1 = LBOUND(InData%DP0,1), UBOUND(InData%DP0,1) - ReKiBuf(Re_Xferred) = InData%DP0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeID2JointID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeID2JointID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeID2JointID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeID2JointID,1), UBOUND(InData%NodeID2JointID,1) - IntKiBuf(Int_Xferred) = InData%NodeID2JointID(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%reduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%T_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red,2), UBOUND(InData%T_red,2) - DO i1 = LBOUND(InData%T_red,1), UBOUND(InData%T_red,1) - DbKiBuf(Db_Xferred) = InData%T_red(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_red_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red_T,2), UBOUND(InData%T_red_T,2) - DO i1 = LBOUND(InData%T_red_T,1), UBOUND(InData%T_red_T,1) - DbKiBuf(Db_Xferred) = InData%T_red_T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOFred) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOFred,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOFred,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemsDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemsDOF,2), UBOUND(InData%ElemsDOF,2) - DO i1 = LBOUND(InData%ElemsDOF,1), UBOUND(InData%ElemsDOF,1) - IntKiBuf(Int_Xferred) = InData%ElemsDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOFred2Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DOFred2Nodes,2), UBOUND(InData%DOFred2Nodes,2) - DO i1 = LBOUND(InData%DOFred2Nodes,1), UBOUND(InData%DOFred2Nodes,1) - IntKiBuf(Int_Xferred) = InData%DOFred2Nodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CtrlElem2Channel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CtrlElem2Channel,2), UBOUND(InData%CtrlElem2Channel,2) - DO i1 = LBOUND(InData%CtrlElem2Channel,1), UBOUND(InData%CtrlElem2Channel,1) - IntKiBuf(Int_Xferred) = InData%CtrlElem2Channel(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SttcSolve - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GuyanLoadCorrection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Floating, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%KMMDiag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%KMMDiag,1), UBOUND(InData%KMMDiag,1) - ReKiBuf(Re_Xferred) = InData%KMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMMDiag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CMMDiag,1), UBOUND(InData%CMMDiag,1) - ReKiBuf(Re_Xferred) = InData%CMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) - DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) - ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBmmB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBmmB,2), UBOUND(InData%MBmmB,2) - DO i1 = LBOUND(InData%MBmmB,1), UBOUND(InData%MBmmB,1) - ReKiBuf(Re_Xferred) = InData%MBmmB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) - DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) - ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) - DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) - ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_141) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_141,2), UBOUND(InData%D1_141,2) - DO i1 = LBOUND(InData%D1_141,1), UBOUND(InData%D1_141,1) - ReKiBuf(Re_Xferred) = InData%D1_141(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_142) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_142,2), UBOUND(InData%D1_142,2) - DO i1 = LBOUND(InData%D1_142,1), UBOUND(InData%D1_142,1) - ReKiBuf(Re_Xferred) = InData%D1_142(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) - DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) - ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) - DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) - ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) - DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) - ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) - DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) - ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) - DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) - ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) - DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) - ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CBB,2), UBOUND(InData%CBB,2) - DO i1 = LBOUND(InData%CBB,1), UBOUND(InData%CBB,1) - ReKiBuf(Re_Xferred) = InData%CBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMM,2), UBOUND(InData%CMM,2) - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) - DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) - ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) - DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) - ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KLLm1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KLLm1,2), UBOUND(InData%KLLm1,2) - DO i1 = LBOUND(InData%KLLm1,1), UBOUND(InData%KLLm1,1) - ReKiBuf(Re_Xferred) = InData%KLLm1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) - DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) - ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2JacPiv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) - IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) - DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) - ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_C - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes_I) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_I,2), UBOUND(InData%Nodes_I,2) - DO i1 = LBOUND(InData%Nodes_I,1), UBOUND(InData%Nodes_I,1) - IntKiBuf(Int_Xferred) = InData%Nodes_I(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_L,2), UBOUND(InData%Nodes_L,2) - DO i1 = LBOUND(InData%Nodes_L,1), UBOUND(InData%Nodes_L,1) - IntKiBuf(Int_Xferred) = InData%Nodes_L(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_C,2), UBOUND(InData%Nodes_C,2) - DO i1 = LBOUND(InData%Nodes_C,1), UBOUND(InData%Nodes_C,1) - IntKiBuf(Int_Xferred) = InData%Nodes_C(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFI__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFL_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFR__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__F - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IDI__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI__,1), UBOUND(InData%IDI__,1) - IntKiBuf(Int_Xferred) = InData%IDI__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_Rb,1), UBOUND(InData%IDI_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDI_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_F,1), UBOUND(InData%IDI_F,1) - IntKiBuf(Int_Xferred) = InData%IDI_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDL_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDL_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDL_L,1), UBOUND(InData%IDL_L,1) - IntKiBuf(Int_Xferred) = InData%IDL_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC__,1), UBOUND(InData%IDC__,1) - IntKiBuf(Int_Xferred) = InData%IDC__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_Rb,1), UBOUND(InData%IDC_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDC_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_L,1), UBOUND(InData%IDC_L,1) - IntKiBuf(Int_Xferred) = InData%IDC_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_F,1), UBOUND(InData%IDC_F,1) - IntKiBuf(Int_Xferred) = InData%IDC_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDR__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDR__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDR__,1), UBOUND(InData%IDR__,1) - IntKiBuf(Int_Xferred) = InData%IDR__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__Rb,1), UBOUND(InData%ID__Rb,1) - IntKiBuf(Int_Xferred) = InData%ID__Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__L,1), UBOUND(InData%ID__L,1) - IntKiBuf(Int_Xferred) = InData%ID__L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__F,1), UBOUND(InData%ID__F,1) - IntKiBuf(Int_Xferred) = InData%ID__F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MoutLst2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MoutLst3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst3,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutCBModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFEMModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackParam - - SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%SDDeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF_red = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Nmembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Elems)) DEALLOCATE(OutData%Elems) - ALLOCATE(OutData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) - DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) - OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackelemproptype( Re_Buf, Db_Buf, Int_Buf, OutData%ElemProps(i1), ErrStat2, ErrMsg2 ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FG)) DEALLOCATE(OutData%FG) - ALLOCATE(OutData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) - OutData%FG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DP0)) DEALLOCATE(OutData%DP0) - ALLOCATE(OutData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP0,2), UBOUND(OutData%DP0,2) - DO i1 = LBOUND(OutData%DP0,1), UBOUND(OutData%DP0,1) - OutData%DP0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeID2JointID not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeID2JointID)) DEALLOCATE(OutData%NodeID2JointID) - ALLOCATE(OutData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeID2JointID,1), UBOUND(OutData%NodeID2JointID,1) - OutData%NodeID2JointID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%reduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%reduced) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_red)) DEALLOCATE(OutData%T_red) - ALLOCATE(OutData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red,2), UBOUND(OutData%T_red,2) - DO i1 = LBOUND(OutData%T_red,1), UBOUND(OutData%T_red,1) - OutData%T_red(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_red_T)) DEALLOCATE(OutData%T_red_T) - ALLOCATE(OutData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red_T,2), UBOUND(OutData%T_red_T,2) - DO i1 = LBOUND(OutData%T_red_T,1), UBOUND(OutData%T_red_T,1) - OutData%T_red_T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesDOF)) DEALLOCATE(OutData%NodesDOF) - ALLOCATE(OutData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOF,1), UBOUND(OutData%NodesDOF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOF(i1), ErrStat2, ErrMsg2 ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOFred not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesDOFred)) DEALLOCATE(OutData%NodesDOFred) - ALLOCATE(OutData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOFred,1), UBOUND(OutData%NodesDOFred,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemsDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemsDOF)) DEALLOCATE(OutData%ElemsDOF) - ALLOCATE(OutData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemsDOF,2), UBOUND(OutData%ElemsDOF,2) - DO i1 = LBOUND(OutData%ElemsDOF,1), UBOUND(OutData%ElemsDOF,1) - OutData%ElemsDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOFred2Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DOFred2Nodes)) DEALLOCATE(OutData%DOFred2Nodes) - ALLOCATE(OutData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DOFred2Nodes,2), UBOUND(OutData%DOFred2Nodes,2) - DO i1 = LBOUND(OutData%DOFred2Nodes,1), UBOUND(OutData%DOFred2Nodes,1) - OutData%DOFred2Nodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CtrlElem2Channel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CtrlElem2Channel)) DEALLOCATE(OutData%CtrlElem2Channel) - ALLOCATE(OutData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CtrlElem2Channel,2), UBOUND(OutData%CtrlElem2Channel,2) - DO i1 = LBOUND(OutData%CtrlElem2Channel,1), UBOUND(OutData%CtrlElem2Channel,1) - OutData%CtrlElem2Channel(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SttcSolve = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GuyanLoadCorrection = TRANSFER(IntKiBuf(Int_Xferred), OutData%GuyanLoadCorrection) - Int_Xferred = Int_Xferred + 1 - OutData%Floating = TRANSFER(IntKiBuf(Int_Xferred), OutData%Floating) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KMMDiag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KMMDiag)) DEALLOCATE(OutData%KMMDiag) - ALLOCATE(OutData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%KMMDiag,1), UBOUND(OutData%KMMDiag,1) - OutData%KMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMMDiag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMMDiag)) DEALLOCATE(OutData%CMMDiag) - ALLOCATE(OutData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMMDiag,1), UBOUND(OutData%CMMDiag,1) - OutData%CMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MMB)) DEALLOCATE(OutData%MMB) - ALLOCATE(OutData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) - DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) - OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBmmB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBmmB)) DEALLOCATE(OutData%MBmmB) - ALLOCATE(OutData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBmmB,2), UBOUND(OutData%MBmmB,2) - DO i1 = LBOUND(OutData%MBmmB,1), UBOUND(OutData%MBmmB,1) - OutData%MBmmB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C1_11)) DEALLOCATE(OutData%C1_11) - ALLOCATE(OutData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) - DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) - OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C1_12)) DEALLOCATE(OutData%C1_12) - ALLOCATE(OutData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) - DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) - OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_141 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_141)) DEALLOCATE(OutData%D1_141) - ALLOCATE(OutData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_141,2), UBOUND(OutData%D1_141,2) - DO i1 = LBOUND(OutData%D1_141,1), UBOUND(OutData%D1_141,1) - OutData%D1_141(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_142 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_142)) DEALLOCATE(OutData%D1_142) - ALLOCATE(OutData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_142,2), UBOUND(OutData%D1_142,2) - DO i1 = LBOUND(OutData%D1_142,1), UBOUND(OutData%D1_142,1) - OutData%D1_142(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiM)) DEALLOCATE(OutData%PhiM) - ALLOCATE(OutData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) - DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) - OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C2_61)) DEALLOCATE(OutData%C2_61) - ALLOCATE(OutData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) - DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) - OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C2_62)) DEALLOCATE(OutData%C2_62) - ALLOCATE(OutData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) - DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) - OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiRb_TI)) DEALLOCATE(OutData%PhiRb_TI) - ALLOCATE(OutData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) - DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) - OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D2_63)) DEALLOCATE(OutData%D2_63) - ALLOCATE(OutData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) - DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) - OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D2_64)) DEALLOCATE(OutData%D2_64) - ALLOCATE(OutData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) - DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) - OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CBB)) DEALLOCATE(OutData%CBB) - ALLOCATE(OutData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CBB,2), UBOUND(OutData%CBB,2) - DO i1 = LBOUND(OutData%CBB,1), UBOUND(OutData%CBB,1) - OutData%CBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMM,2), UBOUND(OutData%CMM,2) - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL_T)) DEALLOCATE(OutData%PhiL_T) - ALLOCATE(OutData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) - DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) - OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiLInvOmgL2)) DEALLOCATE(OutData%PhiLInvOmgL2) - ALLOCATE(OutData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) - DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) - OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KLLm1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KLLm1)) DEALLOCATE(OutData%KLLm1) - ALLOCATE(OutData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KLLm1,2), UBOUND(OutData%KLLm1,2) - DO i1 = LBOUND(OutData%KLLm1,1), UBOUND(OutData%KLLm1,1) - OutData%KLLm1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM2Jac)) DEALLOCATE(OutData%AM2Jac) - ALLOCATE(OutData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) - DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) - OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM2JacPiv)) DEALLOCATE(OutData%AM2JacPiv) - ALLOCATE(OutData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) - OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI)) DEALLOCATE(OutData%TI) - ALLOCATE(OutData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TIreact)) DEALLOCATE(OutData%TIreact) - ALLOCATE(OutData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) - DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) - OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%nNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_I = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_C = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_I not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_I)) DEALLOCATE(OutData%Nodes_I) - ALLOCATE(OutData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_I,2), UBOUND(OutData%Nodes_I,2) - DO i1 = LBOUND(OutData%Nodes_I,1), UBOUND(OutData%Nodes_I,1) - OutData%Nodes_I(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_L)) DEALLOCATE(OutData%Nodes_L) - ALLOCATE(OutData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_L,2), UBOUND(OutData%Nodes_L,2) - DO i1 = LBOUND(OutData%Nodes_L,1), UBOUND(OutData%Nodes_L,1) - OutData%Nodes_L(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_C)) DEALLOCATE(OutData%Nodes_C) - ALLOCATE(OutData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_C,2), UBOUND(OutData%Nodes_C,2) - DO i1 = LBOUND(OutData%Nodes_C,1), UBOUND(OutData%Nodes_C,1) - OutData%Nodes_C(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFI__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFL_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFR__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI__)) DEALLOCATE(OutData%IDI__) - ALLOCATE(OutData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI__,1), UBOUND(OutData%IDI__,1) - OutData%IDI__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI_Rb)) DEALLOCATE(OutData%IDI_Rb) - ALLOCATE(OutData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_Rb,1), UBOUND(OutData%IDI_Rb,1) - OutData%IDI_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI_F)) DEALLOCATE(OutData%IDI_F) - ALLOCATE(OutData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_F,1), UBOUND(OutData%IDI_F,1) - OutData%IDI_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDL_L)) DEALLOCATE(OutData%IDL_L) - ALLOCATE(OutData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDL_L,1), UBOUND(OutData%IDL_L,1) - OutData%IDL_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC__)) DEALLOCATE(OutData%IDC__) - ALLOCATE(OutData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC__,1), UBOUND(OutData%IDC__,1) - OutData%IDC__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_Rb)) DEALLOCATE(OutData%IDC_Rb) - ALLOCATE(OutData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_Rb,1), UBOUND(OutData%IDC_Rb,1) - OutData%IDC_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_L)) DEALLOCATE(OutData%IDC_L) - ALLOCATE(OutData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_L,1), UBOUND(OutData%IDC_L,1) - OutData%IDC_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_F)) DEALLOCATE(OutData%IDC_F) - ALLOCATE(OutData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_F,1), UBOUND(OutData%IDC_F,1) - OutData%IDC_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDR__)) DEALLOCATE(OutData%IDR__) - ALLOCATE(OutData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDR__,1), UBOUND(OutData%IDR__,1) - OutData%IDR__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__Rb)) DEALLOCATE(OutData%ID__Rb) - ALLOCATE(OutData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__Rb,1), UBOUND(OutData%ID__Rb,1) - OutData%ID__Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__L)) DEALLOCATE(OutData%ID__L) - ALLOCATE(OutData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__L,1), UBOUND(OutData%ID__L,1) - OutData%ID__L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__F)) DEALLOCATE(OutData%ID__F) - ALLOCATE(OutData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__F,1), UBOUND(OutData%ID__F,1) - OutData%ID__F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst)) DEALLOCATE(OutData%MoutLst) - ALLOCATE(OutData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst,1), UBOUND(OutData%MoutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst(i1), ErrStat2, ErrMsg2 ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst2)) DEALLOCATE(OutData%MoutLst2) - ALLOCATE(OutData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst2,1), UBOUND(OutData%MoutLst2,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst2(i1), ErrStat2, ErrMsg2 ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst3)) DEALLOCATE(OutData%MoutLst3) - ALLOCATE(OutData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst3,1), UBOUND(OutData%MoutLst3,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst3(i1), ErrStat2, ErrMsg2 ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%OutCBModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutFEMModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%dx,1) - i1_u = UBOUND(OutData%dx,1) - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackParam - - SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%CableDeltaL,1) - i1_u = UBOUND(SrcInputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%CableDeltaL)) THEN - ALLOCATE(DstInputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CableDeltaL = SrcInputData%CableDeltaL -ENDIF - END SUBROUTINE SD_CopyInput - - SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%CableDeltaL)) THEN - DEALLOCATE(InputData%CableDeltaL) -ENDIF - END SUBROUTINE SD_DestroyInput - - SUBROUTINE SD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInput - - SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInput - - SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE SD_CopyOutput - - SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(SD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SD_DestroyOutput - - SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Y1Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y1Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y1Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y1Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y3Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y3Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y3Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y3Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackOutput - - SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackOutput - - - SUBROUTINE SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SD_Input_ExtrapInterp - - - SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = -(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp1 - - - SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = (t(3)**2*(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) + t(2)**2*(-u1%CableDeltaL(i1) + u3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%CableDeltaL(i1) + t(3)*u2%CableDeltaL(i1) - t(2)*u3%CableDeltaL(i1) ) * scaleFactor - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp2 - - - SUBROUTINE SD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SD_Output_ExtrapInterp - - - SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Output_ExtrapInterp1 - - - SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Output_ExtrapInterp2 - -END MODULE SubDyn_Types -!ENDOFREGISTRYGENERATEDFILE +!STARTOFREGISTRYGENERATEDFILE 'SubDyn_Types.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************* +! SubDyn_Types +!................................................................................................................................. +! This file is part of SubDyn. +! +! Copyright (C) 2012-2016 National Renewable Energy Laboratory +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! +! +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! +!********************************************************************************************************************************* +!> This module contains the user-defined types needed in SubDyn. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. +MODULE SubDyn_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE +! ========= IList ======= + TYPE, PUBLIC :: IList + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: List !< List of integers [-] + END TYPE IList +! ======================= +! ========= MeshAuxDataType ======= + TYPE, PUBLIC :: MeshAuxDataType + INTEGER(IntKi) :: MemberID !< Member ID for Output [-] + INTEGER(IntKi) :: NOutCnt !< Number of Nodes for the output member [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeCnt !< Node ordinal numbers for the output member [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIDs !< Node IDs associated with ordinal numbers for the output member [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmIDs !< Element IDs connected to each NodeIDs; max 10 elements [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmNds !< Flag to indicate 1st or 2nd node of element for each ElmIDs [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Me !< Mass matrix connected to each joint element for outAll output [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: Ke !< Mass matrix connected to each joint element for outAll output [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Fg !< Gravity load vector connected to each joint element for requested member output [-] + END TYPE MeshAuxDataType +! ======================= +! ========= CB_MatArrays ======= + TYPE, PUBLIC :: CB_MatArrays + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: MBB !< FULL MBB ( no constraints applied) [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: MBM !< FULL MBM ( no constraints applied) [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: KBB !< FULL KBB ( no constraints applied) [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: PhiL !< Retained CB modes, possibly allPhiL(nDOFL,nDOFL), or PhiL(nDOFL,nDOFM) [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: PhiR !< FULL PhiR ( no constraints applied) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: OmegaL !< Eigenvalues of retained CB modes, possibly all (nDOFL or nDOFM) [-] + END TYPE CB_MatArrays +! ======================= +! ========= ElemPropType ======= + TYPE, PUBLIC :: ElemPropType + INTEGER(IntKi) :: eType !< Element Type [-] + REAL(ReKi) :: Length !< Length of an element [-] + REAL(ReKi) :: Ixx !< Moment of inertia of an element [-] + REAL(ReKi) :: Iyy !< Moment of inertia of an element [-] + REAL(ReKi) :: Jzz !< Moment of inertia of an element [-] + LOGICAL :: Shear !< Use timoshenko (true) E-B (false) [-] + REAL(ReKi) :: Kappa_x !< Shear coefficient [-] + REAL(ReKi) :: Kappa_y !< Shear coefficient [-] + REAL(ReKi) :: YoungE !< Young's modulus [-] + REAL(ReKi) :: ShearG !< Shear modulus [N/m^2] + REAL(ReKi) , DIMENSION(1:2) :: D !< Diameter at node 1 and 2, for visualization only [m] + REAL(ReKi) :: Area !< Area of an element [m^2] + REAL(ReKi) :: Rho !< Density [kg/m^3] + REAL(ReKi) :: T0 !< Pretension [N] + REAL(ReKi) :: k11 !< Spring translational stiffness [N/m] + REAL(ReKi) :: k12 !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k13 !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k14 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k15 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k16 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k22 !< Spring translational stiffness [N/m] + REAL(ReKi) :: k23 !< Spring cross-coupling stiffness [N/m] + REAL(ReKi) :: k24 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k25 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k26 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k33 !< Spring translational stiffness [N/m] + REAL(ReKi) :: k34 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k35 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k36 !< Spring cross-coupling stiffness [N/rad] + REAL(ReKi) :: k44 !< Spring rotational stiffness [Nm/rad] + REAL(ReKi) :: k45 !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k46 !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k55 !< Spring rotational stiffness [Nm/rad] + REAL(ReKi) :: k56 !< Spring cross-coupling stiffness [Nm/rad] + REAL(ReKi) :: k66 !< Spring rotational stiffness [Nm/rad] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< Element direction cosine matrix [-] + END TYPE ElemPropType +! ======================= +! ========= SD_InitInputType ======= + TYPE, PUBLIC :: SD_InitInputType + CHARACTER(1024) :: SDInputFile !< Name of the input file [-] + CHARACTER(1024) :: RootName !< SubDyn rootname [-] + REAL(ReKi) :: g !< Gravity acceleration [-] + REAL(ReKi) :: WtrDpth !< Water Depth (positive valued) [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SoilStiffness !< Soil stiffness matrices from SoilDyn ['(N/m,] + TYPE(MeshType) :: SoilMesh !< Mesh for soil stiffness locations [-] + LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + END TYPE SD_InitInputType +! ======================= +! ========= SD_InitOutputType ======= + TYPE, PUBLIC :: SD_InitOutputType + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: CableCChanRqst !< flag indicating control channel for active cable tensioning is requested [-] + END TYPE SD_InitOutputType +! ======================= +! ========= SD_InitType ======= + TYPE, PUBLIC :: SD_InitType + CHARACTER(1024) :: RootName !< SubDyn rootname [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] + REAL(ReKi) :: g !< Gravity acceleration [-] + REAL(DbKi) :: DT !< Time step from Glue Code [seconds] + INTEGER(IntKi) :: NJoints !< Number of joints of the sub structure [-] + INTEGER(IntKi) :: NPropSetsX !< Number of extended property sets [-] + INTEGER(IntKi) :: NPropSetsB !< Number of property sets for beams [-] + INTEGER(IntKi) :: NPropSetsC !< Number of property sets for cables [-] + INTEGER(IntKi) :: NPropSetsR !< Number of property sets for rigid links [-] + INTEGER(IntKi) :: NPropSetsS !< Number of property sets for spring elements [-] + INTEGER(IntKi) :: NCMass !< Number of joints with concentrated mass [-] + INTEGER(IntKi) :: NCOSMs !< Number of independent cosine matrices [-] + INTEGER(IntKi) :: FEMMod !< FEM switch element model in the FEM [-] + INTEGER(IntKi) :: NDiv !< Number of divisions for each member [-] + LOGICAL :: CBMod !< Perform C-B flag [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Joints !< Joints number and coordinate values [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsB !< Property sets number and values [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsC !< Property ID and values for cables [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsR !< Property ID and values for rigid link [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsS !< Property ID and values for spring element [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsX !< Extended property sets [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: COSMs !< Independent direction cosine matrices [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMass !< Concentrated mass information [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] + INTEGER(IntKi) :: GuyanDampMod !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] + REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] + REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat !< Guyan Damping Matrix, see also CBB [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] + LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] + LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIK !< SSI stiffness packed matrix elements (21 of them), for each reaction joint [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIM !< SSI mass packed matrix elements (21 of them), for each reaction joint [-] + CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SSIfile !< Soil Structure Interaction (SSI) files to associate with each reaction node [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Soil_K !< Soil stiffness (at passed at Init, not in input file) 6x6xn [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Soil_Points !< Node positions where soil stiffness will be added [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Soil_Nodes !< Node indices where soil stiffness will be added [-] + INTEGER(IntKi) :: NElem !< Total number of elements [-] + INTEGER(IntKi) :: NPropB !< Total number of property sets for Beams [-] + INTEGER(IntKi) :: NPropC !< Total number of property sets for Cable [-] + INTEGER(IntKi) :: NPropR !< Total number of property sets for Rigid [-] + INTEGER(IntKi) :: NPropS !< Total number of property sets for Spring [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes !< Nodes number and coordinates [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsB !< Property sets and values for Beams [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsC !< Property sets and values for Cable [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsR !< Property sets and values for Rigid link [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsS !< Property sets and values for Spring [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: K !< System stiffness matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: M !< System mass matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ElemProps !< Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) ) [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: MemberNodes !< Member number and list of nodes making up a member (>2 if subdivided) [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnN !< Nodes that connect to a common node [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnE !< Elements that connect to a common node [-] + LOGICAL :: SSSum !< SubDyn Summary File Flag [-] + END TYPE SD_InitType +! ======================= +! ========= SD_ContinuousStateType ======= + TYPE, PUBLIC :: SD_ContinuousStateType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: qm !< Virtual states, Nmod elements [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: qmdot !< Derivative of states, Nmod elements [-] + END TYPE SD_ContinuousStateType +! ======================= +! ========= SD_DiscreteStateType ======= + TYPE, PUBLIC :: SD_DiscreteStateType + REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + END TYPE SD_DiscreteStateType +! ======================= +! ========= SD_ConstraintStateType ======= + TYPE, PUBLIC :: SD_ConstraintStateType + REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + END TYPE SD_ConstraintStateType +! ======================= +! ========= SD_OtherStateType ======= + TYPE, PUBLIC :: SD_OtherStateType + TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state derivs for m-step time integrator [-] + INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated last [-] + END TYPE SD_OtherStateType +! ======================= +! ========= SD_MiscVarType ======= + TYPE, PUBLIC :: SD_MiscVarType + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] + REAL(ReKi) , DIMENSION(1:6) :: u_TP + REAL(ReKi) , DIMENSION(1:6) :: udot_TP + REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL !< Internal DOFs (L) displacements [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_NS !< Internal DOFs (L) displacements, No SIM (NS) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DU_full !< Delta U used for extra moment, size nDOF [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full !< Displacement of all DOFs (full system) with SIM [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_NS !< Displacement of all DOFs (full system), No SIM (NS) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_dotdot + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_full_elast !< Elastic displacements for computation of K ue (without rigid body mode for floating), includes SIM [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_red + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] + REAL(DbKi) :: LastOutTime !< The time of the most recent stored output data [s] + INTEGER(IntKi) :: Decimat !< Current output decimation counter [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_0m !< Intermediate UL term for SIM = PhiM qm0, size nL [-] + END TYPE SD_MiscVarType +! ======================= +! ========= SD_ParameterType ======= + TYPE, PUBLIC :: SD_ParameterType + REAL(DbKi) :: SDDeltaT !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: IntMethod !< Integration Method (1/2/3)Length of y2 array [-] + INTEGER(IntKi) :: nDOF !< Total degree of freedom [-] + INTEGER(IntKi) :: nDOF_red !< Total degree of freedom after constraint reduction [-] + INTEGER(IntKi) :: Nmembers !< Number of members of the sub structure [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] + TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] + LOGICAL :: reduced !< True if system has been reduced to account for constraints [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] + TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOF !< DOF indices of each nodes in unconstrained assembled system [-] + TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOFred !< DOF indices of each nodes in constrained assembled system [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElemsDOF !< 12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: DOFred2Nodes !< nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1 [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CtrlElem2Channel !< nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index [-] + INTEGER(IntKi) :: nDOFM !< retained degrees of freedom (modes) [-] + INTEGER(IntKi) :: SttcSolve !< Solve dynamics about static equilibrium point (flag) [-] + LOGICAL :: GuyanLoadCorrection !< Add Extra lever arm contribution to interface reaction outputs [-] + LOGICAL :: Floating !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: KMMDiag !< Diagonal coefficients of Kmm (OmegaM squared) [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMMDiag !< Diagonal coefficients of Cmm (~2 Zeta OmegaM)) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MMB !< Matrix after C-B reduction (transpose of MBM [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBmmB !< MBm * MmB, used for Y1 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_11 !< Coefficient of x in Y1 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_12 !< Coefficient of x in Y1 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_141 !< MBm PhiM^T [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_142 !< TI^T PhiR^T [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiM !< Coefficient of x in Y2 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_61 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_62 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiRb_TI !< Coefficient of u in Y2 (Phi_R bar * TI) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_63 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_64 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBB !< Guyan Mass Matrix after C-B reduction [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KBB !< Guyan Stiffness Matrix after C-B reduction [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CBB !< Guyan Damping Matrix after C-B reduction [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMM !< CB damping matrix [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBM !< Matrix after C-B reduction [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiL_T !< Transpose of Matrix of C-B modes [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiLInvOmgL2 !< Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KLLm1 !< KLL^{-1}, inverse of matrix KLL, for static solve only [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AM2Jac !< Jacobian (factored) for Adams-Boulton 2nd order Integration [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AM2JacPiv !< Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI !< Matrix to calculate TP reference point reaction at top of structure [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIreact !< Matrix to calculate single point reaction at base of structure [-] + INTEGER(IntKi) :: nNodes !< Total number of nodes [-] + INTEGER(IntKi) :: nNodes_I !< Number of Interface nodes [-] + INTEGER(IntKi) :: nNodes_L !< Number of Internal nodes [-] + INTEGER(IntKi) :: nNodes_C !< Number of joints with reactions [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_I !< Interface degree of freedoms [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_L !< Internal nodes (not interface nor reaction) [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_C !< React degree of freedoms [-] + INTEGER(IntKi) :: nDOFI__ !< Size of IDI__ [-] + INTEGER(IntKi) :: nDOFI_Rb !< Size of IDI_Rb [-] + INTEGER(IntKi) :: nDOFI_F !< Size of IDI_F [-] + INTEGER(IntKi) :: nDOFL_L !< Size of IDL_L [-] + INTEGER(IntKi) :: nDOFC__ !< Size of IDC__ [-] + INTEGER(IntKi) :: nDOFC_Rb !< Size of IDC_Rb [-] + INTEGER(IntKi) :: nDOFC_L !< Size of IDC_L [-] + INTEGER(IntKi) :: nDOFC_F !< Size of IDC_F [-] + INTEGER(IntKi) :: nDOFR__ !< Size of IDR__ [-] + INTEGER(IntKi) :: nDOF__Rb !< Size of ID__Rb [-] + INTEGER(IntKi) :: nDOF__L !< Size of ID__L [-] + INTEGER(IntKi) :: nDOF__F !< Size of ID__F [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI__ !< Index of all Interface DOFs [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_Rb !< Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_F !< Index array of the interface (nodes connect to TP) dofs that are fixed DOF [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDL_L !< Index array of the internal dofs coming from internal nodes [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC__ !< Index of all bottom DOF [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_Rb !< Index array of the contraint dofs that are retained/master/follower DOF [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_L !< Index array of the contraint dofs that are follower/internal DOF [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDC_F !< Index array of the contraint dofs that are fixd DOF [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDR__ !< Index array of the interface and restraint dofs [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__Rb !< Index array of all the retained/leader/master dofs (from any nodes of the structure) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__L !< Index array of all the follower/internal dofs (from any nodes of the structure) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__F !< Index array of the DOF that are fixed (from any nodes of the structure) [-] + INTEGER(IntKi) :: NMOutputs !< Number of members whose output is written [-] + INTEGER(IntKi) :: NumOuts !< Number of output channels read from input file [-] + INTEGER(IntKi) :: OutSwtch !< Output Requested Channels to local or global output file [1/2/3] [-] + INTEGER(IntKi) :: UnJckF !< Unit of SD ouput file [-] + CHARACTER(1) :: Delim !< Column delimiter for output text files [-] + CHARACTER(20) :: OutFmt !< Format for Output [-] + CHARACTER(20) :: OutSFmt !< Format for Output Headers [-] + TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst !< List of user requested members and nodes [-] + TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst2 !< List of all member joint nodes and elements for output [-] + TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst3 !< List of all member joint nodes and elements for output [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. logical [-] + LOGICAL :: OutAll !< Flag to output or not all joint forces [-] + INTEGER(IntKi) :: OutCBModes !< Flag to output CB and Guyan modes to a given format [-] + INTEGER(IntKi) :: OutFEMModes !< Flag to output FEM modes to a given format [-] + LOGICAL :: OutReact !< Flag to check whether reactions are requested [-] + INTEGER(IntKi) :: OutAllInt !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutAllDims !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutDec !< Output Decimation for Requested Channels [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] + REAL(R8Ki) , DIMENSION(1:2) :: dx !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] + END TYPE SD_ParameterType +! ======================= +! ========= SD_InputType ======= + TYPE, PUBLIC :: SD_InputType + TYPE(MeshType) :: TPMesh !< Transition piece inputs on a point mesh [-] + TYPE(MeshType) :: LMesh !< Point mesh for interior node inputs [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< Cable tension, control input [-] + END TYPE SD_InputType +! ======================= +! ========= SD_OutputType ======= + TYPE, PUBLIC :: SD_OutputType + TYPE(MeshType) :: Y1Mesh !< Transition piece outputs on a point mesh [-] + TYPE(MeshType) :: Y2Mesh !< Interior+Interface nodes rigid body displacements + elastic velocities and accelerations on a point mesh [-] + TYPE(MeshType) :: Y3Mesh !< Interior+Interface nodes full elastic displacements/velocities and accelerations on a point mesh [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file [-] + END TYPE SD_OutputType +! ======================= +CONTAINS + SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IList), INTENT(IN) :: SrcIListData + TYPE(IList), INTENT(INOUT) :: DstIListData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyIList' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcIListData%List)) THEN + i1_l = LBOUND(SrcIListData%List,1) + i1_u = UBOUND(SrcIListData%List,1) + IF (.NOT. ALLOCATED(DstIListData%List)) THEN + ALLOCATE(DstIListData%List(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstIListData%List = SrcIListData%List +ENDIF + END SUBROUTINE SD_CopyIList + + SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(IList), INTENT(INOUT) :: IListData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(IListData%List)) THEN + DEALLOCATE(IListData%List) +ENDIF + END SUBROUTINE SD_DestroyIList + + SUBROUTINE SD_PackIList( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(IList), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackIList' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! List allocated yes/no + IF ( ALLOCATED(InData%List) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! List upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%List) ! List + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%List) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%List,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%List,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%List,1), UBOUND(InData%List,1) + IntKiBuf(Int_Xferred) = InData%List(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackIList + + SUBROUTINE SD_UnPackIList( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(IList), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackIList' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! List not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%List)) DEALLOCATE(OutData%List) + ALLOCATE(OutData%List(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%List,1), UBOUND(OutData%List,1) + OutData%List(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackIList + + SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData + TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMeshAuxDataType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID + DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt +IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeCnt)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeCnt)) THEN + ALLOCATE(DstMeshAuxDataTypeData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt +ENDIF +IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeIDs)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeIDs)) THEN + ALLOCATE(DstMeshAuxDataTypeData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs +ENDIF +IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmIDs)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) + i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) + i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmIDs)) THEN + ALLOCATE(DstMeshAuxDataTypeData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs +ENDIF +IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmNds)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,1) + i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,2) + i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,2) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmNds)) THEN + ALLOCATE(DstMeshAuxDataTypeData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds +ENDIF +IF (ALLOCATED(SrcMeshAuxDataTypeData%Me)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%Me,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%Me,1) + i2_l = LBOUND(SrcMeshAuxDataTypeData%Me,2) + i2_u = UBOUND(SrcMeshAuxDataTypeData%Me,2) + i3_l = LBOUND(SrcMeshAuxDataTypeData%Me,3) + i3_u = UBOUND(SrcMeshAuxDataTypeData%Me,3) + i4_l = LBOUND(SrcMeshAuxDataTypeData%Me,4) + i4_u = UBOUND(SrcMeshAuxDataTypeData%Me,4) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Me)) THEN + ALLOCATE(DstMeshAuxDataTypeData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me +ENDIF +IF (ALLOCATED(SrcMeshAuxDataTypeData%Ke)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%Ke,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%Ke,1) + i2_l = LBOUND(SrcMeshAuxDataTypeData%Ke,2) + i2_u = UBOUND(SrcMeshAuxDataTypeData%Ke,2) + i3_l = LBOUND(SrcMeshAuxDataTypeData%Ke,3) + i3_u = UBOUND(SrcMeshAuxDataTypeData%Ke,3) + i4_l = LBOUND(SrcMeshAuxDataTypeData%Ke,4) + i4_u = UBOUND(SrcMeshAuxDataTypeData%Ke,4) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Ke)) THEN + ALLOCATE(DstMeshAuxDataTypeData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke +ENDIF +IF (ALLOCATED(SrcMeshAuxDataTypeData%Fg)) THEN + i1_l = LBOUND(SrcMeshAuxDataTypeData%Fg,1) + i1_u = UBOUND(SrcMeshAuxDataTypeData%Fg,1) + i2_l = LBOUND(SrcMeshAuxDataTypeData%Fg,2) + i2_u = UBOUND(SrcMeshAuxDataTypeData%Fg,2) + i3_l = LBOUND(SrcMeshAuxDataTypeData%Fg,3) + i3_u = UBOUND(SrcMeshAuxDataTypeData%Fg,3) + IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Fg)) THEN + ALLOCATE(DstMeshAuxDataTypeData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg +ENDIF + END SUBROUTINE SD_CopyMeshAuxDataType + + SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN + DEALLOCATE(MeshAuxDataTypeData%NodeCnt) +ENDIF +IF (ALLOCATED(MeshAuxDataTypeData%NodeIDs)) THEN + DEALLOCATE(MeshAuxDataTypeData%NodeIDs) +ENDIF +IF (ALLOCATED(MeshAuxDataTypeData%ElmIDs)) THEN + DEALLOCATE(MeshAuxDataTypeData%ElmIDs) +ENDIF +IF (ALLOCATED(MeshAuxDataTypeData%ElmNds)) THEN + DEALLOCATE(MeshAuxDataTypeData%ElmNds) +ENDIF +IF (ALLOCATED(MeshAuxDataTypeData%Me)) THEN + DEALLOCATE(MeshAuxDataTypeData%Me) +ENDIF +IF (ALLOCATED(MeshAuxDataTypeData%Ke)) THEN + DEALLOCATE(MeshAuxDataTypeData%Ke) +ENDIF +IF (ALLOCATED(MeshAuxDataTypeData%Fg)) THEN + DEALLOCATE(MeshAuxDataTypeData%Fg) +ENDIF + END SUBROUTINE SD_DestroyMeshAuxDataType + + SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MeshAuxDataType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMeshAuxDataType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! MemberID + Int_BufSz = Int_BufSz + 1 ! NOutCnt + Int_BufSz = Int_BufSz + 1 ! NodeCnt allocated yes/no + IF ( ALLOCATED(InData%NodeCnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NodeCnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NodeCnt) ! NodeCnt + END IF + Int_BufSz = Int_BufSz + 1 ! NodeIDs allocated yes/no + IF ( ALLOCATED(InData%NodeIDs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NodeIDs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NodeIDs) ! NodeIDs + END IF + Int_BufSz = Int_BufSz + 1 ! ElmIDs allocated yes/no + IF ( ALLOCATED(InData%ElmIDs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! ElmIDs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ElmIDs) ! ElmIDs + END IF + Int_BufSz = Int_BufSz + 1 ! ElmNds allocated yes/no + IF ( ALLOCATED(InData%ElmNds) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! ElmNds upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ElmNds) ! ElmNds + END IF + Int_BufSz = Int_BufSz + 1 ! Me allocated yes/no + IF ( ALLOCATED(InData%Me) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Me upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Me) ! Me + END IF + Int_BufSz = Int_BufSz + 1 ! Ke allocated yes/no + IF ( ALLOCATED(InData%Ke) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Ke upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Ke) ! Ke + END IF + Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no + IF ( ALLOCATED(InData%Fg) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutCnt + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeCnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) + IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NodeIDs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIDs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) + IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ElmIDs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) + DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) + IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ElmNds) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) + DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) + IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Me) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) + DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) + DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) + DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) + DbKiBuf(Db_Xferred) = InData%Me(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Ke) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) + DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) + DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) + DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) + DbKiBuf(Db_Xferred) = InData%Ke(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Fg) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) + DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) + DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) + DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE SD_PackMeshAuxDataType + + SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MeshAuxDataType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMeshAuxDataType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutCnt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodeCnt)) DEALLOCATE(OutData%NodeCnt) + ALLOCATE(OutData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) + OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodeIDs)) DEALLOCATE(OutData%NodeIDs) + ALLOCATE(OutData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) + OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ElmIDs)) DEALLOCATE(OutData%ElmIDs) + ALLOCATE(OutData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) + DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) + OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ElmNds)) DEALLOCATE(OutData%ElmNds) + ALLOCATE(OutData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) + DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) + OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Me)) DEALLOCATE(OutData%Me) + ALLOCATE(OutData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) + DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) + DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) + DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) + OutData%Me(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Ke)) DEALLOCATE(OutData%Ke) + ALLOCATE(OutData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) + DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) + DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) + DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) + OutData%Ke(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Fg)) DEALLOCATE(OutData%Fg) + ALLOCATE(OutData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) + DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) + DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) + OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE SD_UnPackMeshAuxDataType + + SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) + TYPE(CB_MatArrays), INTENT(IN) :: SrcCB_MatArraysData + TYPE(CB_MatArrays), INTENT(INOUT) :: DstCB_MatArraysData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyCB_MatArrays' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcCB_MatArraysData%MBB)) THEN + i1_l = LBOUND(SrcCB_MatArraysData%MBB,1) + i1_u = UBOUND(SrcCB_MatArraysData%MBB,1) + i2_l = LBOUND(SrcCB_MatArraysData%MBB,2) + i2_u = UBOUND(SrcCB_MatArraysData%MBB,2) + IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBB)) THEN + ALLOCATE(DstCB_MatArraysData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB +ENDIF +IF (ALLOCATED(SrcCB_MatArraysData%MBM)) THEN + i1_l = LBOUND(SrcCB_MatArraysData%MBM,1) + i1_u = UBOUND(SrcCB_MatArraysData%MBM,1) + i2_l = LBOUND(SrcCB_MatArraysData%MBM,2) + i2_u = UBOUND(SrcCB_MatArraysData%MBM,2) + IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBM)) THEN + ALLOCATE(DstCB_MatArraysData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM +ENDIF +IF (ALLOCATED(SrcCB_MatArraysData%KBB)) THEN + i1_l = LBOUND(SrcCB_MatArraysData%KBB,1) + i1_u = UBOUND(SrcCB_MatArraysData%KBB,1) + i2_l = LBOUND(SrcCB_MatArraysData%KBB,2) + i2_u = UBOUND(SrcCB_MatArraysData%KBB,2) + IF (.NOT. ALLOCATED(DstCB_MatArraysData%KBB)) THEN + ALLOCATE(DstCB_MatArraysData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB +ENDIF +IF (ALLOCATED(SrcCB_MatArraysData%PhiL)) THEN + i1_l = LBOUND(SrcCB_MatArraysData%PhiL,1) + i1_u = UBOUND(SrcCB_MatArraysData%PhiL,1) + i2_l = LBOUND(SrcCB_MatArraysData%PhiL,2) + i2_u = UBOUND(SrcCB_MatArraysData%PhiL,2) + IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiL)) THEN + ALLOCATE(DstCB_MatArraysData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL +ENDIF +IF (ALLOCATED(SrcCB_MatArraysData%PhiR)) THEN + i1_l = LBOUND(SrcCB_MatArraysData%PhiR,1) + i1_u = UBOUND(SrcCB_MatArraysData%PhiR,1) + i2_l = LBOUND(SrcCB_MatArraysData%PhiR,2) + i2_u = UBOUND(SrcCB_MatArraysData%PhiR,2) + IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiR)) THEN + ALLOCATE(DstCB_MatArraysData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR +ENDIF +IF (ALLOCATED(SrcCB_MatArraysData%OmegaL)) THEN + i1_l = LBOUND(SrcCB_MatArraysData%OmegaL,1) + i1_u = UBOUND(SrcCB_MatArraysData%OmegaL,1) + IF (.NOT. ALLOCATED(DstCB_MatArraysData%OmegaL)) THEN + ALLOCATE(DstCB_MatArraysData%OmegaL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL +ENDIF + END SUBROUTINE SD_CopyCB_MatArrays + + SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(CB_MatArraysData%MBB)) THEN + DEALLOCATE(CB_MatArraysData%MBB) +ENDIF +IF (ALLOCATED(CB_MatArraysData%MBM)) THEN + DEALLOCATE(CB_MatArraysData%MBM) +ENDIF +IF (ALLOCATED(CB_MatArraysData%KBB)) THEN + DEALLOCATE(CB_MatArraysData%KBB) +ENDIF +IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN + DEALLOCATE(CB_MatArraysData%PhiL) +ENDIF +IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN + DEALLOCATE(CB_MatArraysData%PhiR) +ENDIF +IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN + DEALLOCATE(CB_MatArraysData%OmegaL) +ENDIF + END SUBROUTINE SD_DestroyCB_MatArrays + + SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(CB_MatArrays), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackCB_MatArrays' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no + IF ( ALLOCATED(InData%MBB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%MBB) ! MBB + END IF + Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no + IF ( ALLOCATED(InData%MBM) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%MBM) ! MBM + END IF + Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no + IF ( ALLOCATED(InData%KBB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%KBB) ! KBB + END IF + Int_BufSz = Int_BufSz + 1 ! PhiL allocated yes/no + IF ( ALLOCATED(InData%PhiL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PhiL upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%PhiL) ! PhiL + END IF + Int_BufSz = Int_BufSz + 1 ! PhiR allocated yes/no + IF ( ALLOCATED(InData%PhiR) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PhiR upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%PhiR) ! PhiR + END IF + Int_BufSz = Int_BufSz + 1 ! OmegaL allocated yes/no + IF ( ALLOCATED(InData%OmegaL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OmegaL upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%OmegaL) ! OmegaL + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%MBB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + DbKiBuf(Db_Xferred) = InData%MBB(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MBM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + DbKiBuf(Db_Xferred) = InData%MBM(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%KBB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + DbKiBuf(Db_Xferred) = InData%KBB(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) + DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) + DbKiBuf(Db_Xferred) = InData%PhiL(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) + DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) + DbKiBuf(Db_Xferred) = InData%PhiR(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OmegaL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) + DbKiBuf(Db_Xferred) = InData%OmegaL(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackCB_MatArrays + + SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(CB_MatArrays), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackCB_MatArrays' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) + ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) + ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) + ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PhiL)) DEALLOCATE(OutData%PhiL) + ALLOCATE(OutData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) + DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) + OutData%PhiL(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PhiR)) DEALLOCATE(OutData%PhiR) + ALLOCATE(OutData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) + DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) + OutData%PhiR(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OmegaL)) DEALLOCATE(OutData%OmegaL) + ALLOCATE(OutData%OmegaL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) + OutData%OmegaL(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackCB_MatArrays + + SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ElemPropType), INTENT(IN) :: SrcElemPropTypeData + TYPE(ElemPropType), INTENT(INOUT) :: DstElemPropTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyElemPropType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstElemPropTypeData%eType = SrcElemPropTypeData%eType + DstElemPropTypeData%Length = SrcElemPropTypeData%Length + DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx + DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy + DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz + DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear + DstElemPropTypeData%Kappa_x = SrcElemPropTypeData%Kappa_x + DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y + DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE + DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG + DstElemPropTypeData%D = SrcElemPropTypeData%D + DstElemPropTypeData%Area = SrcElemPropTypeData%Area + DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho + DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 + DstElemPropTypeData%k11 = SrcElemPropTypeData%k11 + DstElemPropTypeData%k12 = SrcElemPropTypeData%k12 + DstElemPropTypeData%k13 = SrcElemPropTypeData%k13 + DstElemPropTypeData%k14 = SrcElemPropTypeData%k14 + DstElemPropTypeData%k15 = SrcElemPropTypeData%k15 + DstElemPropTypeData%k16 = SrcElemPropTypeData%k16 + DstElemPropTypeData%k22 = SrcElemPropTypeData%k22 + DstElemPropTypeData%k23 = SrcElemPropTypeData%k23 + DstElemPropTypeData%k24 = SrcElemPropTypeData%k24 + DstElemPropTypeData%k25 = SrcElemPropTypeData%k25 + DstElemPropTypeData%k26 = SrcElemPropTypeData%k26 + DstElemPropTypeData%k33 = SrcElemPropTypeData%k33 + DstElemPropTypeData%k34 = SrcElemPropTypeData%k34 + DstElemPropTypeData%k35 = SrcElemPropTypeData%k35 + DstElemPropTypeData%k36 = SrcElemPropTypeData%k36 + DstElemPropTypeData%k44 = SrcElemPropTypeData%k44 + DstElemPropTypeData%k45 = SrcElemPropTypeData%k45 + DstElemPropTypeData%k46 = SrcElemPropTypeData%k46 + DstElemPropTypeData%k55 = SrcElemPropTypeData%k55 + DstElemPropTypeData%k56 = SrcElemPropTypeData%k56 + DstElemPropTypeData%k66 = SrcElemPropTypeData%k66 + DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos + END SUBROUTINE SD_CopyElemPropType + + SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE SD_DestroyElemPropType + + SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ElemPropType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackElemPropType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! eType + Re_BufSz = Re_BufSz + 1 ! Length + Re_BufSz = Re_BufSz + 1 ! Ixx + Re_BufSz = Re_BufSz + 1 ! Iyy + Re_BufSz = Re_BufSz + 1 ! Jzz + Int_BufSz = Int_BufSz + 1 ! Shear + Re_BufSz = Re_BufSz + 1 ! Kappa_x + Re_BufSz = Re_BufSz + 1 ! Kappa_y + Re_BufSz = Re_BufSz + 1 ! YoungE + Re_BufSz = Re_BufSz + 1 ! ShearG + Re_BufSz = Re_BufSz + SIZE(InData%D) ! D + Re_BufSz = Re_BufSz + 1 ! Area + Re_BufSz = Re_BufSz + 1 ! Rho + Re_BufSz = Re_BufSz + 1 ! T0 + Re_BufSz = Re_BufSz + 1 ! k11 + Re_BufSz = Re_BufSz + 1 ! k12 + Re_BufSz = Re_BufSz + 1 ! k13 + Re_BufSz = Re_BufSz + 1 ! k14 + Re_BufSz = Re_BufSz + 1 ! k15 + Re_BufSz = Re_BufSz + 1 ! k16 + Re_BufSz = Re_BufSz + 1 ! k22 + Re_BufSz = Re_BufSz + 1 ! k23 + Re_BufSz = Re_BufSz + 1 ! k24 + Re_BufSz = Re_BufSz + 1 ! k25 + Re_BufSz = Re_BufSz + 1 ! k26 + Re_BufSz = Re_BufSz + 1 ! k33 + Re_BufSz = Re_BufSz + 1 ! k34 + Re_BufSz = Re_BufSz + 1 ! k35 + Re_BufSz = Re_BufSz + 1 ! k36 + Re_BufSz = Re_BufSz + 1 ! k44 + Re_BufSz = Re_BufSz + 1 ! k45 + Re_BufSz = Re_BufSz + 1 ! k46 + Re_BufSz = Re_BufSz + 1 ! k55 + Re_BufSz = Re_BufSz + 1 ! k56 + Re_BufSz = Re_BufSz + 1 ! k66 + Db_BufSz = Db_BufSz + SIZE(InData%DirCos) ! DirCos + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%eType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Length + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ixx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Iyy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Jzz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kappa_x + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kappa_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YoungE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShearG + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) + ReKiBuf(Re_Xferred) = InData%D(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Area + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rho + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k11 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k12 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k13 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k14 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k15 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k16 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k22 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k23 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k24 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k25 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k26 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k33 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k34 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k35 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k36 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k44 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k45 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k46 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k55 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k56 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k66 + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) + DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) + DbKiBuf(Db_Xferred) = InData%DirCos(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END SUBROUTINE SD_PackElemPropType + + SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ElemPropType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackElemPropType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%eType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ixx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Iyy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Jzz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) + Int_Xferred = Int_Xferred + 1 + OutData%Kappa_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kappa_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YoungE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%D,1) + i1_u = UBOUND(OutData%D,1) + DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) + OutData%D(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Area = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rho = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k11 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k12 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k13 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k14 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k15 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k16 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k22 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k23 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k24 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k25 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k26 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k33 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k34 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k35 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k36 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k44 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k45 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k46 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k55 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k56 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k66 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%DirCos,1) + i1_u = UBOUND(OutData%DirCos,1) + i2_l = LBOUND(OutData%DirCos,2) + i2_u = UBOUND(OutData%DirCos,2) + DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) + DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) + OutData%DirCos(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END SUBROUTINE SD_UnPackElemPropType + + SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData + TYPE(SD_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%g = SrcInitInputData%g + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint + DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ +IF (ALLOCATED(SrcInitInputData%SoilStiffness)) THEN + i1_l = LBOUND(SrcInitInputData%SoilStiffness,1) + i1_u = UBOUND(SrcInitInputData%SoilStiffness,1) + i2_l = LBOUND(SrcInitInputData%SoilStiffness,2) + i2_u = UBOUND(SrcInitInputData%SoilStiffness,2) + i3_l = LBOUND(SrcInitInputData%SoilStiffness,3) + i3_u = UBOUND(SrcInitInputData%SoilStiffness,3) + IF (.NOT. ALLOCATED(DstInitInputData%SoilStiffness)) THEN + ALLOCATE(DstInitInputData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness +ENDIF + CALL MeshCopy( SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstInitInputData%Linearize = SrcInitInputData%Linearize + END SUBROUTINE SD_CopyInitInput + + SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(InitInputData%SoilStiffness)) THEN + DEALLOCATE(InitInputData%SoilStiffness) +ENDIF + CALL MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE SD_DestroyInitInput + + SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%SDInputFile) ! SDInputFile + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Re_BufSz = Re_BufSz + 1 ! g + Re_BufSz = Re_BufSz + 1 ! WtrDpth + Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint + Re_BufSz = Re_BufSz + 1 ! SubRotateZ + Int_BufSz = Int_BufSz + 1 ! SoilStiffness allocated yes/no + IF ( ALLOCATED(InData%SoilStiffness) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! SoilStiffness upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SoilStiffness) ! SoilStiffness + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Linearize + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%SDInputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%SoilStiffness) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%SoilStiffness,3), UBOUND(InData%SoilStiffness,3) + DO i2 = LBOUND(InData%SoilStiffness,2), UBOUND(InData%SoilStiffness,2) + DO i1 = LBOUND(InData%SoilStiffness,1), UBOUND(InData%SoilStiffness,1) + ReKiBuf(Re_Xferred) = InData%SoilStiffness(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_PackInitInput + + SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%SDInputFile) + OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%TP_RefPoint,1) + i1_u = UBOUND(OutData%TP_RefPoint,1) + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SoilStiffness not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SoilStiffness)) DEALLOCATE(OutData%SoilStiffness) + ALLOCATE(OutData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%SoilStiffness,3), UBOUND(OutData%SoilStiffness,3) + DO i2 = LBOUND(OutData%SoilStiffness,2), UBOUND(OutData%SoilStiffness,2) + DO i1 = LBOUND(OutData%SoilStiffness,1), UBOUND(OutData%SoilStiffness,1) + OutData%SoilStiffness(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_UnPackInitInput + + SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(SD_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN + ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN + ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN + ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN + i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) + i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) + IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN + ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y +ENDIF +IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN + i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) + i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN + ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN + i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) + i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN + ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN + i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) + i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN + ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) + i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN + ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN + i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) + i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) + IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN + ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst +ENDIF + END SUBROUTINE SD_CopyInitOutput + + SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InitOutputData%LinNames_y)) THEN + DEALLOCATE(InitOutputData%LinNames_y) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_x)) THEN + DEALLOCATE(InitOutputData%LinNames_x) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_u)) THEN + DEALLOCATE(InitOutputData%LinNames_u) +ENDIF +IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN + DEALLOCATE(InitOutputData%RotFrame_y) +ENDIF +IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN + DEALLOCATE(InitOutputData%RotFrame_x) +ENDIF +IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN + DEALLOCATE(InitOutputData%RotFrame_u) +ENDIF +IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN + DEALLOCATE(InitOutputData%IsLoad_u) +ENDIF +IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN + DEALLOCATE(InitOutputData%DerivOrder_x) +ENDIF +IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN + DEALLOCATE(InitOutputData%CableCChanRqst) +ENDIF + END SUBROUTINE SD_DestroyInitOutput + + SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no + IF ( ALLOCATED(InData%LinNames_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no + IF ( ALLOCATED(InData%LinNames_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no + IF ( ALLOCATED(InData%LinNames_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no + IF ( ALLOCATED(InData%RotFrame_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no + IF ( ALLOCATED(InData%RotFrame_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no + IF ( ALLOCATED(InData%RotFrame_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF + Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no + IF ( ALLOCATED(InData%DerivOrder_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x + END IF + Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no + IF ( ALLOCATED(InData%CableCChanRqst) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO I = 1, LEN(InData%LinNames_y) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO I = 1, LEN(InData%LinNames_x) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO I = 1, LEN(InData%LinNames_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackInitOutput + + SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) + ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO I = 1, LEN(OutData%LinNames_y) + OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) + ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO I = 1, LEN(OutData%LinNames_x) + OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) + ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO I = 1, LEN(OutData%LinNames_u) + OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) + ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) + ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) + ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) + ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) + ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) + OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackInitOutput + + SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData + TYPE(SD_InitType), INTENT(INOUT) :: DstInitTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitTypeData%RootName = SrcInitTypeData%RootName + DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint + DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ + DstInitTypeData%g = SrcInitTypeData%g + DstInitTypeData%DT = SrcInitTypeData%DT + DstInitTypeData%NJoints = SrcInitTypeData%NJoints + DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX + DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB + DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC + DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR + DstInitTypeData%NPropSetsS = SrcInitTypeData%NPropSetsS + DstInitTypeData%NCMass = SrcInitTypeData%NCMass + DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs + DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod + DstInitTypeData%NDiv = SrcInitTypeData%NDiv + DstInitTypeData%CBMod = SrcInitTypeData%CBMod +IF (ALLOCATED(SrcInitTypeData%Joints)) THEN + i1_l = LBOUND(SrcInitTypeData%Joints,1) + i1_u = UBOUND(SrcInitTypeData%Joints,1) + i2_l = LBOUND(SrcInitTypeData%Joints,2) + i2_u = UBOUND(SrcInitTypeData%Joints,2) + IF (.NOT. ALLOCATED(DstInitTypeData%Joints)) THEN + ALLOCATE(DstInitTypeData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%Joints = SrcInitTypeData%Joints +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropSetsB)) THEN + i1_l = LBOUND(SrcInitTypeData%PropSetsB,1) + i1_u = UBOUND(SrcInitTypeData%PropSetsB,1) + i2_l = LBOUND(SrcInitTypeData%PropSetsB,2) + i2_u = UBOUND(SrcInitTypeData%PropSetsB,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsB)) THEN + ALLOCATE(DstInitTypeData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropSetsC)) THEN + i1_l = LBOUND(SrcInitTypeData%PropSetsC,1) + i1_u = UBOUND(SrcInitTypeData%PropSetsC,1) + i2_l = LBOUND(SrcInitTypeData%PropSetsC,2) + i2_u = UBOUND(SrcInitTypeData%PropSetsC,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsC)) THEN + ALLOCATE(DstInitTypeData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropSetsR)) THEN + i1_l = LBOUND(SrcInitTypeData%PropSetsR,1) + i1_u = UBOUND(SrcInitTypeData%PropSetsR,1) + i2_l = LBOUND(SrcInitTypeData%PropSetsR,2) + i2_u = UBOUND(SrcInitTypeData%PropSetsR,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsR)) THEN + ALLOCATE(DstInitTypeData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropSetsS)) THEN + i1_l = LBOUND(SrcInitTypeData%PropSetsS,1) + i1_u = UBOUND(SrcInitTypeData%PropSetsS,1) + i2_l = LBOUND(SrcInitTypeData%PropSetsS,2) + i2_u = UBOUND(SrcInitTypeData%PropSetsS,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsS)) THEN + ALLOCATE(DstInitTypeData%PropSetsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropSetsS = SrcInitTypeData%PropSetsS +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropSetsX)) THEN + i1_l = LBOUND(SrcInitTypeData%PropSetsX,1) + i1_u = UBOUND(SrcInitTypeData%PropSetsX,1) + i2_l = LBOUND(SrcInitTypeData%PropSetsX,2) + i2_u = UBOUND(SrcInitTypeData%PropSetsX,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsX)) THEN + ALLOCATE(DstInitTypeData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX +ENDIF +IF (ALLOCATED(SrcInitTypeData%COSMs)) THEN + i1_l = LBOUND(SrcInitTypeData%COSMs,1) + i1_u = UBOUND(SrcInitTypeData%COSMs,1) + i2_l = LBOUND(SrcInitTypeData%COSMs,2) + i2_u = UBOUND(SrcInitTypeData%COSMs,2) + IF (.NOT. ALLOCATED(DstInitTypeData%COSMs)) THEN + ALLOCATE(DstInitTypeData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%COSMs = SrcInitTypeData%COSMs +ENDIF +IF (ALLOCATED(SrcInitTypeData%CMass)) THEN + i1_l = LBOUND(SrcInitTypeData%CMass,1) + i1_u = UBOUND(SrcInitTypeData%CMass,1) + i2_l = LBOUND(SrcInitTypeData%CMass,2) + i2_u = UBOUND(SrcInitTypeData%CMass,2) + IF (.NOT. ALLOCATED(DstInitTypeData%CMass)) THEN + ALLOCATE(DstInitTypeData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%CMass = SrcInitTypeData%CMass +ENDIF +IF (ALLOCATED(SrcInitTypeData%JDampings)) THEN + i1_l = LBOUND(SrcInitTypeData%JDampings,1) + i1_u = UBOUND(SrcInitTypeData%JDampings,1) + IF (.NOT. ALLOCATED(DstInitTypeData%JDampings)) THEN + ALLOCATE(DstInitTypeData%JDampings(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%JDampings = SrcInitTypeData%JDampings +ENDIF + DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod + DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp + DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat +IF (ALLOCATED(SrcInitTypeData%Members)) THEN + i1_l = LBOUND(SrcInitTypeData%Members,1) + i1_u = UBOUND(SrcInitTypeData%Members,1) + i2_l = LBOUND(SrcInitTypeData%Members,2) + i2_u = UBOUND(SrcInitTypeData%Members,2) + IF (.NOT. ALLOCATED(DstInitTypeData%Members)) THEN + ALLOCATE(DstInitTypeData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%Members = SrcInitTypeData%Members +ENDIF +IF (ALLOCATED(SrcInitTypeData%SSOutList)) THEN + i1_l = LBOUND(SrcInitTypeData%SSOutList,1) + i1_u = UBOUND(SrcInitTypeData%SSOutList,1) + IF (.NOT. ALLOCATED(DstInitTypeData%SSOutList)) THEN + ALLOCATE(DstInitTypeData%SSOutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList +ENDIF + DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM + DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim +IF (ALLOCATED(SrcInitTypeData%SSIK)) THEN + i1_l = LBOUND(SrcInitTypeData%SSIK,1) + i1_u = UBOUND(SrcInitTypeData%SSIK,1) + i2_l = LBOUND(SrcInitTypeData%SSIK,2) + i2_u = UBOUND(SrcInitTypeData%SSIK,2) + IF (.NOT. ALLOCATED(DstInitTypeData%SSIK)) THEN + ALLOCATE(DstInitTypeData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%SSIK = SrcInitTypeData%SSIK +ENDIF +IF (ALLOCATED(SrcInitTypeData%SSIM)) THEN + i1_l = LBOUND(SrcInitTypeData%SSIM,1) + i1_u = UBOUND(SrcInitTypeData%SSIM,1) + i2_l = LBOUND(SrcInitTypeData%SSIM,2) + i2_u = UBOUND(SrcInitTypeData%SSIM,2) + IF (.NOT. ALLOCATED(DstInitTypeData%SSIM)) THEN + ALLOCATE(DstInitTypeData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%SSIM = SrcInitTypeData%SSIM +ENDIF +IF (ALLOCATED(SrcInitTypeData%SSIfile)) THEN + i1_l = LBOUND(SrcInitTypeData%SSIfile,1) + i1_u = UBOUND(SrcInitTypeData%SSIfile,1) + IF (.NOT. ALLOCATED(DstInitTypeData%SSIfile)) THEN + ALLOCATE(DstInitTypeData%SSIfile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile +ENDIF +IF (ALLOCATED(SrcInitTypeData%Soil_K)) THEN + i1_l = LBOUND(SrcInitTypeData%Soil_K,1) + i1_u = UBOUND(SrcInitTypeData%Soil_K,1) + i2_l = LBOUND(SrcInitTypeData%Soil_K,2) + i2_u = UBOUND(SrcInitTypeData%Soil_K,2) + i3_l = LBOUND(SrcInitTypeData%Soil_K,3) + i3_u = UBOUND(SrcInitTypeData%Soil_K,3) + IF (.NOT. ALLOCATED(DstInitTypeData%Soil_K)) THEN + ALLOCATE(DstInitTypeData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K +ENDIF +IF (ALLOCATED(SrcInitTypeData%Soil_Points)) THEN + i1_l = LBOUND(SrcInitTypeData%Soil_Points,1) + i1_u = UBOUND(SrcInitTypeData%Soil_Points,1) + i2_l = LBOUND(SrcInitTypeData%Soil_Points,2) + i2_u = UBOUND(SrcInitTypeData%Soil_Points,2) + IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Points)) THEN + ALLOCATE(DstInitTypeData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points +ENDIF +IF (ALLOCATED(SrcInitTypeData%Soil_Nodes)) THEN + i1_l = LBOUND(SrcInitTypeData%Soil_Nodes,1) + i1_u = UBOUND(SrcInitTypeData%Soil_Nodes,1) + IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Nodes)) THEN + ALLOCATE(DstInitTypeData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes +ENDIF + DstInitTypeData%NElem = SrcInitTypeData%NElem + DstInitTypeData%NPropB = SrcInitTypeData%NPropB + DstInitTypeData%NPropC = SrcInitTypeData%NPropC + DstInitTypeData%NPropR = SrcInitTypeData%NPropR + DstInitTypeData%NPropS = SrcInitTypeData%NPropS +IF (ALLOCATED(SrcInitTypeData%Nodes)) THEN + i1_l = LBOUND(SrcInitTypeData%Nodes,1) + i1_u = UBOUND(SrcInitTypeData%Nodes,1) + i2_l = LBOUND(SrcInitTypeData%Nodes,2) + i2_u = UBOUND(SrcInitTypeData%Nodes,2) + IF (.NOT. ALLOCATED(DstInitTypeData%Nodes)) THEN + ALLOCATE(DstInitTypeData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%Nodes = SrcInitTypeData%Nodes +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropsB)) THEN + i1_l = LBOUND(SrcInitTypeData%PropsB,1) + i1_u = UBOUND(SrcInitTypeData%PropsB,1) + i2_l = LBOUND(SrcInitTypeData%PropsB,2) + i2_u = UBOUND(SrcInitTypeData%PropsB,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropsB)) THEN + ALLOCATE(DstInitTypeData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropsB = SrcInitTypeData%PropsB +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropsC)) THEN + i1_l = LBOUND(SrcInitTypeData%PropsC,1) + i1_u = UBOUND(SrcInitTypeData%PropsC,1) + i2_l = LBOUND(SrcInitTypeData%PropsC,2) + i2_u = UBOUND(SrcInitTypeData%PropsC,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropsC)) THEN + ALLOCATE(DstInitTypeData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropsC = SrcInitTypeData%PropsC +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropsR)) THEN + i1_l = LBOUND(SrcInitTypeData%PropsR,1) + i1_u = UBOUND(SrcInitTypeData%PropsR,1) + i2_l = LBOUND(SrcInitTypeData%PropsR,2) + i2_u = UBOUND(SrcInitTypeData%PropsR,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropsR)) THEN + ALLOCATE(DstInitTypeData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropsR = SrcInitTypeData%PropsR +ENDIF +IF (ALLOCATED(SrcInitTypeData%PropsS)) THEN + i1_l = LBOUND(SrcInitTypeData%PropsS,1) + i1_u = UBOUND(SrcInitTypeData%PropsS,1) + i2_l = LBOUND(SrcInitTypeData%PropsS,2) + i2_u = UBOUND(SrcInitTypeData%PropsS,2) + IF (.NOT. ALLOCATED(DstInitTypeData%PropsS)) THEN + ALLOCATE(DstInitTypeData%PropsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%PropsS = SrcInitTypeData%PropsS +ENDIF +IF (ALLOCATED(SrcInitTypeData%K)) THEN + i1_l = LBOUND(SrcInitTypeData%K,1) + i1_u = UBOUND(SrcInitTypeData%K,1) + i2_l = LBOUND(SrcInitTypeData%K,2) + i2_u = UBOUND(SrcInitTypeData%K,2) + IF (.NOT. ALLOCATED(DstInitTypeData%K)) THEN + ALLOCATE(DstInitTypeData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%K = SrcInitTypeData%K +ENDIF +IF (ALLOCATED(SrcInitTypeData%M)) THEN + i1_l = LBOUND(SrcInitTypeData%M,1) + i1_u = UBOUND(SrcInitTypeData%M,1) + i2_l = LBOUND(SrcInitTypeData%M,2) + i2_u = UBOUND(SrcInitTypeData%M,2) + IF (.NOT. ALLOCATED(DstInitTypeData%M)) THEN + ALLOCATE(DstInitTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%M = SrcInitTypeData%M +ENDIF +IF (ALLOCATED(SrcInitTypeData%ElemProps)) THEN + i1_l = LBOUND(SrcInitTypeData%ElemProps,1) + i1_u = UBOUND(SrcInitTypeData%ElemProps,1) + i2_l = LBOUND(SrcInitTypeData%ElemProps,2) + i2_u = UBOUND(SrcInitTypeData%ElemProps,2) + IF (.NOT. ALLOCATED(DstInitTypeData%ElemProps)) THEN + ALLOCATE(DstInitTypeData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps +ENDIF +IF (ALLOCATED(SrcInitTypeData%MemberNodes)) THEN + i1_l = LBOUND(SrcInitTypeData%MemberNodes,1) + i1_u = UBOUND(SrcInitTypeData%MemberNodes,1) + i2_l = LBOUND(SrcInitTypeData%MemberNodes,2) + i2_u = UBOUND(SrcInitTypeData%MemberNodes,2) + IF (.NOT. ALLOCATED(DstInitTypeData%MemberNodes)) THEN + ALLOCATE(DstInitTypeData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes +ENDIF +IF (ALLOCATED(SrcInitTypeData%NodesConnN)) THEN + i1_l = LBOUND(SrcInitTypeData%NodesConnN,1) + i1_u = UBOUND(SrcInitTypeData%NodesConnN,1) + i2_l = LBOUND(SrcInitTypeData%NodesConnN,2) + i2_u = UBOUND(SrcInitTypeData%NodesConnN,2) + IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnN)) THEN + ALLOCATE(DstInitTypeData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN +ENDIF +IF (ALLOCATED(SrcInitTypeData%NodesConnE)) THEN + i1_l = LBOUND(SrcInitTypeData%NodesConnE,1) + i1_u = UBOUND(SrcInitTypeData%NodesConnE,1) + i2_l = LBOUND(SrcInitTypeData%NodesConnE,2) + i2_u = UBOUND(SrcInitTypeData%NodesConnE,2) + IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnE)) THEN + ALLOCATE(DstInitTypeData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE +ENDIF + DstInitTypeData%SSSum = SrcInitTypeData%SSSum + END SUBROUTINE SD_CopyInitType + + SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(InitTypeData%Joints)) THEN + DEALLOCATE(InitTypeData%Joints) +ENDIF +IF (ALLOCATED(InitTypeData%PropSetsB)) THEN + DEALLOCATE(InitTypeData%PropSetsB) +ENDIF +IF (ALLOCATED(InitTypeData%PropSetsC)) THEN + DEALLOCATE(InitTypeData%PropSetsC) +ENDIF +IF (ALLOCATED(InitTypeData%PropSetsR)) THEN + DEALLOCATE(InitTypeData%PropSetsR) +ENDIF +IF (ALLOCATED(InitTypeData%PropSetsS)) THEN + DEALLOCATE(InitTypeData%PropSetsS) +ENDIF +IF (ALLOCATED(InitTypeData%PropSetsX)) THEN + DEALLOCATE(InitTypeData%PropSetsX) +ENDIF +IF (ALLOCATED(InitTypeData%COSMs)) THEN + DEALLOCATE(InitTypeData%COSMs) +ENDIF +IF (ALLOCATED(InitTypeData%CMass)) THEN + DEALLOCATE(InitTypeData%CMass) +ENDIF +IF (ALLOCATED(InitTypeData%JDampings)) THEN + DEALLOCATE(InitTypeData%JDampings) +ENDIF +IF (ALLOCATED(InitTypeData%Members)) THEN + DEALLOCATE(InitTypeData%Members) +ENDIF +IF (ALLOCATED(InitTypeData%SSOutList)) THEN + DEALLOCATE(InitTypeData%SSOutList) +ENDIF +IF (ALLOCATED(InitTypeData%SSIK)) THEN + DEALLOCATE(InitTypeData%SSIK) +ENDIF +IF (ALLOCATED(InitTypeData%SSIM)) THEN + DEALLOCATE(InitTypeData%SSIM) +ENDIF +IF (ALLOCATED(InitTypeData%SSIfile)) THEN + DEALLOCATE(InitTypeData%SSIfile) +ENDIF +IF (ALLOCATED(InitTypeData%Soil_K)) THEN + DEALLOCATE(InitTypeData%Soil_K) +ENDIF +IF (ALLOCATED(InitTypeData%Soil_Points)) THEN + DEALLOCATE(InitTypeData%Soil_Points) +ENDIF +IF (ALLOCATED(InitTypeData%Soil_Nodes)) THEN + DEALLOCATE(InitTypeData%Soil_Nodes) +ENDIF +IF (ALLOCATED(InitTypeData%Nodes)) THEN + DEALLOCATE(InitTypeData%Nodes) +ENDIF +IF (ALLOCATED(InitTypeData%PropsB)) THEN + DEALLOCATE(InitTypeData%PropsB) +ENDIF +IF (ALLOCATED(InitTypeData%PropsC)) THEN + DEALLOCATE(InitTypeData%PropsC) +ENDIF +IF (ALLOCATED(InitTypeData%PropsR)) THEN + DEALLOCATE(InitTypeData%PropsR) +ENDIF +IF (ALLOCATED(InitTypeData%PropsS)) THEN + DEALLOCATE(InitTypeData%PropsS) +ENDIF +IF (ALLOCATED(InitTypeData%K)) THEN + DEALLOCATE(InitTypeData%K) +ENDIF +IF (ALLOCATED(InitTypeData%M)) THEN + DEALLOCATE(InitTypeData%M) +ENDIF +IF (ALLOCATED(InitTypeData%ElemProps)) THEN + DEALLOCATE(InitTypeData%ElemProps) +ENDIF +IF (ALLOCATED(InitTypeData%MemberNodes)) THEN + DEALLOCATE(InitTypeData%MemberNodes) +ENDIF +IF (ALLOCATED(InitTypeData%NodesConnN)) THEN + DEALLOCATE(InitTypeData%NodesConnN) +ENDIF +IF (ALLOCATED(InitTypeData%NodesConnE)) THEN + DEALLOCATE(InitTypeData%NodesConnE) +ENDIF + END SUBROUTINE SD_DestroyInitType + + SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_InitType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint + Re_BufSz = Re_BufSz + 1 ! SubRotateZ + Re_BufSz = Re_BufSz + 1 ! g + Db_BufSz = Db_BufSz + 1 ! DT + Int_BufSz = Int_BufSz + 1 ! NJoints + Int_BufSz = Int_BufSz + 1 ! NPropSetsX + Int_BufSz = Int_BufSz + 1 ! NPropSetsB + Int_BufSz = Int_BufSz + 1 ! NPropSetsC + Int_BufSz = Int_BufSz + 1 ! NPropSetsR + Int_BufSz = Int_BufSz + 1 ! NPropSetsS + Int_BufSz = Int_BufSz + 1 ! NCMass + Int_BufSz = Int_BufSz + 1 ! NCOSMs + Int_BufSz = Int_BufSz + 1 ! FEMMod + Int_BufSz = Int_BufSz + 1 ! NDiv + Int_BufSz = Int_BufSz + 1 ! CBMod + Int_BufSz = Int_BufSz + 1 ! Joints allocated yes/no + IF ( ALLOCATED(InData%Joints) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Joints upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Joints) ! Joints + END IF + Int_BufSz = Int_BufSz + 1 ! PropSetsB allocated yes/no + IF ( ALLOCATED(InData%PropSetsB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropSetsB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropSetsB) ! PropSetsB + END IF + Int_BufSz = Int_BufSz + 1 ! PropSetsC allocated yes/no + IF ( ALLOCATED(InData%PropSetsC) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropSetsC upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropSetsC) ! PropSetsC + END IF + Int_BufSz = Int_BufSz + 1 ! PropSetsR allocated yes/no + IF ( ALLOCATED(InData%PropSetsR) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropSetsR upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropSetsR) ! PropSetsR + END IF + Int_BufSz = Int_BufSz + 1 ! PropSetsS allocated yes/no + IF ( ALLOCATED(InData%PropSetsS) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropSetsS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropSetsS) ! PropSetsS + END IF + Int_BufSz = Int_BufSz + 1 ! PropSetsX allocated yes/no + IF ( ALLOCATED(InData%PropSetsX) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropSetsX upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropSetsX) ! PropSetsX + END IF + Int_BufSz = Int_BufSz + 1 ! COSMs allocated yes/no + IF ( ALLOCATED(InData%COSMs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! COSMs upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%COSMs) ! COSMs + END IF + Int_BufSz = Int_BufSz + 1 ! CMass allocated yes/no + IF ( ALLOCATED(InData%CMass) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CMass upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CMass) ! CMass + END IF + Int_BufSz = Int_BufSz + 1 ! JDampings allocated yes/no + IF ( ALLOCATED(InData%JDampings) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! JDampings upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%JDampings) ! JDampings + END IF + Int_BufSz = Int_BufSz + 1 ! GuyanDampMod + Re_BufSz = Re_BufSz + SIZE(InData%RayleighDamp) ! RayleighDamp + Re_BufSz = Re_BufSz + SIZE(InData%GuyanDampMat) ! GuyanDampMat + Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no + IF ( ALLOCATED(InData%Members) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Members upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Members) ! Members + END IF + Int_BufSz = Int_BufSz + 1 ! SSOutList allocated yes/no + IF ( ALLOCATED(InData%SSOutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SSOutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%SSOutList)*LEN(InData%SSOutList) ! SSOutList + END IF + Int_BufSz = Int_BufSz + 1 ! OutCOSM + Int_BufSz = Int_BufSz + 1 ! TabDelim + Int_BufSz = Int_BufSz + 1 ! SSIK allocated yes/no + IF ( ALLOCATED(InData%SSIK) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! SSIK upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%SSIK) ! SSIK + END IF + Int_BufSz = Int_BufSz + 1 ! SSIM allocated yes/no + IF ( ALLOCATED(InData%SSIM) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! SSIM upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%SSIM) ! SSIM + END IF + Int_BufSz = Int_BufSz + 1 ! SSIfile allocated yes/no + IF ( ALLOCATED(InData%SSIfile) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SSIfile upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%SSIfile)*LEN(InData%SSIfile) ! SSIfile + END IF + Int_BufSz = Int_BufSz + 1 ! Soil_K allocated yes/no + IF ( ALLOCATED(InData%Soil_K) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Soil_K upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Soil_K) ! Soil_K + END IF + Int_BufSz = Int_BufSz + 1 ! Soil_Points allocated yes/no + IF ( ALLOCATED(InData%Soil_Points) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Soil_Points upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Soil_Points) ! Soil_Points + END IF + Int_BufSz = Int_BufSz + 1 ! Soil_Nodes allocated yes/no + IF ( ALLOCATED(InData%Soil_Nodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Soil_Nodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Soil_Nodes) ! Soil_Nodes + END IF + Int_BufSz = Int_BufSz + 1 ! NElem + Int_BufSz = Int_BufSz + 1 ! NPropB + Int_BufSz = Int_BufSz + 1 ! NPropC + Int_BufSz = Int_BufSz + 1 ! NPropR + Int_BufSz = Int_BufSz + 1 ! NPropS + Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no + IF ( ALLOCATED(InData%Nodes) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Nodes upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Nodes) ! Nodes + END IF + Int_BufSz = Int_BufSz + 1 ! PropsB allocated yes/no + IF ( ALLOCATED(InData%PropsB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropsB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropsB) ! PropsB + END IF + Int_BufSz = Int_BufSz + 1 ! PropsC allocated yes/no + IF ( ALLOCATED(InData%PropsC) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropsC upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropsC) ! PropsC + END IF + Int_BufSz = Int_BufSz + 1 ! PropsR allocated yes/no + IF ( ALLOCATED(InData%PropsR) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropsR upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropsR) ! PropsR + END IF + Int_BufSz = Int_BufSz + 1 ! PropsS allocated yes/no + IF ( ALLOCATED(InData%PropsS) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PropsS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PropsS) ! PropsS + END IF + Int_BufSz = Int_BufSz + 1 ! K allocated yes/no + IF ( ALLOCATED(InData%K) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%K) ! K + END IF + Int_BufSz = Int_BufSz + 1 ! M allocated yes/no + IF ( ALLOCATED(InData%M) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%M) ! M + END IF + Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no + IF ( ALLOCATED(InData%ElemProps) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! ElemProps upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ElemProps) ! ElemProps + END IF + Int_BufSz = Int_BufSz + 1 ! MemberNodes allocated yes/no + IF ( ALLOCATED(InData%MemberNodes) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MemberNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%MemberNodes) ! MemberNodes + END IF + Int_BufSz = Int_BufSz + 1 ! NodesConnN allocated yes/no + IF ( ALLOCATED(InData%NodesConnN) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! NodesConnN upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NodesConnN) ! NodesConnN + END IF + Int_BufSz = Int_BufSz + 1 ! NodesConnE allocated yes/no + IF ( ALLOCATED(InData%NodesConnE) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! NodesConnE upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NodesConnE) ! NodesConnE + END IF + Int_BufSz = Int_BufSz + 1 ! SSSum + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSetsX + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSetsB + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSetsC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSetsR + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSetsS + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCMass + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCOSMs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FEMMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDiv + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Joints) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) + DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) + ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropSetsB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropSetsB,2), UBOUND(InData%PropSetsB,2) + DO i1 = LBOUND(InData%PropSetsB,1), UBOUND(InData%PropSetsB,1) + ReKiBuf(Re_Xferred) = InData%PropSetsB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropSetsC) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropSetsC,2), UBOUND(InData%PropSetsC,2) + DO i1 = LBOUND(InData%PropSetsC,1), UBOUND(InData%PropSetsC,1) + ReKiBuf(Re_Xferred) = InData%PropSetsC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropSetsR) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropSetsR,2), UBOUND(InData%PropSetsR,2) + DO i1 = LBOUND(InData%PropSetsR,1), UBOUND(InData%PropSetsR,1) + ReKiBuf(Re_Xferred) = InData%PropSetsR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropSetsS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsS,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsS,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsS,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropSetsS,2), UBOUND(InData%PropSetsS,2) + DO i1 = LBOUND(InData%PropSetsS,1), UBOUND(InData%PropSetsS,1) + ReKiBuf(Re_Xferred) = InData%PropSetsS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropSetsX) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropSetsX,2), UBOUND(InData%PropSetsX,2) + DO i1 = LBOUND(InData%PropSetsX,1), UBOUND(InData%PropSetsX,1) + ReKiBuf(Re_Xferred) = InData%PropSetsX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) + DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) + DbKiBuf(Db_Xferred) = InData%COSMs(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CMass) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) + DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) + ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%JDampings,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) + ReKiBuf(Re_Xferred) = InData%JDampings(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%GuyanDampMod + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RayleighDamp,1), UBOUND(InData%RayleighDamp,1) + ReKiBuf(Re_Xferred) = InData%RayleighDamp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GuyanDampMat,2), UBOUND(InData%GuyanDampMat,2) + DO i1 = LBOUND(InData%GuyanDampMat,1), UBOUND(InData%GuyanDampMat,1) + ReKiBuf(Re_Xferred) = InData%GuyanDampMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IF ( .NOT. ALLOCATED(InData%Members) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) + DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) + IntKiBuf(Int_Xferred) = InData%Members(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SSOutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) + DO I = 1, LEN(InData%SSOutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%SSIK) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%SSIK,2), UBOUND(InData%SSIK,2) + DO i1 = LBOUND(InData%SSIK,1), UBOUND(InData%SSIK,1) + DbKiBuf(Db_Xferred) = InData%SSIK(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SSIM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%SSIM,2), UBOUND(InData%SSIM,2) + DO i1 = LBOUND(InData%SSIM,1), UBOUND(InData%SSIM,1) + DbKiBuf(Db_Xferred) = InData%SSIM(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SSIfile) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIfile,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIfile,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SSIfile,1), UBOUND(InData%SSIfile,1) + DO I = 1, LEN(InData%SSIfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SSIfile(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Soil_K) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Soil_K,3), UBOUND(InData%Soil_K,3) + DO i2 = LBOUND(InData%Soil_K,2), UBOUND(InData%Soil_K,2) + DO i1 = LBOUND(InData%Soil_K,1), UBOUND(InData%Soil_K,1) + ReKiBuf(Re_Xferred) = InData%Soil_K(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Soil_Points) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Soil_Points,2), UBOUND(InData%Soil_Points,2) + DO i1 = LBOUND(InData%Soil_Points,1), UBOUND(InData%Soil_Points,1) + ReKiBuf(Re_Xferred) = InData%Soil_Points(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Soil_Nodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Nodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Nodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Soil_Nodes,1), UBOUND(InData%Soil_Nodes,1) + IntKiBuf(Int_Xferred) = InData%Soil_Nodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropB + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropR + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropS + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) + DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) + ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropsB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropsB,2), UBOUND(InData%PropsB,2) + DO i1 = LBOUND(InData%PropsB,1), UBOUND(InData%PropsB,1) + ReKiBuf(Re_Xferred) = InData%PropsB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropsC) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropsC,2), UBOUND(InData%PropsC,2) + DO i1 = LBOUND(InData%PropsC,1), UBOUND(InData%PropsC,1) + ReKiBuf(Re_Xferred) = InData%PropsC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropsR) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropsR,2), UBOUND(InData%PropsR,2) + DO i1 = LBOUND(InData%PropsR,1), UBOUND(InData%PropsR,1) + ReKiBuf(Re_Xferred) = InData%PropsR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PropsS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsS,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsS,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsS,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PropsS,2), UBOUND(InData%PropsS,2) + DO i1 = LBOUND(InData%PropsS,1), UBOUND(InData%PropsS,1) + ReKiBuf(Re_Xferred) = InData%PropsS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%K) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%K,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) + DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) + DbKiBuf(Db_Xferred) = InData%K(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%M) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + DbKiBuf(Db_Xferred) = InData%M(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) + DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) + ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) + DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) + IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) + DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) + IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) + DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) + IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_PackInitType + + SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_InitType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + i1_l = LBOUND(OutData%TP_RefPoint,1) + i1_u = UBOUND(OutData%TP_RefPoint,1) + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSetsX = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSetsB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSetsC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSetsR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSetsS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCMass = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCOSMs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FEMMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDiv = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Joints)) DEALLOCATE(OutData%Joints) + ALLOCATE(OutData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) + DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) + OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropSetsB)) DEALLOCATE(OutData%PropSetsB) + ALLOCATE(OutData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropSetsB,2), UBOUND(OutData%PropSetsB,2) + DO i1 = LBOUND(OutData%PropSetsB,1), UBOUND(OutData%PropSetsB,1) + OutData%PropSetsB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsC not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropSetsC)) DEALLOCATE(OutData%PropSetsC) + ALLOCATE(OutData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropSetsC,2), UBOUND(OutData%PropSetsC,2) + DO i1 = LBOUND(OutData%PropSetsC,1), UBOUND(OutData%PropSetsC,1) + OutData%PropSetsC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsR not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropSetsR)) DEALLOCATE(OutData%PropSetsR) + ALLOCATE(OutData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropSetsR,2), UBOUND(OutData%PropSetsR,2) + DO i1 = LBOUND(OutData%PropSetsR,1), UBOUND(OutData%PropSetsR,1) + OutData%PropSetsR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropSetsS)) DEALLOCATE(OutData%PropSetsS) + ALLOCATE(OutData%PropSetsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropSetsS,2), UBOUND(OutData%PropSetsS,2) + DO i1 = LBOUND(OutData%PropSetsS,1), UBOUND(OutData%PropSetsS,1) + OutData%PropSetsS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsX not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropSetsX)) DEALLOCATE(OutData%PropSetsX) + ALLOCATE(OutData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropSetsX,2), UBOUND(OutData%PropSetsX,2) + DO i1 = LBOUND(OutData%PropSetsX,1), UBOUND(OutData%PropSetsX,1) + OutData%PropSetsX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%COSMs)) DEALLOCATE(OutData%COSMs) + ALLOCATE(OutData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) + DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) + OutData%COSMs(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CMass)) DEALLOCATE(OutData%CMass) + ALLOCATE(OutData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) + DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) + OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%JDampings)) DEALLOCATE(OutData%JDampings) + ALLOCATE(OutData%JDampings(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) + OutData%JDampings(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%GuyanDampMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%RayleighDamp,1) + i1_u = UBOUND(OutData%RayleighDamp,1) + DO i1 = LBOUND(OutData%RayleighDamp,1), UBOUND(OutData%RayleighDamp,1) + OutData%RayleighDamp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%GuyanDampMat,1) + i1_u = UBOUND(OutData%GuyanDampMat,1) + i2_l = LBOUND(OutData%GuyanDampMat,2) + i2_u = UBOUND(OutData%GuyanDampMat,2) + DO i2 = LBOUND(OutData%GuyanDampMat,2), UBOUND(OutData%GuyanDampMat,2) + DO i1 = LBOUND(OutData%GuyanDampMat,1), UBOUND(OutData%GuyanDampMat,1) + OutData%GuyanDampMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Members)) DEALLOCATE(OutData%Members) + ALLOCATE(OutData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) + DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) + OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SSOutList)) DEALLOCATE(OutData%SSOutList) + ALLOCATE(OutData%SSOutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) + DO I = 1, LEN(OutData%SSOutList) + OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIK not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SSIK)) DEALLOCATE(OutData%SSIK) + ALLOCATE(OutData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%SSIK,2), UBOUND(OutData%SSIK,2) + DO i1 = LBOUND(OutData%SSIK,1), UBOUND(OutData%SSIK,1) + OutData%SSIK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SSIM)) DEALLOCATE(OutData%SSIM) + ALLOCATE(OutData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%SSIM,2), UBOUND(OutData%SSIM,2) + DO i1 = LBOUND(OutData%SSIM,1), UBOUND(OutData%SSIM,1) + OutData%SSIM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIfile not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SSIfile)) DEALLOCATE(OutData%SSIfile) + ALLOCATE(OutData%SSIfile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SSIfile,1), UBOUND(OutData%SSIfile,1) + DO I = 1, LEN(OutData%SSIfile) + OutData%SSIfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_K not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Soil_K)) DEALLOCATE(OutData%Soil_K) + ALLOCATE(OutData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Soil_K,3), UBOUND(OutData%Soil_K,3) + DO i2 = LBOUND(OutData%Soil_K,2), UBOUND(OutData%Soil_K,2) + DO i1 = LBOUND(OutData%Soil_K,1), UBOUND(OutData%Soil_K,1) + OutData%Soil_K(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Points not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Soil_Points)) DEALLOCATE(OutData%Soil_Points) + ALLOCATE(OutData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Soil_Points,2), UBOUND(OutData%Soil_Points,2) + DO i1 = LBOUND(OutData%Soil_Points,1), UBOUND(OutData%Soil_Points,1) + OutData%Soil_Points(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Nodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Soil_Nodes)) DEALLOCATE(OutData%Soil_Nodes) + ALLOCATE(OutData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Soil_Nodes,1), UBOUND(OutData%Soil_Nodes,1) + OutData%Soil_Nodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Nodes)) DEALLOCATE(OutData%Nodes) + ALLOCATE(OutData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) + DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) + OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropsB)) DEALLOCATE(OutData%PropsB) + ALLOCATE(OutData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropsB,2), UBOUND(OutData%PropsB,2) + DO i1 = LBOUND(OutData%PropsB,1), UBOUND(OutData%PropsB,1) + OutData%PropsB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsC not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropsC)) DEALLOCATE(OutData%PropsC) + ALLOCATE(OutData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropsC,2), UBOUND(OutData%PropsC,2) + DO i1 = LBOUND(OutData%PropsC,1), UBOUND(OutData%PropsC,1) + OutData%PropsC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsR not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropsR)) DEALLOCATE(OutData%PropsR) + ALLOCATE(OutData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropsR,2), UBOUND(OutData%PropsR,2) + DO i1 = LBOUND(OutData%PropsR,1), UBOUND(OutData%PropsR,1) + OutData%PropsR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PropsS)) DEALLOCATE(OutData%PropsS) + ALLOCATE(OutData%PropsS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PropsS,2), UBOUND(OutData%PropsS,2) + DO i1 = LBOUND(OutData%PropsS,1), UBOUND(OutData%PropsS,1) + OutData%PropsS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%K)) DEALLOCATE(OutData%K) + ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) + DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) + OutData%K(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) + ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) + ALLOCATE(OutData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) + DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) + OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MemberNodes)) DEALLOCATE(OutData%MemberNodes) + ALLOCATE(OutData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) + DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) + OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodesConnN)) DEALLOCATE(OutData%NodesConnN) + ALLOCATE(OutData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) + DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) + OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodesConnE)) DEALLOCATE(OutData%NodesConnE) + ALLOCATE(OutData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) + DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) + OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_UnPackInitType + + SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(SD_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcContStateData%qm)) THEN + i1_l = LBOUND(SrcContStateData%qm,1) + i1_u = UBOUND(SrcContStateData%qm,1) + IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN + ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%qm = SrcContStateData%qm +ENDIF +IF (ALLOCATED(SrcContStateData%qmdot)) THEN + i1_l = LBOUND(SrcContStateData%qmdot,1) + i1_u = UBOUND(SrcContStateData%qmdot,1) + IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN + ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%qmdot = SrcContStateData%qmdot +ENDIF + END SUBROUTINE SD_CopyContState + + SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(ContStateData%qm)) THEN + DEALLOCATE(ContStateData%qm) +ENDIF +IF (ALLOCATED(ContStateData%qmdot)) THEN + DEALLOCATE(ContStateData%qmdot) +ENDIF + END SUBROUTINE SD_DestroyContState + + SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no + IF ( ALLOCATED(InData%qm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%qm) ! qm + END IF + Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no + IF ( ALLOCATED(InData%qmdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%qmdot) ! qmdot + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%qm) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) + DbKiBuf(Db_Xferred) = InData%qm(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) + DbKiBuf(Db_Xferred) = InData%qmdot(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackContState + + SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%qm)) DEALLOCATE(OutData%qm) + ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) + OutData%qm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%qmdot)) DEALLOCATE(OutData%qmdot) + ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) + OutData%qmdot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackContState + + SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE SD_CopyDiscState + + SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE SD_DestroyDiscState + + SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyDiscState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SD_PackDiscState + + SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SD_UnPackDiscState + + SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(SD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE SD_CopyConstrState + + SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE SD_DestroyConstrState + + SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SD_PackConstrState + + SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SD_UnPackConstrState + + SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(SD_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOtherStateData%xdot)) THEN + i1_l = LBOUND(SrcOtherStateData%xdot,1) + i1_u = UBOUND(SrcOtherStateData%xdot,1) + IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN + ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) + CALL SD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstOtherStateData%n = SrcOtherStateData%n + END SUBROUTINE SD_CopyOtherState + + SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(OtherStateData%xdot)) THEN +DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) + CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OtherStateData%xdot) +ENDIF + END SUBROUTINE SD_DestroyOtherState + + SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no + IF ( ALLOCATED(InData%xdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xdot + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xdot + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xdot + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! n + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%xdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_PackOtherState + + SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) + ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_UnPackOtherState + + SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(SD_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscData%qmdotdot)) THEN + i1_l = LBOUND(SrcMiscData%qmdotdot,1) + i1_u = UBOUND(SrcMiscData%qmdotdot,1) + IF (.NOT. ALLOCATED(DstMiscData%qmdotdot)) THEN + ALLOCATE(DstMiscData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%qmdotdot = SrcMiscData%qmdotdot +ENDIF + DstMiscData%u_TP = SrcMiscData%u_TP + DstMiscData%udot_TP = SrcMiscData%udot_TP + DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP +IF (ALLOCATED(SrcMiscData%F_L)) THEN + i1_l = LBOUND(SrcMiscData%F_L,1) + i1_u = UBOUND(SrcMiscData%F_L,1) + IF (.NOT. ALLOCATED(DstMiscData%F_L)) THEN + ALLOCATE(DstMiscData%F_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%F_L = SrcMiscData%F_L +ENDIF +IF (ALLOCATED(SrcMiscData%F_L2)) THEN + i1_l = LBOUND(SrcMiscData%F_L2,1) + i1_u = UBOUND(SrcMiscData%F_L2,1) + IF (.NOT. ALLOCATED(DstMiscData%F_L2)) THEN + ALLOCATE(DstMiscData%F_L2(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%F_L2 = SrcMiscData%F_L2 +ENDIF +IF (ALLOCATED(SrcMiscData%UR_bar)) THEN + i1_l = LBOUND(SrcMiscData%UR_bar,1) + i1_u = UBOUND(SrcMiscData%UR_bar,1) + IF (.NOT. ALLOCATED(DstMiscData%UR_bar)) THEN + ALLOCATE(DstMiscData%UR_bar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UR_bar = SrcMiscData%UR_bar +ENDIF +IF (ALLOCATED(SrcMiscData%UR_bar_dot)) THEN + i1_l = LBOUND(SrcMiscData%UR_bar_dot,1) + i1_u = UBOUND(SrcMiscData%UR_bar_dot,1) + IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dot)) THEN + ALLOCATE(DstMiscData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot +ENDIF +IF (ALLOCATED(SrcMiscData%UR_bar_dotdot)) THEN + i1_l = LBOUND(SrcMiscData%UR_bar_dotdot,1) + i1_u = UBOUND(SrcMiscData%UR_bar_dotdot,1) + IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dotdot)) THEN + ALLOCATE(DstMiscData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot +ENDIF +IF (ALLOCATED(SrcMiscData%UL)) THEN + i1_l = LBOUND(SrcMiscData%UL,1) + i1_u = UBOUND(SrcMiscData%UL,1) + IF (.NOT. ALLOCATED(DstMiscData%UL)) THEN + ALLOCATE(DstMiscData%UL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UL = SrcMiscData%UL +ENDIF +IF (ALLOCATED(SrcMiscData%UL_NS)) THEN + i1_l = LBOUND(SrcMiscData%UL_NS,1) + i1_u = UBOUND(SrcMiscData%UL_NS,1) + IF (.NOT. ALLOCATED(DstMiscData%UL_NS)) THEN + ALLOCATE(DstMiscData%UL_NS(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UL_NS = SrcMiscData%UL_NS +ENDIF +IF (ALLOCATED(SrcMiscData%UL_dot)) THEN + i1_l = LBOUND(SrcMiscData%UL_dot,1) + i1_u = UBOUND(SrcMiscData%UL_dot,1) + IF (.NOT. ALLOCATED(DstMiscData%UL_dot)) THEN + ALLOCATE(DstMiscData%UL_dot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UL_dot = SrcMiscData%UL_dot +ENDIF +IF (ALLOCATED(SrcMiscData%UL_dotdot)) THEN + i1_l = LBOUND(SrcMiscData%UL_dotdot,1) + i1_u = UBOUND(SrcMiscData%UL_dotdot,1) + IF (.NOT. ALLOCATED(DstMiscData%UL_dotdot)) THEN + ALLOCATE(DstMiscData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot +ENDIF +IF (ALLOCATED(SrcMiscData%DU_full)) THEN + i1_l = LBOUND(SrcMiscData%DU_full,1) + i1_u = UBOUND(SrcMiscData%DU_full,1) + IF (.NOT. ALLOCATED(DstMiscData%DU_full)) THEN + ALLOCATE(DstMiscData%DU_full(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%DU_full = SrcMiscData%DU_full +ENDIF +IF (ALLOCATED(SrcMiscData%U_full)) THEN + i1_l = LBOUND(SrcMiscData%U_full,1) + i1_u = UBOUND(SrcMiscData%U_full,1) + IF (.NOT. ALLOCATED(DstMiscData%U_full)) THEN + ALLOCATE(DstMiscData%U_full(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%U_full = SrcMiscData%U_full +ENDIF +IF (ALLOCATED(SrcMiscData%U_full_NS)) THEN + i1_l = LBOUND(SrcMiscData%U_full_NS,1) + i1_u = UBOUND(SrcMiscData%U_full_NS,1) + IF (.NOT. ALLOCATED(DstMiscData%U_full_NS)) THEN + ALLOCATE(DstMiscData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%U_full_NS = SrcMiscData%U_full_NS +ENDIF +IF (ALLOCATED(SrcMiscData%U_full_dot)) THEN + i1_l = LBOUND(SrcMiscData%U_full_dot,1) + i1_u = UBOUND(SrcMiscData%U_full_dot,1) + IF (.NOT. ALLOCATED(DstMiscData%U_full_dot)) THEN + ALLOCATE(DstMiscData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%U_full_dot = SrcMiscData%U_full_dot +ENDIF +IF (ALLOCATED(SrcMiscData%U_full_dotdot)) THEN + i1_l = LBOUND(SrcMiscData%U_full_dotdot,1) + i1_u = UBOUND(SrcMiscData%U_full_dotdot,1) + IF (.NOT. ALLOCATED(DstMiscData%U_full_dotdot)) THEN + ALLOCATE(DstMiscData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot +ENDIF +IF (ALLOCATED(SrcMiscData%U_full_elast)) THEN + i1_l = LBOUND(SrcMiscData%U_full_elast,1) + i1_u = UBOUND(SrcMiscData%U_full_elast,1) + IF (.NOT. ALLOCATED(DstMiscData%U_full_elast)) THEN + ALLOCATE(DstMiscData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%U_full_elast = SrcMiscData%U_full_elast +ENDIF +IF (ALLOCATED(SrcMiscData%U_red)) THEN + i1_l = LBOUND(SrcMiscData%U_red,1) + i1_u = UBOUND(SrcMiscData%U_red,1) + IF (.NOT. ALLOCATED(DstMiscData%U_red)) THEN + ALLOCATE(DstMiscData%U_red(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%U_red = SrcMiscData%U_red +ENDIF +IF (ALLOCATED(SrcMiscData%FC_unit)) THEN + i1_l = LBOUND(SrcMiscData%FC_unit,1) + i1_u = UBOUND(SrcMiscData%FC_unit,1) + IF (.NOT. ALLOCATED(DstMiscData%FC_unit)) THEN + ALLOCATE(DstMiscData%FC_unit(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%FC_unit = SrcMiscData%FC_unit +ENDIF +IF (ALLOCATED(SrcMiscData%SDWrOutput)) THEN + i1_l = LBOUND(SrcMiscData%SDWrOutput,1) + i1_u = UBOUND(SrcMiscData%SDWrOutput,1) + IF (.NOT. ALLOCATED(DstMiscData%SDWrOutput)) THEN + ALLOCATE(DstMiscData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput +ENDIF +IF (ALLOCATED(SrcMiscData%AllOuts)) THEN + i1_l = LBOUND(SrcMiscData%AllOuts,1) + i1_u = UBOUND(SrcMiscData%AllOuts,1) + IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN + ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%AllOuts = SrcMiscData%AllOuts +ENDIF + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%Decimat = SrcMiscData%Decimat +IF (ALLOCATED(SrcMiscData%Fext)) THEN + i1_l = LBOUND(SrcMiscData%Fext,1) + i1_u = UBOUND(SrcMiscData%Fext,1) + IF (.NOT. ALLOCATED(DstMiscData%Fext)) THEN + ALLOCATE(DstMiscData%Fext(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Fext = SrcMiscData%Fext +ENDIF +IF (ALLOCATED(SrcMiscData%Fext_red)) THEN + i1_l = LBOUND(SrcMiscData%Fext_red,1) + i1_u = UBOUND(SrcMiscData%Fext_red,1) + IF (.NOT. ALLOCATED(DstMiscData%Fext_red)) THEN + ALLOCATE(DstMiscData%Fext_red(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Fext_red = SrcMiscData%Fext_red +ENDIF +IF (ALLOCATED(SrcMiscData%UL_SIM)) THEN + i1_l = LBOUND(SrcMiscData%UL_SIM,1) + i1_u = UBOUND(SrcMiscData%UL_SIM,1) + IF (.NOT. ALLOCATED(DstMiscData%UL_SIM)) THEN + ALLOCATE(DstMiscData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UL_SIM = SrcMiscData%UL_SIM +ENDIF +IF (ALLOCATED(SrcMiscData%UL_0m)) THEN + i1_l = LBOUND(SrcMiscData%UL_0m,1) + i1_u = UBOUND(SrcMiscData%UL_0m,1) + IF (.NOT. ALLOCATED(DstMiscData%UL_0m)) THEN + ALLOCATE(DstMiscData%UL_0m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%UL_0m = SrcMiscData%UL_0m +ENDIF + END SUBROUTINE SD_CopyMisc + + SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(MiscData%qmdotdot)) THEN + DEALLOCATE(MiscData%qmdotdot) +ENDIF +IF (ALLOCATED(MiscData%F_L)) THEN + DEALLOCATE(MiscData%F_L) +ENDIF +IF (ALLOCATED(MiscData%F_L2)) THEN + DEALLOCATE(MiscData%F_L2) +ENDIF +IF (ALLOCATED(MiscData%UR_bar)) THEN + DEALLOCATE(MiscData%UR_bar) +ENDIF +IF (ALLOCATED(MiscData%UR_bar_dot)) THEN + DEALLOCATE(MiscData%UR_bar_dot) +ENDIF +IF (ALLOCATED(MiscData%UR_bar_dotdot)) THEN + DEALLOCATE(MiscData%UR_bar_dotdot) +ENDIF +IF (ALLOCATED(MiscData%UL)) THEN + DEALLOCATE(MiscData%UL) +ENDIF +IF (ALLOCATED(MiscData%UL_NS)) THEN + DEALLOCATE(MiscData%UL_NS) +ENDIF +IF (ALLOCATED(MiscData%UL_dot)) THEN + DEALLOCATE(MiscData%UL_dot) +ENDIF +IF (ALLOCATED(MiscData%UL_dotdot)) THEN + DEALLOCATE(MiscData%UL_dotdot) +ENDIF +IF (ALLOCATED(MiscData%DU_full)) THEN + DEALLOCATE(MiscData%DU_full) +ENDIF +IF (ALLOCATED(MiscData%U_full)) THEN + DEALLOCATE(MiscData%U_full) +ENDIF +IF (ALLOCATED(MiscData%U_full_NS)) THEN + DEALLOCATE(MiscData%U_full_NS) +ENDIF +IF (ALLOCATED(MiscData%U_full_dot)) THEN + DEALLOCATE(MiscData%U_full_dot) +ENDIF +IF (ALLOCATED(MiscData%U_full_dotdot)) THEN + DEALLOCATE(MiscData%U_full_dotdot) +ENDIF +IF (ALLOCATED(MiscData%U_full_elast)) THEN + DEALLOCATE(MiscData%U_full_elast) +ENDIF +IF (ALLOCATED(MiscData%U_red)) THEN + DEALLOCATE(MiscData%U_red) +ENDIF +IF (ALLOCATED(MiscData%FC_unit)) THEN + DEALLOCATE(MiscData%FC_unit) +ENDIF +IF (ALLOCATED(MiscData%SDWrOutput)) THEN + DEALLOCATE(MiscData%SDWrOutput) +ENDIF +IF (ALLOCATED(MiscData%AllOuts)) THEN + DEALLOCATE(MiscData%AllOuts) +ENDIF +IF (ALLOCATED(MiscData%Fext)) THEN + DEALLOCATE(MiscData%Fext) +ENDIF +IF (ALLOCATED(MiscData%Fext_red)) THEN + DEALLOCATE(MiscData%Fext_red) +ENDIF +IF (ALLOCATED(MiscData%UL_SIM)) THEN + DEALLOCATE(MiscData%UL_SIM) +ENDIF +IF (ALLOCATED(MiscData%UL_0m)) THEN + DEALLOCATE(MiscData%UL_0m) +ENDIF + END SUBROUTINE SD_DestroyMisc + + SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! qmdotdot allocated yes/no + IF ( ALLOCATED(InData%qmdotdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! qmdotdot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%qmdotdot) ! qmdotdot + END IF + Re_BufSz = Re_BufSz + SIZE(InData%u_TP) ! u_TP + Re_BufSz = Re_BufSz + SIZE(InData%udot_TP) ! udot_TP + Re_BufSz = Re_BufSz + SIZE(InData%udotdot_TP) ! udotdot_TP + Int_BufSz = Int_BufSz + 1 ! F_L allocated yes/no + IF ( ALLOCATED(InData%F_L) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! F_L upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%F_L) ! F_L + END IF + Int_BufSz = Int_BufSz + 1 ! F_L2 allocated yes/no + IF ( ALLOCATED(InData%F_L2) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! F_L2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%F_L2) ! F_L2 + END IF + Int_BufSz = Int_BufSz + 1 ! UR_bar allocated yes/no + IF ( ALLOCATED(InData%UR_bar) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UR_bar upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UR_bar) ! UR_bar + END IF + Int_BufSz = Int_BufSz + 1 ! UR_bar_dot allocated yes/no + IF ( ALLOCATED(InData%UR_bar_dot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dot) ! UR_bar_dot + END IF + Int_BufSz = Int_BufSz + 1 ! UR_bar_dotdot allocated yes/no + IF ( ALLOCATED(InData%UR_bar_dotdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dotdot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dotdot) ! UR_bar_dotdot + END IF + Int_BufSz = Int_BufSz + 1 ! UL allocated yes/no + IF ( ALLOCATED(InData%UL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UL) ! UL + END IF + Int_BufSz = Int_BufSz + 1 ! UL_NS allocated yes/no + IF ( ALLOCATED(InData%UL_NS) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UL_NS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UL_NS) ! UL_NS + END IF + Int_BufSz = Int_BufSz + 1 ! UL_dot allocated yes/no + IF ( ALLOCATED(InData%UL_dot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UL_dot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UL_dot) ! UL_dot + END IF + Int_BufSz = Int_BufSz + 1 ! UL_dotdot allocated yes/no + IF ( ALLOCATED(InData%UL_dotdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UL_dotdot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UL_dotdot) ! UL_dotdot + END IF + Int_BufSz = Int_BufSz + 1 ! DU_full allocated yes/no + IF ( ALLOCATED(InData%DU_full) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DU_full upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%DU_full) ! DU_full + END IF + Int_BufSz = Int_BufSz + 1 ! U_full allocated yes/no + IF ( ALLOCATED(InData%U_full) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! U_full upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%U_full) ! U_full + END IF + Int_BufSz = Int_BufSz + 1 ! U_full_NS allocated yes/no + IF ( ALLOCATED(InData%U_full_NS) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! U_full_NS upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%U_full_NS) ! U_full_NS + END IF + Int_BufSz = Int_BufSz + 1 ! U_full_dot allocated yes/no + IF ( ALLOCATED(InData%U_full_dot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! U_full_dot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%U_full_dot) ! U_full_dot + END IF + Int_BufSz = Int_BufSz + 1 ! U_full_dotdot allocated yes/no + IF ( ALLOCATED(InData%U_full_dotdot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! U_full_dotdot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%U_full_dotdot) ! U_full_dotdot + END IF + Int_BufSz = Int_BufSz + 1 ! U_full_elast allocated yes/no + IF ( ALLOCATED(InData%U_full_elast) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! U_full_elast upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%U_full_elast) ! U_full_elast + END IF + Int_BufSz = Int_BufSz + 1 ! U_red allocated yes/no + IF ( ALLOCATED(InData%U_red) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! U_red upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%U_red) ! U_red + END IF + Int_BufSz = Int_BufSz + 1 ! FC_unit allocated yes/no + IF ( ALLOCATED(InData%FC_unit) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FC_unit upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%FC_unit) ! FC_unit + END IF + Int_BufSz = Int_BufSz + 1 ! SDWrOutput allocated yes/no + IF ( ALLOCATED(InData%SDWrOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SDWrOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SDWrOutput) ! SDWrOutput + END IF + Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no + IF ( ALLOCATED(InData%AllOuts) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts + END IF + Db_BufSz = Db_BufSz + 1 ! LastOutTime + Int_BufSz = Int_BufSz + 1 ! Decimat + Int_BufSz = Int_BufSz + 1 ! Fext allocated yes/no + IF ( ALLOCATED(InData%Fext) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Fext upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Fext) ! Fext + END IF + Int_BufSz = Int_BufSz + 1 ! Fext_red allocated yes/no + IF ( ALLOCATED(InData%Fext_red) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Fext_red upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Fext_red) ! Fext_red + END IF + Int_BufSz = Int_BufSz + 1 ! UL_SIM allocated yes/no + IF ( ALLOCATED(InData%UL_SIM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UL_SIM upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UL_SIM) ! UL_SIM + END IF + Int_BufSz = Int_BufSz + 1 ! UL_0m allocated yes/no + IF ( ALLOCATED(InData%UL_0m) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! UL_0m upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%UL_0m) ! UL_0m + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%qmdotdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdotdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) + ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) + ReKiBuf(Re_Xferred) = InData%u_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) + ReKiBuf(Re_Xferred) = InData%udot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) + ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%F_L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%F_L,1), UBOUND(InData%F_L,1) + ReKiBuf(Re_Xferred) = InData%F_L(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%F_L2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L2,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%F_L2,1), UBOUND(InData%F_L2,1) + ReKiBuf(Re_Xferred) = InData%F_L2(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) + ReKiBuf(Re_Xferred) = InData%UR_bar(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dotdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) + ReKiBuf(Re_Xferred) = InData%UL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UL_NS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_NS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_NS,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UL_NS,1), UBOUND(InData%UL_NS,1) + ReKiBuf(Re_Xferred) = InData%UL_NS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) + ReKiBuf(Re_Xferred) = InData%UL_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dotdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DU_full) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DU_full,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DU_full,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DU_full,1), UBOUND(InData%DU_full,1) + ReKiBuf(Re_Xferred) = InData%DU_full(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U_full) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%U_full,1), UBOUND(InData%U_full,1) + ReKiBuf(Re_Xferred) = InData%U_full(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U_full_NS) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_NS,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_NS,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%U_full_NS,1), UBOUND(InData%U_full_NS,1) + ReKiBuf(Re_Xferred) = InData%U_full_NS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U_full_dot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%U_full_dot,1), UBOUND(InData%U_full_dot,1) + ReKiBuf(Re_Xferred) = InData%U_full_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U_full_dotdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dotdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dotdot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%U_full_dotdot,1), UBOUND(InData%U_full_dotdot,1) + ReKiBuf(Re_Xferred) = InData%U_full_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U_full_elast) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_elast,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_elast,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%U_full_elast,1), UBOUND(InData%U_full_elast,1) + ReKiBuf(Re_Xferred) = InData%U_full_elast(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U_red) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U_red,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%U_red,1), UBOUND(InData%U_red,1) + ReKiBuf(Re_Xferred) = InData%U_red(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FC_unit) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FC_unit,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FC_unit,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FC_unit,1), UBOUND(InData%FC_unit,1) + ReKiBuf(Re_Xferred) = InData%FC_unit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SDWrOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Decimat + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Fext) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Fext,1), UBOUND(InData%Fext,1) + ReKiBuf(Re_Xferred) = InData%Fext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Fext_red) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext_red,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext_red,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Fext_red,1), UBOUND(InData%Fext_red,1) + ReKiBuf(Re_Xferred) = InData%Fext_red(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UL_SIM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_SIM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_SIM,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UL_SIM,1), UBOUND(InData%UL_SIM,1) + ReKiBuf(Re_Xferred) = InData%UL_SIM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%UL_0m) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_0m,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_0m,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%UL_0m,1), UBOUND(InData%UL_0m,1) + ReKiBuf(Re_Xferred) = InData%UL_0m(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackMisc + + SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdotdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%qmdotdot)) DEALLOCATE(OutData%qmdotdot) + ALLOCATE(OutData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) + OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + i1_l = LBOUND(OutData%u_TP,1) + i1_u = UBOUND(OutData%u_TP,1) + DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) + OutData%u_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%udot_TP,1) + i1_u = UBOUND(OutData%udot_TP,1) + DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) + OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%udotdot_TP,1) + i1_u = UBOUND(OutData%udotdot_TP,1) + DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) + OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%F_L)) DEALLOCATE(OutData%F_L) + ALLOCATE(OutData%F_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%F_L,1), UBOUND(OutData%F_L,1) + OutData%F_L(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%F_L2)) DEALLOCATE(OutData%F_L2) + ALLOCATE(OutData%F_L2(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%F_L2,1), UBOUND(OutData%F_L2,1) + OutData%F_L2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UR_bar)) DEALLOCATE(OutData%UR_bar) + ALLOCATE(OutData%UR_bar(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) + OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UR_bar_dot)) DEALLOCATE(OutData%UR_bar_dot) + ALLOCATE(OutData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) + OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UR_bar_dotdot)) DEALLOCATE(OutData%UR_bar_dotdot) + ALLOCATE(OutData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) + OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UL)) DEALLOCATE(OutData%UL) + ALLOCATE(OutData%UL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) + OutData%UL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_NS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UL_NS)) DEALLOCATE(OutData%UL_NS) + ALLOCATE(OutData%UL_NS(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UL_NS,1), UBOUND(OutData%UL_NS,1) + OutData%UL_NS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UL_dot)) DEALLOCATE(OutData%UL_dot) + ALLOCATE(OutData%UL_dot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) + OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UL_dotdot)) DEALLOCATE(OutData%UL_dotdot) + ALLOCATE(OutData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) + OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DU_full not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DU_full)) DEALLOCATE(OutData%DU_full) + ALLOCATE(OutData%DU_full(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DU_full,1), UBOUND(OutData%DU_full,1) + OutData%DU_full(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U_full)) DEALLOCATE(OutData%U_full) + ALLOCATE(OutData%U_full(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%U_full,1), UBOUND(OutData%U_full,1) + OutData%U_full(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_NS not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U_full_NS)) DEALLOCATE(OutData%U_full_NS) + ALLOCATE(OutData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%U_full_NS,1), UBOUND(OutData%U_full_NS,1) + OutData%U_full_NS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U_full_dot)) DEALLOCATE(OutData%U_full_dot) + ALLOCATE(OutData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%U_full_dot,1), UBOUND(OutData%U_full_dot,1) + OutData%U_full_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dotdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U_full_dotdot)) DEALLOCATE(OutData%U_full_dotdot) + ALLOCATE(OutData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%U_full_dotdot,1), UBOUND(OutData%U_full_dotdot,1) + OutData%U_full_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_elast not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U_full_elast)) DEALLOCATE(OutData%U_full_elast) + ALLOCATE(OutData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%U_full_elast,1), UBOUND(OutData%U_full_elast,1) + OutData%U_full_elast(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U_red)) DEALLOCATE(OutData%U_red) + ALLOCATE(OutData%U_red(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%U_red,1), UBOUND(OutData%U_red,1) + OutData%U_red(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FC_unit not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FC_unit)) DEALLOCATE(OutData%FC_unit) + ALLOCATE(OutData%FC_unit(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FC_unit,1), UBOUND(OutData%FC_unit,1) + OutData%FC_unit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SDWrOutput)) DEALLOCATE(OutData%SDWrOutput) + ALLOCATE(OutData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) + OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) + ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Decimat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Fext)) DEALLOCATE(OutData%Fext) + ALLOCATE(OutData%Fext(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Fext,1), UBOUND(OutData%Fext,1) + OutData%Fext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext_red not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Fext_red)) DEALLOCATE(OutData%Fext_red) + ALLOCATE(OutData%Fext_red(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Fext_red,1), UBOUND(OutData%Fext_red,1) + OutData%Fext_red(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_SIM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UL_SIM)) DEALLOCATE(OutData%UL_SIM) + ALLOCATE(OutData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UL_SIM,1), UBOUND(OutData%UL_SIM,1) + OutData%UL_SIM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_0m not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%UL_0m)) DEALLOCATE(OutData%UL_0m) + ALLOCATE(OutData%UL_0m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%UL_0m,1), UBOUND(OutData%UL_0m,1) + OutData%UL_0m(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackMisc + + SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_ParameterType), INTENT(IN) :: SrcParamData + TYPE(SD_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%SDDeltaT = SrcParamData%SDDeltaT + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%nDOF = SrcParamData%nDOF + DstParamData%nDOF_red = SrcParamData%nDOF_red + DstParamData%Nmembers = SrcParamData%Nmembers +IF (ALLOCATED(SrcParamData%Elems)) THEN + i1_l = LBOUND(SrcParamData%Elems,1) + i1_u = UBOUND(SrcParamData%Elems,1) + i2_l = LBOUND(SrcParamData%Elems,2) + i2_u = UBOUND(SrcParamData%Elems,2) + IF (.NOT. ALLOCATED(DstParamData%Elems)) THEN + ALLOCATE(DstParamData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Elems = SrcParamData%Elems +ENDIF +IF (ALLOCATED(SrcParamData%ElemProps)) THEN + i1_l = LBOUND(SrcParamData%ElemProps,1) + i1_u = UBOUND(SrcParamData%ElemProps,1) + IF (.NOT. ALLOCATED(DstParamData%ElemProps)) THEN + ALLOCATE(DstParamData%ElemProps(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%ElemProps,1), UBOUND(SrcParamData%ElemProps,1) + CALL SD_Copyelemproptype( SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%FG)) THEN + i1_l = LBOUND(SrcParamData%FG,1) + i1_u = UBOUND(SrcParamData%FG,1) + IF (.NOT. ALLOCATED(DstParamData%FG)) THEN + ALLOCATE(DstParamData%FG(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%FG = SrcParamData%FG +ENDIF +IF (ALLOCATED(SrcParamData%DP0)) THEN + i1_l = LBOUND(SrcParamData%DP0,1) + i1_u = UBOUND(SrcParamData%DP0,1) + i2_l = LBOUND(SrcParamData%DP0,2) + i2_u = UBOUND(SrcParamData%DP0,2) + IF (.NOT. ALLOCATED(DstParamData%DP0)) THEN + ALLOCATE(DstParamData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%DP0 = SrcParamData%DP0 +ENDIF +IF (ALLOCATED(SrcParamData%NodeID2JointID)) THEN + i1_l = LBOUND(SrcParamData%NodeID2JointID,1) + i1_u = UBOUND(SrcParamData%NodeID2JointID,1) + IF (.NOT. ALLOCATED(DstParamData%NodeID2JointID)) THEN + ALLOCATE(DstParamData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID +ENDIF + DstParamData%reduced = SrcParamData%reduced +IF (ALLOCATED(SrcParamData%T_red)) THEN + i1_l = LBOUND(SrcParamData%T_red,1) + i1_u = UBOUND(SrcParamData%T_red,1) + i2_l = LBOUND(SrcParamData%T_red,2) + i2_u = UBOUND(SrcParamData%T_red,2) + IF (.NOT. ALLOCATED(DstParamData%T_red)) THEN + ALLOCATE(DstParamData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%T_red = SrcParamData%T_red +ENDIF +IF (ALLOCATED(SrcParamData%T_red_T)) THEN + i1_l = LBOUND(SrcParamData%T_red_T,1) + i1_u = UBOUND(SrcParamData%T_red_T,1) + i2_l = LBOUND(SrcParamData%T_red_T,2) + i2_u = UBOUND(SrcParamData%T_red_T,2) + IF (.NOT. ALLOCATED(DstParamData%T_red_T)) THEN + ALLOCATE(DstParamData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%T_red_T = SrcParamData%T_red_T +ENDIF +IF (ALLOCATED(SrcParamData%NodesDOF)) THEN + i1_l = LBOUND(SrcParamData%NodesDOF,1) + i1_u = UBOUND(SrcParamData%NodesDOF,1) + IF (.NOT. ALLOCATED(DstParamData%NodesDOF)) THEN + ALLOCATE(DstParamData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%NodesDOF,1), UBOUND(SrcParamData%NodesDOF,1) + CALL SD_Copyilist( SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%NodesDOFred)) THEN + i1_l = LBOUND(SrcParamData%NodesDOFred,1) + i1_u = UBOUND(SrcParamData%NodesDOFred,1) + IF (.NOT. ALLOCATED(DstParamData%NodesDOFred)) THEN + ALLOCATE(DstParamData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%NodesDOFred,1), UBOUND(SrcParamData%NodesDOFred,1) + CALL SD_Copyilist( SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%ElemsDOF)) THEN + i1_l = LBOUND(SrcParamData%ElemsDOF,1) + i1_u = UBOUND(SrcParamData%ElemsDOF,1) + i2_l = LBOUND(SrcParamData%ElemsDOF,2) + i2_u = UBOUND(SrcParamData%ElemsDOF,2) + IF (.NOT. ALLOCATED(DstParamData%ElemsDOF)) THEN + ALLOCATE(DstParamData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ElemsDOF = SrcParamData%ElemsDOF +ENDIF +IF (ALLOCATED(SrcParamData%DOFred2Nodes)) THEN + i1_l = LBOUND(SrcParamData%DOFred2Nodes,1) + i1_u = UBOUND(SrcParamData%DOFred2Nodes,1) + i2_l = LBOUND(SrcParamData%DOFred2Nodes,2) + i2_u = UBOUND(SrcParamData%DOFred2Nodes,2) + IF (.NOT. ALLOCATED(DstParamData%DOFred2Nodes)) THEN + ALLOCATE(DstParamData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes +ENDIF +IF (ALLOCATED(SrcParamData%CtrlElem2Channel)) THEN + i1_l = LBOUND(SrcParamData%CtrlElem2Channel,1) + i1_u = UBOUND(SrcParamData%CtrlElem2Channel,1) + i2_l = LBOUND(SrcParamData%CtrlElem2Channel,2) + i2_u = UBOUND(SrcParamData%CtrlElem2Channel,2) + IF (.NOT. ALLOCATED(DstParamData%CtrlElem2Channel)) THEN + ALLOCATE(DstParamData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel +ENDIF + DstParamData%nDOFM = SrcParamData%nDOFM + DstParamData%SttcSolve = SrcParamData%SttcSolve + DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection + DstParamData%Floating = SrcParamData%Floating +IF (ALLOCATED(SrcParamData%KMMDiag)) THEN + i1_l = LBOUND(SrcParamData%KMMDiag,1) + i1_u = UBOUND(SrcParamData%KMMDiag,1) + IF (.NOT. ALLOCATED(DstParamData%KMMDiag)) THEN + ALLOCATE(DstParamData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%KMMDiag = SrcParamData%KMMDiag +ENDIF +IF (ALLOCATED(SrcParamData%CMMDiag)) THEN + i1_l = LBOUND(SrcParamData%CMMDiag,1) + i1_u = UBOUND(SrcParamData%CMMDiag,1) + IF (.NOT. ALLOCATED(DstParamData%CMMDiag)) THEN + ALLOCATE(DstParamData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CMMDiag = SrcParamData%CMMDiag +ENDIF +IF (ALLOCATED(SrcParamData%MMB)) THEN + i1_l = LBOUND(SrcParamData%MMB,1) + i1_u = UBOUND(SrcParamData%MMB,1) + i2_l = LBOUND(SrcParamData%MMB,2) + i2_u = UBOUND(SrcParamData%MMB,2) + IF (.NOT. ALLOCATED(DstParamData%MMB)) THEN + ALLOCATE(DstParamData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%MMB = SrcParamData%MMB +ENDIF +IF (ALLOCATED(SrcParamData%MBmmB)) THEN + i1_l = LBOUND(SrcParamData%MBmmB,1) + i1_u = UBOUND(SrcParamData%MBmmB,1) + i2_l = LBOUND(SrcParamData%MBmmB,2) + i2_u = UBOUND(SrcParamData%MBmmB,2) + IF (.NOT. ALLOCATED(DstParamData%MBmmB)) THEN + ALLOCATE(DstParamData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%MBmmB = SrcParamData%MBmmB +ENDIF +IF (ALLOCATED(SrcParamData%C1_11)) THEN + i1_l = LBOUND(SrcParamData%C1_11,1) + i1_u = UBOUND(SrcParamData%C1_11,1) + i2_l = LBOUND(SrcParamData%C1_11,2) + i2_u = UBOUND(SrcParamData%C1_11,2) + IF (.NOT. ALLOCATED(DstParamData%C1_11)) THEN + ALLOCATE(DstParamData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C1_11 = SrcParamData%C1_11 +ENDIF +IF (ALLOCATED(SrcParamData%C1_12)) THEN + i1_l = LBOUND(SrcParamData%C1_12,1) + i1_u = UBOUND(SrcParamData%C1_12,1) + i2_l = LBOUND(SrcParamData%C1_12,2) + i2_u = UBOUND(SrcParamData%C1_12,2) + IF (.NOT. ALLOCATED(DstParamData%C1_12)) THEN + ALLOCATE(DstParamData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C1_12 = SrcParamData%C1_12 +ENDIF +IF (ALLOCATED(SrcParamData%D1_141)) THEN + i1_l = LBOUND(SrcParamData%D1_141,1) + i1_u = UBOUND(SrcParamData%D1_141,1) + i2_l = LBOUND(SrcParamData%D1_141,2) + i2_u = UBOUND(SrcParamData%D1_141,2) + IF (.NOT. ALLOCATED(DstParamData%D1_141)) THEN + ALLOCATE(DstParamData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%D1_141 = SrcParamData%D1_141 +ENDIF +IF (ALLOCATED(SrcParamData%D1_142)) THEN + i1_l = LBOUND(SrcParamData%D1_142,1) + i1_u = UBOUND(SrcParamData%D1_142,1) + i2_l = LBOUND(SrcParamData%D1_142,2) + i2_u = UBOUND(SrcParamData%D1_142,2) + IF (.NOT. ALLOCATED(DstParamData%D1_142)) THEN + ALLOCATE(DstParamData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%D1_142 = SrcParamData%D1_142 +ENDIF +IF (ALLOCATED(SrcParamData%PhiM)) THEN + i1_l = LBOUND(SrcParamData%PhiM,1) + i1_u = UBOUND(SrcParamData%PhiM,1) + i2_l = LBOUND(SrcParamData%PhiM,2) + i2_u = UBOUND(SrcParamData%PhiM,2) + IF (.NOT. ALLOCATED(DstParamData%PhiM)) THEN + ALLOCATE(DstParamData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%PhiM = SrcParamData%PhiM +ENDIF +IF (ALLOCATED(SrcParamData%C2_61)) THEN + i1_l = LBOUND(SrcParamData%C2_61,1) + i1_u = UBOUND(SrcParamData%C2_61,1) + i2_l = LBOUND(SrcParamData%C2_61,2) + i2_u = UBOUND(SrcParamData%C2_61,2) + IF (.NOT. ALLOCATED(DstParamData%C2_61)) THEN + ALLOCATE(DstParamData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C2_61 = SrcParamData%C2_61 +ENDIF +IF (ALLOCATED(SrcParamData%C2_62)) THEN + i1_l = LBOUND(SrcParamData%C2_62,1) + i1_u = UBOUND(SrcParamData%C2_62,1) + i2_l = LBOUND(SrcParamData%C2_62,2) + i2_u = UBOUND(SrcParamData%C2_62,2) + IF (.NOT. ALLOCATED(DstParamData%C2_62)) THEN + ALLOCATE(DstParamData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%C2_62 = SrcParamData%C2_62 +ENDIF +IF (ALLOCATED(SrcParamData%PhiRb_TI)) THEN + i1_l = LBOUND(SrcParamData%PhiRb_TI,1) + i1_u = UBOUND(SrcParamData%PhiRb_TI,1) + i2_l = LBOUND(SrcParamData%PhiRb_TI,2) + i2_u = UBOUND(SrcParamData%PhiRb_TI,2) + IF (.NOT. ALLOCATED(DstParamData%PhiRb_TI)) THEN + ALLOCATE(DstParamData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI +ENDIF +IF (ALLOCATED(SrcParamData%D2_63)) THEN + i1_l = LBOUND(SrcParamData%D2_63,1) + i1_u = UBOUND(SrcParamData%D2_63,1) + i2_l = LBOUND(SrcParamData%D2_63,2) + i2_u = UBOUND(SrcParamData%D2_63,2) + IF (.NOT. ALLOCATED(DstParamData%D2_63)) THEN + ALLOCATE(DstParamData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%D2_63 = SrcParamData%D2_63 +ENDIF +IF (ALLOCATED(SrcParamData%D2_64)) THEN + i1_l = LBOUND(SrcParamData%D2_64,1) + i1_u = UBOUND(SrcParamData%D2_64,1) + i2_l = LBOUND(SrcParamData%D2_64,2) + i2_u = UBOUND(SrcParamData%D2_64,2) + IF (.NOT. ALLOCATED(DstParamData%D2_64)) THEN + ALLOCATE(DstParamData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%D2_64 = SrcParamData%D2_64 +ENDIF +IF (ALLOCATED(SrcParamData%MBB)) THEN + i1_l = LBOUND(SrcParamData%MBB,1) + i1_u = UBOUND(SrcParamData%MBB,1) + i2_l = LBOUND(SrcParamData%MBB,2) + i2_u = UBOUND(SrcParamData%MBB,2) + IF (.NOT. ALLOCATED(DstParamData%MBB)) THEN + ALLOCATE(DstParamData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%MBB = SrcParamData%MBB +ENDIF +IF (ALLOCATED(SrcParamData%KBB)) THEN + i1_l = LBOUND(SrcParamData%KBB,1) + i1_u = UBOUND(SrcParamData%KBB,1) + i2_l = LBOUND(SrcParamData%KBB,2) + i2_u = UBOUND(SrcParamData%KBB,2) + IF (.NOT. ALLOCATED(DstParamData%KBB)) THEN + ALLOCATE(DstParamData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%KBB = SrcParamData%KBB +ENDIF +IF (ALLOCATED(SrcParamData%CBB)) THEN + i1_l = LBOUND(SrcParamData%CBB,1) + i1_u = UBOUND(SrcParamData%CBB,1) + i2_l = LBOUND(SrcParamData%CBB,2) + i2_u = UBOUND(SrcParamData%CBB,2) + IF (.NOT. ALLOCATED(DstParamData%CBB)) THEN + ALLOCATE(DstParamData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CBB = SrcParamData%CBB +ENDIF +IF (ALLOCATED(SrcParamData%CMM)) THEN + i1_l = LBOUND(SrcParamData%CMM,1) + i1_u = UBOUND(SrcParamData%CMM,1) + i2_l = LBOUND(SrcParamData%CMM,2) + i2_u = UBOUND(SrcParamData%CMM,2) + IF (.NOT. ALLOCATED(DstParamData%CMM)) THEN + ALLOCATE(DstParamData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%CMM = SrcParamData%CMM +ENDIF +IF (ALLOCATED(SrcParamData%MBM)) THEN + i1_l = LBOUND(SrcParamData%MBM,1) + i1_u = UBOUND(SrcParamData%MBM,1) + i2_l = LBOUND(SrcParamData%MBM,2) + i2_u = UBOUND(SrcParamData%MBM,2) + IF (.NOT. ALLOCATED(DstParamData%MBM)) THEN + ALLOCATE(DstParamData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%MBM = SrcParamData%MBM +ENDIF +IF (ALLOCATED(SrcParamData%PhiL_T)) THEN + i1_l = LBOUND(SrcParamData%PhiL_T,1) + i1_u = UBOUND(SrcParamData%PhiL_T,1) + i2_l = LBOUND(SrcParamData%PhiL_T,2) + i2_u = UBOUND(SrcParamData%PhiL_T,2) + IF (.NOT. ALLOCATED(DstParamData%PhiL_T)) THEN + ALLOCATE(DstParamData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%PhiL_T = SrcParamData%PhiL_T +ENDIF +IF (ALLOCATED(SrcParamData%PhiLInvOmgL2)) THEN + i1_l = LBOUND(SrcParamData%PhiLInvOmgL2,1) + i1_u = UBOUND(SrcParamData%PhiLInvOmgL2,1) + i2_l = LBOUND(SrcParamData%PhiLInvOmgL2,2) + i2_u = UBOUND(SrcParamData%PhiLInvOmgL2,2) + IF (.NOT. ALLOCATED(DstParamData%PhiLInvOmgL2)) THEN + ALLOCATE(DstParamData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 +ENDIF +IF (ALLOCATED(SrcParamData%KLLm1)) THEN + i1_l = LBOUND(SrcParamData%KLLm1,1) + i1_u = UBOUND(SrcParamData%KLLm1,1) + i2_l = LBOUND(SrcParamData%KLLm1,2) + i2_u = UBOUND(SrcParamData%KLLm1,2) + IF (.NOT. ALLOCATED(DstParamData%KLLm1)) THEN + ALLOCATE(DstParamData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%KLLm1 = SrcParamData%KLLm1 +ENDIF +IF (ALLOCATED(SrcParamData%AM2Jac)) THEN + i1_l = LBOUND(SrcParamData%AM2Jac,1) + i1_u = UBOUND(SrcParamData%AM2Jac,1) + i2_l = LBOUND(SrcParamData%AM2Jac,2) + i2_u = UBOUND(SrcParamData%AM2Jac,2) + IF (.NOT. ALLOCATED(DstParamData%AM2Jac)) THEN + ALLOCATE(DstParamData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AM2Jac = SrcParamData%AM2Jac +ENDIF +IF (ALLOCATED(SrcParamData%AM2JacPiv)) THEN + i1_l = LBOUND(SrcParamData%AM2JacPiv,1) + i1_u = UBOUND(SrcParamData%AM2JacPiv,1) + IF (.NOT. ALLOCATED(DstParamData%AM2JacPiv)) THEN + ALLOCATE(DstParamData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv +ENDIF +IF (ALLOCATED(SrcParamData%TI)) THEN + i1_l = LBOUND(SrcParamData%TI,1) + i1_u = UBOUND(SrcParamData%TI,1) + i2_l = LBOUND(SrcParamData%TI,2) + i2_u = UBOUND(SrcParamData%TI,2) + IF (.NOT. ALLOCATED(DstParamData%TI)) THEN + ALLOCATE(DstParamData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%TI = SrcParamData%TI +ENDIF +IF (ALLOCATED(SrcParamData%TIreact)) THEN + i1_l = LBOUND(SrcParamData%TIreact,1) + i1_u = UBOUND(SrcParamData%TIreact,1) + i2_l = LBOUND(SrcParamData%TIreact,2) + i2_u = UBOUND(SrcParamData%TIreact,2) + IF (.NOT. ALLOCATED(DstParamData%TIreact)) THEN + ALLOCATE(DstParamData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%TIreact = SrcParamData%TIreact +ENDIF + DstParamData%nNodes = SrcParamData%nNodes + DstParamData%nNodes_I = SrcParamData%nNodes_I + DstParamData%nNodes_L = SrcParamData%nNodes_L + DstParamData%nNodes_C = SrcParamData%nNodes_C +IF (ALLOCATED(SrcParamData%Nodes_I)) THEN + i1_l = LBOUND(SrcParamData%Nodes_I,1) + i1_u = UBOUND(SrcParamData%Nodes_I,1) + i2_l = LBOUND(SrcParamData%Nodes_I,2) + i2_u = UBOUND(SrcParamData%Nodes_I,2) + IF (.NOT. ALLOCATED(DstParamData%Nodes_I)) THEN + ALLOCATE(DstParamData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Nodes_I = SrcParamData%Nodes_I +ENDIF +IF (ALLOCATED(SrcParamData%Nodes_L)) THEN + i1_l = LBOUND(SrcParamData%Nodes_L,1) + i1_u = UBOUND(SrcParamData%Nodes_L,1) + i2_l = LBOUND(SrcParamData%Nodes_L,2) + i2_u = UBOUND(SrcParamData%Nodes_L,2) + IF (.NOT. ALLOCATED(DstParamData%Nodes_L)) THEN + ALLOCATE(DstParamData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Nodes_L = SrcParamData%Nodes_L +ENDIF +IF (ALLOCATED(SrcParamData%Nodes_C)) THEN + i1_l = LBOUND(SrcParamData%Nodes_C,1) + i1_u = UBOUND(SrcParamData%Nodes_C,1) + i2_l = LBOUND(SrcParamData%Nodes_C,2) + i2_u = UBOUND(SrcParamData%Nodes_C,2) + IF (.NOT. ALLOCATED(DstParamData%Nodes_C)) THEN + ALLOCATE(DstParamData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Nodes_C = SrcParamData%Nodes_C +ENDIF + DstParamData%nDOFI__ = SrcParamData%nDOFI__ + DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb + DstParamData%nDOFI_F = SrcParamData%nDOFI_F + DstParamData%nDOFL_L = SrcParamData%nDOFL_L + DstParamData%nDOFC__ = SrcParamData%nDOFC__ + DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb + DstParamData%nDOFC_L = SrcParamData%nDOFC_L + DstParamData%nDOFC_F = SrcParamData%nDOFC_F + DstParamData%nDOFR__ = SrcParamData%nDOFR__ + DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb + DstParamData%nDOF__L = SrcParamData%nDOF__L + DstParamData%nDOF__F = SrcParamData%nDOF__F +IF (ALLOCATED(SrcParamData%IDI__)) THEN + i1_l = LBOUND(SrcParamData%IDI__,1) + i1_u = UBOUND(SrcParamData%IDI__,1) + IF (.NOT. ALLOCATED(DstParamData%IDI__)) THEN + ALLOCATE(DstParamData%IDI__(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDI__ = SrcParamData%IDI__ +ENDIF +IF (ALLOCATED(SrcParamData%IDI_Rb)) THEN + i1_l = LBOUND(SrcParamData%IDI_Rb,1) + i1_u = UBOUND(SrcParamData%IDI_Rb,1) + IF (.NOT. ALLOCATED(DstParamData%IDI_Rb)) THEN + ALLOCATE(DstParamData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDI_Rb = SrcParamData%IDI_Rb +ENDIF +IF (ALLOCATED(SrcParamData%IDI_F)) THEN + i1_l = LBOUND(SrcParamData%IDI_F,1) + i1_u = UBOUND(SrcParamData%IDI_F,1) + IF (.NOT. ALLOCATED(DstParamData%IDI_F)) THEN + ALLOCATE(DstParamData%IDI_F(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDI_F = SrcParamData%IDI_F +ENDIF +IF (ALLOCATED(SrcParamData%IDL_L)) THEN + i1_l = LBOUND(SrcParamData%IDL_L,1) + i1_u = UBOUND(SrcParamData%IDL_L,1) + IF (.NOT. ALLOCATED(DstParamData%IDL_L)) THEN + ALLOCATE(DstParamData%IDL_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDL_L = SrcParamData%IDL_L +ENDIF +IF (ALLOCATED(SrcParamData%IDC__)) THEN + i1_l = LBOUND(SrcParamData%IDC__,1) + i1_u = UBOUND(SrcParamData%IDC__,1) + IF (.NOT. ALLOCATED(DstParamData%IDC__)) THEN + ALLOCATE(DstParamData%IDC__(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDC__ = SrcParamData%IDC__ +ENDIF +IF (ALLOCATED(SrcParamData%IDC_Rb)) THEN + i1_l = LBOUND(SrcParamData%IDC_Rb,1) + i1_u = UBOUND(SrcParamData%IDC_Rb,1) + IF (.NOT. ALLOCATED(DstParamData%IDC_Rb)) THEN + ALLOCATE(DstParamData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDC_Rb = SrcParamData%IDC_Rb +ENDIF +IF (ALLOCATED(SrcParamData%IDC_L)) THEN + i1_l = LBOUND(SrcParamData%IDC_L,1) + i1_u = UBOUND(SrcParamData%IDC_L,1) + IF (.NOT. ALLOCATED(DstParamData%IDC_L)) THEN + ALLOCATE(DstParamData%IDC_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDC_L = SrcParamData%IDC_L +ENDIF +IF (ALLOCATED(SrcParamData%IDC_F)) THEN + i1_l = LBOUND(SrcParamData%IDC_F,1) + i1_u = UBOUND(SrcParamData%IDC_F,1) + IF (.NOT. ALLOCATED(DstParamData%IDC_F)) THEN + ALLOCATE(DstParamData%IDC_F(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDC_F = SrcParamData%IDC_F +ENDIF +IF (ALLOCATED(SrcParamData%IDR__)) THEN + i1_l = LBOUND(SrcParamData%IDR__,1) + i1_u = UBOUND(SrcParamData%IDR__,1) + IF (.NOT. ALLOCATED(DstParamData%IDR__)) THEN + ALLOCATE(DstParamData%IDR__(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IDR__ = SrcParamData%IDR__ +ENDIF +IF (ALLOCATED(SrcParamData%ID__Rb)) THEN + i1_l = LBOUND(SrcParamData%ID__Rb,1) + i1_u = UBOUND(SrcParamData%ID__Rb,1) + IF (.NOT. ALLOCATED(DstParamData%ID__Rb)) THEN + ALLOCATE(DstParamData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ID__Rb = SrcParamData%ID__Rb +ENDIF +IF (ALLOCATED(SrcParamData%ID__L)) THEN + i1_l = LBOUND(SrcParamData%ID__L,1) + i1_u = UBOUND(SrcParamData%ID__L,1) + IF (.NOT. ALLOCATED(DstParamData%ID__L)) THEN + ALLOCATE(DstParamData%ID__L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ID__L = SrcParamData%ID__L +ENDIF +IF (ALLOCATED(SrcParamData%ID__F)) THEN + i1_l = LBOUND(SrcParamData%ID__F,1) + i1_u = UBOUND(SrcParamData%ID__F,1) + IF (.NOT. ALLOCATED(DstParamData%ID__F)) THEN + ALLOCATE(DstParamData%ID__F(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ID__F = SrcParamData%ID__F +ENDIF + DstParamData%NMOutputs = SrcParamData%NMOutputs + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%UnJckF = SrcParamData%UnJckF + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt +IF (ALLOCATED(SrcParamData%MoutLst)) THEN + i1_l = LBOUND(SrcParamData%MoutLst,1) + i1_u = UBOUND(SrcParamData%MoutLst,1) + IF (.NOT. ALLOCATED(DstParamData%MoutLst)) THEN + ALLOCATE(DstParamData%MoutLst(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%MoutLst,1), UBOUND(SrcParamData%MoutLst,1) + CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%MoutLst2)) THEN + i1_l = LBOUND(SrcParamData%MoutLst2,1) + i1_u = UBOUND(SrcParamData%MoutLst2,1) + IF (.NOT. ALLOCATED(DstParamData%MoutLst2)) THEN + ALLOCATE(DstParamData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%MoutLst2,1), UBOUND(SrcParamData%MoutLst2,1) + CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%MoutLst3)) THEN + i1_l = LBOUND(SrcParamData%MoutLst3,1) + i1_u = UBOUND(SrcParamData%MoutLst3,1) + IF (.NOT. ALLOCATED(DstParamData%MoutLst3)) THEN + ALLOCATE(DstParamData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%MoutLst3,1), UBOUND(SrcParamData%MoutLst3,1) + CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%OutAll = SrcParamData%OutAll + DstParamData%OutCBModes = SrcParamData%OutCBModes + DstParamData%OutFEMModes = SrcParamData%OutFEMModes + DstParamData%OutReact = SrcParamData%OutReact + DstParamData%OutAllInt = SrcParamData%OutAllInt + DstParamData%OutAllDims = SrcParamData%OutAllDims + DstParamData%OutDec = SrcParamData%OutDec +IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcParamData%Jac_u_indx,1) + i1_u = UBOUND(SrcParamData%Jac_u_indx,1) + i2_l = LBOUND(SrcParamData%Jac_u_indx,2) + i2_u = UBOUND(SrcParamData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN + ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx +ENDIF +IF (ALLOCATED(SrcParamData%du)) THEN + i1_l = LBOUND(SrcParamData%du,1) + i1_u = UBOUND(SrcParamData%du,1) + IF (.NOT. ALLOCATED(DstParamData%du)) THEN + ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%du = SrcParamData%du +ENDIF + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates + END SUBROUTINE SD_CopyParam + + SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ALLOCATED(ParamData%Elems)) THEN + DEALLOCATE(ParamData%Elems) +ENDIF +IF (ALLOCATED(ParamData%ElemProps)) THEN +DO i1 = LBOUND(ParamData%ElemProps,1), UBOUND(ParamData%ElemProps,1) + CALL SD_Destroyelemproptype( ParamData%ElemProps(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%ElemProps) +ENDIF +IF (ALLOCATED(ParamData%FG)) THEN + DEALLOCATE(ParamData%FG) +ENDIF +IF (ALLOCATED(ParamData%DP0)) THEN + DEALLOCATE(ParamData%DP0) +ENDIF +IF (ALLOCATED(ParamData%NodeID2JointID)) THEN + DEALLOCATE(ParamData%NodeID2JointID) +ENDIF +IF (ALLOCATED(ParamData%T_red)) THEN + DEALLOCATE(ParamData%T_red) +ENDIF +IF (ALLOCATED(ParamData%T_red_T)) THEN + DEALLOCATE(ParamData%T_red_T) +ENDIF +IF (ALLOCATED(ParamData%NodesDOF)) THEN +DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) + CALL SD_Destroyilist( ParamData%NodesDOF(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%NodesDOF) +ENDIF +IF (ALLOCATED(ParamData%NodesDOFred)) THEN +DO i1 = LBOUND(ParamData%NodesDOFred,1), UBOUND(ParamData%NodesDOFred,1) + CALL SD_Destroyilist( ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%NodesDOFred) +ENDIF +IF (ALLOCATED(ParamData%ElemsDOF)) THEN + DEALLOCATE(ParamData%ElemsDOF) +ENDIF +IF (ALLOCATED(ParamData%DOFred2Nodes)) THEN + DEALLOCATE(ParamData%DOFred2Nodes) +ENDIF +IF (ALLOCATED(ParamData%CtrlElem2Channel)) THEN + DEALLOCATE(ParamData%CtrlElem2Channel) +ENDIF +IF (ALLOCATED(ParamData%KMMDiag)) THEN + DEALLOCATE(ParamData%KMMDiag) +ENDIF +IF (ALLOCATED(ParamData%CMMDiag)) THEN + DEALLOCATE(ParamData%CMMDiag) +ENDIF +IF (ALLOCATED(ParamData%MMB)) THEN + DEALLOCATE(ParamData%MMB) +ENDIF +IF (ALLOCATED(ParamData%MBmmB)) THEN + DEALLOCATE(ParamData%MBmmB) +ENDIF +IF (ALLOCATED(ParamData%C1_11)) THEN + DEALLOCATE(ParamData%C1_11) +ENDIF +IF (ALLOCATED(ParamData%C1_12)) THEN + DEALLOCATE(ParamData%C1_12) +ENDIF +IF (ALLOCATED(ParamData%D1_141)) THEN + DEALLOCATE(ParamData%D1_141) +ENDIF +IF (ALLOCATED(ParamData%D1_142)) THEN + DEALLOCATE(ParamData%D1_142) +ENDIF +IF (ALLOCATED(ParamData%PhiM)) THEN + DEALLOCATE(ParamData%PhiM) +ENDIF +IF (ALLOCATED(ParamData%C2_61)) THEN + DEALLOCATE(ParamData%C2_61) +ENDIF +IF (ALLOCATED(ParamData%C2_62)) THEN + DEALLOCATE(ParamData%C2_62) +ENDIF +IF (ALLOCATED(ParamData%PhiRb_TI)) THEN + DEALLOCATE(ParamData%PhiRb_TI) +ENDIF +IF (ALLOCATED(ParamData%D2_63)) THEN + DEALLOCATE(ParamData%D2_63) +ENDIF +IF (ALLOCATED(ParamData%D2_64)) THEN + DEALLOCATE(ParamData%D2_64) +ENDIF +IF (ALLOCATED(ParamData%MBB)) THEN + DEALLOCATE(ParamData%MBB) +ENDIF +IF (ALLOCATED(ParamData%KBB)) THEN + DEALLOCATE(ParamData%KBB) +ENDIF +IF (ALLOCATED(ParamData%CBB)) THEN + DEALLOCATE(ParamData%CBB) +ENDIF +IF (ALLOCATED(ParamData%CMM)) THEN + DEALLOCATE(ParamData%CMM) +ENDIF +IF (ALLOCATED(ParamData%MBM)) THEN + DEALLOCATE(ParamData%MBM) +ENDIF +IF (ALLOCATED(ParamData%PhiL_T)) THEN + DEALLOCATE(ParamData%PhiL_T) +ENDIF +IF (ALLOCATED(ParamData%PhiLInvOmgL2)) THEN + DEALLOCATE(ParamData%PhiLInvOmgL2) +ENDIF +IF (ALLOCATED(ParamData%KLLm1)) THEN + DEALLOCATE(ParamData%KLLm1) +ENDIF +IF (ALLOCATED(ParamData%AM2Jac)) THEN + DEALLOCATE(ParamData%AM2Jac) +ENDIF +IF (ALLOCATED(ParamData%AM2JacPiv)) THEN + DEALLOCATE(ParamData%AM2JacPiv) +ENDIF +IF (ALLOCATED(ParamData%TI)) THEN + DEALLOCATE(ParamData%TI) +ENDIF +IF (ALLOCATED(ParamData%TIreact)) THEN + DEALLOCATE(ParamData%TIreact) +ENDIF +IF (ALLOCATED(ParamData%Nodes_I)) THEN + DEALLOCATE(ParamData%Nodes_I) +ENDIF +IF (ALLOCATED(ParamData%Nodes_L)) THEN + DEALLOCATE(ParamData%Nodes_L) +ENDIF +IF (ALLOCATED(ParamData%Nodes_C)) THEN + DEALLOCATE(ParamData%Nodes_C) +ENDIF +IF (ALLOCATED(ParamData%IDI__)) THEN + DEALLOCATE(ParamData%IDI__) +ENDIF +IF (ALLOCATED(ParamData%IDI_Rb)) THEN + DEALLOCATE(ParamData%IDI_Rb) +ENDIF +IF (ALLOCATED(ParamData%IDI_F)) THEN + DEALLOCATE(ParamData%IDI_F) +ENDIF +IF (ALLOCATED(ParamData%IDL_L)) THEN + DEALLOCATE(ParamData%IDL_L) +ENDIF +IF (ALLOCATED(ParamData%IDC__)) THEN + DEALLOCATE(ParamData%IDC__) +ENDIF +IF (ALLOCATED(ParamData%IDC_Rb)) THEN + DEALLOCATE(ParamData%IDC_Rb) +ENDIF +IF (ALLOCATED(ParamData%IDC_L)) THEN + DEALLOCATE(ParamData%IDC_L) +ENDIF +IF (ALLOCATED(ParamData%IDC_F)) THEN + DEALLOCATE(ParamData%IDC_F) +ENDIF +IF (ALLOCATED(ParamData%IDR__)) THEN + DEALLOCATE(ParamData%IDR__) +ENDIF +IF (ALLOCATED(ParamData%ID__Rb)) THEN + DEALLOCATE(ParamData%ID__Rb) +ENDIF +IF (ALLOCATED(ParamData%ID__L)) THEN + DEALLOCATE(ParamData%ID__L) +ENDIF +IF (ALLOCATED(ParamData%ID__F)) THEN + DEALLOCATE(ParamData%ID__F) +ENDIF +IF (ALLOCATED(ParamData%MoutLst)) THEN +DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) + CALL SD_Destroymeshauxdatatype( ParamData%MoutLst(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%MoutLst) +ENDIF +IF (ALLOCATED(ParamData%MoutLst2)) THEN +DO i1 = LBOUND(ParamData%MoutLst2,1), UBOUND(ParamData%MoutLst2,1) + CALL SD_Destroymeshauxdatatype( ParamData%MoutLst2(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%MoutLst2) +ENDIF +IF (ALLOCATED(ParamData%MoutLst3)) THEN +DO i1 = LBOUND(ParamData%MoutLst3,1), UBOUND(ParamData%MoutLst3,1) + CALL SD_Destroymeshauxdatatype( ParamData%MoutLst3(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%MoutLst3) +ENDIF +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%Jac_u_indx)) THEN + DEALLOCATE(ParamData%Jac_u_indx) +ENDIF +IF (ALLOCATED(ParamData%du)) THEN + DEALLOCATE(ParamData%du) +ENDIF + END SUBROUTINE SD_DestroyParam + + SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! SDDeltaT + Int_BufSz = Int_BufSz + 1 ! IntMethod + Int_BufSz = Int_BufSz + 1 ! nDOF + Int_BufSz = Int_BufSz + 1 ! nDOF_red + Int_BufSz = Int_BufSz + 1 ! Nmembers + Int_BufSz = Int_BufSz + 1 ! Elems allocated yes/no + IF ( ALLOCATED(InData%Elems) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Elems upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Elems) ! Elems + END IF + Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no + IF ( ALLOCATED(InData%ElemProps) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ElemProps upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) + Int_BufSz = Int_BufSz + 3 ! ElemProps: size of buffers for each call to pack subtype + CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ElemProps + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ElemProps + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ElemProps + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ElemProps + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! FG allocated yes/no + IF ( ALLOCATED(InData%FG) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FG upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%FG) ! FG + END IF + Int_BufSz = Int_BufSz + 1 ! DP0 allocated yes/no + IF ( ALLOCATED(InData%DP0) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! DP0 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%DP0) ! DP0 + END IF + Int_BufSz = Int_BufSz + 1 ! NodeID2JointID allocated yes/no + IF ( ALLOCATED(InData%NodeID2JointID) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NodeID2JointID upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NodeID2JointID) ! NodeID2JointID + END IF + Int_BufSz = Int_BufSz + 1 ! reduced + Int_BufSz = Int_BufSz + 1 ! T_red allocated yes/no + IF ( ALLOCATED(InData%T_red) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! T_red upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%T_red) ! T_red + END IF + Int_BufSz = Int_BufSz + 1 ! T_red_T allocated yes/no + IF ( ALLOCATED(InData%T_red_T) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! T_red_T upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%T_red_T) ! T_red_T + END IF + Int_BufSz = Int_BufSz + 1 ! NodesDOF allocated yes/no + IF ( ALLOCATED(InData%NodesDOF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NodesDOF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) + Int_BufSz = Int_BufSz + 3 ! NodesDOF: size of buffers for each call to pack subtype + CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! NodesDOF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! NodesDOF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! NodesDOF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! NodesDOFred allocated yes/no + IF ( ALLOCATED(InData%NodesDOFred) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NodesDOFred upper/lower bounds for each dimension + DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) + Int_BufSz = Int_BufSz + 3 ! NodesDOFred: size of buffers for each call to pack subtype + CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOFred + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! NodesDOFred + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! NodesDOFred + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! NodesDOFred + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! ElemsDOF allocated yes/no + IF ( ALLOCATED(InData%ElemsDOF) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! ElemsDOF upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ElemsDOF) ! ElemsDOF + END IF + Int_BufSz = Int_BufSz + 1 ! DOFred2Nodes allocated yes/no + IF ( ALLOCATED(InData%DOFred2Nodes) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! DOFred2Nodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DOFred2Nodes) ! DOFred2Nodes + END IF + Int_BufSz = Int_BufSz + 1 ! CtrlElem2Channel allocated yes/no + IF ( ALLOCATED(InData%CtrlElem2Channel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CtrlElem2Channel upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CtrlElem2Channel) ! CtrlElem2Channel + END IF + Int_BufSz = Int_BufSz + 1 ! nDOFM + Int_BufSz = Int_BufSz + 1 ! SttcSolve + Int_BufSz = Int_BufSz + 1 ! GuyanLoadCorrection + Int_BufSz = Int_BufSz + 1 ! Floating + Int_BufSz = Int_BufSz + 1 ! KMMDiag allocated yes/no + IF ( ALLOCATED(InData%KMMDiag) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! KMMDiag upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%KMMDiag) ! KMMDiag + END IF + Int_BufSz = Int_BufSz + 1 ! CMMDiag allocated yes/no + IF ( ALLOCATED(InData%CMMDiag) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CMMDiag upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CMMDiag) ! CMMDiag + END IF + Int_BufSz = Int_BufSz + 1 ! MMB allocated yes/no + IF ( ALLOCATED(InData%MMB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MMB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MMB) ! MMB + END IF + Int_BufSz = Int_BufSz + 1 ! MBmmB allocated yes/no + IF ( ALLOCATED(InData%MBmmB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MBmmB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MBmmB) ! MBmmB + END IF + Int_BufSz = Int_BufSz + 1 ! C1_11 allocated yes/no + IF ( ALLOCATED(InData%C1_11) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C1_11 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C1_11) ! C1_11 + END IF + Int_BufSz = Int_BufSz + 1 ! C1_12 allocated yes/no + IF ( ALLOCATED(InData%C1_12) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C1_12 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C1_12) ! C1_12 + END IF + Int_BufSz = Int_BufSz + 1 ! D1_141 allocated yes/no + IF ( ALLOCATED(InData%D1_141) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! D1_141 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%D1_141) ! D1_141 + END IF + Int_BufSz = Int_BufSz + 1 ! D1_142 allocated yes/no + IF ( ALLOCATED(InData%D1_142) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! D1_142 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%D1_142) ! D1_142 + END IF + Int_BufSz = Int_BufSz + 1 ! PhiM allocated yes/no + IF ( ALLOCATED(InData%PhiM) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PhiM upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PhiM) ! PhiM + END IF + Int_BufSz = Int_BufSz + 1 ! C2_61 allocated yes/no + IF ( ALLOCATED(InData%C2_61) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C2_61 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C2_61) ! C2_61 + END IF + Int_BufSz = Int_BufSz + 1 ! C2_62 allocated yes/no + IF ( ALLOCATED(InData%C2_62) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C2_62 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%C2_62) ! C2_62 + END IF + Int_BufSz = Int_BufSz + 1 ! PhiRb_TI allocated yes/no + IF ( ALLOCATED(InData%PhiRb_TI) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PhiRb_TI upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PhiRb_TI) ! PhiRb_TI + END IF + Int_BufSz = Int_BufSz + 1 ! D2_63 allocated yes/no + IF ( ALLOCATED(InData%D2_63) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! D2_63 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%D2_63) ! D2_63 + END IF + Int_BufSz = Int_BufSz + 1 ! D2_64 allocated yes/no + IF ( ALLOCATED(InData%D2_64) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! D2_64 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%D2_64) ! D2_64 + END IF + Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no + IF ( ALLOCATED(InData%MBB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MBB) ! MBB + END IF + Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no + IF ( ALLOCATED(InData%KBB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%KBB) ! KBB + END IF + Int_BufSz = Int_BufSz + 1 ! CBB allocated yes/no + IF ( ALLOCATED(InData%CBB) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CBB upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CBB) ! CBB + END IF + Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no + IF ( ALLOCATED(InData%CMM) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CMM upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM + END IF + Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no + IF ( ALLOCATED(InData%MBM) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%MBM) ! MBM + END IF + Int_BufSz = Int_BufSz + 1 ! PhiL_T allocated yes/no + IF ( ALLOCATED(InData%PhiL_T) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PhiL_T upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PhiL_T) ! PhiL_T + END IF + Int_BufSz = Int_BufSz + 1 ! PhiLInvOmgL2 allocated yes/no + IF ( ALLOCATED(InData%PhiLInvOmgL2) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PhiLInvOmgL2 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PhiLInvOmgL2) ! PhiLInvOmgL2 + END IF + Int_BufSz = Int_BufSz + 1 ! KLLm1 allocated yes/no + IF ( ALLOCATED(InData%KLLm1) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! KLLm1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%KLLm1) ! KLLm1 + END IF + Int_BufSz = Int_BufSz + 1 ! AM2Jac allocated yes/no + IF ( ALLOCATED(InData%AM2Jac) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AM2Jac upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AM2Jac) ! AM2Jac + END IF + Int_BufSz = Int_BufSz + 1 ! AM2JacPiv allocated yes/no + IF ( ALLOCATED(InData%AM2JacPiv) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AM2JacPiv upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%AM2JacPiv) ! AM2JacPiv + END IF + Int_BufSz = Int_BufSz + 1 ! TI allocated yes/no + IF ( ALLOCATED(InData%TI) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TI upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI + END IF + Int_BufSz = Int_BufSz + 1 ! TIreact allocated yes/no + IF ( ALLOCATED(InData%TIreact) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TIreact upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TIreact) ! TIreact + END IF + Int_BufSz = Int_BufSz + 1 ! nNodes + Int_BufSz = Int_BufSz + 1 ! nNodes_I + Int_BufSz = Int_BufSz + 1 ! nNodes_L + Int_BufSz = Int_BufSz + 1 ! nNodes_C + Int_BufSz = Int_BufSz + 1 ! Nodes_I allocated yes/no + IF ( ALLOCATED(InData%Nodes_I) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Nodes_I upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Nodes_I) ! Nodes_I + END IF + Int_BufSz = Int_BufSz + 1 ! Nodes_L allocated yes/no + IF ( ALLOCATED(InData%Nodes_L) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Nodes_L upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Nodes_L) ! Nodes_L + END IF + Int_BufSz = Int_BufSz + 1 ! Nodes_C allocated yes/no + IF ( ALLOCATED(InData%Nodes_C) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Nodes_C upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Nodes_C) ! Nodes_C + END IF + Int_BufSz = Int_BufSz + 1 ! nDOFI__ + Int_BufSz = Int_BufSz + 1 ! nDOFI_Rb + Int_BufSz = Int_BufSz + 1 ! nDOFI_F + Int_BufSz = Int_BufSz + 1 ! nDOFL_L + Int_BufSz = Int_BufSz + 1 ! nDOFC__ + Int_BufSz = Int_BufSz + 1 ! nDOFC_Rb + Int_BufSz = Int_BufSz + 1 ! nDOFC_L + Int_BufSz = Int_BufSz + 1 ! nDOFC_F + Int_BufSz = Int_BufSz + 1 ! nDOFR__ + Int_BufSz = Int_BufSz + 1 ! nDOF__Rb + Int_BufSz = Int_BufSz + 1 ! nDOF__L + Int_BufSz = Int_BufSz + 1 ! nDOF__F + Int_BufSz = Int_BufSz + 1 ! IDI__ allocated yes/no + IF ( ALLOCATED(InData%IDI__) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDI__ upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDI__) ! IDI__ + END IF + Int_BufSz = Int_BufSz + 1 ! IDI_Rb allocated yes/no + IF ( ALLOCATED(InData%IDI_Rb) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDI_Rb upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDI_Rb) ! IDI_Rb + END IF + Int_BufSz = Int_BufSz + 1 ! IDI_F allocated yes/no + IF ( ALLOCATED(InData%IDI_F) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDI_F upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDI_F) ! IDI_F + END IF + Int_BufSz = Int_BufSz + 1 ! IDL_L allocated yes/no + IF ( ALLOCATED(InData%IDL_L) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDL_L upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDL_L) ! IDL_L + END IF + Int_BufSz = Int_BufSz + 1 ! IDC__ allocated yes/no + IF ( ALLOCATED(InData%IDC__) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDC__ upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDC__) ! IDC__ + END IF + Int_BufSz = Int_BufSz + 1 ! IDC_Rb allocated yes/no + IF ( ALLOCATED(InData%IDC_Rb) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDC_Rb upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDC_Rb) ! IDC_Rb + END IF + Int_BufSz = Int_BufSz + 1 ! IDC_L allocated yes/no + IF ( ALLOCATED(InData%IDC_L) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDC_L upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDC_L) ! IDC_L + END IF + Int_BufSz = Int_BufSz + 1 ! IDC_F allocated yes/no + IF ( ALLOCATED(InData%IDC_F) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDC_F upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDC_F) ! IDC_F + END IF + Int_BufSz = Int_BufSz + 1 ! IDR__ allocated yes/no + IF ( ALLOCATED(InData%IDR__) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IDR__ upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IDR__) ! IDR__ + END IF + Int_BufSz = Int_BufSz + 1 ! ID__Rb allocated yes/no + IF ( ALLOCATED(InData%ID__Rb) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ID__Rb upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ID__Rb) ! ID__Rb + END IF + Int_BufSz = Int_BufSz + 1 ! ID__L allocated yes/no + IF ( ALLOCATED(InData%ID__L) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ID__L upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ID__L) ! ID__L + END IF + Int_BufSz = Int_BufSz + 1 ! ID__F allocated yes/no + IF ( ALLOCATED(InData%ID__F) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ID__F upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ID__F) ! ID__F + END IF + Int_BufSz = Int_BufSz + 1 ! NMOutputs + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! OutSwtch + Int_BufSz = Int_BufSz + 1 ! UnJckF + Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim + Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt + Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt + Int_BufSz = Int_BufSz + 1 ! MoutLst allocated yes/no + IF ( ALLOCATED(InData%MoutLst) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MoutLst upper/lower bounds for each dimension + DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) + Int_BufSz = Int_BufSz + 3 ! MoutLst: size of buffers for each call to pack subtype + CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! MoutLst + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! MoutLst + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! MoutLst + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! MoutLst2 allocated yes/no + IF ( ALLOCATED(InData%MoutLst2) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MoutLst2 upper/lower bounds for each dimension + DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) + Int_BufSz = Int_BufSz + 3 ! MoutLst2: size of buffers for each call to pack subtype + CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! MoutLst2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! MoutLst2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! MoutLst2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! MoutLst3 allocated yes/no + IF ( ALLOCATED(InData%MoutLst3) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MoutLst3 upper/lower bounds for each dimension + DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) + Int_BufSz = Int_BufSz + 3 ! MoutLst3: size of buffers for each call to pack subtype + CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst3 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! MoutLst3 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! MoutLst3 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! MoutLst3 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no + IF ( ALLOCATED(InData%OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OutAll + Int_BufSz = Int_BufSz + 1 ! OutCBModes + Int_BufSz = Int_BufSz + 1 ! OutFEMModes + Int_BufSz = Int_BufSz + 1 ! OutReact + Int_BufSz = Int_BufSz + 1 ! OutAllInt + Int_BufSz = Int_BufSz + 1 ! OutAllDims + Int_BufSz = Int_BufSz + 1 ! OutDec + Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no + IF ( ALLOCATED(InData%Jac_u_indx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx + END IF + Int_BufSz = Int_BufSz + 1 ! du allocated yes/no + IF ( ALLOCATED(InData%du) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%du) ! du + END IF + Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx + Int_BufSz = Int_BufSz + 1 ! Jac_ny + Int_BufSz = Int_BufSz + 1 ! Jac_nx + Int_BufSz = Int_BufSz + 1 ! RotStates + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%SDDeltaT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOF_red + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Nmembers + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Elems) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) + DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) + IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) + CALL SD_Packelemproptype( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! ElemProps + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FG) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FG,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) + DbKiBuf(Db_Xferred) = InData%FG(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DP0) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%DP0,2), UBOUND(InData%DP0,2) + DO i1 = LBOUND(InData%DP0,1), UBOUND(InData%DP0,1) + ReKiBuf(Re_Xferred) = InData%DP0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NodeID2JointID) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeID2JointID,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeID2JointID,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NodeID2JointID,1), UBOUND(InData%NodeID2JointID,1) + IntKiBuf(Int_Xferred) = InData%NodeID2JointID(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%reduced, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%T_red) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%T_red,2), UBOUND(InData%T_red,2) + DO i1 = LBOUND(InData%T_red,1), UBOUND(InData%T_red,1) + DbKiBuf(Db_Xferred) = InData%T_red(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%T_red_T) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%T_red_T,2), UBOUND(InData%T_red_T,2) + DO i1 = LBOUND(InData%T_red_T,1), UBOUND(InData%T_red_T,1) + DbKiBuf(Db_Xferred) = InData%T_red_T(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NodesDOF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOF,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) + CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NodesDOFred) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOFred,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOFred,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) + CALL SD_Packilist( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOFred + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ElemsDOF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%ElemsDOF,2), UBOUND(InData%ElemsDOF,2) + DO i1 = LBOUND(InData%ElemsDOF,1), UBOUND(InData%ElemsDOF,1) + IntKiBuf(Int_Xferred) = InData%ElemsDOF(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DOFred2Nodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%DOFred2Nodes,2), UBOUND(InData%DOFred2Nodes,2) + DO i1 = LBOUND(InData%DOFred2Nodes,1), UBOUND(InData%DOFred2Nodes,1) + IntKiBuf(Int_Xferred) = InData%DOFred2Nodes(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CtrlElem2Channel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CtrlElem2Channel,2), UBOUND(InData%CtrlElem2Channel,2) + DO i1 = LBOUND(InData%CtrlElem2Channel,1), UBOUND(InData%CtrlElem2Channel,1) + IntKiBuf(Int_Xferred) = InData%CtrlElem2Channel(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nDOFM + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SttcSolve + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GuyanLoadCorrection, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Floating, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%KMMDiag) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KMMDiag,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KMMDiag,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%KMMDiag,1), UBOUND(InData%KMMDiag,1) + ReKiBuf(Re_Xferred) = InData%KMMDiag(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CMMDiag) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMMDiag,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMMDiag,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CMMDiag,1), UBOUND(InData%CMMDiag,1) + ReKiBuf(Re_Xferred) = InData%CMMDiag(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MMB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) + DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) + ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MBmmB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MBmmB,2), UBOUND(InData%MBmmB,2) + DO i1 = LBOUND(InData%MBmmB,1), UBOUND(InData%MBmmB,1) + ReKiBuf(Re_Xferred) = InData%MBmmB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) + DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) + ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) + DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) + ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%D1_141) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%D1_141,2), UBOUND(InData%D1_141,2) + DO i1 = LBOUND(InData%D1_141,1), UBOUND(InData%D1_141,1) + ReKiBuf(Re_Xferred) = InData%D1_141(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%D1_142) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%D1_142,2), UBOUND(InData%D1_142,2) + DO i1 = LBOUND(InData%D1_142,1), UBOUND(InData%D1_142,1) + ReKiBuf(Re_Xferred) = InData%D1_142(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PhiM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) + DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) + ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) + DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) + ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) + DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) + ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) + DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) + ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) + DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) + ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) + DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) + ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MBB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%KBB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CBB) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CBB,2), UBOUND(InData%CBB,2) + DO i1 = LBOUND(InData%CBB,1), UBOUND(InData%CBB,1) + ReKiBuf(Re_Xferred) = InData%CBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CMM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CMM,2), UBOUND(InData%CMM,2) + DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) + ReKiBuf(Re_Xferred) = InData%CMM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MBM) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) + DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) + ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) + DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) + ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%KLLm1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%KLLm1,2), UBOUND(InData%KLLm1,2) + DO i1 = LBOUND(InData%KLLm1,1), UBOUND(InData%KLLm1,1) + ReKiBuf(Re_Xferred) = InData%KLLm1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) + DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) + ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2JacPiv,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) + IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TI) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) + DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) + ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodes_I + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodes_L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodes_C + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Nodes_I) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Nodes_I,2), UBOUND(InData%Nodes_I,2) + DO i1 = LBOUND(InData%Nodes_I,1), UBOUND(InData%Nodes_I,1) + IntKiBuf(Int_Xferred) = InData%Nodes_I(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Nodes_L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Nodes_L,2), UBOUND(InData%Nodes_L,2) + DO i1 = LBOUND(InData%Nodes_L,1), UBOUND(InData%Nodes_L,1) + IntKiBuf(Int_Xferred) = InData%Nodes_L(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Nodes_C) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Nodes_C,2), UBOUND(InData%Nodes_C,2) + DO i1 = LBOUND(InData%Nodes_C,1), UBOUND(InData%Nodes_C,1) + IntKiBuf(Int_Xferred) = InData%Nodes_C(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nDOFI__ + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFI_Rb + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFI_F + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFL_L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFC__ + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFC_Rb + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFC_L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFC_F + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOFR__ + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOF__Rb + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOF__L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nDOF__F + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%IDI__) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI__,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI__,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDI__,1), UBOUND(InData%IDI__,1) + IntKiBuf(Int_Xferred) = InData%IDI__(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDI_Rb) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_Rb,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_Rb,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDI_Rb,1), UBOUND(InData%IDI_Rb,1) + IntKiBuf(Int_Xferred) = InData%IDI_Rb(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDI_F) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_F,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_F,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDI_F,1), UBOUND(InData%IDI_F,1) + IntKiBuf(Int_Xferred) = InData%IDI_F(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDL_L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDL_L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL_L,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDL_L,1), UBOUND(InData%IDL_L,1) + IntKiBuf(Int_Xferred) = InData%IDL_L(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDC__) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC__,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC__,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDC__,1), UBOUND(InData%IDC__,1) + IntKiBuf(Int_Xferred) = InData%IDC__(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDC_Rb) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_Rb,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_Rb,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDC_Rb,1), UBOUND(InData%IDC_Rb,1) + IntKiBuf(Int_Xferred) = InData%IDC_Rb(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDC_L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_L,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDC_L,1), UBOUND(InData%IDC_L,1) + IntKiBuf(Int_Xferred) = InData%IDC_L(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDC_F) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_F,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_F,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDC_F,1), UBOUND(InData%IDC_F,1) + IntKiBuf(Int_Xferred) = InData%IDC_F(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IDR__) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IDR__,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR__,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IDR__,1), UBOUND(InData%IDR__,1) + IntKiBuf(Int_Xferred) = InData%IDR__(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ID__Rb) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__Rb,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__Rb,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ID__Rb,1), UBOUND(InData%ID__Rb,1) + IntKiBuf(Int_Xferred) = InData%ID__Rb(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ID__L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__L,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ID__L,1), UBOUND(InData%ID__L,1) + IntKiBuf(Int_Xferred) = InData%ID__L(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ID__F) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__F,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__F,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ID__F,1), UBOUND(InData%ID__F,1) + IntKiBuf(Int_Xferred) = InData%ID__F(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnJckF + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) + CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MoutLst2) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst2,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst2,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) + CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MoutLst3) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst3,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst3,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) + CALL SD_Packmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst3 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutCBModes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFEMModes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllInt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllDims + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%du) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_PackParam + + SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%SDDeltaT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOF_red = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Nmembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Elems)) DEALLOCATE(OutData%Elems) + ALLOCATE(OutData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) + DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) + OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) + ALLOCATE(OutData%ElemProps(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_Unpackelemproptype( Re_Buf, Db_Buf, Int_Buf, OutData%ElemProps(i1), ErrStat2, ErrMsg2 ) ! ElemProps + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FG)) DEALLOCATE(OutData%FG) + ALLOCATE(OutData%FG(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) + OutData%FG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP0 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DP0)) DEALLOCATE(OutData%DP0) + ALLOCATE(OutData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%DP0,2), UBOUND(OutData%DP0,2) + DO i1 = LBOUND(OutData%DP0,1), UBOUND(OutData%DP0,1) + OutData%DP0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeID2JointID not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodeID2JointID)) DEALLOCATE(OutData%NodeID2JointID) + ALLOCATE(OutData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NodeID2JointID,1), UBOUND(OutData%NodeID2JointID,1) + OutData%NodeID2JointID(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%reduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%reduced) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%T_red)) DEALLOCATE(OutData%T_red) + ALLOCATE(OutData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%T_red,2), UBOUND(OutData%T_red,2) + DO i1 = LBOUND(OutData%T_red,1), UBOUND(OutData%T_red,1) + OutData%T_red(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red_T not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%T_red_T)) DEALLOCATE(OutData%T_red_T) + ALLOCATE(OutData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%T_red_T,2), UBOUND(OutData%T_red_T,2) + DO i1 = LBOUND(OutData%T_red_T,1), UBOUND(OutData%T_red_T,1) + OutData%T_red_T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodesDOF)) DEALLOCATE(OutData%NodesDOF) + ALLOCATE(OutData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NodesDOF,1), UBOUND(OutData%NodesDOF,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOF(i1), ErrStat2, ErrMsg2 ) ! NodesDOF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOFred not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NodesDOFred)) DEALLOCATE(OutData%NodesDOFred) + ALLOCATE(OutData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NodesDOFred,1), UBOUND(OutData%NodesDOFred,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_Unpackilist( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) ! NodesDOFred + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemsDOF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ElemsDOF)) DEALLOCATE(OutData%ElemsDOF) + ALLOCATE(OutData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%ElemsDOF,2), UBOUND(OutData%ElemsDOF,2) + DO i1 = LBOUND(OutData%ElemsDOF,1), UBOUND(OutData%ElemsDOF,1) + OutData%ElemsDOF(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOFred2Nodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DOFred2Nodes)) DEALLOCATE(OutData%DOFred2Nodes) + ALLOCATE(OutData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%DOFred2Nodes,2), UBOUND(OutData%DOFred2Nodes,2) + DO i1 = LBOUND(OutData%DOFred2Nodes,1), UBOUND(OutData%DOFred2Nodes,1) + OutData%DOFred2Nodes(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CtrlElem2Channel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CtrlElem2Channel)) DEALLOCATE(OutData%CtrlElem2Channel) + ALLOCATE(OutData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CtrlElem2Channel,2), UBOUND(OutData%CtrlElem2Channel,2) + DO i1 = LBOUND(OutData%CtrlElem2Channel,1), UBOUND(OutData%CtrlElem2Channel,1) + OutData%CtrlElem2Channel(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%nDOFM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SttcSolve = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GuyanLoadCorrection = TRANSFER(IntKiBuf(Int_Xferred), OutData%GuyanLoadCorrection) + Int_Xferred = Int_Xferred + 1 + OutData%Floating = TRANSFER(IntKiBuf(Int_Xferred), OutData%Floating) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KMMDiag not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%KMMDiag)) DEALLOCATE(OutData%KMMDiag) + ALLOCATE(OutData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%KMMDiag,1), UBOUND(OutData%KMMDiag,1) + OutData%KMMDiag(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMMDiag not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CMMDiag)) DEALLOCATE(OutData%CMMDiag) + ALLOCATE(OutData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CMMDiag,1), UBOUND(OutData%CMMDiag,1) + OutData%CMMDiag(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MMB)) DEALLOCATE(OutData%MMB) + ALLOCATE(OutData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) + DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) + OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBmmB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MBmmB)) DEALLOCATE(OutData%MBmmB) + ALLOCATE(OutData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MBmmB,2), UBOUND(OutData%MBmmB,2) + DO i1 = LBOUND(OutData%MBmmB,1), UBOUND(OutData%MBmmB,1) + OutData%MBmmB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C1_11)) DEALLOCATE(OutData%C1_11) + ALLOCATE(OutData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) + DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) + OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C1_12)) DEALLOCATE(OutData%C1_12) + ALLOCATE(OutData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) + DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) + OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_141 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%D1_141)) DEALLOCATE(OutData%D1_141) + ALLOCATE(OutData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%D1_141,2), UBOUND(OutData%D1_141,2) + DO i1 = LBOUND(OutData%D1_141,1), UBOUND(OutData%D1_141,1) + OutData%D1_141(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_142 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%D1_142)) DEALLOCATE(OutData%D1_142) + ALLOCATE(OutData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%D1_142,2), UBOUND(OutData%D1_142,2) + DO i1 = LBOUND(OutData%D1_142,1), UBOUND(OutData%D1_142,1) + OutData%D1_142(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PhiM)) DEALLOCATE(OutData%PhiM) + ALLOCATE(OutData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) + DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) + OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C2_61)) DEALLOCATE(OutData%C2_61) + ALLOCATE(OutData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) + DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) + OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C2_62)) DEALLOCATE(OutData%C2_62) + ALLOCATE(OutData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) + DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) + OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PhiRb_TI)) DEALLOCATE(OutData%PhiRb_TI) + ALLOCATE(OutData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) + DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) + OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%D2_63)) DEALLOCATE(OutData%D2_63) + ALLOCATE(OutData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) + DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) + OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%D2_64)) DEALLOCATE(OutData%D2_64) + ALLOCATE(OutData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) + DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) + OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) + ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) + ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBB not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CBB)) DEALLOCATE(OutData%CBB) + ALLOCATE(OutData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CBB,2), UBOUND(OutData%CBB,2) + DO i1 = LBOUND(OutData%CBB,1), UBOUND(OutData%CBB,1) + OutData%CBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CMM)) DEALLOCATE(OutData%CMM) + ALLOCATE(OutData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CMM,2), UBOUND(OutData%CMM,2) + DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) + OutData%CMM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) + ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PhiL_T)) DEALLOCATE(OutData%PhiL_T) + ALLOCATE(OutData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) + DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) + OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PhiLInvOmgL2)) DEALLOCATE(OutData%PhiLInvOmgL2) + ALLOCATE(OutData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) + DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) + OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KLLm1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%KLLm1)) DEALLOCATE(OutData%KLLm1) + ALLOCATE(OutData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%KLLm1,2), UBOUND(OutData%KLLm1,2) + DO i1 = LBOUND(OutData%KLLm1,1), UBOUND(OutData%KLLm1,1) + OutData%KLLm1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AM2Jac)) DEALLOCATE(OutData%AM2Jac) + ALLOCATE(OutData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) + DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) + OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AM2JacPiv)) DEALLOCATE(OutData%AM2JacPiv) + ALLOCATE(OutData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) + OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TI)) DEALLOCATE(OutData%TI) + ALLOCATE(OutData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TIreact)) DEALLOCATE(OutData%TIreact) + ALLOCATE(OutData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) + DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) + OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%nNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodes_I = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodes_L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodes_C = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_I not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Nodes_I)) DEALLOCATE(OutData%Nodes_I) + ALLOCATE(OutData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Nodes_I,2), UBOUND(OutData%Nodes_I,2) + DO i1 = LBOUND(OutData%Nodes_I,1), UBOUND(OutData%Nodes_I,1) + OutData%Nodes_I(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Nodes_L)) DEALLOCATE(OutData%Nodes_L) + ALLOCATE(OutData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Nodes_L,2), UBOUND(OutData%Nodes_L,2) + DO i1 = LBOUND(OutData%Nodes_L,1), UBOUND(OutData%Nodes_L,1) + OutData%Nodes_L(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_C not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Nodes_C)) DEALLOCATE(OutData%Nodes_C) + ALLOCATE(OutData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Nodes_C,2), UBOUND(OutData%Nodes_C,2) + DO i1 = LBOUND(OutData%Nodes_C,1), UBOUND(OutData%Nodes_C,1) + OutData%Nodes_C(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%nDOFI__ = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFI_Rb = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFI_F = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFL_L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFC__ = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFC_Rb = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFC_L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFC_F = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOFR__ = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOF__Rb = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOF__L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nDOF__F = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI__ not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDI__)) DEALLOCATE(OutData%IDI__) + ALLOCATE(OutData%IDI__(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDI__,1), UBOUND(OutData%IDI__,1) + OutData%IDI__(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_Rb not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDI_Rb)) DEALLOCATE(OutData%IDI_Rb) + ALLOCATE(OutData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDI_Rb,1), UBOUND(OutData%IDI_Rb,1) + OutData%IDI_Rb(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_F not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDI_F)) DEALLOCATE(OutData%IDI_F) + ALLOCATE(OutData%IDI_F(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDI_F,1), UBOUND(OutData%IDI_F,1) + OutData%IDI_F(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDL_L)) DEALLOCATE(OutData%IDL_L) + ALLOCATE(OutData%IDL_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDL_L,1), UBOUND(OutData%IDL_L,1) + OutData%IDL_L(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC__ not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDC__)) DEALLOCATE(OutData%IDC__) + ALLOCATE(OutData%IDC__(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDC__,1), UBOUND(OutData%IDC__,1) + OutData%IDC__(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_Rb not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDC_Rb)) DEALLOCATE(OutData%IDC_Rb) + ALLOCATE(OutData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDC_Rb,1), UBOUND(OutData%IDC_Rb,1) + OutData%IDC_Rb(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDC_L)) DEALLOCATE(OutData%IDC_L) + ALLOCATE(OutData%IDC_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDC_L,1), UBOUND(OutData%IDC_L,1) + OutData%IDC_L(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_F not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDC_F)) DEALLOCATE(OutData%IDC_F) + ALLOCATE(OutData%IDC_F(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDC_F,1), UBOUND(OutData%IDC_F,1) + OutData%IDC_F(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR__ not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IDR__)) DEALLOCATE(OutData%IDR__) + ALLOCATE(OutData%IDR__(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IDR__,1), UBOUND(OutData%IDR__,1) + OutData%IDR__(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__Rb not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ID__Rb)) DEALLOCATE(OutData%ID__Rb) + ALLOCATE(OutData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ID__Rb,1), UBOUND(OutData%ID__Rb,1) + OutData%ID__Rb(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ID__L)) DEALLOCATE(OutData%ID__L) + ALLOCATE(OutData%ID__L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ID__L,1), UBOUND(OutData%ID__L,1) + OutData%ID__L(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__F not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ID__F)) DEALLOCATE(OutData%ID__F) + ALLOCATE(OutData%ID__F(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ID__F,1), UBOUND(OutData%ID__F,1) + OutData%ID__F(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnJckF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MoutLst)) DEALLOCATE(OutData%MoutLst) + ALLOCATE(OutData%MoutLst(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%MoutLst,1), UBOUND(OutData%MoutLst,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst(i1), ErrStat2, ErrMsg2 ) ! MoutLst + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst2 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MoutLst2)) DEALLOCATE(OutData%MoutLst2) + ALLOCATE(OutData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%MoutLst2,1), UBOUND(OutData%MoutLst2,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst2(i1), ErrStat2, ErrMsg2 ) ! MoutLst2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst3 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MoutLst3)) DEALLOCATE(OutData%MoutLst3) + ALLOCATE(OutData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%MoutLst3,1), UBOUND(OutData%MoutLst3,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_Unpackmeshauxdatatype( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst3(i1), ErrStat2, ErrMsg2 ) ! MoutLst3 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) + ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%OutCBModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutFEMModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllInt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllDims = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) + ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + i1_l = LBOUND(OutData%dx,1) + i1_u = UBOUND(OutData%dx,1) + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Jac_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SD_UnPackParam + + SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_InputType), INTENT(INOUT) :: SrcInputData + TYPE(SD_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MeshCopy( SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInputData%CableDeltaL)) THEN + i1_l = LBOUND(SrcInputData%CableDeltaL,1) + i1_u = UBOUND(SrcInputData%CableDeltaL,1) + IF (.NOT. ALLOCATED(DstInputData%CableDeltaL)) THEN + ALLOCATE(DstInputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%CableDeltaL = SrcInputData%CableDeltaL +ENDIF + END SUBROUTINE SD_CopyInput + + SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InputData%CableDeltaL)) THEN + DEALLOCATE(InputData%CableDeltaL) +ENDIF + END SUBROUTINE SD_DestroyInput + + SUBROUTINE SD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! TPMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! TPMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! TPMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! TPMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! LMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no + IF ( ALLOCATED(InData%CableDeltaL) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) + ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackInput + + SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) + ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) + OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackInput + + SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SD_OutputType), INTENT(INOUT) :: SrcOutputData + TYPE(SD_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MeshCopy( SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutput,1) + i1_u = UBOUND(SrcOutputData%WriteOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN + ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutput = SrcOutputData%WriteOutput +ENDIF + END SUBROUTINE SD_CopyOutput + + SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(SD_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + CALL MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(OutputData%WriteOutput)) THEN + DEALLOCATE(OutputData%WriteOutput) +ENDIF + END SUBROUTINE SD_DestroyOutput + + SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SD_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Y1Mesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y1Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Y1Mesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Y1Mesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Y1Mesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Y2Mesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y2Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Y2Mesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Y2Mesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Y2Mesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Y3Mesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y3Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Y3Mesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Y3Mesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Y3Mesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no + IF ( ALLOCATED(InData%WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y1Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y2Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y3Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_PackOutput + + SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SD_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y1Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y2Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y3Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) + ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE SD_UnPackOutput + + + SUBROUTINE SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(SD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE SD_Input_ExtrapInterp + + + SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN + DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) + b = -(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) + u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE SD_Input_ExtrapInterp1 + + + SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN + DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) + b = (t(3)**2*(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) + t(2)**2*(-u1%CableDeltaL(i1) + u3%CableDeltaL(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%CableDeltaL(i1) + t(3)*u2%CableDeltaL(i1) - t(2)*u3%CableDeltaL(i1) ) * scaleFactor + u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE SD_Input_ExtrapInterp2 + + + SUBROUTINE SD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(SD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE SD_Output_ExtrapInterp + + + SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + END SUBROUTINE SD_Output_ExtrapInterp1 + + + SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated + END SUBROUTINE SD_Output_ExtrapInterp2 + +END MODULE SubDyn_Types +!ENDOFREGISTRYGENERATEDFILE From 104c521d81bf96ac5360625ba2337cc23db77e89 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Thu, 23 Nov 2023 01:32:22 +0100 Subject: [PATCH 076/232] Cleaning code from checks (print) --- modules/subdyn/src/FEM.f90 | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index 07ffce5f49..2635815249 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -1308,13 +1308,6 @@ SUBROUTINE ElemK_Spring(k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k K(12, 5) = K(11,6) K(12, 11) = K(11,12) - ! Temporary check. Looking at the spring element matrix (local coordinate system). - print*,'Spring element stiffness (local coordinate system)' - print*, K - - ! Temporary check. Looking at direction cosine matrix. - print*,'Direction cosine',DirCos - DC = 0.0_FEKi DC( 1: 3, 1: 3) = DirCos DC( 4: 6, 4: 6) = DirCos @@ -1322,10 +1315,6 @@ SUBROUTINE ElemK_Spring(k11, k12, k13, k14, k15, k16, k22, k23, k24, k25, k26, k DC(10:12, 10:12) = DirCos K = MATMUL( MATMUL(DC, K), TRANSPOSE(DC) ) ! TODO: change me if DirCos convention is transposed - - ! Temporary check. Looking at the spring element matrix (global coordinate system). - print*,'Spring element stiffness (global coordinate system)' - print*, K END SUBROUTINE ElemK_Spring !------------------------------------------------------------------------------------------------------ From ed5d7e4198806343c6130646a531a6145174fd83 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 27 Nov 2023 12:00:30 -0700 Subject: [PATCH 077/232] Update api_change.rst --- docs/source/user/api_change.rst | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 267a5809fc..2af1f4224c 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -9,6 +9,22 @@ 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 v4.0.0 to OpenFAST v3.5.1 +---------------------------------- + +============================================= ==== =============== ======================================================================================================================================================================================================== +Modified in OpenFAST v4.0.0 +--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== =============== ======================================================================================================================================================================================================== +SubDyn 56\* ----------------------- SPRING ELEMENT PROPERTIES ------------------------------------- +SubDyn 57\* NSpringPropSets 0 - Number of spring properties +SubDyn 58\* PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 +SubDyn 59\* (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) +============================================= ==== =============== ======================================================================================================================================================================================================== + +\*Exact line number depends on number of entries in various preceeding tables. + OpenFAST v3.5.0 to OpenFAST v3.5.1 ---------------------------------- From 921341e5df63cf9cff4e62475b3b5f3fc0c655b7 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 27 Nov 2023 12:42:34 -0700 Subject: [PATCH 078/232] Update input_files.rst --- docs/source/user/subdyn/input_files.rst | 46 ++++++++++++++----------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index 157ad04f33..6bdaae4c29 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -179,11 +179,10 @@ properties, the material properties are not allowed to change within a single member. Future releases will allow for members of different cross-sections, -i.e., noncircular members. For this reason, the input file has -(currently unused) sections dedicated to the identification of direction -cosines that in the future will allow the module to identify the correct -orientation of noncircular members. The current release only accepts -tubular (circular) members. +i.e., noncircular members. For this reason, the input file has sections +dedicated to the identification of direction cosines that in the future +will allow the module to identify the correct orientation of noncircular +members. The current release only accepts tubular (circular) members. The file is organized into several functional sections. Each section corresponds to an aspect of the SubDyn model and substructure. @@ -419,7 +418,7 @@ MEMBER X-SECTION PROPERTY table (discussed next) for starting cross-section properties and **MPropSetID2** specifies the identifier for ending cross-section properties, allowing for tapered members. The sixth column specify the member type **MType**. -A member is one of the three following types (see :numref:`SD_FEM`): +A member is one of the four following types (see :numref:`SD_FEM`): - Beams (*MType=1*), Euler-Bernoulli (*FEMMod=1*) or Timoshenko (*FEMMod=3*) @@ -427,9 +426,12 @@ A member is one of the three following types (see :numref:`SD_FEM`): - Rigid link (*MType=3*) +- Spring element (*MType=4*) + **COSMID** refers to the IDs of the members' cosine matrices for noncircular -members; the current release uses SubDyn's default direction cosine convention -if it's not present or when COSMID values are -1. +members and spring elements; the current release uses SubDyn's default direction cosine convention +if it's not present or when COSMID values are -1. Spring elements are defined between joints that +are coincident in the space and the direction cosine must be provided. An example of member table is given below @@ -525,22 +527,26 @@ An example of rigid link properties table is given below (-) (kg/m) 12 7850.0 3 7000.0 - - - - - - - - - - - - +Spring Properties +~~~~~~~~~~~~~~~~ +Members that are specified as spring elements (**MType=5**), +have their properties defined in the spring element properties table. +The table lists for each spring property: the property ID (**PropSetID**), the diagonal stiffness +coefficients (**K11**, **K22**, **K33**, **K44**, **K55**, **K66**), and the cross-coupling +stiffness coefficients (**K12**, **K13**, **K14**, **K15**, **K16**, **K23**, **K24**, **K25**, +**K26**, **K34**, **K35**, **K36**, **K45**, **K46**, **K56**). The stiffness matrix is considered symmetric. +The FEM representation of the spring element is given in :numref:`SD_SpringElement`. +An example of spring properties table is given below: +.. code:: + -------------------------- SPRING ELEMENT PROPERTIES ---------------------------- + 1 NSpringPropSets - Number of spring properties + PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 + (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) + 2 2E7 0 0 0 0 0 1E12 0 0 0 0 1E12 0 0 0 1E12 0 0 1E8 0 1e12 Member Cosine Matrices COSM (i,j) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From d51aeee7d1fdbd65b33ca900ba477f9086b1013a Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 27 Nov 2023 13:36:57 -0700 Subject: [PATCH 079/232] Update theory.rst --- docs/source/user/subdyn/theory.rst | 51 +++++++++++++++++++++++++++--- 1 file changed, 47 insertions(+), 4 deletions(-) diff --git a/docs/source/user/subdyn/theory.rst b/docs/source/user/subdyn/theory.rst index ad56023b4a..edb6762327 100644 --- a/docs/source/user/subdyn/theory.rst +++ b/docs/source/user/subdyn/theory.rst @@ -279,7 +279,7 @@ The following joints are supported: - Ball joint (*JointType=4*) -A member is one of the three following types: +A member is one of the four following types: - Beams (*MType=1*), Euler-Bernoulli (*FEMMod=1*) or Timoshenko (*FEMMod=3*) @@ -287,11 +287,13 @@ A member is one of the three following types: - Rigid link (*MType=3*) +- Spring element (*MType=5*) + Beam members may be split into several elements to increase the accuracy of the model (using -the input parameter *NDiv*). Member of other types (rigid links and -pretension cables) are not split. In this document, the term *element* +the input parameter *NDiv*). Member of other types (rigid links, pretension cables and springs) +are not split. In this document, the term *element* refers to: a sub-division of a beam member or a member of another type -than beam (rigid-link or pretension cable). The term *joints* refers to +than beam (rigid-link, pretension cable or spring). The term *joints* refers to the points defining the extremities of the members. Some joints are defined in the input file, while others arise from the subdivision of beam members. The end points of an elements are called nodes and each @@ -1287,9 +1289,50 @@ The constraint are applied after the full system has been assembled. +.. _SD_SpringElement: + + +Spring Elements +~~~~~~~~~~~ + +Do not confuse the spring member with the springs defined as +a boundary condition in land-based systems. The spring element +relates two joints by means of a 6 by 6 stiffness matrix that +is assumed symmetric (k_ij = k_ji). + +.. math:: + +\begin{aligned} + K= + \begin{bmatrix} + k_{11} & k_{12} & k_{13} & k_{14} & k_{15} & k_{16} \\ + k_{21} & k_{22} & k_{23} & k_{24} & k_{25} & k_{26} \\ + k_{31} & k_{32} & k_{33} & k_{34} & k_{35} & k_{36} \\ + k_{41} & k_{42} & k_{43} & k_{44} & k_{45} & k_{46} \\ + k_{51} & k_{52} & k_{53} & k_{54} & k_{55} & k_{56} \\ + k_{61} & k_{62} & k_{63} & k_{64} & k_{65} & k_{66} \\ + \end{bmatrix} + +The spring element does not have a mass associated. However, if desired, a lumped mass can be +defined at the joints. + +Since each joint has 6 DOFs (3 translations and 3 rotations), mathematically, the +spring element has a 12 by 12 dimension. +.. math:: +\begin{aligned} + K_e= + \begin{bmatrix} + k_{6x6} & -k_{6x6} \\ + -k_{6x6} & k_{6x6} \\ + \end{bmatrix} +The spring element must be defined between two coincident joints and the orientation has to be +provided by means of the direction cosine. This allows the assembly of the spring element in the +global system stiffness matrix. +The spring element can be connected to beams, kinematic joints (e.g., revolute joint, universal joint, +and spherical joint), the interface joint and rigid links. However, it cannot be connected to a cable. .. _GenericCBReduction: From d1c6bab3c7b0dcabbb97cff05ac3c08cef9f6490 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 27 Nov 2023 13:38:59 -0700 Subject: [PATCH 080/232] Update OC4_Jacket_SD_Input.dat --- docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat b/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat index 43111b830f..45c9edafaa 100644 --- a/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat +++ b/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat @@ -247,6 +247,10 @@ PropSetID EA MatDens T0 CtrlChannel 0 NRigidPropSets - Number of rigid link properties PropSetID MatDens (-) (kg/m) +----------------------- SPRING ELEMENT PROPERTIES ------------------------------------- + 0 NSpringPropSets - Number of spring properties +PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 + (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) ---------------------- MEMBER COSINE MATRICES COSM(i,j) ------------------------------- 0 NCOSMs - Number of unique cosine matrices (i.e., of unique member alignments including principal axis rotations); ignored if NXPropSets=0 or 9999 in any element below COSMID COSM11 COSM12 COSM13 COSM21 COSM22 COSM23 COSM31 COSM32 COSM33 From daf2cf748d232af0f4dac435c2f68cb029f30a03 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Mon, 27 Nov 2023 13:40:07 -0700 Subject: [PATCH 081/232] Update OC4_Jacket_SD_Input.dat --- docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat b/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat index 45c9edafaa..2c7cf3dcfe 100644 --- a/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat +++ b/docs/source/user/subdyn/examples/OC4_Jacket_SD_Input.dat @@ -111,7 +111,7 @@ IJointID ItfTDXss ItfTDYss ItfTDZss ItfRDXss ItfRDYss ItfRDZss 56 1 1 1 1 1 1 ----------------------------------- MEMBERS ------------------------------------------- 112 NMembers - Number of members (-) -MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MType COSMID ![MType={1:beam circ., 2:cable, 3:rigid, 4:beam arb.}. COMSID={-1:none}] +MemberID MJointID1 MJointID2 MPropSetID1 MPropSetID2 MType COSMID ![MType={1:beam circ., 2:cable, 3:rigid, 4:beam arb., 5:spring}. COMSID={-1:none}] (-) (-) (-) (-) (-) (-) (-) 1 1 2 2 2 1 -1 2 2 3 2 2 1 -1 From fd37a8430b2deb909010d1801e32432abf26c08b Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Tue, 28 Nov 2023 12:30:39 -0700 Subject: [PATCH 082/232] Update input_files.rst --- docs/source/user/subdyn/input_files.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index 6bdaae4c29..d338ab8c06 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -426,7 +426,7 @@ A member is one of the four following types (see :numref:`SD_FEM`): - Rigid link (*MType=3*) -- Spring element (*MType=4*) +- Spring element (*MType=5*) **COSMID** refers to the IDs of the members' cosine matrices for noncircular members and spring elements; the current release uses SubDyn's default direction cosine convention From aa1582ecdb010a05aaf285b7d533101b5fea91b4 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Tue, 28 Nov 2023 12:46:51 -0700 Subject: [PATCH 083/232] Update SD_FEM.f90 --- modules/subdyn/src/SD_FEM.f90 | 50 +++++++++++++++++------------------ 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index bc75a39cb4..b2e1fd7c16 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -690,7 +690,7 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) ! --- Cables, rigid link and spring properties (these cannot be subdivided, so direct copy of inputs) Init%NPropC = Init%NPropSetsC Init%NPropR = Init%NPropSetsR - Init%NPropS = Init%NPropSetsS + Init%NPropS = Init%NPropSetsS CALL AllocAry(Init%PropsC, Init%NPropC, PropSetsCCol, 'Init%PropsCable', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropsR, Init%NPropR, PropSetsRCol, 'Init%PropsRigid', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropsS, Init%NPropS, PropSetsSCol, 'Init%PropsSpring', ErrStat2, ErrMsg2); if(Failed()) return @@ -888,27 +888,27 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) p%ElemProps(i)%Area = -9.99e+36 p%ElemProps(i)%Rho = -9.99e+36 p%ElemProps(i)%T0 = -9.99e+36 - p%ElemProps(i)%k11 = -9.99e+36 - p%ElemProps(i)%k12 = -9.99e+36 - p%ElemProps(i)%k13 = -9.99e+36 - p%ElemProps(i)%k14 = -9.99e+36 - p%ElemProps(i)%k15 = -9.99e+36 - p%ElemProps(i)%k16 = -9.99e+36 - p%ElemProps(i)%k22 = -9.99e+36 - p%ElemProps(i)%k23 = -9.99e+36 - p%ElemProps(i)%k24 = -9.99e+36 - p%ElemProps(i)%k25 = -9.99e+36 - p%ElemProps(i)%k26 = -9.99e+36 - p%ElemProps(i)%k33 = -9.99e+36 - p%ElemProps(i)%k34 = -9.99e+36 - p%ElemProps(i)%k35 = -9.99e+36 - p%ElemProps(i)%k36 = -9.99e+36 - p%ElemProps(i)%k44 = -9.99e+36 - p%ElemProps(i)%k45 = -9.99e+36 - p%ElemProps(i)%k46 = -9.99e+36 - p%ElemProps(i)%k55 = -9.99e+36 - p%ElemProps(i)%k56 = -9.99e+36 - p%ElemProps(i)%k66 = -9.99e+36 + p%ElemProps(i)%k11 = -9.99e+36 + p%ElemProps(i)%k12 = -9.99e+36 + p%ElemProps(i)%k13 = -9.99e+36 + p%ElemProps(i)%k14 = -9.99e+36 + p%ElemProps(i)%k15 = -9.99e+36 + p%ElemProps(i)%k16 = -9.99e+36 + p%ElemProps(i)%k22 = -9.99e+36 + p%ElemProps(i)%k23 = -9.99e+36 + p%ElemProps(i)%k24 = -9.99e+36 + p%ElemProps(i)%k25 = -9.99e+36 + p%ElemProps(i)%k26 = -9.99e+36 + p%ElemProps(i)%k33 = -9.99e+36 + p%ElemProps(i)%k34 = -9.99e+36 + p%ElemProps(i)%k35 = -9.99e+36 + p%ElemProps(i)%k36 = -9.99e+36 + p%ElemProps(i)%k44 = -9.99e+36 + p%ElemProps(i)%k45 = -9.99e+36 + p%ElemProps(i)%k46 = -9.99e+36 + p%ElemProps(i)%k55 = -9.99e+36 + p%ElemProps(i)%k56 = -9.99e+36 + p%ElemProps(i)%k66 = -9.99e+36 ! --- Properties that are specific to some elements if (eType==idMemberBeamCirc) then @@ -1017,8 +1017,8 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) if (DEV_VERSION) then print*,'Member',I,'is a spring element' endif - p%ElemProps(i)%Area = 0 ! Spring elements have no area - p%ElemProps(i)%Rho = 0 ! Spring elements have no mass + p%ElemProps(i)%Area = 0 ! Spring elements have no area + p%ElemProps(i)%Rho = 0 ! Spring elements have no mass p%ElemProps(i)%k11 = Init%PropsS(P1, 2) p%ElemProps(i)%k12 = Init%PropsS(P1, 3) p%ElemProps(i)%k13 = Init%PropsS(P1, 4) @@ -2344,7 +2344,7 @@ SUBROUTINE ElemM(ep, Me) endif else if (ep%eType==idMemberSpring) then - Me=0.0_FEKi ! Spring element has no mass associated. Consider using a lumped mass at JointID, if desired. + Me=0.0_FEKi ! Spring element has no mass associated. Consider using a lumped mass at JointID, if desired. endif END SUBROUTINE ElemM From 23d90fe1a680a8fd61fcbfa81cdb71dfd350320b Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Tue, 28 Nov 2023 12:51:32 -0700 Subject: [PATCH 084/232] Update SubDyn_Tests.f90 --- modules/subdyn/src/SubDyn_Tests.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/subdyn/src/SubDyn_Tests.f90 b/modules/subdyn/src/SubDyn_Tests.f90 index dd822f52e5..6576a77c05 100644 --- a/modules/subdyn/src/SubDyn_Tests.f90 +++ b/modules/subdyn/src/SubDyn_Tests.f90 @@ -323,7 +323,7 @@ subroutine Test_Transformations(ErrStat,ErrMsg) character(ErrMsgLen), intent(out) :: ErrMsg real(ReKi), dimension(3) :: P1, P2, e1, e2, e3 - integer(IntKi) :: eType + integer(IntKi) :: eType real(FEKi), dimension(3,3) :: DirCos, Ref real(ReKi), dimension(6,6) :: T, Tref real(ReKi) :: L From 2caee67e8822337a1b47dfee427fb4b67a4e217e Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Tue, 28 Nov 2023 13:08:00 -0700 Subject: [PATCH 085/232] Update input_files.rst --- docs/source/user/subdyn/input_files.rst | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index d338ab8c06..f37fd49f96 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -532,10 +532,11 @@ Spring Properties ~~~~~~~~~~~~~~~~ Members that are specified as spring elements (**MType=5**), have their properties defined in the spring element properties table. -The table lists for each spring property: the property ID (**PropSetID**), the diagonal stiffness -coefficients (**K11**, **K22**, **K33**, **K44**, **K55**, **K66**), and the cross-coupling -stiffness coefficients (**K12**, **K13**, **K14**, **K15**, **K16**, **K23**, **K24**, **K25**, -**K26**, **K34**, **K35**, **K36**, **K45**, **K46**, **K56**). The stiffness matrix is considered symmetric. +The table lists for each spring property: the property ID (**PropSetID**) and the +stiffness coefficients (**K11**, **K12**, **K13**, **K14**, **K15**, **K16**, **K22**, +**K23**, **K24**, **K25**, **K26**, **K33**, **K34**, **K35**, **K36**, **K44**, **K45**, +**K46**, **K55**, **K56**, **K66**). The stiffness matrix is considered symmetric and +includes diagonal (kii) and cross-coupling (kij) coefficients. The FEM representation of the spring element is given in :numref:`SD_SpringElement`. An example of spring properties table is given below: From 9ad3f4a81f556fa101933a95fde313a947e53757 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 28 Nov 2023 14:57:34 -0700 Subject: [PATCH 086/232] SD: remove tab characters --- modules/subdyn/src/FEM.f90 | 2 +- modules/subdyn/src/SD_FEM.f90 | 14 +++++++------- modules/subdyn/src/SubDyn.f90 | 28 ++++++++++++++-------------- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index 2635815249..f9ef9422eb 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -953,7 +953,7 @@ END SUBROUTINE GetRigidTransformation !! in the FAST framework. SUBROUTINE GetDirCos(P1, P2, eType, DirCos, L_out, ErrStat, ErrMsg) REAL(ReKi) , INTENT(IN ) :: P1(3), P2(3) ! (x,y,z) global positions of two nodes making up an element - INTEGER(IntKi), INTENT(IN ) :: eType ! element type (1:beam circ., 2:cable, 3:rigid, 4:beam arb., 5:spring) + INTEGER(IntKi), INTENT(IN ) :: eType ! element type (1:beam circ., 2:cable, 3:rigid, 4:beam arb., 5:spring) REAL(FEKi) , INTENT( OUT) :: DirCos(3, 3) ! calculated direction cosine matrix REAL(ReKi) , INTENT( OUT) :: L_out ! length of element INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 82e48d2aa0..2e7390b032 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -398,7 +398,7 @@ SUBROUTINE SD_ReIndex_CreateNodesAndElems(Init,p, ErrStat, ErrMsg) p%Elems(iMem,n) = FINDLOCI(Init%PropSetsX(:,1), Init%Members(iMem, n) ) else if (mType==idMemberSpring) then sType='Spring property' - p%Elems(iMem,n) = FINDLOCI(Init%PropSetsS(:,1), Init%Members(iMem, n) ) + p%Elems(iMem,n) = FINDLOCI(Init%PropSetsS(:,1), Init%Members(iMem, n) ) else ! Should not happen print*,'Element type unknown',mType @@ -694,10 +694,10 @@ SUBROUTINE SD_Discrt(Init,p, ErrStat, ErrMsg) CALL AllocAry(Init%PropsC, Init%NPropC, PropSetsCCol, 'Init%PropsCable', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropsR, Init%NPropR, PropSetsRCol, 'Init%PropsRigid', ErrStat2, ErrMsg2); if(Failed()) return CALL AllocAry(Init%PropsS, Init%NPropS, PropSetsSCol, 'Init%PropsSpring', ErrStat2, ErrMsg2); if(Failed()) return - Init%PropsC(1:Init%NPropC, 1:PropSetsCCol) = Init%PropSetsC(1:Init%NPropC, 1:PropSetsCCol) + Init%PropsC(1:Init%NPropC, 1:PropSetsCCol) = Init%PropSetsC(1:Init%NPropC, 1:PropSetsCCol) Init%PropsR(1:Init%NPropR, 1:PropSetsRCol) = Init%PropSetsR(1:Init%NPropR, 1:PropSetsRCol) - Init%PropsS(1:Init%NPropS, 1:PropSetsSCol) = Init%PropSetsS(1:Init%NPropS, 1:PropSetsSCol) - + Init%PropsS(1:Init%NPropS, 1:PropSetsSCol) = Init%PropSetsS(1:Init%NPropS, 1:PropSetsSCol) + CALL CleanUp_Discrt() CONTAINS @@ -909,7 +909,7 @@ SUBROUTINE SetElementProperties(Init, p, ErrStat, ErrMsg) p%ElemProps(i)%k55 = -9.99e+36 p%ElemProps(i)%k56 = -9.99e+36 p%ElemProps(i)%k66 = -9.99e+36 - + ! --- Properties that are specific to some elements if (eType==idMemberBeamCirc) then E = Init%PropsB(P1, 2) ! TODO E2 @@ -2364,7 +2364,7 @@ SUBROUTINE ElemK(ep, Ke) else if (ep%eType==idMemberSpring) then CALL ElemK_Spring(eP%k11, eP%k12, eP%k13, eP%k14, eP%k15, eP%k16, eP%k22, eP%k23, eP%k24, eP%k25, eP%k26, eP%k33, eP%k34, eP%k35, eP%k36, eP%k44, eP%k45, eP%k46, eP%k55, eP%k56, eP%k66, eP%DirCos, Ke) - + endif END SUBROUTINE ElemK @@ -2380,7 +2380,7 @@ SUBROUTINE ElemF(ep, gravity, Fg, Fo) else if (ep%eType==idMemberRigid) then Fo(1:12)=0.0_FEKi else if (ep%eType==idMemberSpring) then - Fo(1:12)=0.0_FEKi + Fo(1:12)=0.0_FEKi endif CALL ElemG( eP%Area, eP%Length, eP%rho, eP%DirCos, Fg, gravity ) END SUBROUTINE ElemF diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 33a920e792..0f24e5a000 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -1259,7 +1259,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL AllocAry(Init%PropSetsS, Init%NPropSetsS, PropSetsSCol, 'PropSetsS', ErrStat2, ErrMsg2); if(Failed()) return DO I = 1, Init%NPropSetsS READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading spring property line'; if (Failed()) return - call ReadFAryFromStr(Line, Init%PropSetsS(I,:), PropSetsSCol, nColValid, nColNumeric); + call ReadFAryFromStr(Line, Init%PropSetsS(I,:), PropSetsSCol, nColValid, nColNumeric); if ((nColValid/=nColNumeric).or.((nColNumeric/=22).and.(nColNumeric/=PropSetsSCol)) ) then CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Spring property line must consist of 22 numerical values. Problematic line: "'//trim(Line)//'"') return @@ -3783,13 +3783,13 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E WRITE(UnSum, '(A,I6)') '#Number of nodes per member:', Init%Ndiv+1 WRITE(UnSum, '(A9,A10,A10,A10,A10,A15,A15,A16)') '#Member ID', 'Joint1_ID', 'Joint2_ID','Prop_I','Prop_J', 'Mass','Length', 'Node IDs...' DO i=1,p%NMembers - !Calculate member mass here; this should really be done somewhere else, yet it is not used anywhere else - !IT WILL HAVE TO BE MODIFIED FOR OTHER THAN CIRCULAR PIPE ELEMENTS - propIDs=Init%Members(i,iMProp:iMProp+1) - if (Init%Members(I, iMType)/=idMemberSpring) then ! This check only applies for members different than springs (springs have no mass and no length) - mLength=MemberLength(Init%Members(i,1),Init,ErrStat,ErrMsg) ! TODO double check mass and length - endif - IF (ErrStat .EQ. ErrID_None) THEN + !Calculate member mass here; this should really be done somewhere else, yet it is not used anywhere else + !IT WILL HAVE TO BE MODIFIED FOR OTHER THAN CIRCULAR PIPE ELEMENTS + propIDs=Init%Members(i,iMProp:iMProp+1) + if (Init%Members(I, iMType)/=idMemberSpring) then ! This check only applies for members different than springs (springs have no mass and no length) + mLength=MemberLength(Init%Members(i,1),Init,ErrStat,ErrMsg) ! TODO double check mass and length + endif + IF (ErrStat .EQ. ErrID_None) THEN mType = Init%Members(I, iMType) ! if (mType==idMemberBeamCirc) then iProp(1) = FINDLOCI(Init%PropSetsB(:,1), propIDs(1)) @@ -3812,7 +3812,7 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E else if (mType==idMemberSpring) then iProp(1) = FINDLOCI(Init%PropSetsS(:,1), propIDs(1)) mMass= 0.0 ! Spring element has no mass - mLength = 0.0 ! Spring element has no length. Both JointIDs must be coincident. + mLength = 0.0 ! Spring element has no length. Both JointIDs must be coincident. WRITE(UnSum, '("#",I9,I10,I10,I10,I10,ES15.6E2,ES15.6E2, A3,2(I6),A)') Init%Members(i,1:3),propIDs(1),propIDs(2),& mMass,mLength,' ',(Init%MemberNodes(i, j), j = 1, 2), ' # Spring element' else if (mType==idMemberBeamArb) then @@ -3824,9 +3824,9 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E else WRITE(UnSum, '(A)') '#TODO, member unknown' endif - ELSE - RETURN - ENDIF + ELSE + RETURN + ENDIF ENDDO !------------------------------------------------------------------------------------------------------------- ! write Cosine matrix for all members to a txt file @@ -4086,7 +4086,7 @@ END SUBROUTINE StateMatrices FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) TYPE(SD_InitType), INTENT(IN) :: Init !< Input data for initialization routine, this structure contains many variables needed for summary file INTEGER(IntKi), INTENT(IN) :: MemberID !< Member ID # - REAL(ReKi) :: MemberLength !< Member Length + REAL(ReKi) :: MemberLength !< Member Length INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None !Locals @@ -4110,7 +4110,7 @@ FUNCTION MemberLength(MemberID,Init,ErrStat,ErrMsg) xyz1= Init%Joints(Joint1,2:4) xyz2= Init%Joints(Joint2,2:4) MemberLength=SQRT( SUM((xyz2-xyz1)**2.) ) - if ( EqualRealNos(MemberLength, 0.0_ReKi) ) then + if ( EqualRealNos(MemberLength, 0.0_ReKi) ) then call SetErrStat(ErrID_Fatal,' Member with ID '//trim(Num2LStr(MemberID))//' has zero length!', ErrStat,ErrMsg,RoutineName); return endif From 81b9317265d5ae1e1a9e198a76e8479252da4b13 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 28 Nov 2023 22:38:43 -0700 Subject: [PATCH 087/232] SD: update regression test list for spring elements --- reg_tests/CTestList.cmake | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 786e4192fd..9d9006ebbe 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -407,6 +407,12 @@ sd_regression("SD_SparHanging" "subdyn;offshore") sd_regression("SD_AnsysComp1_PinBeam" "subdyn;offshore") # TODO Issue #855 sd_regression("SD_AnsysComp2_Cable" "subdyn;offshore") sd_regression("SD_AnsysComp3_PinBeamCable" "subdyn;offshore") # TODO Issue #855 +sd_regression("SD_Spring_Case1" "subdyn;offshore") +sd_regression("SD_Spring_Case2" "subdyn;offshore") +sd_regression("SD_Spring_Case3" "subdyn;offshore") +sd_regression("SD_Revolute_Joint" "subdyn;offshore") +sd_regression("SD_2Beam_Spring" "subdyn;offshore") +sd_regression("SD_2Beam_Cantilever" "subdyn;offshore") # TODO test below are bugs, should be added when fixed # sd_regression("SD_Force" "subdyn;offshore") # sd_regression("SD_AnsysComp4_UniversalCableRigid" "subdyn;offshore") From 8870ebfa923a4d30bd68235bb1e58565f4079e0c Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Wed, 29 Nov 2023 07:42:30 -0700 Subject: [PATCH 088/232] Update input_files.rst --- docs/source/user/subdyn/input_files.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index f37fd49f96..745767713d 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -547,7 +547,7 @@ An example of spring properties table is given below: 1 NSpringPropSets - Number of spring properties PropSetID k11 k12 k13 k14 k15 k16 k22 k23 k24 k25 k26 k33 k34 k35 k36 k44 k45 k46 k55 k56 k66 (-) (N/m) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/m) (N/rad) (N/rad) (N/rad) (N/m) (N/rad) (N/rad) (N/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) (Nm/rad) - 2 2E7 0 0 0 0 0 1E12 0 0 0 0 1E12 0 0 0 1E12 0 0 1E8 0 1e12 + 2 2E7 0 0 0 0 0 1E12 0 0 0 0 1E12 0 0 0 1E12 0 0 1E8 0 1E12 Member Cosine Matrices COSM (i,j) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From 3b5cfabde9060e89ecd642a65900672bd337c5ce Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 29 Nov 2023 09:47:26 -0700 Subject: [PATCH 089/232] SD springs: update r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 1cbf6a1ae9..9a42b24203 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 1cbf6a1ae96655e2a7fa2a6865ccc99fc39bf6c8 +Subproject commit 9a42b2420312ab5dfd49065e7ddab6fb69dc7d3f From 92c875437224fc4c7933b087a3ed971b3c0a043c Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 29 Nov 2023 10:39:52 -0700 Subject: [PATCH 090/232] Docs: Formatting error preventing rendering on RTD (PR #1889) --- docs/source/user/subdyn/input_files.rst | 2 +- docs/source/user/subdyn/theory.rst | 35 +++++++++++++------------ 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index 745767713d..1db0e858c1 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -529,7 +529,7 @@ An example of rigid link properties table is given below 3 7000.0 Spring Properties -~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~ Members that are specified as spring elements (**MType=5**), have their properties defined in the spring element properties table. The table lists for each spring property: the property ID (**PropSetID**) and the diff --git a/docs/source/user/subdyn/theory.rst b/docs/source/user/subdyn/theory.rst index edb6762327..d93c169b1a 100644 --- a/docs/source/user/subdyn/theory.rst +++ b/docs/source/user/subdyn/theory.rst @@ -1293,7 +1293,7 @@ The constraint are applied after the full system has been assembled. Spring Elements -~~~~~~~~~~~ +~~~~~~~~~~~~~~~ Do not confuse the spring member with the springs defined as a boundary condition in land-based systems. The spring element @@ -1302,30 +1302,31 @@ is assumed symmetric (k_ij = k_ji). .. math:: -\begin{aligned} - K= - \begin{bmatrix} - k_{11} & k_{12} & k_{13} & k_{14} & k_{15} & k_{16} \\ - k_{21} & k_{22} & k_{23} & k_{24} & k_{25} & k_{26} \\ - k_{31} & k_{32} & k_{33} & k_{34} & k_{35} & k_{36} \\ - k_{41} & k_{42} & k_{43} & k_{44} & k_{45} & k_{46} \\ - k_{51} & k_{52} & k_{53} & k_{54} & k_{55} & k_{56} \\ - k_{61} & k_{62} & k_{63} & k_{64} & k_{65} & k_{66} \\ - \end{bmatrix} + \begin{aligned} + K= + \begin{bmatrix} + k_{11} & k_{12} & k_{13} & k_{14} & k_{15} & k_{16} \\ + k_{21} & k_{22} & k_{23} & k_{24} & k_{25} & k_{26} \\ + k_{31} & k_{32} & k_{33} & k_{34} & k_{35} & k_{36} \\ + k_{41} & k_{42} & k_{43} & k_{44} & k_{45} & k_{46} \\ + k_{51} & k_{52} & k_{53} & k_{54} & k_{55} & k_{56} \\ + k_{61} & k_{62} & k_{63} & k_{64} & k_{65} & k_{66} \\ + \end{bmatrix}\end{aligned} The spring element does not have a mass associated. However, if desired, a lumped mass can be defined at the joints. Since each joint has 6 DOFs (3 translations and 3 rotations), mathematically, the spring element has a 12 by 12 dimension. + .. math:: -\begin{aligned} - K_e= - \begin{bmatrix} - k_{6x6} & -k_{6x6} \\ - -k_{6x6} & k_{6x6} \\ - \end{bmatrix} + \begin{aligned} + K_e= + \begin{bmatrix} + k_{6x6} & -k_{6x6} \\ + -k_{6x6} & k_{6x6} \\ + \end{bmatrix}\end{aligned} The spring element must be defined between two coincident joints and the orientation has to be provided by means of the direction cosine. This allows the assembly of the spring element in the From d42d3b89f4a8e7a2d37ae45e0ffb6f0326f0cfe1 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Fri, 1 Dec 2023 08:34:05 +0100 Subject: [PATCH 091/232] SubDyn summary file: fixes --- modules/subdyn/src/SubDyn.f90 | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 0f24e5a000..2398a3851d 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -3567,6 +3567,7 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E INTEGER(IntKi) :: i, j, k, propIDs(2), Iprop(2) !counter and temporary holders INTEGER(IntKi) :: iNode1, iNode2 ! Node indices INTEGER(IntKi) :: mType ! Member Type + INTEGER :: iDirCos REAL(ReKi) :: mMass, mLength ! Member mass and length REAL(ReKi) :: M_O(6,6) ! Equivalent mass matrix at origin REAL(ReKi) :: M_P(6,6) ! Equivalent mass matrix at P (ref point) @@ -3835,11 +3836,25 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E WRITE(UnSum, '(A, I6)') '#Direction Cosine Matrices for all Members: GLOBAL-2-LOCAL. No. of 3x3 matrices=', p%NMembers WRITE(UnSum, '(A9,9(A15))') '#Member ID', 'DC(1,1)', 'DC(1,2)', 'DC(1,3)', 'DC(2,1)','DC(2,2)','DC(2,3)','DC(3,1)','DC(3,2)','DC(3,3)' DO i=1,p%NMembers - iNode1 = FINDLOCI(Init%Joints(:,1), Init%Members(i,2)) ! index of joint 1 of member i + mType = Init%Members(I, iMType) + iNode1 = FINDLOCI(Init%Joints(:,1), Init%Members(i,2)) ! index of joint 1 of member i iNode2 = FINDLOCI(Init%Joints(:,1), Init%Members(i,3)) ! index of joint 2 of member i XYZ1 = Init%Joints(iNode1,2:4) XYZ2 = Init%Joints(iNode2,2:4) - CALL GetDirCos(XYZ1(1:3), XYZ2(1:3), mType, DirCos, mLength, ErrStat, ErrMsg) + if ((mType == idMemberSpring) .or. (mType == idMemberBeamArb)) then ! The direction cosine for these member types must be provided by the user + iDirCos = p%Elems(i, iMDirCosID) + DirCos(1, 1) = Init%COSMs(iDirCos, 2) + DirCos(2, 1) = Init%COSMs(iDirCos, 3) + DirCos(3, 1) = Init%COSMs(iDirCos, 4) + DirCos(1, 2) = Init%COSMs(iDirCos, 5) + DirCos(2, 2) = Init%COSMs(iDirCos, 6) + DirCos(3, 2) = Init%COSMs(iDirCos, 7) + DirCos(1, 3) = Init%COSMs(iDirCos, 8) + DirCos(2, 3) = Init%COSMs(iDirCos, 9) + DirCos(3, 3) = Init%COSMs(iDirCos, 10) + else + CALL GetDirCos(XYZ1(1:3), XYZ2(1:3), mType, DirCos, mLength, ErrStat, ErrMsg) + endif DirCos=TRANSPOSE(DirCos) !This is now global to local WRITE(UnSum, '("#",I9,9(ES28.18E2))') Init%Members(i,1), ((DirCos(k,j),j=1,3),k=1,3) ENDDO From 1e2014ca5c14240124cc743a2b3ef1d2f0719737 Mon Sep 17 00:00:00 2001 From: Roger Bergua Date: Sun, 3 Dec 2023 11:25:38 -0700 Subject: [PATCH 092/232] SubDyn.f90 spaces instead of tabs --- modules/subdyn/src/SubDyn.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index 2398a3851d..d1b576e33d 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -3837,12 +3837,12 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, Modes, Omega, Omega_Gy, E WRITE(UnSum, '(A9,9(A15))') '#Member ID', 'DC(1,1)', 'DC(1,2)', 'DC(1,3)', 'DC(2,1)','DC(2,2)','DC(2,3)','DC(3,1)','DC(3,2)','DC(3,3)' DO i=1,p%NMembers mType = Init%Members(I, iMType) - iNode1 = FINDLOCI(Init%Joints(:,1), Init%Members(i,2)) ! index of joint 1 of member i + iNode1 = FINDLOCI(Init%Joints(:,1), Init%Members(i,2)) ! index of joint 1 of member i iNode2 = FINDLOCI(Init%Joints(:,1), Init%Members(i,3)) ! index of joint 2 of member i XYZ1 = Init%Joints(iNode1,2:4) XYZ2 = Init%Joints(iNode2,2:4) - if ((mType == idMemberSpring) .or. (mType == idMemberBeamArb)) then ! The direction cosine for these member types must be provided by the user - iDirCos = p%Elems(i, iMDirCosID) + if ((mType == idMemberSpring) .or. (mType == idMemberBeamArb)) then ! The direction cosine for these member types must be provided by the user + iDirCos = p%Elems(i, iMDirCosID) DirCos(1, 1) = Init%COSMs(iDirCos, 2) DirCos(2, 1) = Init%COSMs(iDirCos, 3) DirCos(3, 1) = Init%COSMs(iDirCos, 4) From 96eb6b65cfbb51ab644f1ebe5186b452f1ed8e85 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Sun, 3 Dec 2023 11:34:10 -0700 Subject: [PATCH 093/232] ADI: probably memory leak in ADI_UpdateStates The ADI_UpdateStates routine makes a copy of the AD_Input, but never destroyed that data after usage. This could lead to memory continously getting allocated during a simulation with either ADI_C_Binding or the AD driver. --- modules/aerodyn/src/AeroDyn_Inflow.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index e513c1085f..6dd7773665 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -228,10 +228,15 @@ subroutine ADI_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errSta ! Get state variables at next step: INPUT at step nt - 1, OUTPUT at step nt call AD_UpdateStates(t, n, u_AD(:), utimes(:), p%AD, x%AD, xd%AD, z%AD, OtherState%AD, m%AD, errStat2, errMsg2); if(Failed()) return + call CleanUp() + contains subroutine CleanUp() !call ADI_DestroyConstrState(z_guess, errStat2, errMsg2); if(Failed()) return + do it=1,size(utimes) + call AD_DestroyInput(u_AD(it), errStat2, errMsg2); if(Failed()) return + enddo end subroutine logical function Failed() From abbb24003847e75e74d1307571963e711b827946 Mon Sep 17 00:00:00 2001 From: Ganesh Vijayakumar Date: Mon, 4 Dec 2023 13:04:28 -0700 Subject: [PATCH 094/232] Changes to help compile --- glue-codes/openfast-cpp/src/OpenFAST.H | 21 +- glue-codes/openfast-cpp/src/OpenFAST.cpp | 408 ++++++------------ .../src/ExternalInflow_Registry.txt | 6 + modules/openfast-library/src/FAST_Library.f90 | 304 ++++++------- modules/openfast-library/src/FAST_Library.h | 29 +- 5 files changed, 283 insertions(+), 485 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.H b/glue-codes/openfast-cpp/src/OpenFAST.H index ed93214575..8635f373dc 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.H +++ b/glue-codes/openfast-cpp/src/OpenFAST.H @@ -64,6 +64,8 @@ struct turbineDataType { int numForcePtsTwr; //! Total number of actuator points int numForcePts; + //! Node clustering type + int nodeClusterType; //! Inflow Type - 1 (InflowWind) or 2 (Externally specified) int inflowType; //! Drag coefficient of nacelle @@ -324,15 +326,10 @@ class OpenFAST { //! Array containing forces and deflections data for blade-resolved FSI simulations. std::vector> brFSIData; -<<<<<<< HEAD //! Data structure to get forces and deflections from ExternalInflow module in OpenFAST std::vector extinfw_i_f_FAST; // Input from OpenFAST //! Data structure to send velocity information to ExternalInflow module in OpenFAST std::vector extinfw_o_t_FAST; // Output to OpenFAST -======= - std::vector cDriver_Input_from_FAST; - std::vector cDriver_Output_to_FAST; ->>>>>>> OpenFAST/dev //! Data structure to get deflections from ExternalLoads module in OpenFAST std::vector extld_i_f_FAST; // Input from OpenFAST @@ -441,16 +438,7 @@ class OpenFAST { float & fy, float & fz); -<<<<<<< HEAD //! Allocate turbine number 'iTurbGlob' to the processor with global MPI rank 'procNo'. MUST be called from every MPI rank. -======= - hid_t openVelocityDataFile(bool createFile); - void readVelocityData(int nTimesteps); - void writeVelocityData(hid_t h5file, int iTurb, int iTimestep, ExtInfw_InputType_t iData, ExtInfw_OutputType_t oData); - herr_t closeVelocityDataFile(int nt_global, hid_t velDataFile); - void backupVelocityDataFile(int curTimeStep, hid_t & velDataFile); - ->>>>>>> OpenFAST/dev void setTurbineProcNo(int iTurbGlob, int procNo) { turbineMapGlobToProc[iTurbGlob] = procNo; } //! Allocate all turbines to processors in a round-robin fashion. MUST be called from every MPI rank. void allocateTurbinesToProcsSimple(); @@ -769,7 +757,6 @@ private: void loadSuperController(const fastInputs & fi); -<<<<<<< HEAD //! Apply the velocity data at the Aerodyn nodes in 'velData' to turbine number 'iTurb' at time step 'iPrestart' through the data structure 'cDriver_Output_to_FAST' void applyVelocityData(int iPrestart, int iTurb, ExtInfw_OutputType_t o_t_FAST, std::vector & velData) ; @@ -779,10 +766,6 @@ private: void applyWMrotation(double * wm, double * r, double *rRot, double transpose = 1.0); //! Apply a Direction Cosine Matrix rotation 'dcm' to a vector 'r' into 'rRot'. To optionally transpose the rotation, set 'tranpose=-1.0'. void applyDCMrotation(double * dcm, double * r, double *rRot, double transpose = 1.0); -======= - void setOutputsToFAST(ExtInfw_InputType_t cDriver_Input_from_FAST, ExtInfw_OutputType_t cDriver_Output_to_FAST) ; // An example to set velocities at the Aerodyn nodes - void applyVelocityData(int iPrestart, int iTurb, ExtInfw_OutputType_t cDriver_Output_to_FAST, std::vector & velData) ; ->>>>>>> OpenFAST/dev }; diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 3197cc7c94..0b002df101 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -36,7 +36,7 @@ fast::OpenFAST::OpenFAST() sc = std::unique_ptr(new SuperController); - ncRstVarNames_ = {"time", "rst_filename", "twr_ref_pos", "bld_ref_pos", "nac_ref_pos", "hub_ref_pos", "twr_def", "twr_vel", "twr_ld", "bld_def", "bld_vel", "bld_ld", "hub_def", "hub_vel", "nac_def", "nac_vel", "bld_root_def", "bld_pitch", "x_vel", "xdot_vel", "vel_vel", "x_force", "xdot_force", "orient_force", "vel_force", "force"}; + ncRstVarNames_ = {"time", "rst_filename", "twr_ref_pos", "bld_ref_pos", "nac_ref_pos", "hub_ref_pos", "twr_def", "twr_vel", "twr_ld", "bld_def", "bld_vel", "bld_ld", "hub_def", "hub_vel", "nac_def", "nac_vel", "bld_root_def", "bld_pitch", "x_vel", "vel_vel", "x_force", "xdot_force", "orient_force", "vel_force", "force"}; ncRstDimNames_ = {"n_tsteps", "n_states", "n_twr_data", "n_bld_data", "n_pt_data", "n_bld_root_data", "n_bld_pitch_data", "n_vel_pts_data", "n_force_pts_data", "n_force_pts_orient_data"}; ncOutVarNames_ = {"time", "twr_ref_pos", "twr_ref_orient", "bld_chord", "bld_rloc", "bld_ref_pos", "bld_ref_orient", "hub_ref_pos", "hub_ref_orient", "nac_ref_pos", "nac_ref_orient", "twr_disp", "twr_orient", "twr_vel", "twr_rotvel", "twr_ld", "twr_moment", "bld_disp", "bld_orient", "bld_vel", "bld_rotvel", "bld_ld", "bld_ld_loc", "bld_moment", "hub_disp", "hub_orient", "hub_vel", "hub_rotvel", "nac_disp", "nac_orient", "nac_vel", "nac_rotvel", "bld_root_ref_pos", "bld_root_ref_orient", "bld_root_disp", "bld_root_orient"}; @@ -160,7 +160,7 @@ void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { const std::vector twrDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_twr_data"]}; const std::vector bldDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_data"]}; const std::vector bldRootDefsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_root_data"]}; - const std::vector bldPitchDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_pitch_data"]}; + const std::vector bldPitchDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_bld_pitch_data"]}; const std::vector ptDefLoadsDims{ncRstDimIDs_["n_tsteps"], ncRstDimIDs_["n_states"], ncRstDimIDs_["n_pt_data"],}; ierr = nc_def_var(ncid, "twr_def", NC_DOUBLE, 3, twrDefLoadsDims.data(), &tmpVarID); @@ -186,7 +186,7 @@ void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { ierr = nc_def_var(ncid, "bld_root_def", NC_DOUBLE, 3, bldRootDefsDims.data(), &tmpVarID); ncRstVarIDs_["bld_root_def"] = tmpVarID; ierr = nc_def_var(ncid, "bld_pitch", NC_DOUBLE, 3, bldPitchDims.data(), &tmpVarID); - ncRstVarIDs_["bld_pitch"] = tmpVarID; + ncRstVarIDs_["bld_pitch"] = tmpVarID; } else if (turbineData[iTurbLoc].sType == EXTINFLOW) { @@ -203,8 +203,6 @@ void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { ierr = nc_def_var(ncid, "x_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); ncRstVarIDs_["x_vel"] = tmpVarID; - ierr = nc_def_var(ncid, "xdot_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); - ncRstVarIDs_["xdot_vel"] = tmpVarID; ierr = nc_def_var(ncid, "vel_vel", NC_DOUBLE, 3, velPtsDataDims.data(), &tmpVarID); ncRstVarIDs_["vel_vel"] = tmpVarID; ierr = nc_def_var(ncid, "xref_force", NC_DOUBLE, 1, &ncRstDimIDs_["n_force_pts_data"], &tmpVarID); @@ -425,8 +423,6 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { ierr = nc_def_var(ncid, "bld_chord", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); ncOutVarIDs_["bld_chord"] = tmpVarID; - ierr = nc_def_var(ncid, "bld_rloc", NC_DOUBLE, 2, bldParamDims.data(), &tmpVarID); - ncOutVarIDs_["bld_rloc"] = tmpVarID; ierr = nc_def_var(ncid, "twr_ref_pos", NC_DOUBLE, 2, twrRefDataDims.data(), &tmpVarID); ncOutVarIDs_["twr_ref_pos"] = tmpVarID; @@ -605,14 +601,6 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_chord"], start_dim.data(), param_count_dim.data(), tmpArray.data()); } - for (size_t iBlade=0; iBlade < nBlades; iBlade++) { - int iStart = 1 + iBlade*nBldPts; - for (size_t i=0; i < nBldPts; i++) - tmpArray[i] = extinfw_i_f_FAST[iTurbLoc].forceRHloc[iStart+i]; - std::vector start_dim{iBlade,0}; - ierr = nc_put_vara_double(ncid, ncOutVarIDs_["bld_rloc"], start_dim.data(), - param_count_dim.data(), tmpArray.data()); - } } } @@ -623,8 +611,6 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { void fast::OpenFAST::init() { - // Temporary buffer to pass filenames to OpenFAST fortran subroutines - char currentFileName[INTERFACE_STRING_LENGTH]; allocateMemory_preInit(); @@ -634,7 +620,6 @@ void fast::OpenFAST::init() { case fast::trueRestart: for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { -<<<<<<< HEAD findRestartFile(iTurb); findOutputFile(iTurb); @@ -643,38 +628,40 @@ void fast::OpenFAST::init() { tmpRstFileRoot[turbineData[iTurb].FASTRestartFileName.size()] = '\0'; if (turbineData[iTurb].sType == EXTINFLOW) { /* note that this will set nt_global inside the FAST library */ - FAST_AL_CFD_Restart(&iTurb, tmpRstFileRoot, &AbortErrLev, &turbineData[iTurb].dt, &turbineData[iTurb].inflowType, &turbineData[iTurb].numBlades, &turbineData[iTurb].numVelPtsBlade, &turbineData[iTurb].numVelPtsTwr, &ntStart, &extinfw_i_f_FAST[iTurb], &extinfw_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + FAST_ExtInfw_Restart( + &iTurb, + tmpRstFileRoot, + &AbortErrLev, + &turbineData[iTurb].dt, + &turbineData[iTurb].inflowType, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].numVelPtsBlade, + &turbineData[iTurb].numVelPtsTwr, + &ntStart, + &extinfw_i_f_FAST[iTurb], + &extinfw_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); checkError(ErrStat, ErrMsg); - } else if(turbineData[iTurb].sType == EXTLOADS) { - FAST_BR_CFD_Restart(&iTurb, tmpRstFileRoot, &AbortErrLev, &turbineData[iTurb].dt, &turbineData[iTurb].numBlades, &ntStart, &extld_i_f_FAST[iTurb], &extld_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + FAST_ExtLoads_Restart( + &iTurb, + tmpRstFileRoot, + &AbortErrLev, + &turbineData[iTurb].dt, + &turbineData[iTurb].numBlades, + &ntStart, + &extld_i_f_FAST[iTurb], + &extld_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); turbineData[iTurb].inflowType = 0; } -======= - /* note that this will set nt_global inside the FAST library */ - std::copy( - CheckpointFileRoot[iTurb].data(), - CheckpointFileRoot[iTurb].data() + (CheckpointFileRoot[iTurb].size() + 1), - currentFileName - ); - FAST_ExtInfw_Restart( - &iTurb, - currentFileName, - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &ntStart, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); ->>>>>>> OpenFAST/dev nt_global = ntStart; allocateMemory_postInit(iTurb); @@ -702,55 +689,44 @@ void fast::OpenFAST::init() { } // this calls the Init() routines of each module for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { -<<<<<<< HEAD -======= - int nodeClusterType = 0; - if (forcePtsBladeDistributionType[iTurb] == "chordClustered") - { - nodeClusterType = 1; - } - std::copy( - FASTInputFileName[iTurb].data(), - FASTInputFileName[iTurb].data() + (FASTInputFileName[iTurb].size() + 1), - currentFileName - ); - FAST_ExtInfw_Init( - &iTurb, - &tMax, - currentFileName, - &TurbID[iTurb], - &scio.nSC2CtrlGlob, - &scio.nSC2Ctrl, - &scio.nCtrl2SC, - scio.from_SCglob.data(), - scio.from_SC[iTurb].data(), - &numForcePtsBlade[iTurb], - &numForcePtsTwr[iTurb], - TurbineBasePos[iTurb].data(), - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &nodeClusterType, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); ->>>>>>> OpenFAST/dev char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + char inputFileName[INTERFACE_STRING_LENGTH]; if (turbineData[iTurb].sType == EXTINFLOW) { std::copy( turbineData[iTurb].FASTInputFileName.data(), turbineData[iTurb].FASTInputFileName.data() + (turbineData[iTurb].FASTInputFileName.size() + 1), - currentFileName + inputFileName ); - FAST_AL_CFD_Init( &iTurb, &tMax, turbineData[iTurb].FASTInputFileName.data(), &turbineData[iTurb].TurbID, tmpOutFileRoot, &scio.nSC2CtrlGlob, &scio.nSC2Ctrl, &scio.nCtrl2SC, scio.from_SCglob.data(), scio.from_SC[iTurb].data(), &turbineData[iTurb].numForcePtsBlade, &turbineData[iTurb].numForcePtsTwr, turbineData[iTurb].TurbineBasePos.data(), &AbortErrLev, &dtDriver, &turbineData[iTurb].dt, &turbineData[iTurb].inflowType, &turbineData[iTurb].numBlades, &turbineData[iTurb].numVelPtsBlade, &turbineData[iTurb].numVelPtsTwr, &extinfw_i_f_FAST[iTurb], &extinfw_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + FAST_ExtInfw_Init( + &iTurb, + &tMax, + inputFileName, + &turbineData[iTurb].TurbID, + tmpOutFileRoot, + &scio.nSC2CtrlGlob, + &scio.nSC2Ctrl, + &scio.nCtrl2SC, + scio.from_SCglob.data(), + scio.from_SC[iTurb].data(), + &turbineData[iTurb].numForcePtsBlade, + &turbineData[iTurb].numForcePtsTwr, + turbineData[iTurb].TurbineBasePos.data(), + &AbortErrLev, + &dtDriver, + &turbineData[iTurb].dt, + &turbineData[iTurb].inflowType, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].numVelPtsBlade, + &turbineData[iTurb].numVelPtsTwr, + &turbineData[iTurb].nodeClusterType, + &extinfw_i_f_FAST[iTurb], + &extinfw_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); checkError(ErrStat, ErrMsg); turbineData[iTurb].numVelPtsTwr = extinfw_o_t_FAST[iTurb].u_Len - turbineData[iTurb].numBlades*turbineData[iTurb].numVelPtsBlade - 1; @@ -761,7 +737,30 @@ void fast::OpenFAST::init() { } else if(turbineData[iTurb].sType == EXTLOADS) { - FAST_BR_CFD_Init(&iTurb, &tMax, turbineData[iTurb].FASTInputFileName.data(), &turbineData[iTurb].TurbID, tmpOutFileRoot, turbineData[iTurb].TurbineBasePos.data(), &AbortErrLev, &dtDriver, &turbineData[iTurb].dt, &turbineData[iTurb].numBlades, &turbineData[iTurb].azBlendMean, &turbineData[iTurb].azBlendDelta, &turbineData[iTurb].velMean, &turbineData[iTurb].windDir, &turbineData[iTurb].zRef, &turbineData[iTurb].shearExp, &extld_i_f_FAST[iTurb], &extld_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + char inputFileName[INTERFACE_STRING_LENGTH]; + FAST_ExtLoads_Init( + &iTurb, + &tMax, + turbineData[iTurb].FASTInputFileName.data(), + &turbineData[iTurb].TurbID, + tmpOutFileRoot, + turbineData[iTurb].TurbineBasePos.data(), + &AbortErrLev, + &dtDriver, + &turbineData[iTurb].dt, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].azBlendMean, + &turbineData[iTurb].azBlendDelta, + &turbineData[iTurb].velMean, + &turbineData[iTurb].windDir, + &turbineData[iTurb].zRef, + &turbineData[iTurb].shearExp, + &extld_i_f_FAST[iTurb], + &extld_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); checkError(ErrStat, ErrMsg); turbineData[iTurb].inflowType = 0; @@ -796,58 +795,47 @@ void fast::OpenFAST::init() { } for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { -<<<<<<< HEAD -======= - int nodeClusterType = 0; - if (forcePtsBladeDistributionType[iTurb] == "chordClustered") - { - nodeClusterType = 1; - } - std::copy( - FASTInputFileName[iTurb].data(), - FASTInputFileName[iTurb].data() + (FASTInputFileName[iTurb].size() + 1), - currentFileName - ); - FAST_ExtInfw_Init( - &iTurb, - &tMax, - currentFileName, - &TurbID[iTurb], - &scio.nSC2CtrlGlob, - &scio.nSC2Ctrl, - &scio.nCtrl2SC, - scio.from_SCglob.data(), - scio.from_SC[iTurb].data(), - &numForcePtsBlade[iTurb], - &numForcePtsTwr[iTurb], - TurbineBasePos[iTurb].data(), - &AbortErrLev, - &dtFAST, - &numBlades[iTurb], - &numVelPtsBlade[iTurb], - &nodeClusterType, - &cDriver_Input_from_FAST[iTurb], - &cDriver_Output_to_FAST[iTurb], - &sc.ip_from_FAST[iTurb], - &sc.op_to_FAST[iTurb], - &ErrStat, - ErrMsg - ); - checkError(ErrStat, ErrMsg); ->>>>>>> OpenFAST/dev findOutputFile(iTurb); findRestartFile(iTurb); char tmpOutFileRoot[INTERFACE_STRING_LENGTH]; + char inputFileName[INTERFACE_STRING_LENGTH]; if (turbineData[iTurb].sType == EXTINFLOW) { std::copy( turbineData[iTurb].FASTInputFileName.data(), turbineData[iTurb].FASTInputFileName.data() + (turbineData[iTurb].FASTInputFileName.size() + 1), - currentFileName + inputFileName ); - FAST_AL_CFD_Init( &iTurb, &tMax, turbineData[iTurb].FASTInputFileName.data(), &turbineData[iTurb].TurbID, tmpOutFileRoot, &scio.nSC2CtrlGlob, &scio.nSC2Ctrl, &scio.nCtrl2SC, scio.from_SCglob.data(), scio.from_SC[iTurb].data(), &turbineData[iTurb].numForcePtsBlade, &turbineData[iTurb].numForcePtsTwr, turbineData[iTurb].TurbineBasePos.data(), &AbortErrLev, &dtDriver, &turbineData[iTurb].dt, &turbineData[iTurb].inflowType, &turbineData[iTurb].numBlades, &turbineData[iTurb].numVelPtsBlade, &turbineData[iTurb].numVelPtsTwr, &extinfw_i_f_FAST[iTurb], &extinfw_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], &ErrStat, ErrMsg); + FAST_ExtInfw_Init( + &iTurb, + &tMax, + inputFileName, + &turbineData[iTurb].TurbID, + tmpOutFileRoot, + &scio.nSC2CtrlGlob, + &scio.nSC2Ctrl, + &scio.nCtrl2SC, + scio.from_SCglob.data(), + scio.from_SC[iTurb].data(), + &turbineData[iTurb].numForcePtsBlade, + &turbineData[iTurb].numForcePtsTwr, + turbineData[iTurb].TurbineBasePos.data(), + &AbortErrLev, + &dtDriver, + &turbineData[iTurb].dt, + &turbineData[iTurb].inflowType, + &turbineData[iTurb].numBlades, + &turbineData[iTurb].numVelPtsBlade, + &turbineData[iTurb].numVelPtsTwr, + &turbineData[iTurb].nodeClusterType, + &extinfw_i_f_FAST[iTurb], + &extinfw_o_t_FAST[iTurb], + &sc->ip_from_FAST[iTurb], + &sc->op_to_FAST[iTurb], + &ErrStat, + ErrMsg); checkError(ErrStat, ErrMsg); timeZero = true; @@ -949,12 +937,8 @@ void fast::OpenFAST::solution0(bool writeFiles) { send_data_to_openfast(fast::STATE_NP1); for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { -<<<<<<< HEAD FAST_CFD_Solution0(&iTurb, &ErrStat, ErrMsg); -======= - FAST_ExtInfw_Solution0(&iTurb, &ErrStat, ErrMsg); ->>>>>>> OpenFAST/dev checkError(ErrStat, ErrMsg); FAST_CFD_InitIOarrays_SS(&iTurb, &ErrStat, ErrMsg); @@ -987,14 +971,12 @@ void fast::OpenFAST::set_state_from_state(fast::timeStep fromState, fast::timeSt for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { -<<<<<<< HEAD if (turbineData[iTurb].sType == EXTINFLOW) { int nvelpts = get_numVelPtsLoc(iTurb); int nfpts = get_numForcePtsLoc(iTurb); for (int i=0; i0.) { - calc_nacelle_force ( - cDriver_Output_to_FAST[iTurb].u[0], - cDriver_Output_to_FAST[iTurb].v[0], - cDriver_Output_to_FAST[iTurb].w[0], - nacelle_cd[iTurb], - nacelle_area[iTurb], - air_density[iTurb], - cDriver_Input_from_FAST[iTurb].fx[0], - cDriver_Input_from_FAST[iTurb].fy[0], - cDriver_Input_from_FAST[iTurb].fz[0] - ); - } - - if ( isDebug() ) { - std::ofstream actuatorForcesFile; - actuatorForcesFile.open("actuator_forces.csv") ; - actuatorForcesFile << "# x, y, z, fx, fy, fz" << std::endl ; - for (int iNode=0; iNode < get_numForcePtsLoc(iTurb); iNode++) { - actuatorForcesFile << cDriver_Input_from_FAST[iTurb].pxForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pyForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].pzForce[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fx[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fy[iNode] << ", " << cDriver_Input_from_FAST[iTurb].fz[iNode] << " " << std::endl ; ->>>>>>> OpenFAST/dev } } } @@ -1166,12 +1102,10 @@ void fast::OpenFAST::predict_states() { for (int i=0; i>>>>>> OpenFAST/dev checkError(ErrStat, ErrMsg); } @@ -1680,11 +1602,7 @@ void fast::OpenFAST::setDriverCheckpoint(int nt_checkpoint_driver) { } } -<<<<<<< HEAD void fast::OpenFAST::get_turbineParams(int iTurbGlob, turbineDataType & turbData) { -======= -void fast::OpenFAST::setOutputsToFAST(ExtInfw_InputType_t cDriver_Input_from_FAST, ExtInfw_OutputType_t cDriver_Output_to_FAST){ ->>>>>>> OpenFAST/dev //TODO: Figure out a better copy operator for the turbineDataType struct int iTurbLoc = get_localTurbNo(iTurbGlob); @@ -1729,6 +1647,7 @@ void fast::OpenFAST::setOutputsToFAST(ExtInfw_InputType_t cDriver_Input_from_FAS } + void fast::OpenFAST::checkError(const int ErrStat, const char * ErrMsg) { if (ErrStat != ErrID_None){ @@ -1835,13 +1754,8 @@ void fast::OpenFAST::getForce(double* currentForce, int iNode, int iTurbGlob, fa double fast::OpenFAST::getRHloc(int iNode, int iTurbGlob) { // Return radial location/height along blade/tower at current node of current turbine - int iTurbLoc = get_localTurbNo(iTurbGlob); - if (turbineData[iTurbLoc].sType == EXTINFLOW) { - for(int j=0; j < iTurbLoc; j++) iNode = iNode - get_numForcePtsLoc(iTurbLoc); - return extinfw_i_f_FAST[iTurbLoc].forceRHloc[iNode] ; - } else { - return -1.0; - } + // Inactive for now + return -1.0; } @@ -1995,7 +1909,7 @@ void fast::OpenFAST::computeTorqueThrust(int iTurbGlob, double* torque, double* std::vector hubShftVec(3); getHubShftDir(hubShftVec, iTurbGlob, fast::STATE_NP1); - + int nfpts = get_numForcePtsBlade(iTurbLoc); for (int k=0; k < get_numBladesLoc(iTurbLoc); k++) { for (int j=0; j < nfpts; j++) { @@ -2151,17 +2065,12 @@ void fast::OpenFAST::allocateMemory_preInit() { FAST_AllocateTurbines(&nTurbinesProc, &ErrStat, ErrMsg); // Allocate memory for ExtInfw Input types in FAST -<<<<<<< HEAD extinfw_i_f_FAST.resize(nTurbinesProc) ; extinfw_o_t_FAST.resize(nTurbinesProc) ; // Allocate memory for ExtLd Input types in FAST extld_i_f_FAST.resize(nTurbinesProc) ; extld_o_t_FAST.resize(nTurbinesProc) ; -======= - cDriver_Input_from_FAST.resize(nTurbinesProc) ; - cDriver_Output_to_FAST.resize(nTurbinesProc) ; ->>>>>>> OpenFAST/dev if(scStatus) { std::cout << "Use of Supercontroller is not supported through the C++ API right now" << std::endl; @@ -2195,7 +2104,6 @@ void fast::OpenFAST::allocateMemory_postInit(int iTurbLoc) { velForceNodeData[iTurbLoc][3].xref_force.resize(3*nfpts); for(int k=0; k<4; k++) { velForceNodeData[iTurbLoc][k].x_vel.resize(3*nvelpts) ; - velForceNodeData[iTurbLoc][k].xdot_vel.resize(3*nvelpts) ; velForceNodeData[iTurbLoc][k].vel_vel.resize(3*nvelpts) ; velForceNodeData[iTurbLoc][k].x_force.resize(3*nfpts) ; velForceNodeData[iTurbLoc][k].xdot_force.resize(3*nfpts) ; @@ -2459,12 +2367,6 @@ void fast::OpenFAST::get_data_from_openfast(timeStep t) { velForceNodeData[iTurb][t].x_vel[i*3+1] = extinfw_i_f_FAST[iTurb].pyVel[i]; velForceNodeData[iTurb][t].x_vel_resid += (velForceNodeData[iTurb][t].x_vel[i*3+2] - extinfw_i_f_FAST[iTurb].pzVel[i])*(velForceNodeData[iTurb][t].x_vel[i*3+2] - extinfw_i_f_FAST[iTurb].pzVel[i]); velForceNodeData[iTurb][t].x_vel[i*3+2] = extinfw_i_f_FAST[iTurb].pzVel[i]; - velForceNodeData[iTurb][t].xdot_vel_resid += (velForceNodeData[iTurb][t].xdot_vel[i*3+0] - extinfw_i_f_FAST[iTurb].pxdotVel[i])*(velForceNodeData[iTurb][t].xdot_vel[i*3+0] - extinfw_i_f_FAST[iTurb].pxdotVel[i]); - velForceNodeData[iTurb][t].xdot_vel[i*3+0] = extinfw_i_f_FAST[iTurb].pxdotVel[i]; - velForceNodeData[iTurb][t].xdot_vel_resid += (velForceNodeData[iTurb][t].xdot_vel[i*3+1] - extinfw_i_f_FAST[iTurb].pydotVel[i])*(velForceNodeData[iTurb][t].xdot_vel[i*3+1] - extinfw_i_f_FAST[iTurb].pydotVel[i]); - velForceNodeData[iTurb][t].xdot_vel[i*3+1] = extinfw_i_f_FAST[iTurb].pydotVel[i]; - velForceNodeData[iTurb][t].xdot_vel_resid += (velForceNodeData[iTurb][t].xdot_vel[i*3+2] - extinfw_i_f_FAST[iTurb].pzdotVel[i])*(velForceNodeData[iTurb][t].xdot_vel[i*3+2] - extinfw_i_f_FAST[iTurb].pzdotVel[i]); - velForceNodeData[iTurb][t].xdot_vel[i*3+2] = extinfw_i_f_FAST[iTurb].pzdotVel[i]; } for (int i=0; i start_dim{n_tsteps,j,0}; ierr = nc_get_vara_double(ncid, ncRstVarIDs_["x_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_vel.data()); - ierr = nc_get_vara_double(ncid, ncRstVarIDs_["xdot_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_vel.data()); ierr = nc_get_vara_double(ncid, ncRstVarIDs_["vel_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_vel.data()); ierr = nc_get_vara_double(ncid, ncRstVarIDs_["x_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_force.data()); ierr = nc_get_vara_double(ncid, ncRstVarIDs_["xdot_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_force.data()); @@ -2591,7 +2492,7 @@ void fast::OpenFAST::readRestartFile(int iTurbLoc, int n_t_global) { const std::vector twrDataDims{1, 1, static_cast(6*nBRfsiPtsTwr)}; const std::vector bldDataDims{1, 1, static_cast(6*nTotBRfsiPtsBlade)}; const std::vector bldRootDataDims{1, 1, static_cast(6*nBlades)}; - const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; + const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; const std::vector ptDataDims{1, 1, 6}; for (size_t j=0; j < 4; j++) { // Loop over states - NM2, STATE_NM1, N, NP1 @@ -2617,7 +2518,7 @@ void fast::OpenFAST::readRestartFile(int iTurbLoc, int n_t_global) { } - + } @@ -2996,7 +2897,6 @@ void fast::OpenFAST::writeRestartFile(int iTurbLoc, int n_t_global) { const std::vector start_dim{n_tsteps,j,0}; ierr = nc_put_vara_double(ncid, ncRstVarIDs_["x_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_vel.data()); - ierr = nc_put_vara_double(ncid, ncRstVarIDs_["xdot_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_vel.data()); ierr = nc_put_vara_double(ncid, ncRstVarIDs_["vel_vel"], start_dim.data(), velPtsDataDims.data(), velForceNodeData[iTurbLoc][j].vel_vel.data()); ierr = nc_put_vara_double(ncid, ncRstVarIDs_["x_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].x_force.data()); ierr = nc_put_vara_double(ncid, ncRstVarIDs_["xdot_force"], start_dim.data(), forcePtsDataDims.data(), velForceNodeData[iTurbLoc][j].xdot_force.data()); @@ -3013,7 +2913,7 @@ void fast::OpenFAST::writeRestartFile(int iTurbLoc, int n_t_global) { const std::vector twrDataDims{1, 1, static_cast(6*nPtsTwr)}; const std::vector bldDataDims{1, 1, static_cast(6*nTotBldPts)}; const std::vector bldRootDataDims{1, 1, static_cast(6*nBlades)}; - const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; + const std::vector bldPitchDataDims{1, 1, static_cast(nBlades)}; const std::vector ptDataDims{1, 1, 6}; for (size_t j=0; j < 4; j++) { // Loop over states - STATE_NM2, STATE_NM1, STATE_N, STATE_NP1 @@ -3183,7 +3083,7 @@ void fast::OpenFAST::getBladeDisplacements(double* bldDefl, double* bldVel, int << brFSIData[iTurbLoc][t].bld_vel[iRunTot*6+3] << "," << brFSIData[iTurbLoc][t].bld_vel[iRunTot*6+4] << "," << brFSIData[iTurbLoc][t].bld_vel[iRunTot*6+5] << std::endl; - + for (int k=0; k < nSize; k++) { bldDefl[iRunTot*6+k] = brFSIData[iTurbLoc][t].bld_def[iRunTot*6+k]; bldVel[iRunTot*6+k] = brFSIData[iTurbLoc][t].bld_vel[iRunTot*6+k]; @@ -3228,7 +3128,6 @@ void fast::OpenFAST::getTowerRefPositions(double* twrRefPos, int iTurbGlob, int void fast::OpenFAST::getTowerDisplacements(double* twrDefl, double* twrVel, int iTurbGlob, fast::timeStep t, int nSize) { -<<<<<<< HEAD int iTurbLoc = get_localTurbNo(iTurbGlob); int nPtsTwr = turbineData[iTurbLoc].nBRfsiPtsTwr; for (int i=0; i < nPtsTwr; i++) { @@ -3236,38 +3135,6 @@ void fast::OpenFAST::getTowerDisplacements(double* twrDefl, double* twrVel, int twrDefl[i*6+j] = brFSIData[iTurbLoc][t].twr_def[i*6+j]; twrVel[i*6+j] = brFSIData[iTurbLoc][t].twr_vel[i*6+j]; } -======= -void fast::OpenFAST::backupVelocityDataFile(int curTimeStep, hid_t & velDataFile) { - - closeVelocityDataFile(curTimeStep, velDataFile); - - std::ifstream source("velDatafile." + std::to_string(worldMPIRank) + ".h5", std::ios::binary); - std::ofstream dest("velDatafile." + std::to_string(worldMPIRank) + ".h5." + std::to_string(curTimeStep) + ".bak", std::ios::binary); - - dest << source.rdbuf(); - source.close(); - dest.close(); - - velDataFile = openVelocityDataFile(false); -} - -void fast::OpenFAST::writeVelocityData(hid_t h5File, int iTurb, int iTimestep, ExtInfw_InputType_t iData, ExtInfw_OutputType_t oData) { - - hsize_t start[3]; start[0] = iTimestep; start[1] = 0; start[2] = 0; - int nVelPts = get_numVelPtsLoc(iTurb) ; - hsize_t count[3]; count[0] = 1; count[1] = nVelPts; count[2] = 6; - - std::vector tmpVelData; - tmpVelData.resize(nVelPts * 6); - - for (int iNode=0 ; iNode < nVelPts; iNode++) { - tmpVelData[iNode*6 + 0] = iData.pxVel[iNode]; - tmpVelData[iNode*6 + 1] = iData.pyVel[iNode]; - tmpVelData[iNode*6 + 2] = iData.pzVel[iNode]; - tmpVelData[iNode*6 + 3] = oData.u[iNode]; - tmpVelData[iNode*6 + 4] = oData.v[iNode]; - tmpVelData[iNode*6 + 5] = oData.w[iNode]; ->>>>>>> OpenFAST/dev } } @@ -3280,7 +3147,6 @@ void fast::OpenFAST::getHubRefPosition(double* hubRefPos, int iTurbGlob, int nSi } -<<<<<<< HEAD void fast::OpenFAST::getHubDisplacement(double* hubDefl, double* hubVel, int iTurbGlob, fast::timeStep t, int nSize) { int iTurbLoc = get_localTurbNo(iTurbGlob); @@ -3361,7 +3227,7 @@ void fast::OpenFAST::setUniformXBladeForces(double loadX) { int nBldPts = turbineData[iTurb].nBRfsiPtsBlade[iBlade]; dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode+1] - brFSIData[iTurb][3].bld_rloc[iNode]); iNode++; - + for(int i=1; i < nBldPts-1; i++) { dr[iNode] = 0.5*(brFSIData[iTurb][3].bld_rloc[iNode+1] - brFSIData[iTurb][3].bld_rloc[iNode-1]); iNode++; @@ -3375,14 +3241,6 @@ void fast::OpenFAST::setUniformXBladeForces(double loadX) { setBladeForces(fsiForceBlade, iTurbGlob, fast::STATE_NP1); -======= -void fast::OpenFAST::applyVelocityData(int iPrestart, int iTurb, ExtInfw_OutputType_t cDriver_Output_to_FAST, std::vector & velData) { - int nVelPts = get_numVelPtsLoc(iTurb); - for (int j = 0; j < nVelPts; j++){ - cDriver_Output_to_FAST.u[j] = velData[(iPrestart*nVelPts+j)*6 + 3]; - cDriver_Output_to_FAST.v[j] = velData[(iPrestart*nVelPts+j)*6 + 4]; - cDriver_Output_to_FAST.w[j] = velData[(iPrestart*nVelPts+j)*6 + 5]; ->>>>>>> OpenFAST/dev } } diff --git a/modules/externalinflow/src/ExternalInflow_Registry.txt b/modules/externalinflow/src/ExternalInflow_Registry.txt index e066d5c414..e5659ed467 100644 --- a/modules/externalinflow/src/ExternalInflow_Registry.txt +++ b/modules/externalinflow/src/ExternalInflow_Registry.txt @@ -54,9 +54,15 @@ typedef ExternalInflow/ExtInfw ParameterType IntKi NodeClusterType - typedef ^ InputType ReKi pxVel {:} - - "x position of velocity interface (Aerodyn) nodes" "m" typedef ^ InputType ReKi pyVel {:} - - "y position of velocity interface (Aerodyn) nodes" "m" typedef ^ InputType ReKi pzVel {:} - - "z position of velocity interface (Aerodyn) nodes" "m" +typedef ^ InputType ReKi pxdotVel {:} - - "x of velocity interface (Aerodyn) nodes" "m" +typedef ^ InputType ReKi pydotVel {:} - - "y position of velocity interface (Aerodyn) nodes" "m" +typedef ^ InputType ReKi pzdotVel {:} - - "z position of velocity interface (Aerodyn) nodes" "m" typedef ^ InputType ReKi pxForce {:} - - "x position of actuator force nodes" "m" typedef ^ InputType ReKi pyForce {:} - - "y position of actuator force nodes" "m" typedef ^ InputType ReKi pzForce {:} - - "z position of actuator force nodes" "m" +typedef ^ InputType ReKi pxdotForce {:} - - "x velocity of actuator force nodes" "m/s" +typedef ^ InputType ReKi pydotForce {:} - - "y velocity of actuator force nodes" "m/s" +typedef ^ InputType ReKi pzdotForce {:} - - "z velocity of actuator force nodes" "m/s" typedef ^ InputType ReKi xdotForce {:} - - "x velocity of actuator force nodes" "m/s" typedef ^ InputType ReKi ydotForce {:} - - "y velocity of actuator force nodes" "m/s" typedef ^ InputType ReKi zdotForce {:} - - "z velocity of actuator force nodes" "m/s" diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 38b93fa258..247137d84d 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -508,14 +508,14 @@ subroutine FAST_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, d end subroutine FAST_Restart !================================================================================================================================== -subroutine FAST_BR_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, NumBl_c, & +subroutine FAST_ExtLoads_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, NumBl_c, & az_blend_mean_c, az_blend_delta_c, vel_mean_c, wind_dir_c, z_ref_c, shear_exp_c, & - ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_BR_CFD_Init') -!DEC$ ATTRIBUTES DLLEXPORT::FAST_BR_CFD_Init + ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Init') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_ExtLoads_Init IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Init -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Init +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Init +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Init #endif INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number REAL(C_DOUBLE), INTENT(IN ) :: TMax @@ -546,7 +546,7 @@ subroutine FAST_BR_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, TYPE(FAST_ExternInitType) :: ExternInitData INTEGER(IntKi) :: CompLoadsType - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_BR_CFD_Init' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ExtLoads_Init' ! transfer the character array from C to a Fortran string: InputFileName = TRANSFER( InputFileName_c, InputFileName ) @@ -604,72 +604,68 @@ subroutine FAST_BR_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, ErrStat_c = ErrStat ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) -end subroutine FAST_BR_CFD_Init - +end subroutine FAST_ExtLoads_Init !================================================================================================================================== -subroutine FAST_AL_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, InitSCOutputsGlob, InitSCOutputsTurbine, & - NumActForcePtsBlade, NumActForcePtsTower, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, InflowType, NumBl_c, NumBlElem_c, NumTwrElem_c, & - ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_AL_CFD_Init') -!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_Init +subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, NumSC2CtrlGlob, NumSC2Ctrl, NumCtrl2SC, InitSCOutputsGlob, InitSCOutputsTurbine, NumActForcePtsBlade, NumActForcePtsTower, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, InflowType, NumBl_c, NumBlElem_c, NumTwrElem_c, NodeClusterType_c, & + ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Init') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Init -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Init +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - REAL(C_DOUBLE), INTENT(IN ) :: TMax - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) - INTEGER(C_INT), INTENT(IN ) :: TurbID ! Need not be same as iTurb - INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + REAL(C_DOUBLE), INTENT(IN ) :: TMax + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: TurbID ! Need not be same as iTurb CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutFileRoot_c(IntfStrLen) ! Root of output and restart file name - INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs - INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs - REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs - REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsTurbine (*) ! Initial Supercontroller turbine specific outputs = controller inputs - INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade - INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower - REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) - REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: InflowType ! inflow type - 1 = From Inflow module, 2 = External - INTEGER(C_INT), INTENT( OUT) :: NumBl_c - INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c - INTEGER(C_INT), INTENT( OUT) :: NumTwrElem_c - TYPE(ExtInfw_InputType_C), INTENT( OUT) :: ExtInfw_Input_from_FAST - TYPE(ExtInfw_OutputType_C),INTENT( OUT) :: ExtInfw_Output_to_FAST + INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs + INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs + INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs + REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs + REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsTurbine (*) ! Initial Supercontroller turbine specific outputs = controller inputs + INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade + INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower + INTEGER(C_INT), INTENT(IN ):: NodeClusterType_c + REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: InflowType ! inflow type - 1 = From Inflow module, 2 = External + INTEGER(C_INT), INTENT( OUT) :: NumBl_c + INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c + INTEGER(C_INT), INTENT( OUT) :: NumTwrElem_c + TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: InputFileName - INTEGER(C_INT) :: i + CHARACTER(IntfStrLen) :: InputFileName + INTEGER(C_INT) :: i TYPE(FAST_ExternInitType) :: ExternInitData - - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CFD_Init' - - ! transfer the character array from C to a Fortran string: + + ! transfer the character array from C to a Fortran string: InputFileName = TRANSFER( InputFileName_c, InputFileName ) I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it - - ! initialize variables: - n_t_global = 0 + + ! initialize variables: + n_t_global = 0 ErrStat = ErrID_None ErrMsg = "" - + NumBl_c = 0 ! initialize here in case of error NumBlElem_c = 0 ! initialize here in case of error - + ExternInitData%TMax = TMax ExternInitData%TurbineID = TurbID ExternInitData%TurbinePos = TurbPosn ExternInitData%SensorType = SensorType_None ExternInitData%NumCtrl2SC = NumCtrl2SC ExternInitData%NumSC2CtrlGlob = NumSC2CtrlGlob - + if ( NumSC2CtrlGlob > 0 ) then CALL AllocAry( ExternInitData%fromSCGlob, NumSC2CtrlGlob, 'ExternInitData%fromSCGlob', ErrStat, ErrMsg) IF (FAILED()) RETURN @@ -678,7 +674,7 @@ subroutine FAST_AL_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, ExternInitData%fromSCGlob(i) = InitScOutputsGlob(i) end do end if - + ExternInitData%NumSC2Ctrl = NumSC2Ctrl if ( NumSC2Ctrl > 0 ) then CALL AllocAry( ExternInitData%fromSC, NumSC2Ctrl, 'ExternInitData%fromSC', ErrStat, ErrMsg) @@ -688,45 +684,33 @@ subroutine FAST_AL_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, ExternInitData%fromSC(i) = InitScOutputsTurbine(i) end do end if - + ExternInitData%NumActForcePtsBlade = NumActForcePtsBlade ExternInitData%NumActForcePtsTower = NumActForcePtsTower ExternInitData%DTdriver = dtDriver_c + ExternInitData%NodeClusterType = NodeClusterType_c - CALL FAST_InitializeAll_T( t_initial, 1_IntKi, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) + CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) ! set values for return to ExternalInflow - if (ErrStat .ne. ErrID_None) then - AbortErrLev_c = AbortErrLev - ErrStat_c = ErrStat - ErrMsg_c = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) - return - end if - - dt_c = Turbine(iTurb)%p_FAST%dt - - InflowType = Turbine(iTurb)%p_FAST%CompInflow - - if ( (InflowType == 3) .and. (NumActForcePtsBlade .eq. 0) .and. (NumActForcePtsTower .eq. 0) ) then - CALL SetErrStat(ErrID_Warn, "Number of actuator points is zero when inflow type is 2. Mapping of loads may not work. ", ErrStat, ErrMsg, RoutineName ) - end if - - if ( (InflowType .ne. 3) .and. ((NumActForcePtsBlade .ne. 0) .or. (NumActForcePtsTower .ne. 0)) ) then - !!FAST reassigns CompInflow after reading it to a module number based on an internal list in the FAST_Registry. So 2 in input file becomes 3 inside the code. - CALL SetErrStat(ErrID_Fatal, "Number of requested actuator points is non-zero when inflow type is not 2. Please set number of actuator points to zero when induction is turned on.", ErrStat, ErrMsg, RoutineName ) - ErrStat_c = ErrStat - ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) - return - end if - + 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_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) + RETURN + END IF + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) - - ! 7-Sep-2015: OpenFAST doesn't restrict the number of nodes on each blade mesh to be the same, so if this DOES ever change, - ! we'll need to make ExternalInflow less tied to the AeroDyn mapping. - IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN + + ! 7-Sep-2015: Sang wants these integers for the ExternalInflow mapping, which is tied to the AeroDyn nodes. FAST doesn't restrict the number of nodes on each + ! blade mesh to be the same, so if this DOES ever change, we'll need to make ExternalInflow less tied to the AeroDyn mapping. + IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN NumBl_c = SIZE(Turbine(iTurb)%AD14%Input(1)%InputMarkers) NumBlElem_c = Turbine(iTurb)%AD14%Input(1)%InputMarkers(1)%Nnodes - NumTwrElem_c = 0 ! Don't care about Aerodyn14 anymore ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors)) THEN IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion)) THEN @@ -736,43 +720,34 @@ subroutine FAST_AL_CFD_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, IF (NumBl_c > 0) THEN NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes END IF -!FIXME: need some checks on this. If the Tower mesh is not initialized, this will be garbage - NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes - ELSE - NumBl_c = 0 - NumBlElem_c = 0 - NumTwrElem_c = 0 END IF OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) - - ErrStat_c = ErrStat - ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) - - contains + +contains LOGICAL FUNCTION FAILED() - - FAILED = ErrStat >= AbortErrLev - - IF (ErrStat > 0) THEN - CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - - IF ( FAILED ) THEN - - AbortErrLev_c = AbortErrLev - ErrStat_c = ErrStat - ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR - ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - - !IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) - ! bjj: if there is an error, the driver should call FAST_DeallocateTurbines() instead of putting this deallocate statement here - END IF - END IF - - + + FAILED = ErrStat >= AbortErrLev + + IF (ErrStat > 0) THEN + CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) + + IF ( FAILED ) THEN + + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR + ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) + + !IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) + ! bjj: if there is an error, the driver should call FAST_DeallocateTurbines() instead of putting this deallocate statement here + END IF + END IF + + END FUNCTION FAILED +end subroutine -end subroutine FAST_AL_CFD_Init !================================================================================================================================== subroutine FAST_CFD_Solution0(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Solution0') IMPLICIT NONE @@ -818,107 +793,88 @@ subroutine FAST_CFD_InitIOarrays_SS(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='F end subroutine FAST_CFD_InitIOarrays_SS !================================================================================================================================== -subroutine FAST_AL_CFD_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, InflowType, numblades_c, & - numElementsPerBlade_c, numElementsTower_c, n_t_global_c, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, & - SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_AL_CFD_Restart') -!DEC$ ATTRIBUTES DLLEXPORT::FAST_AL_CFD_Restart +subroutine FAST_ExtInfw_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, numElementsPerBlade_c, numElementsTower_c, n_t_global_c, & + ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Restart') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_AL_CFD_Restart -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_AL_CFD_Restart +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: numblades_c - INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c - INTEGER(C_INT), INTENT( OUT) :: numElementsTower_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: InflowType - INTEGER(C_INT), INTENT( OUT) :: n_t_global_c - TYPE(ExtInfw_InputType_C), INTENT( OUT) :: ExtInfw_Input_from_FAST - TYPE(ExtInfw_OutputType_C),INTENT( OUT) :: ExtInfw_Output_to_FAST + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: numblades_c + INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c + INTEGER(C_INT), INTENT( OUT) :: numElementsTower_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes + TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local variables - INTEGER(C_INT) :: NumOuts_c - CHARACTER(IntfStrLen) :: CheckpointRootName + INTEGER(C_INT) :: NumOuts_c + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit REAL(DbKi) :: t_initial_out INTEGER(IntKi) :: NumTurbines_out - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + CALL NWTC_Init() - ! transfer the character array from C to a Fortran string: + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + Unit = -1 CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - + ! check that these are valid: IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) - - ! transfer Fortran variables to C: + + ! transfer Fortran variables to C: n_t_global_c = n_t_global - AbortErrLev_c = AbortErrLev - NumOuts_c = min(MAXOUTPUTS, 1 + SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time - + AbortErrLev_c = AbortErrLev + NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time if (allocated(Turbine(iTurb)%ad%p%rotors)) then ! this might not be allocated if we had an error earlier numBlades_c = Turbine(iTurb)%ad%p%rotors(1)%numblades numElementsPerBlade_c = Turbine(iTurb)%ad%p%rotors(1)%numblnds ! I'm not sure if FASTv8 can handle different number of blade nodes for each blade. - numElementsTower_c = Turbine(iTurb)%ad%y%rotors(1)%TowerLoad%Nnodes else numBlades_c = 0 numElementsPerBlade_c = 0 - numElementsTower_c = 0 end if - dt_c = Turbine(iTurb)%p_FAST%dt - + numElementsTower_c = Turbine(iTurb)%ad%p%rotors(1)%numtwrnds + + dt_c = Turbine(iTurb)%p_FAST%dt + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE - if (ErrStat .ne. ErrID_None) call wrscr1(trim(ErrMsg)) -#endif +#ifdef CONSOLE_FILE + if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) +#endif if (ErrStat >= AbortErrLev) return - - call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) - - InflowType = Turbine(iTurb)%p_FAST%CompInflow - - if (ErrStat .ne. ErrID_None) then - call wrscr1(trim(ErrMsg)) - return - end if - - if (dt_c == Turbine(iTurb)%p_FAST%dt) then - CALL SetErrStat(ErrID_Fatal, "Time step specified in C++ API does not match with time step specified in OpenFAST input file.", ErrStat, ErrMsg, RoutineName ) - return - end if - + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) -end subroutine FAST_AL_CFD_Restart - +end subroutine FAST_ExtInfw_Restart !================================================================================================================================== -subroutine FAST_BR_CFD_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, & +subroutine FAST_ExtLoads_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, & n_t_global_c, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, & - SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_BR_CFD_Restart') -!DEC$ ATTRIBUTES DLLEXPORT::FAST_BR_CFD_Restart + SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Restart') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_ExtLoads_Restart IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!DEC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Restart -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_BR_CFD_Restart +!DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Restart +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtLoads_Restart #endif INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) @@ -988,7 +944,7 @@ subroutine FAST_BR_CFD_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, ErrStat_c = ErrStat ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) -end subroutine FAST_BR_CFD_Restart +end subroutine FAST_ExtLoads_Restart !================================================================================================================================== subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_oToOF) diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index aa8ccb6005..51269339f0 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -16,24 +16,19 @@ EXTERNAL_ROUTINE void FAST_AllocateTurbines(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_DeallocateTurbines(int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_AL_CFD_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, - double * dt, int * InflowType, int * NumBl, int * NumBlElem, int * NumTwrElem, int * n_t_global, - ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, - SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, - int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_AL_CFD_Init(int * iTurb, double *TMax, const char *InputFileName, - int * TurbineID, char *OutFileRoot, - int * NumSC2CtrlGlob, int * NumSC2Ctrl, int * NumCtrl2SC, - float * initSCInputsGlob, float * initSCInputsTurbine, - int * NumActForcePtsBlade, int * NumActForcePtsTower, float * TurbinePosition, - int *AbortErrLev, double * dtDriver, double * dt, int * InflowType, - int * NumBl, int * NumBlElem, int * NumTwrElem, - ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, - SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, - int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtInfw_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * InflowType, + int * NumBl, int * NumBlElem, int * NumTwrElem, int * n_t_global, + ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, + int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtInfw_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, + int * NumSC2CtrlGlob, int * NumSC2Ctrl, int * NumCtrl2SC, float * initSCInputsGlob, float * initSCInputsTurbine, + int * NumActForcePtsBlade, int * NumActForcePtsTower, float * TurbinePosition, int *AbortErrLev, + double * dtDriver, double * dt, int * InflowType, int * NumBl, int * NumBlElem, int * NumTwrElem, int * NodeClusterType, + ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, + int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_BR_CFD_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_BR_CFD_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, double * vel_mean, double * wind_dir, double * z_ref, double * shear_exp, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtLoads_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtLoads_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, double * vel_mean, double * wind_dir, double * z_ref, double * shear_exp, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_InitIOarrays_SS(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Prework(int * iTurb, int *ErrStat, char *ErrMsg); From c85a0c89135456eb4460df41836320dd5c2a2a18 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 4 Dec 2023 14:15:49 -0700 Subject: [PATCH 095/232] AD15: memory leak, fix in FVW also --- modules/aerodyn/src/FVW.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 616d96ffc7..f3cf5fb330 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -757,6 +757,7 @@ end subroutine RollBackPreviousTimeStep subroutine CleanUp() call FVW_DestroyConstrState(z_guess, ErrStat2, ErrMsg2); if(Failed()) return + call FVW_DestroyInput(uInterp, ErrStat2, ErrMsg2); if(Failed()) return end subroutine logical function Failed() From a233bc142bf385368b38382e5b637475ebc6e9b2 Mon Sep 17 00:00:00 2001 From: Ganesh Vijayakumar Date: Mon, 4 Dec 2023 15:52:54 -0700 Subject: [PATCH 096/232] Addressing some issues found by Andy --- .../src/ExternalInflow_Registry.txt | 3 - modules/openfast-library/src/FAST_Library.f90 | 436 +++++++++--------- 2 files changed, 230 insertions(+), 209 deletions(-) diff --git a/modules/externalinflow/src/ExternalInflow_Registry.txt b/modules/externalinflow/src/ExternalInflow_Registry.txt index e5659ed467..8f32087734 100644 --- a/modules/externalinflow/src/ExternalInflow_Registry.txt +++ b/modules/externalinflow/src/ExternalInflow_Registry.txt @@ -54,9 +54,6 @@ typedef ExternalInflow/ExtInfw ParameterType IntKi NodeClusterType - typedef ^ InputType ReKi pxVel {:} - - "x position of velocity interface (Aerodyn) nodes" "m" typedef ^ InputType ReKi pyVel {:} - - "y position of velocity interface (Aerodyn) nodes" "m" typedef ^ InputType ReKi pzVel {:} - - "z position of velocity interface (Aerodyn) nodes" "m" -typedef ^ InputType ReKi pxdotVel {:} - - "x of velocity interface (Aerodyn) nodes" "m" -typedef ^ InputType ReKi pydotVel {:} - - "y position of velocity interface (Aerodyn) nodes" "m" -typedef ^ InputType ReKi pzdotVel {:} - - "z position of velocity interface (Aerodyn) nodes" "m" typedef ^ InputType ReKi pxForce {:} - - "x position of actuator force nodes" "m" typedef ^ InputType ReKi pyForce {:} - - "y position of actuator force nodes" "m" typedef ^ InputType ReKi pzForce {:} - - "z position of actuator force nodes" "m" diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 247137d84d..5de7b339f8 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -1,53 +1,53 @@ -! FAST_Library.f90 +! FAST_Library.f90 ! ! FUNCTIONS/SUBROUTINES exported from FAST_Library.dll: -! FAST_Start - subroutine -! FAST_Update - subroutine -! FAST_End - subroutine -! +! FAST_Start - subroutine +! FAST_Update - subroutine +! FAST_End - subroutine +! ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran ! -!================================================================================================================================== +!================================================================================================================================== MODULE FAST_Data USE, INTRINSIC :: ISO_C_Binding USE FAST_Subs ! all of the ModuleName and ModuleName_types modules are inherited from FAST_Subs - + IMPLICIT NONE SAVE - + ! Local parameters: REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time - INTEGER(IntKi) :: NumTurbines + INTEGER(IntKi) :: NumTurbines INTEGER, PARAMETER :: IntfStrLen = 1025 ! length of strings through the C interface INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 53 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 51 - - + + ! Global (static) data: TYPE(FAST_TurbineType), ALLOCATABLE :: Turbine(:) ! Data for each turbine INTEGER(IntKi) :: n_t_global ! simulation time step, loop counter for global (FAST) simulation INTEGER(IntKi) :: ErrStat ! Error status CHARACTER(IntfStrLen-1) :: ErrMsg ! Error message (this needs to be static so that it will print in Matlab's mex library) - + contains -!================================================================================================================================== +!================================================================================================================================== subroutine FAST_AllocateTurbines(nTurbines, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_AllocateTurbines') - IMPLICIT NONE + IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: FAST_AllocateTurbines !GCC$ ATTRIBUTES DLLEXPORT :: FAST_AllocateTurbines #endif INTEGER(C_INT), INTENT(IN ) :: nTurbines INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + if (nTurbines > 0) then NumTurbines = nTurbines end if - + if (nTurbines > 10) then call wrscr1('Number of turbines is > 10! Are you sure you have enough memory?') call wrscr1('Proceeding anyway.') @@ -63,7 +63,7 @@ subroutine FAST_AllocateTurbines(nTurbines, ErrStat_c, ErrMsg_c) BIND (C, NAME=' ErrMsg = " "//C_NULL_CHAR end if ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - + end subroutine FAST_AllocateTurbines !================================================================================================================================== subroutine FAST_DeallocateTurbines(ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_DeallocateTurbines') @@ -84,35 +84,35 @@ subroutine FAST_DeallocateTurbines(ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Deal end subroutine !================================================================================================================================== subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, dt_out_c, tmax_c, ErrStat_c, ErrMsg_c, ChannelNames_c, TMax, InitInpAry) BIND (C, NAME='FAST_Sizes') - IMPLICIT NONE + IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: FAST_Sizes !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Sizes #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: NumOuts_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_out_c + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: NumOuts_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_out_c REAL(C_DOUBLE), INTENT( OUT) :: tmax_c - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ChannelNames_c(ChanLen*MAXOUTPUTS+1) - REAL(C_DOUBLE),OPTIONAL,INTENT(IN ) :: TMax - REAL(C_DOUBLE),OPTIONAL,INTENT(IN ) :: InitInpAry(MAXInitINPUTS) - + REAL(C_DOUBLE),OPTIONAL,INTENT(IN ) :: TMax + REAL(C_DOUBLE),OPTIONAL,INTENT(IN ) :: InitInpAry(MAXInitINPUTS) + ! local - CHARACTER(IntfStrLen) :: InputFileName + CHARACTER(IntfStrLen) :: InputFileName INTEGER :: i, j, k TYPE(FAST_ExternInitType) :: ExternInitData - - ! transfer the character array from C to a Fortran string: + + ! transfer the character array from C to a Fortran string: InputFileName = TRANSFER( InputFileName_c, InputFileName ) I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it - - ! initialize variables: + + ! initialize variables: n_t_global = 0 IF (PRESENT(TMax) .AND. .NOT. PRESENT(InitInpAry)) THEN @@ -130,18 +130,18 @@ subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, dt ExternInitData%TurbinePos = 0.0_ReKi ! turbine position is at the origin ExternInitData%NumCtrl2SC = 0 ExternInitData%NumSC2Ctrl = 0 - ExternInitData%SensorType = NINT(InitInpAry(1)) + ExternInitData%SensorType = NINT(InitInpAry(1)) ! -- MATLAB Integration -- ! Make sure fast farm integration is false ExternInitData%FarmIntegration = .false. ExternInitData%WaveFieldMod = 0 - + IF ( NINT(InitInpAry(2)) == 1 ) THEN ExternInitData%LidRadialVel = .true. ELSE ExternInitData%LidRadialVel = .false. END IF - + CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData) ELSE @@ -149,8 +149,8 @@ subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, dt CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName) END IF - - AbortErrLev_c = AbortErrLev + + AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) dt_c = Turbine(iTurb)%p_FAST%dt dt_out_c = Turbine(iTurb)%p_FAST%DT_Out @@ -159,11 +159,11 @@ subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, dt ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - -#ifdef CONSOLE_FILE + +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - +#endif + ! return the names of the output channels IF ( ALLOCATED( Turbine(iTurb)%y_FAST%ChannelNames ) ) then k = 1; @@ -177,71 +177,71 @@ subroutine FAST_Sizes(iTurb, InputFileName_c, AbortErrLev_c, NumOuts_c, dt_c, dt ELSE ChannelNames_c = C_NULL_CHAR END IF - + end subroutine FAST_Sizes !================================================================================================================================== subroutine FAST_Start(iTurb, NumInputs_c, NumOutputs_c, InputAry, OutputAry, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Start') - IMPLICIT NONE + IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: FAST_Start !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Start #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - INTEGER(C_INT), INTENT(IN ) :: NumInputs_c - INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: NumInputs_c + INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c REAL(C_DOUBLE), INTENT(IN ) :: InputAry(NumInputs_c) REAL(C_DOUBLE), INTENT( OUT) :: OutputAry(NumOutputs_c) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + - ! local - CHARACTER(IntfStrLen) :: InputFileName + CHARACTER(IntfStrLen) :: InputFileName INTEGER :: i REAL(ReKi) :: Outputs(NumOutputs_c-1) - + INTEGER(IntKi) :: ErrStat2 ! Error status CHARACTER(IntfStrLen-1) :: ErrMsg2 ! Error message (this needs to be static so that it will print in Matlab's mex library) - - ! initialize variables: + + ! initialize variables: n_t_global = 0 !............................................................................................................................... ! Initialization of solver: (calculate outputs based on states at t=t_initial as well as guesses of inputs and constraint states) - !............................................................................................................................... - CALL FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) - + !............................................................................................................................... + CALL FAST_Solution0_T(Turbine(iTurb), ErrStat, ErrMsg ) + if (ErrStat <= AbortErrLev) then ! return outputs here, too IF(NumOutputs_c /= SIZE(Turbine(iTurb)%y_FAST%ChannelNames) ) THEN ErrStat = ErrID_Fatal ErrMsg = trim(ErrMsg)//NewLine//"FAST_Start:size of NumOutputs is invalid." ELSE - - CALL FillOutputAry_T(Turbine(iTurb), Outputs) - OutputAry(1) = Turbine(iTurb)%m_FAST%t_global - OutputAry(2:NumOutputs_c) = Outputs + + CALL FillOutputAry_T(Turbine(iTurb), Outputs) + OutputAry(1) = Turbine(iTurb)%m_FAST%t_global + OutputAry(2:NumOutputs_c) = Outputs CALL FAST_Linearize_T(t_initial, 0, Turbine(iTurb), ErrStat2, ErrMsg2) if (ErrStat2 /= ErrID_None) then ErrStat = max(ErrStat,ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) end if - - + + END IF end if - - + + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - -#ifdef CONSOLE_FILE + +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - +#endif + end subroutine FAST_Start !================================================================================================================================== subroutine FAST_Update(iTurb, NumInputs_c, NumOutputs_c, InputAry, OutputAry, EndSimulationEarly, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Update') @@ -250,25 +250,25 @@ subroutine FAST_Update(iTurb, NumInputs_c, NumOutputs_c, InputAry, OutputAry, En !DEC$ ATTRIBUTES DLLEXPORT :: FAST_Update !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Update #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - INTEGER(C_INT), INTENT(IN ) :: NumInputs_c - INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: NumInputs_c + INTEGER(C_INT), INTENT(IN ) :: NumOutputs_c REAL(C_DOUBLE), INTENT(IN ) :: InputAry(NumInputs_c) REAL(C_DOUBLE), INTENT( OUT) :: OutputAry(NumOutputs_c) LOGICAL(C_BOOL), INTENT( OUT) :: EndSimulationEarly - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local variables REAL(ReKi) :: Outputs(NumOutputs_c-1) INTEGER(IntKi) :: i INTEGER(IntKi) :: ErrStat2 ! Error status CHARACTER(IntfStrLen-1) :: ErrMsg2 ! Error message (this needs to be static so that it will print in Matlab's mex library) - + EndSimulationEarly = .FALSE. - IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish - + IF ( n_t_global > Turbine(iTurb)%p_FAST%n_TMax_m1 ) THEN !finish + ! we can't continue because we might over-step some arrays that are allocated to the size of the simulation IF (n_t_global == Turbine(iTurb)%p_FAST%n_TMax_m1 + 1) THEN ! we call update an extra time in Simulink, which we can ignore until the time shift with outputs is solved @@ -276,12 +276,12 @@ subroutine FAST_Update(iTurb, NumInputs_c, NumOutputs_c, InputAry, OutputAry, En ErrStat_c = ErrID_None ErrMsg = C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - ELSE + ELSE ErrStat_c = ErrID_Info ErrMsg = "Simulation completed."//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF - + ELSEIF(NumOutputs_c /= SIZE(Turbine(iTurb)%y_FAST%ChannelNames) ) THEN ErrStat_c = ErrID_Fatal ErrMsg = "FAST_Update:size of OutputAry is invalid or FAST has too many outputs."//C_NULL_CHAR @@ -296,7 +296,7 @@ subroutine FAST_Update(iTurb, NumInputs_c, NumOutputs_c, InputAry, OutputAry, En CALL FAST_SetExternalInputs(iTurb, NumInputs_c, InputAry, Turbine(iTurb)%m_FAST) - CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) n_t_global = n_t_global + 1 CALL FAST_Linearize_T( t_initial, n_t_global, Turbine(iTurb), ErrStat2, ErrMsg2) @@ -304,26 +304,26 @@ subroutine FAST_Update(iTurb, NumInputs_c, NumOutputs_c, InputAry, OutputAry, En ErrStat = max(ErrStat,ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) end if - + IF ( Turbine(iTurb)%m_FAST%Lin%FoundSteady) THEN EndSimulationEarly = .TRUE. END IF - + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) END IF ! set the outputs for external code here - CALL FillOutputAry_T(Turbine(iTurb), Outputs) - OutputAry(1) = Turbine(iTurb)%m_FAST%t_global - OutputAry(2:NumOutputs_c) = Outputs + CALL FillOutputAry_T(Turbine(iTurb), Outputs) + OutputAry(1) = Turbine(iTurb)%m_FAST%t_global + OutputAry(2:NumOutputs_c) = Outputs -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - -end subroutine FAST_Update +#endif + +end subroutine FAST_Update !================================================================================================================================== ! Get the hub's absolute position, rotation velocity, and orientation DCM for the current time step subroutine FAST_HubPosition(iTurb, AbsPosition_c, RotationalVel_c, Orientation_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_HubPosition') @@ -369,14 +369,14 @@ subroutine FAST_SetExternalInputs(iTurb, NumInputs_c, InputAry, m_FAST) USE, INTRINSIC :: ISO_C_Binding USE FAST_Types ! USE FAST_Data, only: NumFixedInputs - + IMPLICIT NONE - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - INTEGER(C_INT), INTENT(IN ) :: NumInputs_c + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: NumInputs_c REAL(C_DOUBLE), INTENT(IN ) :: InputAry(NumInputs_c) ! Inputs from Simulink TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST ! Miscellaneous variables - + ! set the inputs from external code here... ! transfer inputs from Simulink to FAST IF ( NumInputs_c < NumFixedInputs ) RETURN ! This is an error @@ -391,12 +391,12 @@ subroutine FAST_SetExternalInputs(iTurb, NumInputs_c, InputAry, m_FAST) m_FAST%ExternInput%BlAirfoilCom = InputAry(9:11) m_FAST%ExternInput%CableDeltaL = InputAry(12:31) m_FAST%ExternInput%CableDeltaLdot = InputAry(32:51) - + IF ( NumInputs_c > NumFixedInputs ) THEN ! NumFixedInputs is the fixed number of inputs IF ( NumInputs_c == NumFixedInputs + 3 ) & m_FAST%ExternInput%LidarFocus = InputAry(52:54) - END IF - + END IF + end subroutine FAST_SetExternalInputs !================================================================================================================================== subroutine FAST_End(iTurb, StopTheProgram) BIND (C, NAME='FAST_End') @@ -405,11 +405,11 @@ subroutine FAST_End(iTurb, StopTheProgram) BIND (C, NAME='FAST_End') !DEC$ ATTRIBUTES DLLEXPORT :: FAST_End !GCC$ ATTRIBUTES DLLEXPORT :: FAST_End #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number LOGICAL(C_BOOL), INTENT(IN) :: StopTheProgram ! flag indicating if the program should end (false if there are more turbines to end) CALL ExitThisProgram_T( Turbine(iTurb), ErrID_None, LOGICAL(StopTheProgram)) - + end subroutine FAST_End !================================================================================================================================== subroutine FAST_CreateCheckpoint(iTurb, CheckpointRootName_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CreateCheckpoint') @@ -418,41 +418,41 @@ subroutine FAST_CreateCheckpoint(iTurb, CheckpointRootName_c, ErrStat_c, ErrMsg_ !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CreateCheckpoint !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CreateCheckpoint #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: CheckpointRootName + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit - - - ! transfer the character array from C to a Fortran string: + + + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + if ( LEN_TRIM(CheckpointRootName) == 0 ) then CheckpointRootName = TRIM(Turbine(iTurb)%p_FAST%OutFileRoot)//'.'//trim( Num2LStr(n_t_global) ) end if - - + + Unit = -1 CALL FAST_CreateCheckpoint_T(t_initial, n_t_global, 1, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - ! transfer Fortran variables to C: + ! transfer Fortran variables to C: ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - -end subroutine FAST_CreateCheckpoint +#endif + +end subroutine FAST_CreateCheckpoint !================================================================================================================================== subroutine FAST_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, dt_c, n_t_global_c, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_Restart') IMPLICIT NONE @@ -460,52 +460,52 @@ subroutine FAST_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, NumOuts_c, d !DEC$ ATTRIBUTES DLLEXPORT :: FAST_Restart !GCC$ ATTRIBUTES DLLEXPORT :: FAST_Restart #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c - INTEGER(C_INT), INTENT( OUT) :: NumOuts_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: n_t_global_c - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT( OUT) :: NumOuts_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: CheckpointRootName + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit REAL(DbKi) :: t_initial_out INTEGER(IntKi) :: NumTurbines_out - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' - - - ! transfer the character array from C to a Fortran string: + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + + + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + Unit = -1 CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - + ! check that these are valid: IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) - - - ! transfer Fortran variables to C: + + + ! transfer Fortran variables to C: n_t_global_c = n_t_global - AbortErrLev_c = AbortErrLev + AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time - dt_c = Turbine(iTurb)%p_FAST%dt - + dt_c = Turbine(iTurb)%p_FAST%dt + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif - -end subroutine FAST_Restart +#endif + +end subroutine FAST_Restart !================================================================================================================================== subroutine FAST_ExtLoads_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, NumBl_c, & @@ -613,12 +613,12 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c !DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init !GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Init #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - REAL(C_DOUBLE), INTENT(IN ) :: TMax - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + REAL(C_DOUBLE), INTENT(IN ) :: TMax + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: InputFileName_c(IntfStrLen) INTEGER(C_INT), INTENT(IN ) :: TurbID ! Need not be same as iTurb CHARACTER(KIND=C_CHAR), INTENT( OUT) :: OutFileRoot_c(IntfStrLen) ! Root of output and restart file name - INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs + INTEGER(C_INT), INTENT(IN ) :: NumSC2CtrlGlob ! Supercontroller global outputs = controller global inputs INTEGER(C_INT), INTENT(IN ) :: NumSC2Ctrl ! Supercontroller outputs = controller inputs INTEGER(C_INT), INTENT(IN ) :: NumCtrl2SC ! controller outputs = Supercontroller inputs REAL(C_FLOAT), INTENT(IN ) :: InitScOutputsGlob (*) ! Initial Supercontroller global outputs = controller inputs @@ -626,46 +626,48 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsBlade ! number of actuator line force points in blade INTEGER(C_INT), INTENT(IN ) :: NumActForcePtsTower ! number of actuator line force points in tower INTEGER(C_INT), INTENT(IN ):: NodeClusterType_c - REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) + REAL(C_FLOAT), INTENT(IN ) :: TurbPosn(3) INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c REAL(C_DOUBLE), INTENT(IN ) :: dtDriver_c REAL(C_DOUBLE), INTENT( OUT) :: dt_c INTEGER(C_INT), INTENT( OUT) :: InflowType ! inflow type - 1 = From Inflow module, 2 = External - INTEGER(C_INT), INTENT( OUT) :: NumBl_c - INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c - INTEGER(C_INT), INTENT( OUT) :: NumTwrElem_c + INTEGER(C_INT), INTENT( OUT) :: NumBl_c + INTEGER(C_INT), INTENT( OUT) :: NumBlElem_c + INTEGER(C_INT), INTENT( OUT) :: NumTwrElem_c TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local - CHARACTER(IntfStrLen) :: InputFileName - INTEGER(C_INT) :: i + CHARACTER(IntfStrLen) :: InputFileName + INTEGER(C_INT) :: i TYPE(FAST_ExternInitType) :: ExternInitData - - ! transfer the character array from C to a Fortran string: + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ExtInfw_Init' + + ! transfer the character array from C to a Fortran string: InputFileName = TRANSFER( InputFileName_c, InputFileName ) I = INDEX(InputFileName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) InputFileName = InputFileName(1:I) ! remove it - - ! initialize variables: - n_t_global = 0 + + ! initialize variables: + n_t_global = 0 ErrStat = ErrID_None ErrMsg = "" - + NumBl_c = 0 ! initialize here in case of error NumBlElem_c = 0 ! initialize here in case of error - + ExternInitData%TMax = TMax ExternInitData%TurbineID = TurbID ExternInitData%TurbinePos = TurbPosn ExternInitData%SensorType = SensorType_None ExternInitData%NumCtrl2SC = NumCtrl2SC ExternInitData%NumSC2CtrlGlob = NumSC2CtrlGlob - + if ( NumSC2CtrlGlob > 0 ) then CALL AllocAry( ExternInitData%fromSCGlob, NumSC2CtrlGlob, 'ExternInitData%fromSCGlob', ErrStat, ErrMsg) IF (FAILED()) RETURN @@ -674,7 +676,7 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c ExternInitData%fromSCGlob(i) = InitScOutputsGlob(i) end do end if - + ExternInitData%NumSC2Ctrl = NumSC2Ctrl if ( NumSC2Ctrl > 0 ) then CALL AllocAry( ExternInitData%fromSC, NumSC2Ctrl, 'ExternInitData%fromSC', ErrStat, ErrMsg) @@ -684,7 +686,7 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c ExternInitData%fromSC(i) = InitScOutputsTurbine(i) end do end if - + ExternInitData%NumActForcePtsBlade = NumActForcePtsBlade ExternInitData%NumActForcePtsTower = NumActForcePtsTower ExternInitData%DTdriver = dtDriver_c @@ -693,22 +695,36 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) ! set values for return to ExternalInflow - AbortErrLev_c = AbortErrLev + 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 ) - + + InflowType = Turbine(iTurb)%p_FAST%CompInflow + IF ( ErrStat >= AbortErrLev ) THEN CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) RETURN END IF - + + if ( (InflowType == 3) .and. (NumActForcePtsBlade .eq. 0) .and. (NumActForcePtsTower .eq. 0) ) then + CALL SetErrStat(ErrID_Warn, "Number of actuator points is zero when inflow type is 2. Mapping of loads may not work. ", ErrStat, ErrMsg, RoutineName ) + end if + + if ( (InflowType .ne. 3) .and. ((NumActForcePtsBlade .ne. 0) .or. (NumActForcePtsTower .ne. 0)) ) then + !!FAST reassigns CompInflow after reading it to a module number based on an internal list in the FAST_Registry. So 2 in input file becomes 3 inside the code. + CALL SetErrStat(ErrID_Fatal, "Number of requested actuator points is non-zero when inflow type is not 2. Please set number of actuator points to zero when induction is turned on.", ErrStat, ErrMsg, RoutineName ) + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) - - ! 7-Sep-2015: Sang wants these integers for the ExternalInflow mapping, which is tied to the AeroDyn nodes. FAST doesn't restrict the number of nodes on each + + ! 7-Sep-2015: Sang wants these integers for the ExternalInflow mapping, which is tied to the AeroDyn nodes. FAST doesn't restrict the number of nodes on each ! blade mesh to be the same, so if this DOES ever change, we'll need to make ExternalInflow less tied to the AeroDyn mapping. - IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN + IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN NumBl_c = SIZE(Turbine(iTurb)%AD14%Input(1)%InputMarkers) NumBlElem_c = Turbine(iTurb)%AD14%Input(1)%InputMarkers(1)%Nnodes ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN @@ -720,33 +736,41 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c IF (NumBl_c > 0) THEN NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes END IF + NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes + ELSE + NumBl_c = 0 + NumBlElem_c = 0 + NumTwrElem_c = 0 END IF + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) - + contains LOGICAL FUNCTION FAILED() - + FAILED = ErrStat >= AbortErrLev - + IF (ErrStat > 0) THEN CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - + IF ( FAILED ) THEN - + AbortErrLev_c = AbortErrLev ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) - + !IF (ALLOCATED(Turbine)) DEALLOCATE(Turbine) ! bjj: if there is an error, the driver should call FAST_DeallocateTurbines() instead of putting this deallocate statement here END IF END IF - - + + END FUNCTION FAILED -end subroutine +end subroutine !================================================================================================================================== subroutine FAST_CFD_Solution0(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Solution0') @@ -800,46 +824,46 @@ subroutine FAST_ExtInfw_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c !DEC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart !GCC$ ATTRIBUTES DLLEXPORT :: FAST_ExtInfw_Restart #endif - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) - INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + CHARACTER(KIND=C_CHAR), INTENT(IN ) :: CheckpointRootName_c(IntfStrLen) + INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c INTEGER(C_INT), INTENT( OUT) :: numblades_c INTEGER(C_INT), INTENT( OUT) :: numElementsPerBlade_c INTEGER(C_INT), INTENT( OUT) :: numElementsTower_c - REAL(C_DOUBLE), INTENT( OUT) :: dt_c - INTEGER(C_INT), INTENT( OUT) :: n_t_global_c + REAL(C_DOUBLE), INTENT( OUT) :: dt_c + INTEGER(C_INT), INTENT( OUT) :: n_t_global_c TYPE(ExtInfw_InputType_C), INTENT(INOUT) :: ExtInfw_Input_from_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(ExtInfw_OutputType_C),INTENT(INOUT) :: ExtInfw_Output_to_FAST !INTENT(INOUT) instead of INTENT(OUT) to avoid gcc compiler warnings about variable tracking sizes TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST - INTEGER(C_INT), INTENT( OUT) :: ErrStat_c - CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - + INTEGER(C_INT), INTENT( OUT) :: ErrStat_c + CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) + ! local variables - INTEGER(C_INT) :: NumOuts_c - CHARACTER(IntfStrLen) :: CheckpointRootName + INTEGER(C_INT) :: NumOuts_c + CHARACTER(IntfStrLen) :: CheckpointRootName INTEGER(IntKi) :: I INTEGER(IntKi) :: Unit REAL(DbKi) :: t_initial_out INTEGER(IntKi) :: NumTurbines_out - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Restart' + CALL NWTC_Init() - ! transfer the character array from C to a Fortran string: + ! transfer the character array from C to a Fortran string: CheckpointRootName = TRANSFER( CheckpointRootName_c, CheckpointRootName ) I = INDEX(CheckpointRootName,C_NULL_CHAR) - 1 ! if this has a c null character at the end... IF ( I > 0 ) CheckpointRootName = CheckpointRootName(1:I) ! remove it - + Unit = -1 CALL FAST_RestoreFromCheckpoint_T(t_initial_out, n_t_global, NumTurbines_out, Turbine(iTurb), CheckpointRootName, ErrStat, ErrMsg, Unit ) - + ! check that these are valid: IF (t_initial_out /= t_initial) CALL SetErrStat(ErrID_Fatal, "invalid value of t_initial.", ErrStat, ErrMsg, RoutineName ) IF (NumTurbines_out /= 1) CALL SetErrStat(ErrID_Fatal, "invalid value of NumTurbines.", ErrStat, ErrMsg, RoutineName ) - - ! transfer Fortran variables to C: + + ! transfer Fortran variables to C: n_t_global_c = n_t_global - AbortErrLev_c = AbortErrLev + AbortErrLev_c = AbortErrLev NumOuts_c = min(MAXOUTPUTS, SUM( Turbine(iTurb)%y_FAST%numOuts )) ! includes time if (allocated(Turbine(iTurb)%ad%p%rotors)) then ! this might not be allocated if we had an error earlier numBlades_c = Turbine(iTurb)%ad%p%rotors(1)%numblades @@ -850,19 +874,19 @@ subroutine FAST_ExtInfw_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c end if numElementsTower_c = Turbine(iTurb)%ad%p%rotors(1)%numtwrnds - - dt_c = Turbine(iTurb)%p_FAST%dt - + + dt_c = Turbine(iTurb)%p_FAST%dt + ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -#ifdef CONSOLE_FILE +#ifdef CONSOLE_FILE if (ErrStat /= ErrID_None) call wrscr1(trim(ErrMsg)) -#endif +#endif if (ErrStat >= AbortErrLev) return - + call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) end subroutine FAST_ExtInfw_Restart From a492600e9fe89d5fb1a7097a2e781a9672eabb30 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 4 Dec 2023 17:11:39 -0700 Subject: [PATCH 097/232] Revert minor unintended changes --- .../src/ExternalInflow_Registry.txt | 3 -- modules/openfast-library/src/FAST_Library.f90 | 30 +++++++++---------- 2 files changed, 15 insertions(+), 18 deletions(-) diff --git a/modules/externalinflow/src/ExternalInflow_Registry.txt b/modules/externalinflow/src/ExternalInflow_Registry.txt index 8f32087734..e066d5c414 100644 --- a/modules/externalinflow/src/ExternalInflow_Registry.txt +++ b/modules/externalinflow/src/ExternalInflow_Registry.txt @@ -57,9 +57,6 @@ typedef ^ InputType ReKi pzVel {:} - - "z position of veloc typedef ^ InputType ReKi pxForce {:} - - "x position of actuator force nodes" "m" typedef ^ InputType ReKi pyForce {:} - - "y position of actuator force nodes" "m" typedef ^ InputType ReKi pzForce {:} - - "z position of actuator force nodes" "m" -typedef ^ InputType ReKi pxdotForce {:} - - "x velocity of actuator force nodes" "m/s" -typedef ^ InputType ReKi pydotForce {:} - - "y velocity of actuator force nodes" "m/s" -typedef ^ InputType ReKi pzdotForce {:} - - "z velocity of actuator force nodes" "m/s" typedef ^ InputType ReKi xdotForce {:} - - "x velocity of actuator force nodes" "m/s" typedef ^ InputType ReKi ydotForce {:} - - "y velocity of actuator force nodes" "m/s" typedef ^ InputType ReKi zdotForce {:} - - "z velocity of actuator force nodes" "m/s" diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 5de7b339f8..db8780f82c 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -695,18 +695,16 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c CALL FAST_InitializeAll_T( t_initial, iTurb, Turbine(iTurb), ErrStat, ErrMsg, InputFileName, ExternInitData ) ! set values for return to ExternalInflow - 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 .ne. ErrID_None) then + AbortErrLev_c = AbortErrLev + ErrStat_c = ErrStat + ErrMsg_c = TRANSFER( TRIM(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) + return + end if - InflowType = Turbine(iTurb)%p_FAST%CompInflow + dt_c = Turbine(iTurb)%p_FAST%dt - IF ( ErrStat >= AbortErrLev ) THEN - CALL WrScr( "Error in FAST_ExtInfw_Init:FAST_InitializeAll_T" // TRIM(ErrMsg) ) - RETURN - END IF + InflowType = Turbine(iTurb)%p_FAST%CompInflow if ( (InflowType == 3) .and. (NumActForcePtsBlade .eq. 0) .and. (NumActForcePtsTower .eq. 0) ) then CALL SetErrStat(ErrID_Warn, "Number of actuator points is zero when inflow type is 2. Mapping of loads may not work. ", ErrStat, ErrMsg, RoutineName ) @@ -722,11 +720,12 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c call SetExternalInflow_pointers(iTurb, ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST) - ! 7-Sep-2015: Sang wants these integers for the ExternalInflow mapping, which is tied to the AeroDyn nodes. FAST doesn't restrict the number of nodes on each - ! blade mesh to be the same, so if this DOES ever change, we'll need to make ExternalInflow less tied to the AeroDyn mapping. + ! 7-Sep-2015: OpenFAST doesn't restrict the number of nodes on each blade mesh to be the same, so if this DOES ever change, + ! we'll need to make ExternalInflow less tied to the AeroDyn mapping. IF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD14) THEN NumBl_c = SIZE(Turbine(iTurb)%AD14%Input(1)%InputMarkers) NumBlElem_c = Turbine(iTurb)%AD14%Input(1)%InputMarkers(1)%Nnodes + NumTwrElem_c = 0 ! Don't care about Aerodyn14 anymore ELSEIF (Turbine(iTurb)%p_FAST%CompAero == MODULE_AD) THEN IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors)) THEN IF (ALLOCATED(Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion)) THEN @@ -736,6 +735,7 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c IF (NumBl_c > 0) THEN NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes END IF +!FIXME: need some checks on this. If the Tower mesh is not initialized, this will be garbage NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes ELSE NumBl_c = 0 @@ -743,12 +743,12 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c NumTwrElem_c = 0 END IF + OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) + ErrStat_c = ErrStat ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) - OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) - -contains + contains LOGICAL FUNCTION FAILED() FAILED = ErrStat >= AbortErrLev From a6a97a353f2ddf91b8b9ee3d12b69782783aef24 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 4 Dec 2023 17:43:24 -0700 Subject: [PATCH 098/232] Blade Resolved: update FAST_SS_Subs for new ExtLoads module --- modules/openfast-library/src/FAST_SS_Subs.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 index ca1fb0dd18..f391591f60 100644 --- a/modules/openfast-library/src/FAST_SS_Subs.f90 +++ b/modules/openfast-library/src/FAST_SS_Subs.f90 @@ -99,9 +99,10 @@ SUBROUTINE FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) Turbine%TurbID = 1 CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) + END SUBROUTINE FAST_InitializeSteadyState_T !---------------------------------------------------------------------------------------------------------------------------------- From 4065df8ff4e2949b10b24534afe9e6eb20868243 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 4 Dec 2023 18:12:15 -0700 Subject: [PATCH 099/232] ExtLoads: update simulink CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index b84ee0d80d..da79175927 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -72,6 +72,7 @@ target_include_directories(FAST_SFunc PUBLIC $ $ $ + $ ) if(APPLE OR UNIX) target_compile_definitions(FAST_SFunc PRIVATE IMPLICIT_DLLEXPORT) From 38ef4b66ef8a80a4abfae6e84fea0e7bfa8f03b4 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Dec 2023 10:45:12 -0700 Subject: [PATCH 100/232] ExtLoads: one more update to the simulink CMakeLists.txt --- glue-codes/simulink/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index da79175927..b2b495ec40 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -34,6 +34,7 @@ set(MEX_LIBS $ # MATLAB Specific $ $ + $ $ $ $ From c09f2ce56356d1f53beb18e5c01f38c6b86e4d7b Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Dec 2023 13:29:48 -0700 Subject: [PATCH 101/232] ExtLoads: update Simulink create SFunc --- glue-codes/simulink/src/create_FAST_SFunc.m | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/simulink/src/create_FAST_SFunc.m b/glue-codes/simulink/src/create_FAST_SFunc.m index 4a7c6fdf54..207128b1ed 100644 --- a/glue-codes/simulink/src/create_FAST_SFunc.m +++ b/glue-codes/simulink/src/create_FAST_SFunc.m @@ -71,7 +71,7 @@ ['-l' libName], ... ['-I' includeDir], ... '-I../../../modules/supercontroller/src', ... % needed for visual studio builds to find "SuperController_Types.h" - '-I../../../modules/openfoam/src', ... % needed for visual studio builds to find "OpenFOAM_Types.h" + '-I../../../modules/externalinflow/src', ... % needed for visual studio builds to find "ExternalInflow_Types.h" '-outdir', outDir, ... ['COMPFLAGS=$COMPFLAGS -MT -DS_FUNCTION_NAME=' mexname], ... '-output', mexname, ... From c0115c014ccb14b1c6fb2f7f6528b7639ca63b1a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Dec 2023 20:50:16 +0000 Subject: [PATCH 102/232] FAST_subs, don't apply DTdriver if not set This needed to be added because the C++ interface sets DTdriver, but simulink doesn't --- modules/openfast-library/src/FAST_Subs.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 1c09e0b137..ec6e8f37f8 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -2036,7 +2036,9 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, END IF IF (PRESENT(DTdriver)) THEN - IF ( ABS( NINT(DTdriver/p%DT) * p%DT - DTdriver ) .lt. 0.001 ) THEN + IF (DTdriver == -1.0_DbKi) THEN + ! DTdriver wasn't set, so don't use it + ELSE IF ( ABS( NINT(DTdriver/p%DT) * p%DT - DTdriver ) .lt. 0.001 ) THEN p%DT_Out = NINT(DTdriver/p%DT) * p%DT p%n_DT_Out = NINT(DTdriver/p%DT) ELSE From c7b0eeced993ac3f71ae3e42f679a79fd6ebd62e Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Tue, 5 Dec 2023 14:38:47 -0700 Subject: [PATCH 103/232] Coupled bodies intialization fix --- modules/moordyn/src/MoorDyn.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index da79fe50a3..d0ab4b941c 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1788,14 +1788,13 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set absolute initial positions in MoorDyn IF (p%Standalone /= 1) THEN !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation + OrMat2 = MATMUL(OrMat, ( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< ! calculate initial point relative position, adjusted due to initial platform translations u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6))))) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(OrMat2) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation ENDIF CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element From 0dde4a04fcd0b92473c75fe95d2e2894cdcd2a9e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 5 Dec 2023 22:11:02 +0000 Subject: [PATCH 104/232] Update registry pack/unpack to use int64 indices This also includes a change to the NWTC_Library CMakeLists.txt which automatically regenerates NWTC_Library_Types.f90 when Registry_NWTC_Library_base.txt changes --- .../fast-farm/src/FASTWrapper_Types.f90 | 140 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 230 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 748 ++-- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 202 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 262 +- modules/aerodyn/src/AeroDyn_Types.f90 | 1390 +++---- modules/aerodyn/src/AirfoilInfo_Types.f90 | 70 +- modules/aerodyn/src/BEMT_Types.f90 | 474 +-- modules/aerodyn/src/DBEMT_Types.f90 | 150 +- modules/aerodyn/src/FVW_Types.f90 | 856 ++-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 474 +-- modules/aerodyn14/src/AeroDyn14_Types.f90 | 818 ++-- modules/aerodyn14/src/DWM_Types.f90 | 368 +- modules/awae/src/AWAE_Types.f90 | 606 +-- modules/beamdyn/src/BeamDyn_Types.f90 | 758 ++-- modules/elastodyn/src/ElastoDyn_Types.f90 | 1506 +++---- .../src/ExternalInflow_Types.f90 | 314 +- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 338 +- modules/feamooring/src/FEAMooring_Types.f90 | 448 +- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 62 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 466 +-- modules/hydrodyn/src/Morison_Types.f90 | 872 ++-- modules/hydrodyn/src/SS_Excitation_Types.f90 | 126 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 128 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 56 +- modules/hydrodyn/src/WAMIT_Types.f90 | 122 +- modules/icedyn/src/IceDyn_Types.f90 | 160 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 54 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 164 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 8 +- modules/inflowwind/src/InflowWind_Types.f90 | 204 +- modules/inflowwind/src/Lidar_Types.f90 | 62 +- modules/map/src/MAP_Fortran_Types.f90 | 32 +- modules/map/src/MAP_Types.f90 | 270 +- modules/moordyn/src/MoorDyn_Types.f90 | 974 ++--- modules/nwtc-library/CMakeLists.txt | 13 +- modules/nwtc-library/ModRegGen.py | 69 +- .../src/Generate_NWTC_Library_Types.bat | 4 +- modules/nwtc-library/src/ModMesh_Mapping.f90 | 986 ++--- modules/nwtc-library/src/ModReg.f90 | 436 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 60 +- .../src/Registry_NWTC_Library.txt | 116 +- ...esh.txt => Registry_NWTC_Library_base.txt} | 0 ...esh.txt => Registry_NWTC_Library_mesh.txt} | 0 modules/openfast-library/src/FAST_Types.f90 | 3614 ++++++++--------- .../src/registry_gen_fortran.cpp | 48 +- .../src/OrcaFlexInterface_Types.f90 | 66 +- modules/seastate/src/Current_Types.f90 | 26 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 94 +- modules/seastate/src/SeaState_Types.f90 | 146 +- modules/seastate/src/Waves2_Types.f90 | 62 +- modules/seastate/src/Waves_Types.f90 | 34 +- modules/servodyn/src/ServoDyn_Types.f90 | 1536 +++---- modules/servodyn/src/StrucCtrl_Types.f90 | 348 +- modules/subdyn/src/SubDyn_Types.f90 | 976 ++--- .../supercontroller/src/SCDataEx_Types.f90 | 36 +- .../src/SuperController_Types.f90 | 88 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 348 +- 58 files changed, 11599 insertions(+), 11419 deletions(-) rename modules/nwtc-library/src/{Registry_NWTC_Library_typedef_nomesh.txt => Registry_NWTC_Library_base.txt} (100%) rename modules/nwtc-library/src/{Registry_NWTC_Library_typedef_mesh.txt => Registry_NWTC_Library_mesh.txt} (100%) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index cb9cab5c0a..4b56e2cc0d 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -133,7 +133,7 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyInitInput' ErrStat = ErrID_None @@ -160,8 +160,8 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC DstInitInputData%UseSC = SrcInitInputData%UseSC if (allocated(SrcInitInputData%fromSCGlob)) then - LB(1:1) = lbound(SrcInitInputData%fromSCGlob) - UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + LB(1:1) = lbound(SrcInitInputData%fromSCGlob, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob, kind=B8Ki) if (.not. allocated(DstInitInputData%fromSCGlob)) then allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -172,8 +172,8 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob end if if (allocated(SrcInitInputData%fromSC)) then - LB(1:1) = lbound(SrcInitInputData%fromSC) - UB(1:1) = ubound(SrcInitInputData%fromSC) + LB(1:1) = lbound(SrcInitInputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%fromSC, kind=B8Ki) if (.not. allocated(DstInitInputData%fromSC)) then allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -231,17 +231,17 @@ subroutine FWrap_PackInitInput(Buf, Indata) call RegPack(Buf, InData%UseSC) call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob, kind=B8Ki), ubound(InData%fromSCGlob, kind=B8Ki)) call RegPack(Buf, InData%fromSCGlob) end if call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPack(Buf, InData%fromSC) end if call RegPack(Buf, associated(InData%Vdist_High)) if (associated(InData%Vdist_High)) then - call RegPackBounds(Buf, 5, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + call RegPackBounds(Buf, 5, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Vdist_High), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Vdist_High) @@ -254,10 +254,10 @@ subroutine FWrap_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FWrap_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%nr) @@ -568,8 +568,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FWrap_CopyMisc' @@ -579,8 +579,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%TempDisp)) then - LB(1:1) = lbound(SrcMiscData%TempDisp) - UB(1:1) = ubound(SrcMiscData%TempDisp) + LB(1:1) = lbound(SrcMiscData%TempDisp, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%TempDisp, kind=B8Ki) if (.not. allocated(DstMiscData%TempDisp)) then allocate(DstMiscData%TempDisp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -595,8 +595,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%TempLoads)) then - LB(1:1) = lbound(SrcMiscData%TempLoads) - UB(1:1) = ubound(SrcMiscData%TempLoads) + LB(1:1) = lbound(SrcMiscData%TempLoads, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%TempLoads, kind=B8Ki) if (.not. allocated(DstMiscData%TempLoads)) then allocate(DstMiscData%TempLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -611,8 +611,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%ADRotorDisk)) then - LB(1:1) = lbound(SrcMiscData%ADRotorDisk) - UB(1:1) = ubound(SrcMiscData%ADRotorDisk) + LB(1:1) = lbound(SrcMiscData%ADRotorDisk, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ADRotorDisk, kind=B8Ki) if (.not. allocated(DstMiscData%ADRotorDisk)) then allocate(DstMiscData%ADRotorDisk(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -627,8 +627,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%AD_L2L)) then - LB(1:1) = lbound(SrcMiscData%AD_L2L) - UB(1:1) = ubound(SrcMiscData%AD_L2L) + LB(1:1) = lbound(SrcMiscData%AD_L2L, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AD_L2L, kind=B8Ki) if (.not. allocated(DstMiscData%AD_L2L)) then allocate(DstMiscData%AD_L2L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -648,8 +648,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FWrap_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' @@ -658,8 +658,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) call FAST_DestroyTurbineType(MiscData%Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%TempDisp)) then - LB(1:1) = lbound(MiscData%TempDisp) - UB(1:1) = ubound(MiscData%TempDisp) + LB(1:1) = lbound(MiscData%TempDisp, kind=B8Ki) + UB(1:1) = ubound(MiscData%TempDisp, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -667,8 +667,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TempDisp) end if if (allocated(MiscData%TempLoads)) then - LB(1:1) = lbound(MiscData%TempLoads) - UB(1:1) = ubound(MiscData%TempLoads) + LB(1:1) = lbound(MiscData%TempLoads, kind=B8Ki) + UB(1:1) = ubound(MiscData%TempLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -676,8 +676,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TempLoads) end if if (allocated(MiscData%ADRotorDisk)) then - LB(1:1) = lbound(MiscData%ADRotorDisk) - UB(1:1) = ubound(MiscData%ADRotorDisk) + LB(1:1) = lbound(MiscData%ADRotorDisk, kind=B8Ki) + UB(1:1) = ubound(MiscData%ADRotorDisk, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -685,8 +685,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ADRotorDisk) end if if (allocated(MiscData%AD_L2L)) then - LB(1:1) = lbound(MiscData%AD_L2L) - UB(1:1) = ubound(MiscData%AD_L2L) + LB(1:1) = lbound(MiscData%AD_L2L, kind=B8Ki) + UB(1:1) = ubound(MiscData%AD_L2L, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%AD_L2L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -699,42 +699,42 @@ subroutine FWrap_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call FAST_PackTurbineType(Buf, InData%Turbine) call RegPack(Buf, allocated(InData%TempDisp)) if (allocated(InData%TempDisp)) then - call RegPackBounds(Buf, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) - LB(1:1) = lbound(InData%TempDisp) - UB(1:1) = ubound(InData%TempDisp) + call RegPackBounds(Buf, 1, lbound(InData%TempDisp, kind=B8Ki), ubound(InData%TempDisp, kind=B8Ki)) + LB(1:1) = lbound(InData%TempDisp, kind=B8Ki) + UB(1:1) = ubound(InData%TempDisp, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%TempDisp(i1)) end do end if call RegPack(Buf, allocated(InData%TempLoads)) if (allocated(InData%TempLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) - LB(1:1) = lbound(InData%TempLoads) - UB(1:1) = ubound(InData%TempLoads) + call RegPackBounds(Buf, 1, lbound(InData%TempLoads, kind=B8Ki), ubound(InData%TempLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%TempLoads, kind=B8Ki) + UB(1:1) = ubound(InData%TempLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%TempLoads(i1)) end do end if call RegPack(Buf, allocated(InData%ADRotorDisk)) if (allocated(InData%ADRotorDisk)) then - call RegPackBounds(Buf, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) - LB(1:1) = lbound(InData%ADRotorDisk) - UB(1:1) = ubound(InData%ADRotorDisk) + call RegPackBounds(Buf, 1, lbound(InData%ADRotorDisk, kind=B8Ki), ubound(InData%ADRotorDisk, kind=B8Ki)) + LB(1:1) = lbound(InData%ADRotorDisk, kind=B8Ki) + UB(1:1) = ubound(InData%ADRotorDisk, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%ADRotorDisk(i1)) end do end if call RegPack(Buf, allocated(InData%AD_L2L)) if (allocated(InData%AD_L2L)) then - call RegPackBounds(Buf, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) - LB(1:1) = lbound(InData%AD_L2L) - UB(1:1) = ubound(InData%AD_L2L) + call RegPackBounds(Buf, 1, lbound(InData%AD_L2L, kind=B8Ki), ubound(InData%AD_L2L, kind=B8Ki)) + LB(1:1) = lbound(InData%AD_L2L, kind=B8Ki) + UB(1:1) = ubound(InData%AD_L2L, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%AD_L2L(i1)) end do @@ -746,8 +746,8 @@ subroutine FWrap_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FWrap_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -820,15 +820,15 @@ subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%nr = SrcParamData%nr if (allocated(SrcParamData%r)) then - LB(1:1) = lbound(SrcParamData%r) - UB(1:1) = ubound(SrcParamData%r) + LB(1:1) = lbound(SrcParamData%r, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%r, kind=B8Ki) if (.not. allocated(DstParamData%r)) then allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -862,7 +862,7 @@ subroutine FWrap_PackParam(Buf, Indata) call RegPack(Buf, InData%nr) call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then - call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) + call RegPackBounds(Buf, 1, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) call RegPack(Buf, InData%r) end if call RegPack(Buf, InData%n_FAST_low) @@ -874,7 +874,7 @@ subroutine FWrap_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FWrap_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackParam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -906,14 +906,14 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob) - UB(1:1) = ubound(SrcInputData%fromSCglob) + LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) if (.not. allocated(DstInputData%fromSCglob)) then allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -924,8 +924,8 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%fromSCglob = SrcInputData%fromSCglob end if if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC) - UB(1:1) = ubound(SrcInputData%fromSC) + LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) if (.not. allocated(DstInputData%fromSC)) then allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -959,12 +959,12 @@ subroutine FWrap_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%fromSCglob)) if (allocated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) call RegPack(Buf, InData%fromSCglob) end if call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPack(Buf, InData%fromSC) end if if (RegCheckErr(Buf, RoutineName)) return @@ -974,7 +974,7 @@ subroutine FWrap_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FWrap_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1014,14 +1014,14 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC) - UB(1:1) = ubound(SrcOutputData%toSC) + LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) if (.not. allocated(DstOutputData%toSC)) then allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1039,8 +1039,8 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%D_rotor = SrcOutputData%D_rotor DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel if (allocated(SrcOutputData%AzimAvg_Ct)) then - LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct) - UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct) + LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct, kind=B8Ki) if (.not. allocated(DstOutputData%AzimAvg_Ct)) then allocate(DstOutputData%AzimAvg_Ct(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1051,8 +1051,8 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct end if if (allocated(SrcOutputData%AzimAvg_Cq)) then - LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) - UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq) + LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq, kind=B8Ki) if (.not. allocated(DstOutputData%AzimAvg_Cq)) then allocate(DstOutputData%AzimAvg_Cq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1089,7 +1089,7 @@ subroutine FWrap_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) call RegPack(Buf, InData%toSC) end if call RegPack(Buf, InData%xHat_Disk) @@ -1101,12 +1101,12 @@ subroutine FWrap_PackOutput(Buf, Indata) call RegPack(Buf, InData%DiskAvg_Vx_Rel) call RegPack(Buf, allocated(InData%AzimAvg_Ct)) if (allocated(InData%AzimAvg_Ct)) then - call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Ct), ubound(InData%AzimAvg_Ct)) + call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Ct, kind=B8Ki), ubound(InData%AzimAvg_Ct, kind=B8Ki)) call RegPack(Buf, InData%AzimAvg_Ct) end if call RegPack(Buf, allocated(InData%AzimAvg_Cq)) if (allocated(InData%AzimAvg_Cq)) then - call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Cq), ubound(InData%AzimAvg_Cq)) + call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Cq, kind=B8Ki), ubound(InData%AzimAvg_Cq, kind=B8Ki)) call RegPack(Buf, InData%AzimAvg_Cq) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1116,7 +1116,7 @@ subroutine FWrap_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FWrap_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index c4582b0b6e..c7bdc1d425 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -197,8 +197,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyParam' @@ -213,8 +213,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SC_FileName = SrcParamData%SC_FileName DstParamData%UseSC = SrcParamData%UseSC if (allocated(SrcParamData%WT_Position)) then - LB(1:2) = lbound(SrcParamData%WT_Position) - UB(1:2) = ubound(SrcParamData%WT_Position) + LB(1:2) = lbound(SrcParamData%WT_Position, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%WT_Position, kind=B8Ki) if (.not. allocated(DstParamData%WT_Position)) then allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -230,8 +230,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DT_mooring = SrcParamData%DT_mooring DstParamData%n_mooring = SrcParamData%n_mooring if (allocated(SrcParamData%WT_FASTInFile)) then - LB(1:1) = lbound(SrcParamData%WT_FASTInFile) - UB(1:1) = ubound(SrcParamData%WT_FASTInFile) + LB(1:1) = lbound(SrcParamData%WT_FASTInFile, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WT_FASTInFile, kind=B8Ki) if (.not. allocated(DstParamData%WT_FASTInFile)) then allocate(DstParamData%WT_FASTInFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -257,8 +257,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NOutTurb = SrcParamData%NOutTurb DstParamData%NOutRadii = SrcParamData%NOutRadii if (allocated(SrcParamData%OutRadii)) then - LB(1:1) = lbound(SrcParamData%OutRadii) - UB(1:1) = ubound(SrcParamData%OutRadii) + LB(1:1) = lbound(SrcParamData%OutRadii, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutRadii, kind=B8Ki) if (.not. allocated(DstParamData%OutRadii)) then allocate(DstParamData%OutRadii(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -270,8 +270,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDist = SrcParamData%NOutDist if (allocated(SrcParamData%OutDist)) then - LB(1:1) = lbound(SrcParamData%OutDist) - UB(1:1) = ubound(SrcParamData%OutDist) + LB(1:1) = lbound(SrcParamData%OutDist, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutDist, kind=B8Ki) if (.not. allocated(DstParamData%OutDist)) then allocate(DstParamData%OutDist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -283,8 +283,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NWindVel = SrcParamData%NWindVel if (allocated(SrcParamData%WindVelX)) then - LB(1:1) = lbound(SrcParamData%WindVelX) - UB(1:1) = ubound(SrcParamData%WindVelX) + LB(1:1) = lbound(SrcParamData%WindVelX, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WindVelX, kind=B8Ki) if (.not. allocated(DstParamData%WindVelX)) then allocate(DstParamData%WindVelX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -295,8 +295,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelX = SrcParamData%WindVelX end if if (allocated(SrcParamData%WindVelY)) then - LB(1:1) = lbound(SrcParamData%WindVelY) - UB(1:1) = ubound(SrcParamData%WindVelY) + LB(1:1) = lbound(SrcParamData%WindVelY, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WindVelY, kind=B8Ki) if (.not. allocated(DstParamData%WindVelY)) then allocate(DstParamData%WindVelY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -307,8 +307,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelY = SrcParamData%WindVelY end if if (allocated(SrcParamData%WindVelZ)) then - LB(1:1) = lbound(SrcParamData%WindVelZ) - UB(1:1) = ubound(SrcParamData%WindVelZ) + LB(1:1) = lbound(SrcParamData%WindVelZ, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WindVelZ, kind=B8Ki) if (.not. allocated(DstParamData%WindVelZ)) then allocate(DstParamData%WindVelZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -319,8 +319,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelZ = SrcParamData%WindVelZ end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -337,8 +337,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%NOutSteps = SrcParamData%NOutSteps DstParamData%FileDescLines = SrcParamData%FileDescLines - LB(1:1) = lbound(SrcParamData%Module_Ver) - UB(1:1) = ubound(SrcParamData%Module_Ver) + LB(1:1) = lbound(SrcParamData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -360,8 +360,8 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) type(Farm_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyParam' @@ -389,16 +389,16 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WindVelZ) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ParamData%OutParam) end if - LB(1:1) = lbound(ParamData%Module_Ver) - UB(1:1) = ubound(ParamData%Module_Ver) + LB(1:1) = lbound(ParamData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(ParamData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyProgDesc(ParamData%Module_Ver(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -409,8 +409,8 @@ subroutine Farm_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Farm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT_low) call RegPack(Buf, InData%DT_high) @@ -422,7 +422,7 @@ subroutine Farm_PackParam(Buf, Indata) call RegPack(Buf, InData%UseSC) call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then - call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPackBounds(Buf, 2, lbound(InData%WT_Position, kind=B8Ki), ubound(InData%WT_Position, kind=B8Ki)) call RegPack(Buf, InData%WT_Position) end if call RegPack(Buf, InData%WaveFieldMod) @@ -432,7 +432,7 @@ subroutine Farm_PackParam(Buf, Indata) call RegPack(Buf, InData%n_mooring) call RegPack(Buf, allocated(InData%WT_FASTInFile)) if (allocated(InData%WT_FASTInFile)) then - call RegPackBounds(Buf, 1, lbound(InData%WT_FASTInFile), ubound(InData%WT_FASTInFile)) + call RegPackBounds(Buf, 1, lbound(InData%WT_FASTInFile, kind=B8Ki), ubound(InData%WT_FASTInFile, kind=B8Ki)) call RegPack(Buf, InData%WT_FASTInFile) end if call RegPack(Buf, InData%FTitle) @@ -452,36 +452,36 @@ subroutine Farm_PackParam(Buf, Indata) call RegPack(Buf, InData%NOutRadii) call RegPack(Buf, allocated(InData%OutRadii)) if (allocated(InData%OutRadii)) then - call RegPackBounds(Buf, 1, lbound(InData%OutRadii), ubound(InData%OutRadii)) + call RegPackBounds(Buf, 1, lbound(InData%OutRadii, kind=B8Ki), ubound(InData%OutRadii, kind=B8Ki)) call RegPack(Buf, InData%OutRadii) end if call RegPack(Buf, InData%NOutDist) call RegPack(Buf, allocated(InData%OutDist)) if (allocated(InData%OutDist)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDist), ubound(InData%OutDist)) + call RegPackBounds(Buf, 1, lbound(InData%OutDist, kind=B8Ki), ubound(InData%OutDist, kind=B8Ki)) call RegPack(Buf, InData%OutDist) end if call RegPack(Buf, InData%NWindVel) call RegPack(Buf, allocated(InData%WindVelX)) if (allocated(InData%WindVelX)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVelX), ubound(InData%WindVelX)) + call RegPackBounds(Buf, 1, lbound(InData%WindVelX, kind=B8Ki), ubound(InData%WindVelX, kind=B8Ki)) call RegPack(Buf, InData%WindVelX) end if call RegPack(Buf, allocated(InData%WindVelY)) if (allocated(InData%WindVelY)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVelY), ubound(InData%WindVelY)) + call RegPackBounds(Buf, 1, lbound(InData%WindVelY, kind=B8Ki), ubound(InData%WindVelY, kind=B8Ki)) call RegPack(Buf, InData%WindVelY) end if call RegPack(Buf, allocated(InData%WindVelZ)) if (allocated(InData%WindVelZ)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVelZ), ubound(InData%WindVelZ)) + call RegPackBounds(Buf, 1, lbound(InData%WindVelZ, kind=B8Ki), ubound(InData%WindVelZ, kind=B8Ki)) call RegPack(Buf, InData%WindVelZ) end if call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -489,8 +489,8 @@ subroutine Farm_PackParam(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, InData%NOutSteps) call RegPack(Buf, InData%FileDescLines) - LB(1:1) = lbound(InData%Module_Ver) - UB(1:1) = ubound(InData%Module_Ver) + LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) end do @@ -511,8 +511,8 @@ subroutine Farm_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Farm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -695,8 +695,8 @@ subroutine Farm_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%FileDescLines) if (RegCheckErr(Buf, RoutineName)) return - LB(1:1) = lbound(OutData%Module_Ver) - UB(1:1) = ubound(OutData%Module_Ver) + LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver end do @@ -728,16 +728,16 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -748,8 +748,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%TimeData)) then - LB(1:1) = lbound(SrcMiscData%TimeData) - UB(1:1) = ubound(SrcMiscData%TimeData) + LB(1:1) = lbound(SrcMiscData%TimeData, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%TimeData, kind=B8Ki) if (.not. allocated(DstMiscData%TimeData)) then allocate(DstMiscData%TimeData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -760,8 +760,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TimeData = SrcMiscData%TimeData end if if (allocated(SrcMiscData%AllOutData)) then - LB(1:2) = lbound(SrcMiscData%AllOutData) - UB(1:2) = ubound(SrcMiscData%AllOutData) + LB(1:2) = lbound(SrcMiscData%AllOutData, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AllOutData, kind=B8Ki) if (.not. allocated(DstMiscData%AllOutData)) then allocate(DstMiscData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -773,8 +773,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%n_Out = SrcMiscData%n_Out if (allocated(SrcMiscData%FWrap_2_MD)) then - LB(1:1) = lbound(SrcMiscData%FWrap_2_MD) - UB(1:1) = ubound(SrcMiscData%FWrap_2_MD) + LB(1:1) = lbound(SrcMiscData%FWrap_2_MD, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FWrap_2_MD, kind=B8Ki) if (.not. allocated(DstMiscData%FWrap_2_MD)) then allocate(DstMiscData%FWrap_2_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -789,8 +789,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%MD_2_FWrap)) then - LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) - UB(1:1) = ubound(SrcMiscData%MD_2_FWrap) + LB(1:1) = lbound(SrcMiscData%MD_2_FWrap, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%MD_2_FWrap, kind=B8Ki) if (.not. allocated(DstMiscData%MD_2_FWrap)) then allocate(DstMiscData%MD_2_FWrap(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -810,8 +810,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Farm_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyMisc' @@ -827,8 +827,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%AllOutData) end if if (allocated(MiscData%FWrap_2_MD)) then - LB(1:1) = lbound(MiscData%FWrap_2_MD) - UB(1:1) = ubound(MiscData%FWrap_2_MD) + LB(1:1) = lbound(MiscData%FWrap_2_MD, kind=B8Ki) + UB(1:1) = ubound(MiscData%FWrap_2_MD, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -836,8 +836,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%FWrap_2_MD) end if if (allocated(MiscData%MD_2_FWrap)) then - LB(1:1) = lbound(MiscData%MD_2_FWrap) - UB(1:1) = ubound(MiscData%MD_2_FWrap) + LB(1:1) = lbound(MiscData%MD_2_FWrap, kind=B8Ki) + UB(1:1) = ubound(MiscData%MD_2_FWrap, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -850,39 +850,39 @@ subroutine Farm_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Farm_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, allocated(InData%TimeData)) if (allocated(InData%TimeData)) then - call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPackBounds(Buf, 1, lbound(InData%TimeData, kind=B8Ki), ubound(InData%TimeData, kind=B8Ki)) call RegPack(Buf, InData%TimeData) end if call RegPack(Buf, allocated(InData%AllOutData)) if (allocated(InData%AllOutData)) then - call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPackBounds(Buf, 2, lbound(InData%AllOutData, kind=B8Ki), ubound(InData%AllOutData, kind=B8Ki)) call RegPack(Buf, InData%AllOutData) end if call RegPack(Buf, InData%n_Out) call RegPack(Buf, allocated(InData%FWrap_2_MD)) if (allocated(InData%FWrap_2_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) - LB(1:1) = lbound(InData%FWrap_2_MD) - UB(1:1) = ubound(InData%FWrap_2_MD) + call RegPackBounds(Buf, 1, lbound(InData%FWrap_2_MD, kind=B8Ki), ubound(InData%FWrap_2_MD, kind=B8Ki)) + LB(1:1) = lbound(InData%FWrap_2_MD, kind=B8Ki) + UB(1:1) = ubound(InData%FWrap_2_MD, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%FWrap_2_MD(i1)) end do end if call RegPack(Buf, allocated(InData%MD_2_FWrap)) if (allocated(InData%MD_2_FWrap)) then - call RegPackBounds(Buf, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) - LB(1:1) = lbound(InData%MD_2_FWrap) - UB(1:1) = ubound(InData%MD_2_FWrap) + call RegPackBounds(Buf, 1, lbound(InData%MD_2_FWrap, kind=B8Ki), ubound(InData%MD_2_FWrap, kind=B8Ki)) + LB(1:1) = lbound(InData%MD_2_FWrap, kind=B8Ki) + UB(1:1) = ubound(InData%MD_2_FWrap, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%MD_2_FWrap(i1)) end do @@ -894,8 +894,8 @@ subroutine Farm_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Farm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1381,8 +1381,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyMD_Data' @@ -1407,8 +1407,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMD_DataData%Input)) then - LB(1:1) = lbound(SrcMD_DataData%Input) - UB(1:1) = ubound(SrcMD_DataData%Input) + LB(1:1) = lbound(SrcMD_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcMD_DataData%Input, kind=B8Ki) if (.not. allocated(DstMD_DataData%Input)) then allocate(DstMD_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1423,8 +1423,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E end do end if if (allocated(SrcMD_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMD_DataData%InputTimes) - UB(1:1) = ubound(SrcMD_DataData%InputTimes) + LB(1:1) = lbound(SrcMD_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcMD_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstMD_DataData%InputTimes)) then allocate(DstMD_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1447,8 +1447,8 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) type(MD_Data), intent(inout) :: MD_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' @@ -1467,8 +1467,8 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) call MD_DestroyInput(MD_DataData%u, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MD_DataData%Input)) then - LB(1:1) = lbound(MD_DataData%Input) - UB(1:1) = ubound(MD_DataData%Input) + LB(1:1) = lbound(MD_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(MD_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyInput(MD_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1488,8 +1488,8 @@ subroutine Farm_PackMD_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMD_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MD_PackContState(Buf, InData%x) call MD_PackDiscState(Buf, InData%xd) @@ -1499,16 +1499,16 @@ subroutine Farm_PackMD_Data(Buf, Indata) call MD_PackInput(Buf, InData%u) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if call MD_PackOutput(Buf, InData%y) @@ -1521,8 +1521,8 @@ subroutine Farm_UnPackMD_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1573,8 +1573,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyAll_FastFarm_Data' @@ -1587,8 +1587,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAll_FastFarm_DataData%FWrap)) then - LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap) - UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap) + LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap, kind=B8Ki) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap, kind=B8Ki) if (.not. allocated(DstAll_FastFarm_DataData%FWrap)) then allocate(DstAll_FastFarm_DataData%FWrap(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1603,8 +1603,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ end do end if if (allocated(SrcAll_FastFarm_DataData%WD)) then - LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) - UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD) + LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD, kind=B8Ki) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD, kind=B8Ki) if (.not. allocated(DstAll_FastFarm_DataData%WD)) then allocate(DstAll_FastFarm_DataData%WD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1633,8 +1633,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) type(All_FastFarm_Data), intent(inout) :: All_FastFarm_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' @@ -1645,8 +1645,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) call Farm_DestroyMisc(All_FastFarm_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(All_FastFarm_DataData%FWrap)) then - LB(1:1) = lbound(All_FastFarm_DataData%FWrap) - UB(1:1) = ubound(All_FastFarm_DataData%FWrap) + LB(1:1) = lbound(All_FastFarm_DataData%FWrap, kind=B8Ki) + UB(1:1) = ubound(All_FastFarm_DataData%FWrap, kind=B8Ki) do i1 = LB(1), UB(1) call Farm_DestroyFASTWrapper_Data(All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1654,8 +1654,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) deallocate(All_FastFarm_DataData%FWrap) end if if (allocated(All_FastFarm_DataData%WD)) then - LB(1:1) = lbound(All_FastFarm_DataData%WD) - UB(1:1) = ubound(All_FastFarm_DataData%WD) + LB(1:1) = lbound(All_FastFarm_DataData%WD, kind=B8Ki) + UB(1:1) = ubound(All_FastFarm_DataData%WD, kind=B8Ki) do i1 = LB(1), UB(1) call Farm_DestroyWakeDynamics_Data(All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1674,25 +1674,25 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(All_FastFarm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call Farm_PackParam(Buf, InData%p) call Farm_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%FWrap)) if (allocated(InData%FWrap)) then - call RegPackBounds(Buf, 1, lbound(InData%FWrap), ubound(InData%FWrap)) - LB(1:1) = lbound(InData%FWrap) - UB(1:1) = ubound(InData%FWrap) + call RegPackBounds(Buf, 1, lbound(InData%FWrap, kind=B8Ki), ubound(InData%FWrap, kind=B8Ki)) + LB(1:1) = lbound(InData%FWrap, kind=B8Ki) + UB(1:1) = ubound(InData%FWrap, kind=B8Ki) do i1 = LB(1), UB(1) call Farm_PackFASTWrapper_Data(Buf, InData%FWrap(i1)) end do end if call RegPack(Buf, allocated(InData%WD)) if (allocated(InData%WD)) then - call RegPackBounds(Buf, 1, lbound(InData%WD), ubound(InData%WD)) - LB(1:1) = lbound(InData%WD) - UB(1:1) = ubound(InData%WD) + call RegPackBounds(Buf, 1, lbound(InData%WD, kind=B8Ki), ubound(InData%WD, kind=B8Ki)) + LB(1:1) = lbound(InData%WD, kind=B8Ki) + UB(1:1) = ubound(InData%WD, kind=B8Ki) do i1 = LB(1), UB(1) call Farm_PackWakeDynamics_Data(Buf, InData%WD(i1)) end do @@ -1707,8 +1707,8 @@ subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(All_FastFarm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index ce44f2d6cd..991e744710 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -328,8 +328,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitInput' @@ -340,8 +340,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%BlSpn)) then - LB(1:2) = lbound(SrcInitInputData%BlSpn) - UB(1:2) = ubound(SrcInitInputData%BlSpn) + LB(1:2) = lbound(SrcInitInputData%BlSpn, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%BlSpn, kind=B8Ki) if (.not. allocated(DstInitInputData%BlSpn)) then allocate(DstInitInputData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -352,8 +352,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%BlSpn = SrcInitInputData%BlSpn end if if (allocated(SrcInitInputData%BlChord)) then - LB(1:2) = lbound(SrcInitInputData%BlChord) - UB(1:2) = ubound(SrcInitInputData%BlChord) + LB(1:2) = lbound(SrcInitInputData%BlChord, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%BlChord, kind=B8Ki) if (.not. allocated(DstInitInputData%BlChord)) then allocate(DstInitInputData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -368,8 +368,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%SpdSound = SrcInitInputData%SpdSound DstInitInputData%HubHeight = SrcInitInputData%HubHeight if (allocated(SrcInitInputData%BlAFID)) then - LB(1:2) = lbound(SrcInitInputData%BlAFID) - UB(1:2) = ubound(SrcInitInputData%BlAFID) + LB(1:2) = lbound(SrcInitInputData%BlAFID, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%BlAFID, kind=B8Ki) if (.not. allocated(DstInitInputData%BlAFID)) then allocate(DstInitInputData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -380,8 +380,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%BlAFID = SrcInitInputData%BlAFID end if if (allocated(SrcInitInputData%AFInfo)) then - LB(1:1) = lbound(SrcInitInputData%AFInfo) - UB(1:1) = ubound(SrcInitInputData%AFInfo) + LB(1:1) = lbound(SrcInitInputData%AFInfo, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%AFInfo, kind=B8Ki) if (.not. allocated(DstInitInputData%AFInfo)) then allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -401,8 +401,8 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AA_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInitInput' @@ -418,8 +418,8 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%BlAFID) end if if (allocated(InitInputData%AFInfo)) then - LB(1:1) = lbound(InitInputData%AFInfo) - UB(1:1) = ubound(InitInputData%AFInfo) + LB(1:1) = lbound(InitInputData%AFInfo, kind=B8Ki) + UB(1:1) = ubound(InitInputData%AFInfo, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -432,8 +432,8 @@ subroutine AA_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) call RegPack(Buf, InData%NumBlades) @@ -441,12 +441,12 @@ subroutine AA_PackInitInput(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then - call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPackBounds(Buf, 2, lbound(InData%BlSpn, kind=B8Ki), ubound(InData%BlSpn, kind=B8Ki)) call RegPack(Buf, InData%BlSpn) end if call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then - call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPackBounds(Buf, 2, lbound(InData%BlChord, kind=B8Ki), ubound(InData%BlChord, kind=B8Ki)) call RegPack(Buf, InData%BlChord) end if call RegPack(Buf, InData%AirDens) @@ -455,14 +455,14 @@ subroutine AA_PackInitInput(Buf, Indata) call RegPack(Buf, InData%HubHeight) call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPackBounds(Buf, 2, lbound(InData%BlAFID, kind=B8Ki), ubound(InData%BlAFID, kind=B8Ki)) call RegPack(Buf, InData%BlAFID) end if call RegPack(Buf, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) - LB(1:1) = lbound(InData%AFInfo) - UB(1:1) = ubound(InData%AFInfo) + call RegPackBounds(Buf, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) + LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) + UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_PackParam(Buf, InData%AFInfo(i1)) end do @@ -474,8 +474,8 @@ subroutine AA_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -560,15 +560,15 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -579,8 +579,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -591,8 +591,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdrforPE)) then allocate(DstInitOutputData%WriteOutputHdrforPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -603,8 +603,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE end if if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUntforPE)) then allocate(DstInitOutputData%WriteOutputUntforPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -615,8 +615,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE end if if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdrSep)) then allocate(DstInitOutputData%WriteOutputHdrSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -627,8 +627,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep end if if (allocated(SrcInitOutputData%WriteOutputUntSep)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUntSep)) then allocate(DstInitOutputData%WriteOutputUntSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -639,8 +639,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep end if if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdrNodes)) then allocate(DstInitOutputData%WriteOutputHdrNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -651,8 +651,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes end if if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUntNodes)) then allocate(DstInitOutputData%WriteOutputUntNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -713,42 +713,42 @@ subroutine AA_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call RegPack(Buf, allocated(InData%WriteOutputHdrforPE)) if (allocated(InData%WriteOutputHdrforPE)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE), ubound(InData%WriteOutputHdrforPE)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE, kind=B8Ki), ubound(InData%WriteOutputHdrforPE, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdrforPE) end if call RegPack(Buf, allocated(InData%WriteOutputUntforPE)) if (allocated(InData%WriteOutputUntforPE)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE), ubound(InData%WriteOutputUntforPE)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE, kind=B8Ki), ubound(InData%WriteOutputUntforPE, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUntforPE) end if call RegPack(Buf, allocated(InData%WriteOutputHdrSep)) if (allocated(InData%WriteOutputHdrSep)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep), ubound(InData%WriteOutputHdrSep)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep, kind=B8Ki), ubound(InData%WriteOutputHdrSep, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdrSep) end if call RegPack(Buf, allocated(InData%WriteOutputUntSep)) if (allocated(InData%WriteOutputUntSep)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep), ubound(InData%WriteOutputUntSep)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep, kind=B8Ki), ubound(InData%WriteOutputUntSep, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUntSep) end if call RegPack(Buf, allocated(InData%WriteOutputHdrNodes)) if (allocated(InData%WriteOutputHdrNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes), ubound(InData%WriteOutputHdrNodes)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes, kind=B8Ki), ubound(InData%WriteOutputHdrNodes, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdrNodes) end if call RegPack(Buf, allocated(InData%WriteOutputUntNodes)) if (allocated(InData%WriteOutputUntNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes), ubound(InData%WriteOutputUntNodes)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes, kind=B8Ki), ubound(InData%WriteOutputUntNodes, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUntNodes) end if call RegPack(Buf, InData%delim) @@ -761,7 +761,7 @@ subroutine AA_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -890,8 +890,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInputFile' @@ -913,8 +913,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc if (allocated(SrcInputFileData%ObsX)) then - LB(1:1) = lbound(SrcInputFileData%ObsX) - UB(1:1) = ubound(SrcInputFileData%ObsX) + LB(1:1) = lbound(SrcInputFileData%ObsX, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%ObsX, kind=B8Ki) if (.not. allocated(DstInputFileData%ObsX)) then allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -925,8 +925,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsX = SrcInputFileData%ObsX end if if (allocated(SrcInputFileData%ObsY)) then - LB(1:1) = lbound(SrcInputFileData%ObsY) - UB(1:1) = ubound(SrcInputFileData%ObsY) + LB(1:1) = lbound(SrcInputFileData%ObsY, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%ObsY, kind=B8Ki) if (.not. allocated(DstInputFileData%ObsY)) then allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -937,8 +937,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsY = SrcInputFileData%ObsY end if if (allocated(SrcInputFileData%ObsZ)) then - LB(1:1) = lbound(SrcInputFileData%ObsZ) - UB(1:1) = ubound(SrcInputFileData%ObsZ) + LB(1:1) = lbound(SrcInputFileData%ObsZ, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%ObsZ, kind=B8Ki) if (.not. allocated(DstInputFileData%ObsZ)) then allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -949,8 +949,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsZ = SrcInputFileData%ObsZ end if if (allocated(SrcInputFileData%BladeProps)) then - LB(1:1) = lbound(SrcInputFileData%BladeProps) - UB(1:1) = ubound(SrcInputFileData%BladeProps) + LB(1:1) = lbound(SrcInputFileData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BladeProps, kind=B8Ki) if (.not. allocated(DstInputFileData%BladeProps)) then allocate(DstInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -966,8 +966,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile if (allocated(SrcInputFileData%AAoutfile)) then - LB(1:1) = lbound(SrcInputFileData%AAoutfile) - UB(1:1) = ubound(SrcInputFileData%AAoutfile) + LB(1:1) = lbound(SrcInputFileData%AAoutfile, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%AAoutfile, kind=B8Ki) if (.not. allocated(DstInputFileData%AAoutfile)) then allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -983,8 +983,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Lturb = SrcInputFileData%Lturb DstInputFileData%AvgV = SrcInputFileData%AvgV if (allocated(SrcInputFileData%ReListBL)) then - LB(1:1) = lbound(SrcInputFileData%ReListBL) - UB(1:1) = ubound(SrcInputFileData%ReListBL) + LB(1:1) = lbound(SrcInputFileData%ReListBL, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%ReListBL, kind=B8Ki) if (.not. allocated(DstInputFileData%ReListBL)) then allocate(DstInputFileData%ReListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -995,8 +995,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ReListBL = SrcInputFileData%ReListBL end if if (allocated(SrcInputFileData%AoAListBL)) then - LB(1:1) = lbound(SrcInputFileData%AoAListBL) - UB(1:1) = ubound(SrcInputFileData%AoAListBL) + LB(1:1) = lbound(SrcInputFileData%AoAListBL, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%AoAListBL, kind=B8Ki) if (.not. allocated(DstInputFileData%AoAListBL)) then allocate(DstInputFileData%AoAListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1007,8 +1007,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL end if if (allocated(SrcInputFileData%Pres_DispThick)) then - LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) - UB(1:3) = ubound(SrcInputFileData%Pres_DispThick) + LB(1:3) = lbound(SrcInputFileData%Pres_DispThick, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Pres_DispThick, kind=B8Ki) if (.not. allocated(DstInputFileData%Pres_DispThick)) then allocate(DstInputFileData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1019,8 +1019,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick end if if (allocated(SrcInputFileData%Suct_DispThick)) then - LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) - UB(1:3) = ubound(SrcInputFileData%Suct_DispThick) + LB(1:3) = lbound(SrcInputFileData%Suct_DispThick, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Suct_DispThick, kind=B8Ki) if (.not. allocated(DstInputFileData%Suct_DispThick)) then allocate(DstInputFileData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1031,8 +1031,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick end if if (allocated(SrcInputFileData%Pres_BLThick)) then - LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) - UB(1:3) = ubound(SrcInputFileData%Pres_BLThick) + LB(1:3) = lbound(SrcInputFileData%Pres_BLThick, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Pres_BLThick, kind=B8Ki) if (.not. allocated(DstInputFileData%Pres_BLThick)) then allocate(DstInputFileData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1043,8 +1043,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick end if if (allocated(SrcInputFileData%Suct_BLThick)) then - LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) - UB(1:3) = ubound(SrcInputFileData%Suct_BLThick) + LB(1:3) = lbound(SrcInputFileData%Suct_BLThick, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Suct_BLThick, kind=B8Ki) if (.not. allocated(DstInputFileData%Suct_BLThick)) then allocate(DstInputFileData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1055,8 +1055,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick end if if (allocated(SrcInputFileData%Pres_Cf)) then - LB(1:3) = lbound(SrcInputFileData%Pres_Cf) - UB(1:3) = ubound(SrcInputFileData%Pres_Cf) + LB(1:3) = lbound(SrcInputFileData%Pres_Cf, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Pres_Cf, kind=B8Ki) if (.not. allocated(DstInputFileData%Pres_Cf)) then allocate(DstInputFileData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1067,8 +1067,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf end if if (allocated(SrcInputFileData%Suct_Cf)) then - LB(1:3) = lbound(SrcInputFileData%Suct_Cf) - UB(1:3) = ubound(SrcInputFileData%Suct_Cf) + LB(1:3) = lbound(SrcInputFileData%Suct_Cf, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Suct_Cf, kind=B8Ki) if (.not. allocated(DstInputFileData%Suct_Cf)) then allocate(DstInputFileData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1079,8 +1079,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf end if if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then - LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) - UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat) + LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat, kind=B8Ki) if (.not. allocated(DstInputFileData%Pres_EdgeVelRat)) then allocate(DstInputFileData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1091,8 +1091,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat end if if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then - LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) - UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat) + LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat, kind=B8Ki) if (.not. allocated(DstInputFileData%Suct_EdgeVelRat)) then allocate(DstInputFileData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1103,8 +1103,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat end if if (allocated(SrcInputFileData%TI_Grid_In)) then - LB(1:2) = lbound(SrcInputFileData%TI_Grid_In) - UB(1:2) = ubound(SrcInputFileData%TI_Grid_In) + LB(1:2) = lbound(SrcInputFileData%TI_Grid_In, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileData%TI_Grid_In, kind=B8Ki) if (.not. allocated(DstInputFileData%TI_Grid_In)) then allocate(DstInputFileData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1122,8 +1122,8 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(AA_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInputFile' @@ -1139,8 +1139,8 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%ObsZ) end if if (allocated(InputFileData%BladeProps)) then - LB(1:1) = lbound(InputFileData%BladeProps) - UB(1:1) = ubound(InputFileData%BladeProps) + LB(1:1) = lbound(InputFileData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(InputFileData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) call AA_DestroyBladePropsType(InputFileData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1189,8 +1189,8 @@ subroutine AA_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInputFile' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT_AA) call RegPack(Buf, InData%IBLUNT) @@ -1209,24 +1209,24 @@ subroutine AA_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NrObsLoc) call RegPack(Buf, allocated(InData%ObsX)) if (allocated(InData%ObsX)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) + call RegPackBounds(Buf, 1, lbound(InData%ObsX, kind=B8Ki), ubound(InData%ObsX, kind=B8Ki)) call RegPack(Buf, InData%ObsX) end if call RegPack(Buf, allocated(InData%ObsY)) if (allocated(InData%ObsY)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) + call RegPackBounds(Buf, 1, lbound(InData%ObsY, kind=B8Ki), ubound(InData%ObsY, kind=B8Ki)) call RegPack(Buf, InData%ObsY) end if call RegPack(Buf, allocated(InData%ObsZ)) if (allocated(InData%ObsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) + call RegPackBounds(Buf, 1, lbound(InData%ObsZ, kind=B8Ki), ubound(InData%ObsZ, kind=B8Ki)) call RegPack(Buf, InData%ObsZ) end if call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) - LB(1:1) = lbound(InData%BladeProps) - UB(1:1) = ubound(InData%BladeProps) + call RegPackBounds(Buf, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) call AA_PackBladePropsType(Buf, InData%BladeProps(i1)) end do @@ -1234,7 +1234,7 @@ subroutine AA_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NrOutFile) call RegPack(Buf, allocated(InData%AAoutfile)) if (allocated(InData%AAoutfile)) then - call RegPackBounds(Buf, 1, lbound(InData%AAoutfile), ubound(InData%AAoutfile)) + call RegPackBounds(Buf, 1, lbound(InData%AAoutfile, kind=B8Ki), ubound(InData%AAoutfile, kind=B8Ki)) call RegPack(Buf, InData%AAoutfile) end if call RegPack(Buf, InData%TICalcTabFile) @@ -1244,57 +1244,57 @@ subroutine AA_PackInputFile(Buf, Indata) call RegPack(Buf, InData%AvgV) call RegPack(Buf, allocated(InData%ReListBL)) if (allocated(InData%ReListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) + call RegPackBounds(Buf, 1, lbound(InData%ReListBL, kind=B8Ki), ubound(InData%ReListBL, kind=B8Ki)) call RegPack(Buf, InData%ReListBL) end if call RegPack(Buf, allocated(InData%AoAListBL)) if (allocated(InData%AoAListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%AoAListBL), ubound(InData%AoAListBL)) + call RegPackBounds(Buf, 1, lbound(InData%AoAListBL, kind=B8Ki), ubound(InData%AoAListBL, kind=B8Ki)) call RegPack(Buf, InData%AoAListBL) end if call RegPack(Buf, allocated(InData%Pres_DispThick)) if (allocated(InData%Pres_DispThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick), ubound(InData%Pres_DispThick)) + call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick, kind=B8Ki), ubound(InData%Pres_DispThick, kind=B8Ki)) call RegPack(Buf, InData%Pres_DispThick) end if call RegPack(Buf, allocated(InData%Suct_DispThick)) if (allocated(InData%Suct_DispThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick), ubound(InData%Suct_DispThick)) + call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick, kind=B8Ki), ubound(InData%Suct_DispThick, kind=B8Ki)) call RegPack(Buf, InData%Suct_DispThick) end if call RegPack(Buf, allocated(InData%Pres_BLThick)) if (allocated(InData%Pres_BLThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick), ubound(InData%Pres_BLThick)) + call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick, kind=B8Ki), ubound(InData%Pres_BLThick, kind=B8Ki)) call RegPack(Buf, InData%Pres_BLThick) end if call RegPack(Buf, allocated(InData%Suct_BLThick)) if (allocated(InData%Suct_BLThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick), ubound(InData%Suct_BLThick)) + call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick, kind=B8Ki), ubound(InData%Suct_BLThick, kind=B8Ki)) call RegPack(Buf, InData%Suct_BLThick) end if call RegPack(Buf, allocated(InData%Pres_Cf)) if (allocated(InData%Pres_Cf)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf), ubound(InData%Pres_Cf)) + call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf, kind=B8Ki), ubound(InData%Pres_Cf, kind=B8Ki)) call RegPack(Buf, InData%Pres_Cf) end if call RegPack(Buf, allocated(InData%Suct_Cf)) if (allocated(InData%Suct_Cf)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf), ubound(InData%Suct_Cf)) + call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf, kind=B8Ki), ubound(InData%Suct_Cf, kind=B8Ki)) call RegPack(Buf, InData%Suct_Cf) end if call RegPack(Buf, allocated(InData%Pres_EdgeVelRat)) if (allocated(InData%Pres_EdgeVelRat)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat), ubound(InData%Pres_EdgeVelRat)) + call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat, kind=B8Ki), ubound(InData%Pres_EdgeVelRat, kind=B8Ki)) call RegPack(Buf, InData%Pres_EdgeVelRat) end if call RegPack(Buf, allocated(InData%Suct_EdgeVelRat)) if (allocated(InData%Suct_EdgeVelRat)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat), ubound(InData%Suct_EdgeVelRat)) + call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat, kind=B8Ki), ubound(InData%Suct_EdgeVelRat, kind=B8Ki)) call RegPack(Buf, InData%Suct_EdgeVelRat) end if call RegPack(Buf, allocated(InData%TI_Grid_In)) if (allocated(InData%TI_Grid_In)) then - call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) + call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In, kind=B8Ki), ubound(InData%TI_Grid_In, kind=B8Ki)) call RegPack(Buf, InData%TI_Grid_In) end if call RegPack(Buf, InData%dz_turb_in) @@ -1306,8 +1306,8 @@ subroutine AA_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInputFile' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1629,14 +1629,14 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%MeanVrel)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVrel) - UB(1:2) = ubound(SrcDiscStateData%MeanVrel) + LB(1:2) = lbound(SrcDiscStateData%MeanVrel, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%MeanVrel, kind=B8Ki) if (.not. allocated(DstDiscStateData%MeanVrel)) then allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1647,8 +1647,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel end if if (allocated(SrcDiscStateData%VrelSq)) then - LB(1:2) = lbound(SrcDiscStateData%VrelSq) - UB(1:2) = ubound(SrcDiscStateData%VrelSq) + LB(1:2) = lbound(SrcDiscStateData%VrelSq, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%VrelSq, kind=B8Ki) if (.not. allocated(DstDiscStateData%VrelSq)) then allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1659,8 +1659,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq end if if (allocated(SrcDiscStateData%TIVrel)) then - LB(1:2) = lbound(SrcDiscStateData%TIVrel) - UB(1:2) = ubound(SrcDiscStateData%TIVrel) + LB(1:2) = lbound(SrcDiscStateData%TIVrel, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%TIVrel, kind=B8Ki) if (.not. allocated(DstDiscStateData%TIVrel)) then allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1671,8 +1671,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel end if if (allocated(SrcDiscStateData%VrelStore)) then - LB(1:3) = lbound(SrcDiscStateData%VrelStore) - UB(1:3) = ubound(SrcDiscStateData%VrelStore) + LB(1:3) = lbound(SrcDiscStateData%VrelStore, kind=B8Ki) + UB(1:3) = ubound(SrcDiscStateData%VrelStore, kind=B8Ki) if (.not. allocated(DstDiscStateData%VrelStore)) then allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1683,8 +1683,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore end if if (allocated(SrcDiscStateData%TIVx)) then - LB(1:2) = lbound(SrcDiscStateData%TIVx) - UB(1:2) = ubound(SrcDiscStateData%TIVx) + LB(1:2) = lbound(SrcDiscStateData%TIVx, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%TIVx, kind=B8Ki) if (.not. allocated(DstDiscStateData%TIVx)) then allocate(DstDiscStateData%TIVx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1695,8 +1695,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TIVx = SrcDiscStateData%TIVx end if if (allocated(SrcDiscStateData%MeanVxVyVz)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) - UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) + LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz, kind=B8Ki) if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1707,8 +1707,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz end if if (allocated(SrcDiscStateData%VxSq)) then - LB(1:2) = lbound(SrcDiscStateData%VxSq) - UB(1:2) = ubound(SrcDiscStateData%VxSq) + LB(1:2) = lbound(SrcDiscStateData%VxSq, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%VxSq, kind=B8Ki) if (.not. allocated(DstDiscStateData%VxSq)) then allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1719,8 +1719,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VxSq = SrcDiscStateData%VxSq end if if (allocated(SrcDiscStateData%allregcounter)) then - LB(1:2) = lbound(SrcDiscStateData%allregcounter) - UB(1:2) = ubound(SrcDiscStateData%allregcounter) + LB(1:2) = lbound(SrcDiscStateData%allregcounter, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%allregcounter, kind=B8Ki) if (.not. allocated(DstDiscStateData%allregcounter)) then allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1731,8 +1731,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter end if if (allocated(SrcDiscStateData%VxSqRegion)) then - LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) - UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) + LB(1:2) = lbound(SrcDiscStateData%VxSqRegion, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%VxSqRegion, kind=B8Ki) if (.not. allocated(DstDiscStateData%VxSqRegion)) then allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1743,8 +1743,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion end if if (allocated(SrcDiscStateData%RegVxStor)) then - LB(1:3) = lbound(SrcDiscStateData%RegVxStor) - UB(1:3) = ubound(SrcDiscStateData%RegVxStor) + LB(1:3) = lbound(SrcDiscStateData%RegVxStor, kind=B8Ki) + UB(1:3) = ubound(SrcDiscStateData%RegVxStor, kind=B8Ki) if (.not. allocated(DstDiscStateData%RegVxStor)) then allocate(DstDiscStateData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1755,8 +1755,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor end if if (allocated(SrcDiscStateData%RegionTIDelete)) then - LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) - UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) + LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete, kind=B8Ki) if (.not. allocated(DstDiscStateData%RegionTIDelete)) then allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1817,57 +1817,57 @@ subroutine AA_PackDiscState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%MeanVrel)) if (allocated(InData%MeanVrel)) then - call RegPackBounds(Buf, 2, lbound(InData%MeanVrel), ubound(InData%MeanVrel)) + call RegPackBounds(Buf, 2, lbound(InData%MeanVrel, kind=B8Ki), ubound(InData%MeanVrel, kind=B8Ki)) call RegPack(Buf, InData%MeanVrel) end if call RegPack(Buf, allocated(InData%VrelSq)) if (allocated(InData%VrelSq)) then - call RegPackBounds(Buf, 2, lbound(InData%VrelSq), ubound(InData%VrelSq)) + call RegPackBounds(Buf, 2, lbound(InData%VrelSq, kind=B8Ki), ubound(InData%VrelSq, kind=B8Ki)) call RegPack(Buf, InData%VrelSq) end if call RegPack(Buf, allocated(InData%TIVrel)) if (allocated(InData%TIVrel)) then - call RegPackBounds(Buf, 2, lbound(InData%TIVrel), ubound(InData%TIVrel)) + call RegPackBounds(Buf, 2, lbound(InData%TIVrel, kind=B8Ki), ubound(InData%TIVrel, kind=B8Ki)) call RegPack(Buf, InData%TIVrel) end if call RegPack(Buf, allocated(InData%VrelStore)) if (allocated(InData%VrelStore)) then - call RegPackBounds(Buf, 3, lbound(InData%VrelStore), ubound(InData%VrelStore)) + call RegPackBounds(Buf, 3, lbound(InData%VrelStore, kind=B8Ki), ubound(InData%VrelStore, kind=B8Ki)) call RegPack(Buf, InData%VrelStore) end if call RegPack(Buf, allocated(InData%TIVx)) if (allocated(InData%TIVx)) then - call RegPackBounds(Buf, 2, lbound(InData%TIVx), ubound(InData%TIVx)) + call RegPackBounds(Buf, 2, lbound(InData%TIVx, kind=B8Ki), ubound(InData%TIVx, kind=B8Ki)) call RegPack(Buf, InData%TIVx) end if call RegPack(Buf, allocated(InData%MeanVxVyVz)) if (allocated(InData%MeanVxVyVz)) then - call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz), ubound(InData%MeanVxVyVz)) + call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz, kind=B8Ki), ubound(InData%MeanVxVyVz, kind=B8Ki)) call RegPack(Buf, InData%MeanVxVyVz) end if call RegPack(Buf, allocated(InData%VxSq)) if (allocated(InData%VxSq)) then - call RegPackBounds(Buf, 2, lbound(InData%VxSq), ubound(InData%VxSq)) + call RegPackBounds(Buf, 2, lbound(InData%VxSq, kind=B8Ki), ubound(InData%VxSq, kind=B8Ki)) call RegPack(Buf, InData%VxSq) end if call RegPack(Buf, allocated(InData%allregcounter)) if (allocated(InData%allregcounter)) then - call RegPackBounds(Buf, 2, lbound(InData%allregcounter), ubound(InData%allregcounter)) + call RegPackBounds(Buf, 2, lbound(InData%allregcounter, kind=B8Ki), ubound(InData%allregcounter, kind=B8Ki)) call RegPack(Buf, InData%allregcounter) end if call RegPack(Buf, allocated(InData%VxSqRegion)) if (allocated(InData%VxSqRegion)) then - call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion), ubound(InData%VxSqRegion)) + call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion, kind=B8Ki), ubound(InData%VxSqRegion, kind=B8Ki)) call RegPack(Buf, InData%VxSqRegion) end if call RegPack(Buf, allocated(InData%RegVxStor)) if (allocated(InData%RegVxStor)) then - call RegPackBounds(Buf, 3, lbound(InData%RegVxStor), ubound(InData%RegVxStor)) + call RegPackBounds(Buf, 3, lbound(InData%RegVxStor, kind=B8Ki), ubound(InData%RegVxStor, kind=B8Ki)) call RegPack(Buf, InData%RegVxStor) end if call RegPack(Buf, allocated(InData%RegionTIDelete)) if (allocated(InData%RegionTIDelete)) then - call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete), ubound(InData%RegionTIDelete)) + call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete, kind=B8Ki), ubound(InData%RegionTIDelete, kind=B8Ki)) call RegPack(Buf, InData%RegionTIDelete) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1877,7 +1877,7 @@ subroutine AA_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackDiscState' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2121,14 +2121,14 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2139,8 +2139,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%ChordAngleTE)) then - LB(1:3) = lbound(SrcMiscData%ChordAngleTE) - UB(1:3) = ubound(SrcMiscData%ChordAngleTE) + LB(1:3) = lbound(SrcMiscData%ChordAngleTE, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%ChordAngleTE, kind=B8Ki) if (.not. allocated(DstMiscData%ChordAngleTE)) then allocate(DstMiscData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2151,8 +2151,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE end if if (allocated(SrcMiscData%SpanAngleTE)) then - LB(1:3) = lbound(SrcMiscData%SpanAngleTE) - UB(1:3) = ubound(SrcMiscData%SpanAngleTE) + LB(1:3) = lbound(SrcMiscData%SpanAngleTE, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%SpanAngleTE, kind=B8Ki) if (.not. allocated(DstMiscData%SpanAngleTE)) then allocate(DstMiscData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2163,8 +2163,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE end if if (allocated(SrcMiscData%ChordAngleLE)) then - LB(1:3) = lbound(SrcMiscData%ChordAngleLE) - UB(1:3) = ubound(SrcMiscData%ChordAngleLE) + LB(1:3) = lbound(SrcMiscData%ChordAngleLE, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%ChordAngleLE, kind=B8Ki) if (.not. allocated(DstMiscData%ChordAngleLE)) then allocate(DstMiscData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2175,8 +2175,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE end if if (allocated(SrcMiscData%SpanAngleLE)) then - LB(1:3) = lbound(SrcMiscData%SpanAngleLE) - UB(1:3) = ubound(SrcMiscData%SpanAngleLE) + LB(1:3) = lbound(SrcMiscData%SpanAngleLE, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%SpanAngleLE, kind=B8Ki) if (.not. allocated(DstMiscData%SpanAngleLE)) then allocate(DstMiscData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2187,8 +2187,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE end if if (allocated(SrcMiscData%rTEtoObserve)) then - LB(1:3) = lbound(SrcMiscData%rTEtoObserve) - UB(1:3) = ubound(SrcMiscData%rTEtoObserve) + LB(1:3) = lbound(SrcMiscData%rTEtoObserve, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%rTEtoObserve, kind=B8Ki) if (.not. allocated(DstMiscData%rTEtoObserve)) then allocate(DstMiscData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2199,8 +2199,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve end if if (allocated(SrcMiscData%rLEtoObserve)) then - LB(1:3) = lbound(SrcMiscData%rLEtoObserve) - UB(1:3) = ubound(SrcMiscData%rLEtoObserve) + LB(1:3) = lbound(SrcMiscData%rLEtoObserve, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%rLEtoObserve, kind=B8Ki) if (.not. allocated(DstMiscData%rLEtoObserve)) then allocate(DstMiscData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2211,8 +2211,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve end if if (allocated(SrcMiscData%LE_Location)) then - LB(1:3) = lbound(SrcMiscData%LE_Location) - UB(1:3) = ubound(SrcMiscData%LE_Location) + LB(1:3) = lbound(SrcMiscData%LE_Location, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%LE_Location, kind=B8Ki) if (.not. allocated(DstMiscData%LE_Location)) then allocate(DstMiscData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2224,8 +2224,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA if (allocated(SrcMiscData%SPLLBL)) then - LB(1:1) = lbound(SrcMiscData%SPLLBL) - UB(1:1) = ubound(SrcMiscData%SPLLBL) + LB(1:1) = lbound(SrcMiscData%SPLLBL, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLLBL, kind=B8Ki) if (.not. allocated(DstMiscData%SPLLBL)) then allocate(DstMiscData%SPLLBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2236,8 +2236,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLLBL = SrcMiscData%SPLLBL end if if (allocated(SrcMiscData%SPLP)) then - LB(1:1) = lbound(SrcMiscData%SPLP) - UB(1:1) = ubound(SrcMiscData%SPLP) + LB(1:1) = lbound(SrcMiscData%SPLP, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLP, kind=B8Ki) if (.not. allocated(DstMiscData%SPLP)) then allocate(DstMiscData%SPLP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2248,8 +2248,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLP = SrcMiscData%SPLP end if if (allocated(SrcMiscData%SPLS)) then - LB(1:1) = lbound(SrcMiscData%SPLS) - UB(1:1) = ubound(SrcMiscData%SPLS) + LB(1:1) = lbound(SrcMiscData%SPLS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLS, kind=B8Ki) if (.not. allocated(DstMiscData%SPLS)) then allocate(DstMiscData%SPLS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2260,8 +2260,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLS = SrcMiscData%SPLS end if if (allocated(SrcMiscData%SPLALPH)) then - LB(1:1) = lbound(SrcMiscData%SPLALPH) - UB(1:1) = ubound(SrcMiscData%SPLALPH) + LB(1:1) = lbound(SrcMiscData%SPLALPH, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLALPH, kind=B8Ki) if (.not. allocated(DstMiscData%SPLALPH)) then allocate(DstMiscData%SPLALPH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2272,8 +2272,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLALPH = SrcMiscData%SPLALPH end if if (allocated(SrcMiscData%SPLTBL)) then - LB(1:1) = lbound(SrcMiscData%SPLTBL) - UB(1:1) = ubound(SrcMiscData%SPLTBL) + LB(1:1) = lbound(SrcMiscData%SPLTBL, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLTBL, kind=B8Ki) if (.not. allocated(DstMiscData%SPLTBL)) then allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2284,8 +2284,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTBL = SrcMiscData%SPLTBL end if if (allocated(SrcMiscData%SPLTIP)) then - LB(1:1) = lbound(SrcMiscData%SPLTIP) - UB(1:1) = ubound(SrcMiscData%SPLTIP) + LB(1:1) = lbound(SrcMiscData%SPLTIP, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLTIP, kind=B8Ki) if (.not. allocated(DstMiscData%SPLTIP)) then allocate(DstMiscData%SPLTIP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2296,8 +2296,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTIP = SrcMiscData%SPLTIP end if if (allocated(SrcMiscData%SPLTI)) then - LB(1:1) = lbound(SrcMiscData%SPLTI) - UB(1:1) = ubound(SrcMiscData%SPLTI) + LB(1:1) = lbound(SrcMiscData%SPLTI, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLTI, kind=B8Ki) if (.not. allocated(DstMiscData%SPLTI)) then allocate(DstMiscData%SPLTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2308,8 +2308,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTI = SrcMiscData%SPLTI end if if (allocated(SrcMiscData%SPLTIGui)) then - LB(1:1) = lbound(SrcMiscData%SPLTIGui) - UB(1:1) = ubound(SrcMiscData%SPLTIGui) + LB(1:1) = lbound(SrcMiscData%SPLTIGui, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLTIGui, kind=B8Ki) if (.not. allocated(DstMiscData%SPLTIGui)) then allocate(DstMiscData%SPLTIGui(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2320,8 +2320,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui end if if (allocated(SrcMiscData%SPLBLUNT)) then - LB(1:1) = lbound(SrcMiscData%SPLBLUNT) - UB(1:1) = ubound(SrcMiscData%SPLBLUNT) + LB(1:1) = lbound(SrcMiscData%SPLBLUNT, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SPLBLUNT, kind=B8Ki) if (.not. allocated(DstMiscData%SPLBLUNT)) then allocate(DstMiscData%SPLBLUNT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2332,8 +2332,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT end if if (allocated(SrcMiscData%CfVar)) then - LB(1:1) = lbound(SrcMiscData%CfVar) - UB(1:1) = ubound(SrcMiscData%CfVar) + LB(1:1) = lbound(SrcMiscData%CfVar, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%CfVar, kind=B8Ki) if (.not. allocated(DstMiscData%CfVar)) then allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2344,8 +2344,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CfVar = SrcMiscData%CfVar end if if (allocated(SrcMiscData%d99Var)) then - LB(1:1) = lbound(SrcMiscData%d99Var) - UB(1:1) = ubound(SrcMiscData%d99Var) + LB(1:1) = lbound(SrcMiscData%d99Var, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%d99Var, kind=B8Ki) if (.not. allocated(DstMiscData%d99Var)) then allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2356,8 +2356,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%d99Var = SrcMiscData%d99Var end if if (allocated(SrcMiscData%dStarVar)) then - LB(1:1) = lbound(SrcMiscData%dStarVar) - UB(1:1) = ubound(SrcMiscData%dStarVar) + LB(1:1) = lbound(SrcMiscData%dStarVar, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%dStarVar, kind=B8Ki) if (.not. allocated(DstMiscData%dStarVar)) then allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2368,8 +2368,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dStarVar = SrcMiscData%dStarVar end if if (allocated(SrcMiscData%EdgeVelVar)) then - LB(1:1) = lbound(SrcMiscData%EdgeVelVar) - UB(1:1) = ubound(SrcMiscData%EdgeVelVar) + LB(1:1) = lbound(SrcMiscData%EdgeVelVar, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%EdgeVelVar, kind=B8Ki) if (.not. allocated(DstMiscData%EdgeVelVar)) then allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2462,108 +2462,108 @@ subroutine AA_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, allocated(InData%ChordAngleTE)) if (allocated(InData%ChordAngleTE)) then - call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE), ubound(InData%ChordAngleTE)) + call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE, kind=B8Ki), ubound(InData%ChordAngleTE, kind=B8Ki)) call RegPack(Buf, InData%ChordAngleTE) end if call RegPack(Buf, allocated(InData%SpanAngleTE)) if (allocated(InData%SpanAngleTE)) then - call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE), ubound(InData%SpanAngleTE)) + call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE, kind=B8Ki), ubound(InData%SpanAngleTE, kind=B8Ki)) call RegPack(Buf, InData%SpanAngleTE) end if call RegPack(Buf, allocated(InData%ChordAngleLE)) if (allocated(InData%ChordAngleLE)) then - call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE), ubound(InData%ChordAngleLE)) + call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE, kind=B8Ki), ubound(InData%ChordAngleLE, kind=B8Ki)) call RegPack(Buf, InData%ChordAngleLE) end if call RegPack(Buf, allocated(InData%SpanAngleLE)) if (allocated(InData%SpanAngleLE)) then - call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE), ubound(InData%SpanAngleLE)) + call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE, kind=B8Ki), ubound(InData%SpanAngleLE, kind=B8Ki)) call RegPack(Buf, InData%SpanAngleLE) end if call RegPack(Buf, allocated(InData%rTEtoObserve)) if (allocated(InData%rTEtoObserve)) then - call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve), ubound(InData%rTEtoObserve)) + call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve, kind=B8Ki), ubound(InData%rTEtoObserve, kind=B8Ki)) call RegPack(Buf, InData%rTEtoObserve) end if call RegPack(Buf, allocated(InData%rLEtoObserve)) if (allocated(InData%rLEtoObserve)) then - call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve), ubound(InData%rLEtoObserve)) + call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve, kind=B8Ki), ubound(InData%rLEtoObserve, kind=B8Ki)) call RegPack(Buf, InData%rLEtoObserve) end if call RegPack(Buf, allocated(InData%LE_Location)) if (allocated(InData%LE_Location)) then - call RegPackBounds(Buf, 3, lbound(InData%LE_Location), ubound(InData%LE_Location)) + call RegPackBounds(Buf, 3, lbound(InData%LE_Location, kind=B8Ki), ubound(InData%LE_Location, kind=B8Ki)) call RegPack(Buf, InData%LE_Location) end if call RegPack(Buf, InData%RotSpeedAoA) call RegPack(Buf, allocated(InData%SPLLBL)) if (allocated(InData%SPLLBL)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLLBL), ubound(InData%SPLLBL)) + call RegPackBounds(Buf, 1, lbound(InData%SPLLBL, kind=B8Ki), ubound(InData%SPLLBL, kind=B8Ki)) call RegPack(Buf, InData%SPLLBL) end if call RegPack(Buf, allocated(InData%SPLP)) if (allocated(InData%SPLP)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLP), ubound(InData%SPLP)) + call RegPackBounds(Buf, 1, lbound(InData%SPLP, kind=B8Ki), ubound(InData%SPLP, kind=B8Ki)) call RegPack(Buf, InData%SPLP) end if call RegPack(Buf, allocated(InData%SPLS)) if (allocated(InData%SPLS)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLS), ubound(InData%SPLS)) + call RegPackBounds(Buf, 1, lbound(InData%SPLS, kind=B8Ki), ubound(InData%SPLS, kind=B8Ki)) call RegPack(Buf, InData%SPLS) end if call RegPack(Buf, allocated(InData%SPLALPH)) if (allocated(InData%SPLALPH)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLALPH), ubound(InData%SPLALPH)) + call RegPackBounds(Buf, 1, lbound(InData%SPLALPH, kind=B8Ki), ubound(InData%SPLALPH, kind=B8Ki)) call RegPack(Buf, InData%SPLALPH) end if call RegPack(Buf, allocated(InData%SPLTBL)) if (allocated(InData%SPLTBL)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTBL), ubound(InData%SPLTBL)) + call RegPackBounds(Buf, 1, lbound(InData%SPLTBL, kind=B8Ki), ubound(InData%SPLTBL, kind=B8Ki)) call RegPack(Buf, InData%SPLTBL) end if call RegPack(Buf, allocated(InData%SPLTIP)) if (allocated(InData%SPLTIP)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTIP), ubound(InData%SPLTIP)) + call RegPackBounds(Buf, 1, lbound(InData%SPLTIP, kind=B8Ki), ubound(InData%SPLTIP, kind=B8Ki)) call RegPack(Buf, InData%SPLTIP) end if call RegPack(Buf, allocated(InData%SPLTI)) if (allocated(InData%SPLTI)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTI), ubound(InData%SPLTI)) + call RegPackBounds(Buf, 1, lbound(InData%SPLTI, kind=B8Ki), ubound(InData%SPLTI, kind=B8Ki)) call RegPack(Buf, InData%SPLTI) end if call RegPack(Buf, allocated(InData%SPLTIGui)) if (allocated(InData%SPLTIGui)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui), ubound(InData%SPLTIGui)) + call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui, kind=B8Ki), ubound(InData%SPLTIGui, kind=B8Ki)) call RegPack(Buf, InData%SPLTIGui) end if call RegPack(Buf, allocated(InData%SPLBLUNT)) if (allocated(InData%SPLBLUNT)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT), ubound(InData%SPLBLUNT)) + call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT, kind=B8Ki), ubound(InData%SPLBLUNT, kind=B8Ki)) call RegPack(Buf, InData%SPLBLUNT) end if call RegPack(Buf, allocated(InData%CfVar)) if (allocated(InData%CfVar)) then - call RegPackBounds(Buf, 1, lbound(InData%CfVar), ubound(InData%CfVar)) + call RegPackBounds(Buf, 1, lbound(InData%CfVar, kind=B8Ki), ubound(InData%CfVar, kind=B8Ki)) call RegPack(Buf, InData%CfVar) end if call RegPack(Buf, allocated(InData%d99Var)) if (allocated(InData%d99Var)) then - call RegPackBounds(Buf, 1, lbound(InData%d99Var), ubound(InData%d99Var)) + call RegPackBounds(Buf, 1, lbound(InData%d99Var, kind=B8Ki), ubound(InData%d99Var, kind=B8Ki)) call RegPack(Buf, InData%d99Var) end if call RegPack(Buf, allocated(InData%dStarVar)) if (allocated(InData%dStarVar)) then - call RegPackBounds(Buf, 1, lbound(InData%dStarVar), ubound(InData%dStarVar)) + call RegPackBounds(Buf, 1, lbound(InData%dStarVar, kind=B8Ki), ubound(InData%dStarVar, kind=B8Ki)) call RegPack(Buf, InData%dStarVar) end if call RegPack(Buf, allocated(InData%EdgeVelVar)) if (allocated(InData%EdgeVelVar)) then - call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar), ubound(InData%EdgeVelVar)) + call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar, kind=B8Ki), ubound(InData%EdgeVelVar, kind=B8Ki)) call RegPack(Buf, InData%EdgeVelVar) end if call RegPack(Buf, InData%speccou) @@ -2575,7 +2575,7 @@ subroutine AA_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackMisc' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2887,8 +2887,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyParam' @@ -2914,8 +2914,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%toptip = SrcParamData%toptip DstParamData%bottip = SrcParamData%bottip if (allocated(SrcParamData%rotorregionlimitsVert)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) if (.not. allocated(DstParamData%rotorregionlimitsVert)) then allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2926,8 +2926,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert end if if (allocated(SrcParamData%rotorregionlimitsHorz)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2938,8 +2938,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz end if if (allocated(SrcParamData%rotorregionlimitsalph)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) if (.not. allocated(DstParamData%rotorregionlimitsalph)) then allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2950,8 +2950,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph end if if (allocated(SrcParamData%rotorregionlimitsrad)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) if (.not. allocated(DstParamData%rotorregionlimitsrad)) then allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2966,8 +2966,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput DstParamData%AAStart = SrcParamData%AAStart if (allocated(SrcParamData%ObsX)) then - LB(1:1) = lbound(SrcParamData%ObsX) - UB(1:1) = ubound(SrcParamData%ObsX) + LB(1:1) = lbound(SrcParamData%ObsX, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ObsX, kind=B8Ki) if (.not. allocated(DstParamData%ObsX)) then allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2978,8 +2978,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsX = SrcParamData%ObsX end if if (allocated(SrcParamData%ObsY)) then - LB(1:1) = lbound(SrcParamData%ObsY) - UB(1:1) = ubound(SrcParamData%ObsY) + LB(1:1) = lbound(SrcParamData%ObsY, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ObsY, kind=B8Ki) if (.not. allocated(DstParamData%ObsY)) then allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2990,8 +2990,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsY = SrcParamData%ObsY end if if (allocated(SrcParamData%ObsZ)) then - LB(1:1) = lbound(SrcParamData%ObsZ) - UB(1:1) = ubound(SrcParamData%ObsZ) + LB(1:1) = lbound(SrcParamData%ObsZ, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ObsZ, kind=B8Ki) if (.not. allocated(DstParamData%ObsZ)) then allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3002,8 +3002,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsZ = SrcParamData%ObsZ end if if (allocated(SrcParamData%FreqList)) then - LB(1:1) = lbound(SrcParamData%FreqList) - UB(1:1) = ubound(SrcParamData%FreqList) + LB(1:1) = lbound(SrcParamData%FreqList, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FreqList, kind=B8Ki) if (.not. allocated(DstParamData%FreqList)) then allocate(DstParamData%FreqList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3014,8 +3014,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FreqList = SrcParamData%FreqList end if if (allocated(SrcParamData%Aweight)) then - LB(1:1) = lbound(SrcParamData%Aweight) - UB(1:1) = ubound(SrcParamData%Aweight) + LB(1:1) = lbound(SrcParamData%Aweight, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Aweight, kind=B8Ki) if (.not. allocated(DstParamData%Aweight)) then allocate(DstParamData%Aweight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3035,8 +3035,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dz_turb_in = SrcParamData%dz_turb_in DstParamData%dy_turb_in = SrcParamData%dy_turb_in if (allocated(SrcParamData%TI_Grid_In)) then - LB(1:2) = lbound(SrcParamData%TI_Grid_In) - UB(1:2) = ubound(SrcParamData%TI_Grid_In) + LB(1:2) = lbound(SrcParamData%TI_Grid_In, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TI_Grid_In, kind=B8Ki) if (.not. allocated(DstParamData%TI_Grid_In)) then allocate(DstParamData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3060,8 +3060,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%unOutFile4 = SrcParamData%unOutFile4 DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3076,8 +3076,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%StallStart)) then - LB(1:2) = lbound(SrcParamData%StallStart) - UB(1:2) = ubound(SrcParamData%StallStart) + LB(1:2) = lbound(SrcParamData%StallStart, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%StallStart, kind=B8Ki) if (.not. allocated(DstParamData%StallStart)) then allocate(DstParamData%StallStart(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3088,8 +3088,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StallStart = SrcParamData%StallStart end if if (allocated(SrcParamData%TEThick)) then - LB(1:2) = lbound(SrcParamData%TEThick) - UB(1:2) = ubound(SrcParamData%TEThick) + LB(1:2) = lbound(SrcParamData%TEThick, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TEThick, kind=B8Ki) if (.not. allocated(DstParamData%TEThick)) then allocate(DstParamData%TEThick(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3100,8 +3100,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEThick = SrcParamData%TEThick end if if (allocated(SrcParamData%TEAngle)) then - LB(1:2) = lbound(SrcParamData%TEAngle) - UB(1:2) = ubound(SrcParamData%TEAngle) + LB(1:2) = lbound(SrcParamData%TEAngle, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TEAngle, kind=B8Ki) if (.not. allocated(DstParamData%TEAngle)) then allocate(DstParamData%TEAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3112,8 +3112,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEAngle = SrcParamData%TEAngle end if if (allocated(SrcParamData%AerCent)) then - LB(1:3) = lbound(SrcParamData%AerCent) - UB(1:3) = ubound(SrcParamData%AerCent) + LB(1:3) = lbound(SrcParamData%AerCent, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AerCent, kind=B8Ki) if (.not. allocated(DstParamData%AerCent)) then allocate(DstParamData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3124,8 +3124,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AerCent = SrcParamData%AerCent end if if (allocated(SrcParamData%BlAFID)) then - LB(1:2) = lbound(SrcParamData%BlAFID) - UB(1:2) = ubound(SrcParamData%BlAFID) + LB(1:2) = lbound(SrcParamData%BlAFID, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BlAFID, kind=B8Ki) if (.not. allocated(DstParamData%BlAFID)) then allocate(DstParamData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3136,8 +3136,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlAFID = SrcParamData%BlAFID end if if (allocated(SrcParamData%AFInfo)) then - LB(1:1) = lbound(SrcParamData%AFInfo) - UB(1:1) = ubound(SrcParamData%AFInfo) + LB(1:1) = lbound(SrcParamData%AFInfo, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AFInfo, kind=B8Ki) if (.not. allocated(DstParamData%AFInfo)) then allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3152,8 +3152,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%AFLECo)) then - LB(1:3) = lbound(SrcParamData%AFLECo) - UB(1:3) = ubound(SrcParamData%AFLECo) + LB(1:3) = lbound(SrcParamData%AFLECo, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AFLECo, kind=B8Ki) if (.not. allocated(DstParamData%AFLECo)) then allocate(DstParamData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3164,8 +3164,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFLECo = SrcParamData%AFLECo end if if (allocated(SrcParamData%AFTECo)) then - LB(1:3) = lbound(SrcParamData%AFTECo) - UB(1:3) = ubound(SrcParamData%AFTECo) + LB(1:3) = lbound(SrcParamData%AFTECo, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AFTECo, kind=B8Ki) if (.not. allocated(DstParamData%AFTECo)) then allocate(DstParamData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3176,8 +3176,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFTECo = SrcParamData%AFTECo end if if (allocated(SrcParamData%BlSpn)) then - LB(1:2) = lbound(SrcParamData%BlSpn) - UB(1:2) = ubound(SrcParamData%BlSpn) + LB(1:2) = lbound(SrcParamData%BlSpn, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BlSpn, kind=B8Ki) if (.not. allocated(DstParamData%BlSpn)) then allocate(DstParamData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3188,8 +3188,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlSpn = SrcParamData%BlSpn end if if (allocated(SrcParamData%BlChord)) then - LB(1:2) = lbound(SrcParamData%BlChord) - UB(1:2) = ubound(SrcParamData%BlChord) + LB(1:2) = lbound(SrcParamData%BlChord, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BlChord, kind=B8Ki) if (.not. allocated(DstParamData%BlChord)) then allocate(DstParamData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3200,8 +3200,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlChord = SrcParamData%BlChord end if if (allocated(SrcParamData%ReListBL)) then - LB(1:1) = lbound(SrcParamData%ReListBL) - UB(1:1) = ubound(SrcParamData%ReListBL) + LB(1:1) = lbound(SrcParamData%ReListBL, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ReListBL, kind=B8Ki) if (.not. allocated(DstParamData%ReListBL)) then allocate(DstParamData%ReListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3212,8 +3212,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ReListBL = SrcParamData%ReListBL end if if (allocated(SrcParamData%AOAListBL)) then - LB(1:1) = lbound(SrcParamData%AOAListBL) - UB(1:1) = ubound(SrcParamData%AOAListBL) + LB(1:1) = lbound(SrcParamData%AOAListBL, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AOAListBL, kind=B8Ki) if (.not. allocated(DstParamData%AOAListBL)) then allocate(DstParamData%AOAListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3224,8 +3224,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AOAListBL = SrcParamData%AOAListBL end if if (allocated(SrcParamData%dStarAll1)) then - LB(1:3) = lbound(SrcParamData%dStarAll1) - UB(1:3) = ubound(SrcParamData%dStarAll1) + LB(1:3) = lbound(SrcParamData%dStarAll1, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%dStarAll1, kind=B8Ki) if (.not. allocated(DstParamData%dStarAll1)) then allocate(DstParamData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3236,8 +3236,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dStarAll1 = SrcParamData%dStarAll1 end if if (allocated(SrcParamData%dStarAll2)) then - LB(1:3) = lbound(SrcParamData%dStarAll2) - UB(1:3) = ubound(SrcParamData%dStarAll2) + LB(1:3) = lbound(SrcParamData%dStarAll2, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%dStarAll2, kind=B8Ki) if (.not. allocated(DstParamData%dStarAll2)) then allocate(DstParamData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3248,8 +3248,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dStarAll2 = SrcParamData%dStarAll2 end if if (allocated(SrcParamData%d99All1)) then - LB(1:3) = lbound(SrcParamData%d99All1) - UB(1:3) = ubound(SrcParamData%d99All1) + LB(1:3) = lbound(SrcParamData%d99All1, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%d99All1, kind=B8Ki) if (.not. allocated(DstParamData%d99All1)) then allocate(DstParamData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3260,8 +3260,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%d99All1 = SrcParamData%d99All1 end if if (allocated(SrcParamData%d99All2)) then - LB(1:3) = lbound(SrcParamData%d99All2) - UB(1:3) = ubound(SrcParamData%d99All2) + LB(1:3) = lbound(SrcParamData%d99All2, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%d99All2, kind=B8Ki) if (.not. allocated(DstParamData%d99All2)) then allocate(DstParamData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3272,8 +3272,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%d99All2 = SrcParamData%d99All2 end if if (allocated(SrcParamData%CfAll1)) then - LB(1:3) = lbound(SrcParamData%CfAll1) - UB(1:3) = ubound(SrcParamData%CfAll1) + LB(1:3) = lbound(SrcParamData%CfAll1, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%CfAll1, kind=B8Ki) if (.not. allocated(DstParamData%CfAll1)) then allocate(DstParamData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3284,8 +3284,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CfAll1 = SrcParamData%CfAll1 end if if (allocated(SrcParamData%CfAll2)) then - LB(1:3) = lbound(SrcParamData%CfAll2) - UB(1:3) = ubound(SrcParamData%CfAll2) + LB(1:3) = lbound(SrcParamData%CfAll2, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%CfAll2, kind=B8Ki) if (.not. allocated(DstParamData%CfAll2)) then allocate(DstParamData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3296,8 +3296,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CfAll2 = SrcParamData%CfAll2 end if if (allocated(SrcParamData%EdgeVelRat1)) then - LB(1:3) = lbound(SrcParamData%EdgeVelRat1) - UB(1:3) = ubound(SrcParamData%EdgeVelRat1) + LB(1:3) = lbound(SrcParamData%EdgeVelRat1, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%EdgeVelRat1, kind=B8Ki) if (.not. allocated(DstParamData%EdgeVelRat1)) then allocate(DstParamData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3308,8 +3308,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 end if if (allocated(SrcParamData%EdgeVelRat2)) then - LB(1:3) = lbound(SrcParamData%EdgeVelRat2) - UB(1:3) = ubound(SrcParamData%EdgeVelRat2) + LB(1:3) = lbound(SrcParamData%EdgeVelRat2, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%EdgeVelRat2, kind=B8Ki) if (.not. allocated(DstParamData%EdgeVelRat2)) then allocate(DstParamData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3320,8 +3320,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 end if if (allocated(SrcParamData%AFThickGuida)) then - LB(1:2) = lbound(SrcParamData%AFThickGuida) - UB(1:2) = ubound(SrcParamData%AFThickGuida) + LB(1:2) = lbound(SrcParamData%AFThickGuida, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AFThickGuida, kind=B8Ki) if (.not. allocated(DstParamData%AFThickGuida)) then allocate(DstParamData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3337,8 +3337,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) type(AA_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyParam' @@ -3375,8 +3375,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TI_Grid_In) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3399,8 +3399,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BlAFID) end if if (allocated(ParamData%AFInfo)) then - LB(1:1) = lbound(ParamData%AFInfo) - UB(1:1) = ubound(ParamData%AFInfo) + LB(1:1) = lbound(ParamData%AFInfo, kind=B8Ki) + UB(1:1) = ubound(ParamData%AFInfo, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3458,8 +3458,8 @@ subroutine AA_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%IBLUNT) @@ -3482,22 +3482,22 @@ subroutine AA_PackParam(Buf, Indata) call RegPack(Buf, InData%bottip) call RegPack(Buf, allocated(InData%rotorregionlimitsVert)) if (allocated(InData%rotorregionlimitsVert)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert), ubound(InData%rotorregionlimitsVert)) + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert, kind=B8Ki), ubound(InData%rotorregionlimitsVert, kind=B8Ki)) call RegPack(Buf, InData%rotorregionlimitsVert) end if call RegPack(Buf, allocated(InData%rotorregionlimitsHorz)) if (allocated(InData%rotorregionlimitsHorz)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz), ubound(InData%rotorregionlimitsHorz)) + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz, kind=B8Ki), ubound(InData%rotorregionlimitsHorz, kind=B8Ki)) call RegPack(Buf, InData%rotorregionlimitsHorz) end if call RegPack(Buf, allocated(InData%rotorregionlimitsalph)) if (allocated(InData%rotorregionlimitsalph)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph), ubound(InData%rotorregionlimitsalph)) + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph, kind=B8Ki), ubound(InData%rotorregionlimitsalph, kind=B8Ki)) call RegPack(Buf, InData%rotorregionlimitsalph) end if call RegPack(Buf, allocated(InData%rotorregionlimitsrad)) if (allocated(InData%rotorregionlimitsrad)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad), ubound(InData%rotorregionlimitsrad)) + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad, kind=B8Ki), ubound(InData%rotorregionlimitsrad, kind=B8Ki)) call RegPack(Buf, InData%rotorregionlimitsrad) end if call RegPack(Buf, InData%NrObsLoc) @@ -3506,27 +3506,27 @@ subroutine AA_PackParam(Buf, Indata) call RegPack(Buf, InData%AAStart) call RegPack(Buf, allocated(InData%ObsX)) if (allocated(InData%ObsX)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) + call RegPackBounds(Buf, 1, lbound(InData%ObsX, kind=B8Ki), ubound(InData%ObsX, kind=B8Ki)) call RegPack(Buf, InData%ObsX) end if call RegPack(Buf, allocated(InData%ObsY)) if (allocated(InData%ObsY)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) + call RegPackBounds(Buf, 1, lbound(InData%ObsY, kind=B8Ki), ubound(InData%ObsY, kind=B8Ki)) call RegPack(Buf, InData%ObsY) end if call RegPack(Buf, allocated(InData%ObsZ)) if (allocated(InData%ObsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) + call RegPackBounds(Buf, 1, lbound(InData%ObsZ, kind=B8Ki), ubound(InData%ObsZ, kind=B8Ki)) call RegPack(Buf, InData%ObsZ) end if call RegPack(Buf, allocated(InData%FreqList)) if (allocated(InData%FreqList)) then - call RegPackBounds(Buf, 1, lbound(InData%FreqList), ubound(InData%FreqList)) + call RegPackBounds(Buf, 1, lbound(InData%FreqList, kind=B8Ki), ubound(InData%FreqList, kind=B8Ki)) call RegPack(Buf, InData%FreqList) end if call RegPack(Buf, allocated(InData%Aweight)) if (allocated(InData%Aweight)) then - call RegPackBounds(Buf, 1, lbound(InData%Aweight), ubound(InData%Aweight)) + call RegPackBounds(Buf, 1, lbound(InData%Aweight, kind=B8Ki), ubound(InData%Aweight, kind=B8Ki)) call RegPack(Buf, InData%Aweight) end if call RegPack(Buf, InData%Fsample) @@ -3540,7 +3540,7 @@ subroutine AA_PackParam(Buf, Indata) call RegPack(Buf, InData%dy_turb_in) call RegPack(Buf, allocated(InData%TI_Grid_In)) if (allocated(InData%TI_Grid_In)) then - call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) + call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In, kind=B8Ki), ubound(InData%TI_Grid_In, kind=B8Ki)) call RegPack(Buf, InData%TI_Grid_In) end if call RegPack(Buf, InData%FTitle) @@ -3558,120 +3558,120 @@ subroutine AA_PackParam(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if call RegPack(Buf, allocated(InData%StallStart)) if (allocated(InData%StallStart)) then - call RegPackBounds(Buf, 2, lbound(InData%StallStart), ubound(InData%StallStart)) + call RegPackBounds(Buf, 2, lbound(InData%StallStart, kind=B8Ki), ubound(InData%StallStart, kind=B8Ki)) call RegPack(Buf, InData%StallStart) end if call RegPack(Buf, allocated(InData%TEThick)) if (allocated(InData%TEThick)) then - call RegPackBounds(Buf, 2, lbound(InData%TEThick), ubound(InData%TEThick)) + call RegPackBounds(Buf, 2, lbound(InData%TEThick, kind=B8Ki), ubound(InData%TEThick, kind=B8Ki)) call RegPack(Buf, InData%TEThick) end if call RegPack(Buf, allocated(InData%TEAngle)) if (allocated(InData%TEAngle)) then - call RegPackBounds(Buf, 2, lbound(InData%TEAngle), ubound(InData%TEAngle)) + call RegPackBounds(Buf, 2, lbound(InData%TEAngle, kind=B8Ki), ubound(InData%TEAngle, kind=B8Ki)) call RegPack(Buf, InData%TEAngle) end if call RegPack(Buf, allocated(InData%AerCent)) if (allocated(InData%AerCent)) then - call RegPackBounds(Buf, 3, lbound(InData%AerCent), ubound(InData%AerCent)) + call RegPackBounds(Buf, 3, lbound(InData%AerCent, kind=B8Ki), ubound(InData%AerCent, kind=B8Ki)) call RegPack(Buf, InData%AerCent) end if call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPackBounds(Buf, 2, lbound(InData%BlAFID, kind=B8Ki), ubound(InData%BlAFID, kind=B8Ki)) call RegPack(Buf, InData%BlAFID) end if call RegPack(Buf, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) - LB(1:1) = lbound(InData%AFInfo) - UB(1:1) = ubound(InData%AFInfo) + call RegPackBounds(Buf, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) + LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) + UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_PackParam(Buf, InData%AFInfo(i1)) end do end if call RegPack(Buf, allocated(InData%AFLECo)) if (allocated(InData%AFLECo)) then - call RegPackBounds(Buf, 3, lbound(InData%AFLECo), ubound(InData%AFLECo)) + call RegPackBounds(Buf, 3, lbound(InData%AFLECo, kind=B8Ki), ubound(InData%AFLECo, kind=B8Ki)) call RegPack(Buf, InData%AFLECo) end if call RegPack(Buf, allocated(InData%AFTECo)) if (allocated(InData%AFTECo)) then - call RegPackBounds(Buf, 3, lbound(InData%AFTECo), ubound(InData%AFTECo)) + call RegPackBounds(Buf, 3, lbound(InData%AFTECo, kind=B8Ki), ubound(InData%AFTECo, kind=B8Ki)) call RegPack(Buf, InData%AFTECo) end if call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then - call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPackBounds(Buf, 2, lbound(InData%BlSpn, kind=B8Ki), ubound(InData%BlSpn, kind=B8Ki)) call RegPack(Buf, InData%BlSpn) end if call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then - call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPackBounds(Buf, 2, lbound(InData%BlChord, kind=B8Ki), ubound(InData%BlChord, kind=B8Ki)) call RegPack(Buf, InData%BlChord) end if call RegPack(Buf, allocated(InData%ReListBL)) if (allocated(InData%ReListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) + call RegPackBounds(Buf, 1, lbound(InData%ReListBL, kind=B8Ki), ubound(InData%ReListBL, kind=B8Ki)) call RegPack(Buf, InData%ReListBL) end if call RegPack(Buf, allocated(InData%AOAListBL)) if (allocated(InData%AOAListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%AOAListBL), ubound(InData%AOAListBL)) + call RegPackBounds(Buf, 1, lbound(InData%AOAListBL, kind=B8Ki), ubound(InData%AOAListBL, kind=B8Ki)) call RegPack(Buf, InData%AOAListBL) end if call RegPack(Buf, allocated(InData%dStarAll1)) if (allocated(InData%dStarAll1)) then - call RegPackBounds(Buf, 3, lbound(InData%dStarAll1), ubound(InData%dStarAll1)) + call RegPackBounds(Buf, 3, lbound(InData%dStarAll1, kind=B8Ki), ubound(InData%dStarAll1, kind=B8Ki)) call RegPack(Buf, InData%dStarAll1) end if call RegPack(Buf, allocated(InData%dStarAll2)) if (allocated(InData%dStarAll2)) then - call RegPackBounds(Buf, 3, lbound(InData%dStarAll2), ubound(InData%dStarAll2)) + call RegPackBounds(Buf, 3, lbound(InData%dStarAll2, kind=B8Ki), ubound(InData%dStarAll2, kind=B8Ki)) call RegPack(Buf, InData%dStarAll2) end if call RegPack(Buf, allocated(InData%d99All1)) if (allocated(InData%d99All1)) then - call RegPackBounds(Buf, 3, lbound(InData%d99All1), ubound(InData%d99All1)) + call RegPackBounds(Buf, 3, lbound(InData%d99All1, kind=B8Ki), ubound(InData%d99All1, kind=B8Ki)) call RegPack(Buf, InData%d99All1) end if call RegPack(Buf, allocated(InData%d99All2)) if (allocated(InData%d99All2)) then - call RegPackBounds(Buf, 3, lbound(InData%d99All2), ubound(InData%d99All2)) + call RegPackBounds(Buf, 3, lbound(InData%d99All2, kind=B8Ki), ubound(InData%d99All2, kind=B8Ki)) call RegPack(Buf, InData%d99All2) end if call RegPack(Buf, allocated(InData%CfAll1)) if (allocated(InData%CfAll1)) then - call RegPackBounds(Buf, 3, lbound(InData%CfAll1), ubound(InData%CfAll1)) + call RegPackBounds(Buf, 3, lbound(InData%CfAll1, kind=B8Ki), ubound(InData%CfAll1, kind=B8Ki)) call RegPack(Buf, InData%CfAll1) end if call RegPack(Buf, allocated(InData%CfAll2)) if (allocated(InData%CfAll2)) then - call RegPackBounds(Buf, 3, lbound(InData%CfAll2), ubound(InData%CfAll2)) + call RegPackBounds(Buf, 3, lbound(InData%CfAll2, kind=B8Ki), ubound(InData%CfAll2, kind=B8Ki)) call RegPack(Buf, InData%CfAll2) end if call RegPack(Buf, allocated(InData%EdgeVelRat1)) if (allocated(InData%EdgeVelRat1)) then - call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1), ubound(InData%EdgeVelRat1)) + call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1, kind=B8Ki), ubound(InData%EdgeVelRat1, kind=B8Ki)) call RegPack(Buf, InData%EdgeVelRat1) end if call RegPack(Buf, allocated(InData%EdgeVelRat2)) if (allocated(InData%EdgeVelRat2)) then - call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2), ubound(InData%EdgeVelRat2)) + call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2, kind=B8Ki), ubound(InData%EdgeVelRat2, kind=B8Ki)) call RegPack(Buf, InData%EdgeVelRat2) end if call RegPack(Buf, allocated(InData%AFThickGuida)) if (allocated(InData%AFThickGuida)) then - call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida), ubound(InData%AFThickGuida)) + call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida, kind=B8Ki), ubound(InData%AFThickGuida, kind=B8Ki)) call RegPack(Buf, InData%AFThickGuida) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3681,8 +3681,8 @@ subroutine AA_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4234,14 +4234,14 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%RotGtoL)) then - LB(1:4) = lbound(SrcInputData%RotGtoL) - UB(1:4) = ubound(SrcInputData%RotGtoL) + LB(1:4) = lbound(SrcInputData%RotGtoL, kind=B8Ki) + UB(1:4) = ubound(SrcInputData%RotGtoL, kind=B8Ki) if (.not. allocated(DstInputData%RotGtoL)) then allocate(DstInputData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4252,8 +4252,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%RotGtoL = SrcInputData%RotGtoL end if if (allocated(SrcInputData%AeroCent_G)) then - LB(1:3) = lbound(SrcInputData%AeroCent_G) - UB(1:3) = ubound(SrcInputData%AeroCent_G) + LB(1:3) = lbound(SrcInputData%AeroCent_G, kind=B8Ki) + UB(1:3) = ubound(SrcInputData%AeroCent_G, kind=B8Ki) if (.not. allocated(DstInputData%AeroCent_G)) then allocate(DstInputData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4264,8 +4264,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%AeroCent_G = SrcInputData%AeroCent_G end if if (allocated(SrcInputData%Vrel)) then - LB(1:2) = lbound(SrcInputData%Vrel) - UB(1:2) = ubound(SrcInputData%Vrel) + LB(1:2) = lbound(SrcInputData%Vrel, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%Vrel, kind=B8Ki) if (.not. allocated(DstInputData%Vrel)) then allocate(DstInputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4276,8 +4276,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vrel = SrcInputData%Vrel end if if (allocated(SrcInputData%AoANoise)) then - LB(1:2) = lbound(SrcInputData%AoANoise) - UB(1:2) = ubound(SrcInputData%AoANoise) + LB(1:2) = lbound(SrcInputData%AoANoise, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%AoANoise, kind=B8Ki) if (.not. allocated(DstInputData%AoANoise)) then allocate(DstInputData%AoANoise(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4288,8 +4288,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%AoANoise = SrcInputData%AoANoise end if if (allocated(SrcInputData%Inflow)) then - LB(1:3) = lbound(SrcInputData%Inflow) - UB(1:3) = ubound(SrcInputData%Inflow) + LB(1:3) = lbound(SrcInputData%Inflow, kind=B8Ki) + UB(1:3) = ubound(SrcInputData%Inflow, kind=B8Ki) if (.not. allocated(DstInputData%Inflow)) then allocate(DstInputData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4332,27 +4332,27 @@ subroutine AA_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%RotGtoL)) if (allocated(InData%RotGtoL)) then - call RegPackBounds(Buf, 4, lbound(InData%RotGtoL), ubound(InData%RotGtoL)) + call RegPackBounds(Buf, 4, lbound(InData%RotGtoL, kind=B8Ki), ubound(InData%RotGtoL, kind=B8Ki)) call RegPack(Buf, InData%RotGtoL) end if call RegPack(Buf, allocated(InData%AeroCent_G)) if (allocated(InData%AeroCent_G)) then - call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G), ubound(InData%AeroCent_G)) + call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G, kind=B8Ki), ubound(InData%AeroCent_G, kind=B8Ki)) call RegPack(Buf, InData%AeroCent_G) end if call RegPack(Buf, allocated(InData%Vrel)) if (allocated(InData%Vrel)) then - call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) + call RegPackBounds(Buf, 2, lbound(InData%Vrel, kind=B8Ki), ubound(InData%Vrel, kind=B8Ki)) call RegPack(Buf, InData%Vrel) end if call RegPack(Buf, allocated(InData%AoANoise)) if (allocated(InData%AoANoise)) then - call RegPackBounds(Buf, 2, lbound(InData%AoANoise), ubound(InData%AoANoise)) + call RegPackBounds(Buf, 2, lbound(InData%AoANoise, kind=B8Ki), ubound(InData%AoANoise, kind=B8Ki)) call RegPack(Buf, InData%AoANoise) end if call RegPack(Buf, allocated(InData%Inflow)) if (allocated(InData%Inflow)) then - call RegPackBounds(Buf, 3, lbound(InData%Inflow), ubound(InData%Inflow)) + call RegPackBounds(Buf, 3, lbound(InData%Inflow, kind=B8Ki), ubound(InData%Inflow, kind=B8Ki)) call RegPack(Buf, InData%Inflow) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4362,7 +4362,7 @@ subroutine AA_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInput' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4444,14 +4444,14 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%SumSpecNoise)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoise) - UB(1:3) = ubound(SrcOutputData%SumSpecNoise) + LB(1:3) = lbound(SrcOutputData%SumSpecNoise, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%SumSpecNoise, kind=B8Ki) if (.not. allocated(DstOutputData%SumSpecNoise)) then allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4462,8 +4462,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise end if if (allocated(SrcOutputData%SumSpecNoiseSep)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) - UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) + LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep, kind=B8Ki) if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4474,8 +4474,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep end if if (allocated(SrcOutputData%OASPL)) then - LB(1:3) = lbound(SrcOutputData%OASPL) - UB(1:3) = ubound(SrcOutputData%OASPL) + LB(1:3) = lbound(SrcOutputData%OASPL, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%OASPL, kind=B8Ki) if (.not. allocated(DstOutputData%OASPL)) then allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4486,8 +4486,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OASPL = SrcOutputData%OASPL end if if (allocated(SrcOutputData%OASPL_Mech)) then - LB(1:4) = lbound(SrcOutputData%OASPL_Mech) - UB(1:4) = ubound(SrcOutputData%OASPL_Mech) + LB(1:4) = lbound(SrcOutputData%OASPL_Mech, kind=B8Ki) + UB(1:4) = ubound(SrcOutputData%OASPL_Mech, kind=B8Ki) if (.not. allocated(DstOutputData%OASPL_Mech)) then allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4498,8 +4498,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech end if if (allocated(SrcOutputData%DirectiviOutput)) then - LB(1:1) = lbound(SrcOutputData%DirectiviOutput) - UB(1:1) = ubound(SrcOutputData%DirectiviOutput) + LB(1:1) = lbound(SrcOutputData%DirectiviOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%DirectiviOutput, kind=B8Ki) if (.not. allocated(DstOutputData%DirectiviOutput)) then allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4510,8 +4510,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput end if if (allocated(SrcOutputData%OutLECoords)) then - LB(1:4) = lbound(SrcOutputData%OutLECoords) - UB(1:4) = ubound(SrcOutputData%OutLECoords) + LB(1:4) = lbound(SrcOutputData%OutLECoords, kind=B8Ki) + UB(1:4) = ubound(SrcOutputData%OutLECoords, kind=B8Ki) if (.not. allocated(DstOutputData%OutLECoords)) then allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4522,8 +4522,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OutLECoords = SrcOutputData%OutLECoords end if if (allocated(SrcOutputData%PtotalFreq)) then - LB(1:2) = lbound(SrcOutputData%PtotalFreq) - UB(1:2) = ubound(SrcOutputData%PtotalFreq) + LB(1:2) = lbound(SrcOutputData%PtotalFreq, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%PtotalFreq, kind=B8Ki) if (.not. allocated(DstOutputData%PtotalFreq)) then allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4534,8 +4534,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq end if if (allocated(SrcOutputData%WriteOutputForPE)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) - UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) + LB(1:1) = lbound(SrcOutputData%WriteOutputForPE, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutputForPE, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutputForPE)) then allocate(DstOutputData%WriteOutputForPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4546,8 +4546,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4558,8 +4558,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%WriteOutputSep)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputSep) - UB(1:1) = ubound(SrcOutputData%WriteOutputSep) + LB(1:1) = lbound(SrcOutputData%WriteOutputSep, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutputSep, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutputSep)) then allocate(DstOutputData%WriteOutputSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4570,8 +4570,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep end if if (allocated(SrcOutputData%WriteOutputNode)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputNode) - UB(1:1) = ubound(SrcOutputData%WriteOutputNode) + LB(1:1) = lbound(SrcOutputData%WriteOutputNode, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutputNode, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutputNode)) then allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4632,57 +4632,57 @@ subroutine AA_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%SumSpecNoise)) if (allocated(InData%SumSpecNoise)) then - call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise), ubound(InData%SumSpecNoise)) + call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise, kind=B8Ki), ubound(InData%SumSpecNoise, kind=B8Ki)) call RegPack(Buf, InData%SumSpecNoise) end if call RegPack(Buf, allocated(InData%SumSpecNoiseSep)) if (allocated(InData%SumSpecNoiseSep)) then - call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep), ubound(InData%SumSpecNoiseSep)) + call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep, kind=B8Ki), ubound(InData%SumSpecNoiseSep, kind=B8Ki)) call RegPack(Buf, InData%SumSpecNoiseSep) end if call RegPack(Buf, allocated(InData%OASPL)) if (allocated(InData%OASPL)) then - call RegPackBounds(Buf, 3, lbound(InData%OASPL), ubound(InData%OASPL)) + call RegPackBounds(Buf, 3, lbound(InData%OASPL, kind=B8Ki), ubound(InData%OASPL, kind=B8Ki)) call RegPack(Buf, InData%OASPL) end if call RegPack(Buf, allocated(InData%OASPL_Mech)) if (allocated(InData%OASPL_Mech)) then - call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech), ubound(InData%OASPL_Mech)) + call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech, kind=B8Ki), ubound(InData%OASPL_Mech, kind=B8Ki)) call RegPack(Buf, InData%OASPL_Mech) end if call RegPack(Buf, allocated(InData%DirectiviOutput)) if (allocated(InData%DirectiviOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput), ubound(InData%DirectiviOutput)) + call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput, kind=B8Ki), ubound(InData%DirectiviOutput, kind=B8Ki)) call RegPack(Buf, InData%DirectiviOutput) end if call RegPack(Buf, allocated(InData%OutLECoords)) if (allocated(InData%OutLECoords)) then - call RegPackBounds(Buf, 4, lbound(InData%OutLECoords), ubound(InData%OutLECoords)) + call RegPackBounds(Buf, 4, lbound(InData%OutLECoords, kind=B8Ki), ubound(InData%OutLECoords, kind=B8Ki)) call RegPack(Buf, InData%OutLECoords) end if call RegPack(Buf, allocated(InData%PtotalFreq)) if (allocated(InData%PtotalFreq)) then - call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq), ubound(InData%PtotalFreq)) + call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq, kind=B8Ki), ubound(InData%PtotalFreq, kind=B8Ki)) call RegPack(Buf, InData%PtotalFreq) end if call RegPack(Buf, allocated(InData%WriteOutputForPE)) if (allocated(InData%WriteOutputForPE)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE), ubound(InData%WriteOutputForPE)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE, kind=B8Ki), ubound(InData%WriteOutputForPE, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputForPE) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, allocated(InData%WriteOutputSep)) if (allocated(InData%WriteOutputSep)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep), ubound(InData%WriteOutputSep)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep, kind=B8Ki), ubound(InData%WriteOutputSep, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputSep) end if call RegPack(Buf, allocated(InData%WriteOutputNode)) if (allocated(InData%WriteOutputNode)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode), ubound(InData%WriteOutputNode)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode, kind=B8Ki), ubound(InData%WriteOutputNode, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputNode) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4692,7 +4692,7 @@ subroutine AA_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOutput' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 71835dac10..4a9345bb6c 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -331,8 +331,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' @@ -342,8 +342,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDvr_OutputsData%unOutFile)) then - LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile) - UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile) + LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile, kind=B8Ki) if (.not. allocated(DstDvr_OutputsData%unOutFile)) then allocate(DstDvr_OutputsData%unOutFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -365,8 +365,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot if (allocated(SrcDvr_OutputsData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr) - UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr) + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstDvr_OutputsData%WriteOutputHdr)) then allocate(DstDvr_OutputsData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -377,8 +377,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr end if if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) - UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt) + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstDvr_OutputsData%WriteOutputUnt)) then allocate(DstDvr_OutputsData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -389,8 +389,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt end if if (allocated(SrcDvr_OutputsData%storage)) then - LB(1:3) = lbound(SrcDvr_OutputsData%storage) - UB(1:3) = ubound(SrcDvr_OutputsData%storage) + LB(1:3) = lbound(SrcDvr_OutputsData%storage, kind=B8Ki) + UB(1:3) = ubound(SrcDvr_OutputsData%storage, kind=B8Ki) if (.not. allocated(DstDvr_OutputsData%storage)) then allocate(DstDvr_OutputsData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -401,8 +401,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage end if if (allocated(SrcDvr_OutputsData%outLine)) then - LB(1:1) = lbound(SrcDvr_OutputsData%outLine) - UB(1:1) = ubound(SrcDvr_OutputsData%outLine) + LB(1:1) = lbound(SrcDvr_OutputsData%outLine, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_OutputsData%outLine, kind=B8Ki) if (.not. allocated(DstDvr_OutputsData%outLine)) then allocate(DstDvr_OutputsData%outLine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -413,8 +413,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine end if if (allocated(SrcDvr_OutputsData%VTK_surface)) then - LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) - UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface) + LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface, kind=B8Ki) if (.not. allocated(DstDvr_OutputsData%VTK_surface)) then allocate(DstDvr_OutputsData%VTK_surface(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -441,8 +441,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) type(Dvr_Outputs), intent(inout) :: Dvr_OutputsData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' @@ -466,8 +466,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) deallocate(Dvr_OutputsData%outLine) end if if (allocated(Dvr_OutputsData%VTK_surface)) then - LB(1:1) = lbound(Dvr_OutputsData%VTK_surface) - UB(1:1) = ubound(Dvr_OutputsData%VTK_surface) + LB(1:1) = lbound(Dvr_OutputsData%VTK_surface, kind=B8Ki) + UB(1:1) = ubound(Dvr_OutputsData%VTK_surface, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_DestroyDvrVTK_SurfaceType(Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -480,13 +480,13 @@ subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Dvr_Outputs), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%AD_ver) call RegPack(Buf, allocated(InData%unOutFile)) if (allocated(InData%unOutFile)) then - call RegPackBounds(Buf, 1, lbound(InData%unOutFile), ubound(InData%unOutFile)) + call RegPackBounds(Buf, 1, lbound(InData%unOutFile, kind=B8Ki), ubound(InData%unOutFile, kind=B8Ki)) call RegPack(Buf, InData%unOutFile) end if call RegPack(Buf, InData%ActualChanLen) @@ -502,29 +502,29 @@ subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) call RegPack(Buf, InData%VTK_OutFileRoot) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call RegPack(Buf, allocated(InData%storage)) if (allocated(InData%storage)) then - call RegPackBounds(Buf, 3, lbound(InData%storage), ubound(InData%storage)) + call RegPackBounds(Buf, 3, lbound(InData%storage, kind=B8Ki), ubound(InData%storage, kind=B8Ki)) call RegPack(Buf, InData%storage) end if call RegPack(Buf, allocated(InData%outLine)) if (allocated(InData%outLine)) then - call RegPackBounds(Buf, 1, lbound(InData%outLine), ubound(InData%outLine)) + call RegPackBounds(Buf, 1, lbound(InData%outLine, kind=B8Ki), ubound(InData%outLine, kind=B8Ki)) call RegPack(Buf, InData%outLine) end if call RegPack(Buf, allocated(InData%VTK_surface)) if (allocated(InData%VTK_surface)) then - call RegPackBounds(Buf, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) - LB(1:1) = lbound(InData%VTK_surface) - UB(1:1) = ubound(InData%VTK_surface) + call RegPackBounds(Buf, 1, lbound(InData%VTK_surface, kind=B8Ki), ubound(InData%VTK_surface, kind=B8Ki)) + LB(1:1) = lbound(InData%VTK_surface, kind=B8Ki) + UB(1:1) = ubound(InData%VTK_surface, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_PackDvrVTK_SurfaceType(Buf, InData%VTK_surface(i1)) end do @@ -543,8 +543,8 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Dvr_Outputs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -678,7 +678,7 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyBladeData' ErrStat = ErrID_None @@ -693,8 +693,8 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er DstBladeDataData%motionType = SrcBladeDataData%motionType DstBladeDataData%iMotion = SrcBladeDataData%iMotion if (allocated(SrcBladeDataData%motion)) then - LB(1:2) = lbound(SrcBladeDataData%motion) - UB(1:2) = ubound(SrcBladeDataData%motion) + LB(1:2) = lbound(SrcBladeDataData%motion, kind=B8Ki) + UB(1:2) = ubound(SrcBladeDataData%motion, kind=B8Ki) if (.not. allocated(DstBladeDataData%motion)) then allocate(DstBladeDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -735,7 +735,7 @@ subroutine AD_Dvr_PackBladeData(Buf, Indata) call RegPack(Buf, InData%iMotion) call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) call RegPack(Buf, InData%motion) end if call RegPack(Buf, InData%motionFileName) @@ -746,7 +746,7 @@ subroutine AD_Dvr_UnPackBladeData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BladeData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -792,7 +792,7 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyHubData' ErrStat = ErrID_None @@ -806,8 +806,8 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, DstHubDataData%rotAcc = SrcHubDataData%rotAcc DstHubDataData%motionFileName = SrcHubDataData%motionFileName if (allocated(SrcHubDataData%motion)) then - LB(1:2) = lbound(SrcHubDataData%motion) - UB(1:2) = ubound(SrcHubDataData%motion) + LB(1:2) = lbound(SrcHubDataData%motion, kind=B8Ki) + UB(1:2) = ubound(SrcHubDataData%motion, kind=B8Ki) if (.not. allocated(DstHubDataData%motion)) then allocate(DstHubDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -846,7 +846,7 @@ subroutine AD_Dvr_PackHubData(Buf, Indata) call RegPack(Buf, InData%motionFileName) call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) call RegPack(Buf, InData%motion) end if if (RegCheckErr(Buf, RoutineName)) return @@ -856,7 +856,7 @@ subroutine AD_Dvr_UnPackHubData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HubData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -898,7 +898,7 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyNacData' ErrStat = ErrID_None @@ -911,8 +911,8 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, DstNacDataData%yawAcc = SrcNacDataData%yawAcc DstNacDataData%motionFileName = SrcNacDataData%motionFileName if (allocated(SrcNacDataData%motion)) then - LB(1:2) = lbound(SrcNacDataData%motion) - UB(1:2) = ubound(SrcNacDataData%motion) + LB(1:2) = lbound(SrcNacDataData%motion, kind=B8Ki) + UB(1:2) = ubound(SrcNacDataData%motion, kind=B8Ki) if (.not. allocated(DstNacDataData%motion)) then allocate(DstNacDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -950,7 +950,7 @@ subroutine AD_Dvr_PackNacData(Buf, Indata) call RegPack(Buf, InData%motionFileName) call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) call RegPack(Buf, InData%motion) end if if (RegCheckErr(Buf, RoutineName)) return @@ -960,7 +960,7 @@ subroutine AD_Dvr_UnPackNacData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(NacData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1039,8 +1039,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyWTData' @@ -1058,8 +1058,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcWTDataData%map2BldPt)) then - LB(1:1) = lbound(SrcWTDataData%map2BldPt) - UB(1:1) = ubound(SrcWTDataData%map2BldPt) + LB(1:1) = lbound(SrcWTDataData%map2BldPt, kind=B8Ki) + UB(1:1) = ubound(SrcWTDataData%map2BldPt, kind=B8Ki) if (.not. allocated(DstWTDataData%map2BldPt)) then allocate(DstWTDataData%map2BldPt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1074,8 +1074,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er end do end if if (allocated(SrcWTDataData%bld)) then - LB(1:1) = lbound(SrcWTDataData%bld) - UB(1:1) = ubound(SrcWTDataData%bld) + LB(1:1) = lbound(SrcWTDataData%bld, kind=B8Ki) + UB(1:1) = ubound(SrcWTDataData%bld, kind=B8Ki) if (.not. allocated(DstWTDataData%bld)) then allocate(DstWTDataData%bld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1106,8 +1106,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection DstWTDataData%motionType = SrcWTDataData%motionType if (allocated(SrcWTDataData%motion)) then - LB(1:2) = lbound(SrcWTDataData%motion) - UB(1:2) = ubound(SrcWTDataData%motion) + LB(1:2) = lbound(SrcWTDataData%motion, kind=B8Ki) + UB(1:2) = ubound(SrcWTDataData%motion, kind=B8Ki) if (.not. allocated(DstWTDataData%motion)) then allocate(DstWTDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1123,8 +1123,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%frequency = SrcWTDataData%frequency DstWTDataData%motionFileName = SrcWTDataData%motionFileName if (allocated(SrcWTDataData%WriteOutput)) then - LB(1:1) = lbound(SrcWTDataData%WriteOutput) - UB(1:1) = ubound(SrcWTDataData%WriteOutput) + LB(1:1) = lbound(SrcWTDataData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcWTDataData%WriteOutput, kind=B8Ki) if (.not. allocated(DstWTDataData%WriteOutput)) then allocate(DstWTDataData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1135,8 +1135,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput end if if (allocated(SrcWTDataData%userSwapArray)) then - LB(1:1) = lbound(SrcWTDataData%userSwapArray) - UB(1:1) = ubound(SrcWTDataData%userSwapArray) + LB(1:1) = lbound(SrcWTDataData%userSwapArray, kind=B8Ki) + UB(1:1) = ubound(SrcWTDataData%userSwapArray, kind=B8Ki) if (.not. allocated(DstWTDataData%userSwapArray)) then allocate(DstWTDataData%userSwapArray(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1152,8 +1152,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) type(WTData), intent(inout) :: WTDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' @@ -1166,8 +1166,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(WTDataData%map2hubPt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(WTDataData%map2BldPt)) then - LB(1:1) = lbound(WTDataData%map2BldPt) - UB(1:1) = ubound(WTDataData%map2BldPt) + LB(1:1) = lbound(WTDataData%map2BldPt, kind=B8Ki) + UB(1:1) = ubound(WTDataData%map2BldPt, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1175,8 +1175,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) deallocate(WTDataData%map2BldPt) end if if (allocated(WTDataData%bld)) then - LB(1:1) = lbound(WTDataData%bld) - UB(1:1) = ubound(WTDataData%bld) + LB(1:1) = lbound(WTDataData%bld, kind=B8Ki) + UB(1:1) = ubound(WTDataData%bld, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_DestroyBladeData(WTDataData%bld(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1204,8 +1204,8 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WTData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%originInit) call RegPack(Buf, InData%orientationInit) @@ -1214,18 +1214,18 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%map2hubPt) call RegPack(Buf, allocated(InData%map2BldPt)) if (allocated(InData%map2BldPt)) then - call RegPackBounds(Buf, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) - LB(1:1) = lbound(InData%map2BldPt) - UB(1:1) = ubound(InData%map2BldPt) + call RegPackBounds(Buf, 1, lbound(InData%map2BldPt, kind=B8Ki), ubound(InData%map2BldPt, kind=B8Ki)) + LB(1:1) = lbound(InData%map2BldPt, kind=B8Ki) + UB(1:1) = ubound(InData%map2BldPt, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%map2BldPt(i1)) end do end if call RegPack(Buf, allocated(InData%bld)) if (allocated(InData%bld)) then - call RegPackBounds(Buf, 1, lbound(InData%bld), ubound(InData%bld)) - LB(1:1) = lbound(InData%bld) - UB(1:1) = ubound(InData%bld) + call RegPackBounds(Buf, 1, lbound(InData%bld, kind=B8Ki), ubound(InData%bld, kind=B8Ki)) + LB(1:1) = lbound(InData%bld, kind=B8Ki) + UB(1:1) = ubound(InData%bld, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_PackBladeData(Buf, InData%bld(i1)) end do @@ -1242,7 +1242,7 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) call RegPack(Buf, InData%motionType) call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) call RegPack(Buf, InData%motion) end if call RegPack(Buf, InData%iMotion) @@ -1252,12 +1252,12 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) call RegPack(Buf, InData%motionFileName) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, allocated(InData%userSwapArray)) if (allocated(InData%userSwapArray)) then - call RegPackBounds(Buf, 1, lbound(InData%userSwapArray), ubound(InData%userSwapArray)) + call RegPackBounds(Buf, 1, lbound(InData%userSwapArray, kind=B8Ki), ubound(InData%userSwapArray, kind=B8Ki)) call RegPack(Buf, InData%userSwapArray) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1267,8 +1267,8 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WTData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1386,8 +1386,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_SimData' @@ -1405,8 +1405,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines if (allocated(SrcDvr_SimDataData%WT)) then - LB(1:1) = lbound(SrcDvr_SimDataData%WT) - UB(1:1) = ubound(SrcDvr_SimDataData%WT) + LB(1:1) = lbound(SrcDvr_SimDataData%WT, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_SimDataData%WT, kind=B8Ki) if (.not. allocated(DstDvr_SimDataData%WT)) then allocate(DstDvr_SimDataData%WT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1425,8 +1425,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases if (allocated(SrcDvr_SimDataData%Cases)) then - LB(1:1) = lbound(SrcDvr_SimDataData%Cases) - UB(1:1) = ubound(SrcDvr_SimDataData%Cases) + LB(1:1) = lbound(SrcDvr_SimDataData%Cases, kind=B8Ki) + UB(1:1) = ubound(SrcDvr_SimDataData%Cases, kind=B8Ki) if (.not. allocated(DstDvr_SimDataData%Cases)) then allocate(DstDvr_SimDataData%Cases(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1442,8 +1442,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo end if DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase if (allocated(SrcDvr_SimDataData%timeSeries)) then - LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries) - UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries) + LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries, kind=B8Ki) + UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries, kind=B8Ki) if (.not. allocated(DstDvr_SimDataData%timeSeries)) then allocate(DstDvr_SimDataData%timeSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1467,16 +1467,16 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) type(Dvr_SimData), intent(inout) :: Dvr_SimDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' ErrStat = ErrID_None ErrMsg = '' if (allocated(Dvr_SimDataData%WT)) then - LB(1:1) = lbound(Dvr_SimDataData%WT) - UB(1:1) = ubound(Dvr_SimDataData%WT) + LB(1:1) = lbound(Dvr_SimDataData%WT, kind=B8Ki) + UB(1:1) = ubound(Dvr_SimDataData%WT, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_DestroyWTData(Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1484,8 +1484,8 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) deallocate(Dvr_SimDataData%WT) end if if (allocated(Dvr_SimDataData%Cases)) then - LB(1:1) = lbound(Dvr_SimDataData%Cases) - UB(1:1) = ubound(Dvr_SimDataData%Cases) + LB(1:1) = lbound(Dvr_SimDataData%Cases, kind=B8Ki) + UB(1:1) = ubound(Dvr_SimDataData%Cases, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_DestroyDvr_Case(Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1505,8 +1505,8 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Dvr_SimData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AD_InputFile) call RegPack(Buf, InData%MHK) @@ -1521,9 +1521,9 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) call RegPack(Buf, InData%numTurbines) call RegPack(Buf, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) - LB(1:1) = lbound(InData%WT) - UB(1:1) = ubound(InData%WT) + call RegPackBounds(Buf, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) + LB(1:1) = lbound(InData%WT, kind=B8Ki) + UB(1:1) = ubound(InData%WT, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_PackWTData(Buf, InData%WT(i1)) end do @@ -1534,9 +1534,9 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) call RegPack(Buf, InData%numCases) call RegPack(Buf, allocated(InData%Cases)) if (allocated(InData%Cases)) then - call RegPackBounds(Buf, 1, lbound(InData%Cases), ubound(InData%Cases)) - LB(1:1) = lbound(InData%Cases) - UB(1:1) = ubound(InData%Cases) + call RegPackBounds(Buf, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) + LB(1:1) = lbound(InData%Cases, kind=B8Ki) + UB(1:1) = ubound(InData%Cases, kind=B8Ki) do i1 = LB(1), UB(1) call AD_Dvr_PackDvr_Case(Buf, InData%Cases(i1)) end do @@ -1544,7 +1544,7 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) call RegPack(Buf, InData%iCase) call RegPack(Buf, allocated(InData%timeSeries)) if (allocated(InData%timeSeries)) then - call RegPackBounds(Buf, 2, lbound(InData%timeSeries), ubound(InData%timeSeries)) + call RegPackBounds(Buf, 2, lbound(InData%timeSeries, kind=B8Ki), ubound(InData%timeSeries, kind=B8Ki)) call RegPack(Buf, InData%timeSeries) end if call RegPack(Buf, InData%iTimeSeries) @@ -1558,8 +1558,8 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Dvr_SimData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index d0acace6f4..c243d8f180 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -444,7 +444,7 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyInitOutput' @@ -454,8 +454,8 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -466,8 +466,8 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -506,12 +506,12 @@ subroutine ADI_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -521,7 +521,7 @@ subroutine ADI_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ADI_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -746,8 +746,8 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyMisc' @@ -760,8 +760,8 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%VTK_surfaces)) then - LB(1:1) = lbound(SrcMiscData%VTK_surfaces) - UB(1:1) = ubound(SrcMiscData%VTK_surfaces) + LB(1:1) = lbound(SrcMiscData%VTK_surfaces, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%VTK_surfaces, kind=B8Ki) if (.not. allocated(DstMiscData%VTK_surfaces)) then allocate(DstMiscData%VTK_surfaces(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -781,8 +781,8 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ADI_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyMisc' @@ -793,8 +793,8 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) call ADI_DestroyInflowWindData(MiscData%IW, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%VTK_surfaces)) then - LB(1:1) = lbound(MiscData%VTK_surfaces) - UB(1:1) = ubound(MiscData%VTK_surfaces) + LB(1:1) = lbound(MiscData%VTK_surfaces, kind=B8Ki) + UB(1:1) = ubound(MiscData%VTK_surfaces, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyVTK_RotSurfaceType(MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -807,16 +807,16 @@ subroutine ADI_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call AD_PackMisc(Buf, InData%AD) call ADI_PackInflowWindData(Buf, InData%IW) call RegPack(Buf, allocated(InData%VTK_surfaces)) if (allocated(InData%VTK_surfaces)) then - call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) - LB(1:1) = lbound(InData%VTK_surfaces) - UB(1:1) = ubound(InData%VTK_surfaces) + call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces, kind=B8Ki), ubound(InData%VTK_surfaces, kind=B8Ki)) + LB(1:1) = lbound(InData%VTK_surfaces, kind=B8Ki) + UB(1:1) = ubound(InData%VTK_surfaces, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackVTK_RotSurfaceType(Buf, InData%VTK_surfaces(i1)) end do @@ -828,8 +828,8 @@ subroutine ADI_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ADI_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -978,7 +978,7 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyOutput' @@ -988,8 +988,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%HHVel)) then - LB(1:2) = lbound(SrcOutputData%HHVel) - UB(1:2) = ubound(SrcOutputData%HHVel) + LB(1:2) = lbound(SrcOutputData%HHVel, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%HHVel, kind=B8Ki) if (.not. allocated(DstOutputData%HHVel)) then allocate(DstOutputData%HHVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1001,8 +1001,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if DstOutputData%PLExp = SrcOutputData%PLExp if (allocated(SrcOutputData%IW_WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%IW_WriteOutput) - UB(1:1) = ubound(SrcOutputData%IW_WriteOutput) + LB(1:1) = lbound(SrcOutputData%IW_WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%IW_WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%IW_WriteOutput)) then allocate(DstOutputData%IW_WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1013,8 +1013,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1056,18 +1056,18 @@ subroutine ADI_PackOutput(Buf, Indata) call AD_PackOutput(Buf, InData%AD) call RegPack(Buf, allocated(InData%HHVel)) if (allocated(InData%HHVel)) then - call RegPackBounds(Buf, 2, lbound(InData%HHVel), ubound(InData%HHVel)) + call RegPackBounds(Buf, 2, lbound(InData%HHVel, kind=B8Ki), ubound(InData%HHVel, kind=B8Ki)) call RegPack(Buf, InData%HHVel) end if call RegPack(Buf, InData%PLExp) call RegPack(Buf, allocated(InData%IW_WriteOutput)) if (allocated(InData%IW_WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput), ubound(InData%IW_WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput, kind=B8Ki), ubound(InData%IW_WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%IW_WriteOutput) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1077,7 +1077,7 @@ subroutine ADI_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ADI_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1134,16 +1134,16 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyData' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDataData%x)) then - LB(1:1) = lbound(SrcDataData%x) - UB(1:1) = ubound(SrcDataData%x) + LB(1:1) = lbound(SrcDataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcDataData%x, kind=B8Ki) if (.not. allocated(DstDataData%x)) then allocate(DstDataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1158,8 +1158,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%xd)) then - LB(1:1) = lbound(SrcDataData%xd) - UB(1:1) = ubound(SrcDataData%xd) + LB(1:1) = lbound(SrcDataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcDataData%xd, kind=B8Ki) if (.not. allocated(DstDataData%xd)) then allocate(DstDataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1174,8 +1174,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%z)) then - LB(1:1) = lbound(SrcDataData%z) - UB(1:1) = ubound(SrcDataData%z) + LB(1:1) = lbound(SrcDataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcDataData%z, kind=B8Ki) if (.not. allocated(DstDataData%z)) then allocate(DstDataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1190,8 +1190,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%OtherState)) then - LB(1:1) = lbound(SrcDataData%OtherState) - UB(1:1) = ubound(SrcDataData%OtherState) + LB(1:1) = lbound(SrcDataData%OtherState, kind=B8Ki) + UB(1:1) = ubound(SrcDataData%OtherState, kind=B8Ki) if (.not. allocated(DstDataData%OtherState)) then allocate(DstDataData%OtherState(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1212,8 +1212,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDataData%u)) then - LB(1:1) = lbound(SrcDataData%u) - UB(1:1) = ubound(SrcDataData%u) + LB(1:1) = lbound(SrcDataData%u, kind=B8Ki) + UB(1:1) = ubound(SrcDataData%u, kind=B8Ki) if (.not. allocated(DstDataData%u)) then allocate(DstDataData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1231,8 +1231,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDataData%inputTimes)) then - LB(1:1) = lbound(SrcDataData%inputTimes) - UB(1:1) = ubound(SrcDataData%inputTimes) + LB(1:1) = lbound(SrcDataData%inputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcDataData%inputTimes, kind=B8Ki) if (.not. allocated(DstDataData%inputTimes)) then allocate(DstDataData%inputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1248,16 +1248,16 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) type(ADI_Data), intent(inout) :: DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyData' ErrStat = ErrID_None ErrMsg = '' if (allocated(DataData%x)) then - LB(1:1) = lbound(DataData%x) - UB(1:1) = ubound(DataData%x) + LB(1:1) = lbound(DataData%x, kind=B8Ki) + UB(1:1) = ubound(DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_DestroyContState(DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1265,8 +1265,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%x) end if if (allocated(DataData%xd)) then - LB(1:1) = lbound(DataData%xd) - UB(1:1) = ubound(DataData%xd) + LB(1:1) = lbound(DataData%xd, kind=B8Ki) + UB(1:1) = ubound(DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_DestroyDiscState(DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1274,8 +1274,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%xd) end if if (allocated(DataData%z)) then - LB(1:1) = lbound(DataData%z) - UB(1:1) = ubound(DataData%z) + LB(1:1) = lbound(DataData%z, kind=B8Ki) + UB(1:1) = ubound(DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_DestroyConstrState(DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1283,8 +1283,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%z) end if if (allocated(DataData%OtherState)) then - LB(1:1) = lbound(DataData%OtherState) - UB(1:1) = ubound(DataData%OtherState) + LB(1:1) = lbound(DataData%OtherState, kind=B8Ki) + UB(1:1) = ubound(DataData%OtherState, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_DestroyOtherState(DataData%OtherState(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1296,8 +1296,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) call ADI_DestroyMisc(DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(DataData%u)) then - LB(1:1) = lbound(DataData%u) - UB(1:1) = ubound(DataData%u) + LB(1:1) = lbound(DataData%u, kind=B8Ki) + UB(1:1) = ubound(DataData%u, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_DestroyInput(DataData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1315,41 +1315,41 @@ subroutine ADI_PackData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackData' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_PackContState(Buf, InData%x(i1)) end do end if call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(Buf, 1, lbound(InData%xd), ubound(InData%xd)) - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + call RegPackBounds(Buf, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_PackDiscState(Buf, InData%xd(i1)) end do end if call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_PackConstrState(Buf, InData%z(i1)) end do end if call RegPack(Buf, allocated(InData%OtherState)) if (allocated(InData%OtherState)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherState), ubound(InData%OtherState)) - LB(1:1) = lbound(InData%OtherState) - UB(1:1) = ubound(InData%OtherState) + call RegPackBounds(Buf, 1, lbound(InData%OtherState, kind=B8Ki), ubound(InData%OtherState, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherState, kind=B8Ki) + UB(1:1) = ubound(InData%OtherState, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_PackOtherState(Buf, InData%OtherState(i1)) end do @@ -1358,9 +1358,9 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) - LB(1:1) = lbound(InData%u) - UB(1:1) = ubound(InData%u) + call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + LB(1:1) = lbound(InData%u, kind=B8Ki) + UB(1:1) = ubound(InData%u, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_PackInput(Buf, InData%u(i1)) end do @@ -1368,7 +1368,7 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackOutput(Buf, InData%y) call RegPack(Buf, allocated(InData%inputTimes)) if (allocated(InData%inputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%inputTimes), ubound(InData%inputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%inputTimes, kind=B8Ki), ubound(InData%inputTimes, kind=B8Ki)) call RegPack(Buf, InData%inputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1378,8 +1378,8 @@ subroutine ADI_UnPackData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ADI_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackData' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1483,8 +1483,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyRotFED' @@ -1506,8 +1506,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion) - UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion) + LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion, kind=B8Ki) if (.not. allocated(DstRotFEDData%BladeRootMotion)) then allocate(DstRotFEDData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1522,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs end do end if if (allocated(SrcRotFEDData%BladeLn2Mesh)) then - LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) - UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh) + LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh, kind=B8Ki) + UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh, kind=B8Ki) if (.not. allocated(DstRotFEDData%BladeLn2Mesh)) then allocate(DstRotFEDData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1547,8 +1547,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%AD_P_2_AD_L_B)) then - LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B) - UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B) + LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B, kind=B8Ki) + UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B, kind=B8Ki) if (.not. allocated(DstRotFEDData%AD_P_2_AD_L_B)) then allocate(DstRotFEDData%AD_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1566,8 +1566,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R) - UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R) + LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R, kind=B8Ki) + UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R, kind=B8Ki) if (.not. allocated(DstRotFEDData%ED_P_2_AD_P_R)) then allocate(DstRotFEDData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1593,8 +1593,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) type(RotFED), intent(inout) :: RotFEDData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' @@ -1611,8 +1611,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%BladeRootMotion)) then - LB(1:1) = lbound(RotFEDData%BladeRootMotion) - UB(1:1) = ubound(RotFEDData%BladeRootMotion) + LB(1:1) = lbound(RotFEDData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(RotFEDData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1620,8 +1620,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) deallocate(RotFEDData%BladeRootMotion) end if if (allocated(RotFEDData%BladeLn2Mesh)) then - LB(1:1) = lbound(RotFEDData%BladeLn2Mesh) - UB(1:1) = ubound(RotFEDData%BladeLn2Mesh) + LB(1:1) = lbound(RotFEDData%BladeLn2Mesh, kind=B8Ki) + UB(1:1) = ubound(RotFEDData%BladeLn2Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1633,8 +1633,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%AD_P_2_AD_L_B)) then - LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) - UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) + LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B, kind=B8Ki) + UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1644,8 +1644,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) - UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) + LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R, kind=B8Ki) + UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1662,8 +1662,8 @@ subroutine ADI_PackRotFED(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotFED), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackRotFED' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%PlatformPtMesh) call MeshPack(Buf, InData%TwrPtMesh) @@ -1672,18 +1672,18 @@ subroutine ADI_PackRotFED(Buf, Indata) call MeshPack(Buf, InData%HubPtMotion) call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) - LB(1:1) = lbound(InData%BladeRootMotion) - UB(1:1) = ubound(InData%BladeRootMotion) + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeRootMotion(i1)) end do end if call RegPack(Buf, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) - LB(1:1) = lbound(InData%BladeLn2Mesh) - UB(1:1) = ubound(InData%BladeLn2Mesh) + call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) + UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeLn2Mesh(i1)) end do @@ -1695,9 +1695,9 @@ subroutine ADI_PackRotFED(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_T) call RegPack(Buf, allocated(InData%AD_P_2_AD_L_B)) if (allocated(InData%AD_P_2_AD_L_B)) then - call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) - LB(1:1) = lbound(InData%AD_P_2_AD_L_B) - UB(1:1) = ubound(InData%AD_P_2_AD_L_B) + call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B, kind=B8Ki), ubound(InData%AD_P_2_AD_L_B, kind=B8Ki)) + LB(1:1) = lbound(InData%AD_P_2_AD_L_B, kind=B8Ki) + UB(1:1) = ubound(InData%AD_P_2_AD_L_B, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_B(i1)) end do @@ -1705,9 +1705,9 @@ subroutine ADI_PackRotFED(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) - LB(1:1) = lbound(InData%ED_P_2_AD_P_R) - UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) end do @@ -1721,8 +1721,8 @@ subroutine ADI_UnPackRotFED(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotFED), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1810,16 +1810,16 @@ subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyFED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcFED_DataData%WT)) then - LB(1:1) = lbound(SrcFED_DataData%WT) - UB(1:1) = ubound(SrcFED_DataData%WT) + LB(1:1) = lbound(SrcFED_DataData%WT, kind=B8Ki) + UB(1:1) = ubound(SrcFED_DataData%WT, kind=B8Ki) if (.not. allocated(DstFED_DataData%WT)) then allocate(DstFED_DataData%WT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1839,16 +1839,16 @@ subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) type(FED_Data), intent(inout) :: FED_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyFED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(FED_DataData%WT)) then - LB(1:1) = lbound(FED_DataData%WT) - UB(1:1) = ubound(FED_DataData%WT) + LB(1:1) = lbound(FED_DataData%WT, kind=B8Ki) + UB(1:1) = ubound(FED_DataData%WT, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_DestroyRotFED(FED_DataData%WT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1861,14 +1861,14 @@ subroutine ADI_PackFED_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FED_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackFED_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) - LB(1:1) = lbound(InData%WT) - UB(1:1) = ubound(InData%WT) + call RegPackBounds(Buf, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) + LB(1:1) = lbound(InData%WT, kind=B8Ki) + UB(1:1) = ubound(InData%WT, kind=B8Ki) do i1 = LB(1), UB(1) call ADI_PackRotFED(Buf, InData%WT(i1)) end do @@ -1880,8 +1880,8 @@ subroutine ADI_UnPackFED_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FED_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 3bd6d76a50..09b91be6f3 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -623,14 +623,14 @@ subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTy integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyVTK_BLSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) - UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -661,7 +661,7 @@ subroutine AD_PackVTK_BLSurfaceType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AirfoilCoords)) if (allocated(InData%AirfoilCoords)) then - call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords, kind=B8Ki), ubound(InData%AirfoilCoords, kind=B8Ki)) call RegPack(Buf, InData%AirfoilCoords) end if if (RegCheckErr(Buf, RoutineName)) return @@ -671,7 +671,7 @@ subroutine AD_UnPackVTK_BLSurfaceType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -697,16 +697,16 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyVTK_RotSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_RotSurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape) - UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape) + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) if (.not. allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then allocate(DstVTK_RotSurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -721,8 +721,8 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac end do end if if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then - LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) - UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad) + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad, kind=B8Ki) if (.not. allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then allocate(DstVTK_RotSurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -738,16 +738,16 @@ subroutine AD_DestroyVTK_RotSurfaceType(VTK_RotSurfaceTypeData, ErrStat, ErrMsg) type(AD_VTK_RotSurfaceType), intent(inout) :: VTK_RotSurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(VTK_RotSurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape) - UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape) + LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyVTK_BLSurfaceType(VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -763,21 +763,21 @@ subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_VTK_RotSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) - LB(1:1) = lbound(InData%BladeShape) - UB(1:1) = ubound(InData%BladeShape) + call RegPackBounds(Buf, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) end do end if call RegPack(Buf, allocated(InData%TowerRad)) if (allocated(InData%TowerRad)) then - call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) + call RegPackBounds(Buf, 1, lbound(InData%TowerRad, kind=B8Ki), ubound(InData%TowerRad, kind=B8Ki)) call RegPack(Buf, InData%TowerRad) end if if (RegCheckErr(Buf, RoutineName)) return @@ -787,8 +787,8 @@ subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_VTK_RotSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -829,7 +829,7 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyRotInitInputType' ErrStat = ErrID_None @@ -839,8 +839,8 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation if (allocated(SrcRotInitInputTypeData%BladeRootPosition)) then - LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition) - UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition) + LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition, kind=B8Ki) + UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition, kind=B8Ki) if (.not. allocated(DstRotInitInputTypeData%BladeRootPosition)) then allocate(DstRotInitInputTypeData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -851,8 +851,8 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition end if if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then - LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) - UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation) + LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation, kind=B8Ki) + UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation, kind=B8Ki) if (.not. allocated(DstRotInitInputTypeData%BladeRootOrientation)) then allocate(DstRotInitInputTypeData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -895,12 +895,12 @@ subroutine AD_PackRotInitInputType(Buf, Indata) call RegPack(Buf, InData%HubOrientation) call RegPack(Buf, allocated(InData%BladeRootPosition)) if (allocated(InData%BladeRootPosition)) then - call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition), ubound(InData%BladeRootPosition)) + call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition, kind=B8Ki), ubound(InData%BladeRootPosition, kind=B8Ki)) call RegPack(Buf, InData%BladeRootPosition) end if call RegPack(Buf, allocated(InData%BladeRootOrientation)) if (allocated(InData%BladeRootOrientation)) then - call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation), ubound(InData%BladeRootOrientation)) + call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation, kind=B8Ki), ubound(InData%BladeRootOrientation, kind=B8Ki)) call RegPack(Buf, InData%BladeRootOrientation) end if call RegPack(Buf, InData%NacellePosition) @@ -915,7 +915,7 @@ subroutine AD_UnPackRotInitInputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotInitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -973,16 +973,16 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitInputData%rotors)) then - LB(1:1) = lbound(SrcInitInputData%rotors) - UB(1:1) = ubound(SrcInitInputData%rotors) + LB(1:1) = lbound(SrcInitInputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%rotors, kind=B8Ki) if (.not. allocated(DstInitInputData%rotors)) then allocate(DstInitInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1019,16 +1019,16 @@ subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AD_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%rotors)) then - LB(1:1) = lbound(InitInputData%rotors) - UB(1:1) = ubound(InitInputData%rotors) + LB(1:1) = lbound(InitInputData%rotors, kind=B8Ki) + UB(1:1) = ubound(InitInputData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotInitInputType(InitInputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1043,14 +1043,14 @@ subroutine AD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotInitInputType(Buf, InData%rotors(i1)) end do @@ -1077,8 +1077,8 @@ subroutine AD_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1134,15 +1134,15 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBladePropsType' ErrStat = ErrID_None ErrMsg = '' DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds if (allocated(SrcBladePropsTypeData%BlSpn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn) - UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn) + LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlSpn)) then allocate(DstBladePropsTypeData%BlSpn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1153,8 +1153,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn end if if (allocated(SrcBladePropsTypeData%BlCrvAC)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCrvAC)) then allocate(DstBladePropsTypeData%BlCrvAC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1165,8 +1165,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC end if if (allocated(SrcBladePropsTypeData%BlSwpAC)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) - UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC) + LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlSwpAC)) then allocate(DstBladePropsTypeData%BlSwpAC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1177,8 +1177,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC end if if (allocated(SrcBladePropsTypeData%BlCrvAng)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCrvAng)) then allocate(DstBladePropsTypeData%BlCrvAng(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1189,8 +1189,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng end if if (allocated(SrcBladePropsTypeData%BlTwist)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) - UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist) + LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlTwist)) then allocate(DstBladePropsTypeData%BlTwist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1201,8 +1201,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist end if if (allocated(SrcBladePropsTypeData%BlChord)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) - UB(1:1) = ubound(SrcBladePropsTypeData%BlChord) + LB(1:1) = lbound(SrcBladePropsTypeData%BlChord, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlChord, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlChord)) then allocate(DstBladePropsTypeData%BlChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1213,8 +1213,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord end if if (allocated(SrcBladePropsTypeData%BlAFID)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) - UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID) + LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlAFID)) then allocate(DstBladePropsTypeData%BlAFID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1225,8 +1225,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID end if if (allocated(SrcBladePropsTypeData%BlCb)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCb, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCb, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCb)) then allocate(DstBladePropsTypeData%BlCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1237,8 +1237,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb end if if (allocated(SrcBladePropsTypeData%BlCenBn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCenBn)) then allocate(DstBladePropsTypeData%BlCenBn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1249,8 +1249,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn end if if (allocated(SrcBladePropsTypeData%BlCenBt)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt, kind=B8Ki) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt, kind=B8Ki) if (.not. allocated(DstBladePropsTypeData%BlCenBt)) then allocate(DstBladePropsTypeData%BlCenBt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1309,52 +1309,52 @@ subroutine AD_PackBladePropsType(Buf, Indata) call RegPack(Buf, InData%NumBlNds) call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then - call RegPackBounds(Buf, 1, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPackBounds(Buf, 1, lbound(InData%BlSpn, kind=B8Ki), ubound(InData%BlSpn, kind=B8Ki)) call RegPack(Buf, InData%BlSpn) end if call RegPack(Buf, allocated(InData%BlCrvAC)) if (allocated(InData%BlCrvAC)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC), ubound(InData%BlCrvAC)) + call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC, kind=B8Ki), ubound(InData%BlCrvAC, kind=B8Ki)) call RegPack(Buf, InData%BlCrvAC) end if call RegPack(Buf, allocated(InData%BlSwpAC)) if (allocated(InData%BlSwpAC)) then - call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC), ubound(InData%BlSwpAC)) + call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC, kind=B8Ki), ubound(InData%BlSwpAC, kind=B8Ki)) call RegPack(Buf, InData%BlSwpAC) end if call RegPack(Buf, allocated(InData%BlCrvAng)) if (allocated(InData%BlCrvAng)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng), ubound(InData%BlCrvAng)) + call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng, kind=B8Ki), ubound(InData%BlCrvAng, kind=B8Ki)) call RegPack(Buf, InData%BlCrvAng) end if call RegPack(Buf, allocated(InData%BlTwist)) if (allocated(InData%BlTwist)) then - call RegPackBounds(Buf, 1, lbound(InData%BlTwist), ubound(InData%BlTwist)) + call RegPackBounds(Buf, 1, lbound(InData%BlTwist, kind=B8Ki), ubound(InData%BlTwist, kind=B8Ki)) call RegPack(Buf, InData%BlTwist) end if call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then - call RegPackBounds(Buf, 1, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPackBounds(Buf, 1, lbound(InData%BlChord, kind=B8Ki), ubound(InData%BlChord, kind=B8Ki)) call RegPack(Buf, InData%BlChord) end if call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then - call RegPackBounds(Buf, 1, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPackBounds(Buf, 1, lbound(InData%BlAFID, kind=B8Ki), ubound(InData%BlAFID, kind=B8Ki)) call RegPack(Buf, InData%BlAFID) end if call RegPack(Buf, allocated(InData%BlCb)) if (allocated(InData%BlCb)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCb), ubound(InData%BlCb)) + call RegPackBounds(Buf, 1, lbound(InData%BlCb, kind=B8Ki), ubound(InData%BlCb, kind=B8Ki)) call RegPack(Buf, InData%BlCb) end if call RegPack(Buf, allocated(InData%BlCenBn)) if (allocated(InData%BlCenBn)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) + call RegPackBounds(Buf, 1, lbound(InData%BlCenBn, kind=B8Ki), ubound(InData%BlCenBn, kind=B8Ki)) call RegPack(Buf, InData%BlCenBn) end if call RegPack(Buf, allocated(InData%BlCenBt)) if (allocated(InData%BlCenBt)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) + call RegPackBounds(Buf, 1, lbound(InData%BlCenBt, kind=B8Ki), ubound(InData%BlCenBt, kind=B8Ki)) call RegPack(Buf, InData%BlCenBt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1364,7 +1364,7 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_BladePropsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1518,14 +1518,14 @@ subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBladeShape' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladeShapeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords) - UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords) + LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords, kind=B8Ki) + UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords, kind=B8Ki) if (.not. allocated(DstBladeShapeData%AirfoilCoords)) then allocate(DstBladeShapeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1556,7 +1556,7 @@ subroutine AD_PackBladeShape(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AirfoilCoords)) if (allocated(InData%AirfoilCoords)) then - call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords, kind=B8Ki), ubound(InData%AirfoilCoords, kind=B8Ki)) call RegPack(Buf, InData%AirfoilCoords) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1566,7 +1566,7 @@ subroutine AD_UnPackBladeShape(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_BladeShape), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1592,8 +1592,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' @@ -1601,8 +1601,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy ErrMsg = '' DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) - UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr) + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then allocate(DstRotInitOutputTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1613,8 +1613,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr end if if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) - UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt) + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then allocate(DstRotInitOutputTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1625,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt end if if (allocated(SrcRotInitOutputTypeData%BladeShape)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) - UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape) + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%BladeShape)) then allocate(DstRotInitOutputTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1641,8 +1641,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end do end if if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%LinNames_y)) then allocate(DstRotInitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1653,8 +1653,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y end if if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%LinNames_x)) then allocate(DstRotInitOutputTypeData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1665,8 +1665,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x end if if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%LinNames_u)) then allocate(DstRotInitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1677,8 +1677,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u end if if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_y)) then allocate(DstRotInitOutputTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1689,8 +1689,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y end if if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_x)) then allocate(DstRotInitOutputTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1701,8 +1701,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x end if if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_u)) then allocate(DstRotInitOutputTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1713,8 +1713,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u end if if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) - UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u) + LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%IsLoad_u)) then allocate(DstRotInitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1725,8 +1725,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u end if if (allocated(SrcRotInitOutputTypeData%BladeProps)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) - UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps) + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%BladeProps)) then allocate(DstRotInitOutputTypeData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1741,8 +1741,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end do end if if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) - UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x) + LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%DerivOrder_x)) then allocate(DstRotInitOutputTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1753,8 +1753,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x end if if (allocated(SrcRotInitOutputTypeData%TwrElev)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) - UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev) + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%TwrElev)) then allocate(DstRotInitOutputTypeData%TwrElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1765,8 +1765,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev end if if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) - UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam) + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam, kind=B8Ki) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam, kind=B8Ki) if (.not. allocated(DstRotInitOutputTypeData%TwrDiam)) then allocate(DstRotInitOutputTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1782,8 +1782,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) type(RotInitOutputType), intent(inout) :: RotInitOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' @@ -1796,8 +1796,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) deallocate(RotInitOutputTypeData%WriteOutputUnt) end if if (allocated(RotInitOutputTypeData%BladeShape)) then - LB(1:1) = lbound(RotInitOutputTypeData%BladeShape) - UB(1:1) = ubound(RotInitOutputTypeData%BladeShape) + LB(1:1) = lbound(RotInitOutputTypeData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(RotInitOutputTypeData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyBladeShape(RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1826,8 +1826,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) deallocate(RotInitOutputTypeData%IsLoad_u) end if if (allocated(RotInitOutputTypeData%BladeProps)) then - LB(1:1) = lbound(RotInitOutputTypeData%BladeProps) - UB(1:1) = ubound(RotInitOutputTypeData%BladeProps) + LB(1:1) = lbound(RotInitOutputTypeData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(RotInitOutputTypeData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyBladePropsType(RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1849,86 +1849,86 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotInitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AirDens) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) - LB(1:1) = lbound(InData%BladeShape) - UB(1:1) = ubound(InData%BladeShape) + call RegPackBounds(Buf, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackBladeShape(Buf, InData%BladeShape(i1)) end do end if call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) - LB(1:1) = lbound(InData%BladeProps) - UB(1:1) = ubound(InData%BladeProps) + call RegPackBounds(Buf, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) end do end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if call RegPack(Buf, allocated(InData%TwrElev)) if (allocated(InData%TwrElev)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) + call RegPackBounds(Buf, 1, lbound(InData%TwrElev, kind=B8Ki), ubound(InData%TwrElev, kind=B8Ki)) call RegPack(Buf, InData%TwrElev) end if call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam, kind=B8Ki), ubound(InData%TwrDiam, kind=B8Ki)) call RegPack(Buf, InData%TwrDiam) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1938,8 +1938,8 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotInitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2151,16 +2151,16 @@ subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%rotors)) then - LB(1:1) = lbound(SrcInitOutputData%rotors) - UB(1:1) = ubound(SrcInitOutputData%rotors) + LB(1:1) = lbound(SrcInitOutputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%rotors, kind=B8Ki) if (.not. allocated(DstInitOutputData%rotors)) then allocate(DstInitOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2183,16 +2183,16 @@ subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AD_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitOutputData%rotors)) then - LB(1:1) = lbound(InitOutputData%rotors) - UB(1:1) = ubound(InitOutputData%rotors) + LB(1:1) = lbound(InitOutputData%rotors, kind=B8Ki) + UB(1:1) = ubound(InitOutputData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotInitOutputType(InitOutputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2207,14 +2207,14 @@ subroutine AD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotInitOutputType(Buf, InData%rotors(i1)) end do @@ -2227,8 +2227,8 @@ subroutine AD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2256,16 +2256,16 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInputFile' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcRotInputFileData%BladeProps)) then - LB(1:1) = lbound(SrcRotInputFileData%BladeProps) - UB(1:1) = ubound(SrcRotInputFileData%BladeProps) + LB(1:1) = lbound(SrcRotInputFileData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%BladeProps, kind=B8Ki) if (.not. allocated(DstRotInputFileData%BladeProps)) then allocate(DstRotInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2281,8 +2281,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds if (allocated(SrcRotInputFileData%TwrElev)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrElev) - UB(1:1) = ubound(SrcRotInputFileData%TwrElev) + LB(1:1) = lbound(SrcRotInputFileData%TwrElev, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrElev, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrElev)) then allocate(DstRotInputFileData%TwrElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2293,8 +2293,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev end if if (allocated(SrcRotInputFileData%TwrDiam)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) - UB(1:1) = ubound(SrcRotInputFileData%TwrDiam) + LB(1:1) = lbound(SrcRotInputFileData%TwrDiam, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrDiam, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrDiam)) then allocate(DstRotInputFileData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2305,8 +2305,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam end if if (allocated(SrcRotInputFileData%TwrCd)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCd) - UB(1:1) = ubound(SrcRotInputFileData%TwrCd) + LB(1:1) = lbound(SrcRotInputFileData%TwrCd, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrCd, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrCd)) then allocate(DstRotInputFileData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2317,8 +2317,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd end if if (allocated(SrcRotInputFileData%TwrTI)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrTI) - UB(1:1) = ubound(SrcRotInputFileData%TwrTI) + LB(1:1) = lbound(SrcRotInputFileData%TwrTI, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrTI, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrTI)) then allocate(DstRotInputFileData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2329,8 +2329,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI end if if (allocated(SrcRotInputFileData%TwrCb)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCb) - UB(1:1) = ubound(SrcRotInputFileData%TwrCb) + LB(1:1) = lbound(SrcRotInputFileData%TwrCb, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputFileData%TwrCb, kind=B8Ki) if (.not. allocated(DstRotInputFileData%TwrCb)) then allocate(DstRotInputFileData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2355,16 +2355,16 @@ subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) type(RotInputFile), intent(inout) :: RotInputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInputFile' ErrStat = ErrID_None ErrMsg = '' if (allocated(RotInputFileData%BladeProps)) then - LB(1:1) = lbound(RotInputFileData%BladeProps) - UB(1:1) = ubound(RotInputFileData%BladeProps) + LB(1:1) = lbound(RotInputFileData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(RotInputFileData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyBladePropsType(RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2394,14 +2394,14 @@ subroutine AD_PackRotInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotInputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputFile' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) - LB(1:1) = lbound(InData%BladeProps) - UB(1:1) = ubound(InData%BladeProps) + call RegPackBounds(Buf, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) + UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) end do @@ -2409,27 +2409,27 @@ subroutine AD_PackRotInputFile(Buf, Indata) call RegPack(Buf, InData%NumTwrNds) call RegPack(Buf, allocated(InData%TwrElev)) if (allocated(InData%TwrElev)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) + call RegPackBounds(Buf, 1, lbound(InData%TwrElev, kind=B8Ki), ubound(InData%TwrElev, kind=B8Ki)) call RegPack(Buf, InData%TwrElev) end if call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam, kind=B8Ki), ubound(InData%TwrDiam, kind=B8Ki)) call RegPack(Buf, InData%TwrDiam) end if call RegPack(Buf, allocated(InData%TwrCd)) if (allocated(InData%TwrCd)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCd, kind=B8Ki), ubound(InData%TwrCd, kind=B8Ki)) call RegPack(Buf, InData%TwrCd) end if call RegPack(Buf, allocated(InData%TwrTI)) if (allocated(InData%TwrTI)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) + call RegPackBounds(Buf, 1, lbound(InData%TwrTI, kind=B8Ki), ubound(InData%TwrTI, kind=B8Ki)) call RegPack(Buf, InData%TwrTI) end if call RegPack(Buf, allocated(InData%TwrCb)) if (allocated(InData%TwrCb)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCb, kind=B8Ki), ubound(InData%TwrCb, kind=B8Ki)) call RegPack(Buf, InData%TwrCb) end if call RegPack(Buf, InData%VolHub) @@ -2446,8 +2446,8 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotInputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2559,8 +2559,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInputFile' @@ -2579,8 +2579,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%CompAA = SrcInputFileData%CompAA DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile if (allocated(SrcInputFileData%ADBlFile)) then - LB(1:1) = lbound(SrcInputFileData%ADBlFile) - UB(1:1) = ubound(SrcInputFileData%ADBlFile) + LB(1:1) = lbound(SrcInputFileData%ADBlFile, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%ADBlFile, kind=B8Ki) if (.not. allocated(DstInputFileData%ADBlFile)) then allocate(DstInputFileData%ADBlFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2615,8 +2615,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName if (allocated(SrcInputFileData%AFNames)) then - LB(1:1) = lbound(SrcInputFileData%AFNames) - UB(1:1) = ubound(SrcInputFileData%AFNames) + LB(1:1) = lbound(SrcInputFileData%AFNames, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%AFNames, kind=B8Ki) if (.not. allocated(DstInputFileData%AFNames)) then allocate(DstInputFileData%AFNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2634,8 +2634,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2649,8 +2649,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2665,8 +2665,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad if (allocated(SrcInputFileData%rotors)) then - LB(1:1) = lbound(SrcInputFileData%rotors) - UB(1:1) = ubound(SrcInputFileData%rotors) + LB(1:1) = lbound(SrcInputFileData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%rotors, kind=B8Ki) if (.not. allocated(DstInputFileData%rotors)) then allocate(DstInputFileData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2686,8 +2686,8 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(AD_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInputFile' @@ -2706,8 +2706,8 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%BldNd_OutList) end if if (allocated(InputFileData%rotors)) then - LB(1:1) = lbound(InputFileData%rotors) - UB(1:1) = ubound(InputFileData%rotors) + LB(1:1) = lbound(InputFileData%rotors, kind=B8Ki) + UB(1:1) = ubound(InputFileData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotInputFile(InputFileData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2720,8 +2720,8 @@ subroutine AD_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInputFile' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Echo) call RegPack(Buf, InData%DTAero) @@ -2737,7 +2737,7 @@ subroutine AD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%AA_InputFile) call RegPack(Buf, allocated(InData%ADBlFile)) if (allocated(InData%ADBlFile)) then - call RegPackBounds(Buf, 1, lbound(InData%ADBlFile), ubound(InData%ADBlFile)) + call RegPackBounds(Buf, 1, lbound(InData%ADBlFile, kind=B8Ki), ubound(InData%ADBlFile, kind=B8Ki)) call RegPack(Buf, InData%ADBlFile) end if call RegPack(Buf, InData%AirDens) @@ -2766,7 +2766,7 @@ subroutine AD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%FVWFileName) call RegPack(Buf, allocated(InData%AFNames)) if (allocated(InData%AFNames)) then - call RegPackBounds(Buf, 1, lbound(InData%AFNames), ubound(InData%AFNames)) + call RegPackBounds(Buf, 1, lbound(InData%AFNames, kind=B8Ki), ubound(InData%AFNames, kind=B8Ki)) call RegPack(Buf, InData%AFNames) end if call RegPack(Buf, InData%UseBlCm) @@ -2778,7 +2778,7 @@ subroutine AD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%tau1_const) @@ -2786,7 +2786,7 @@ subroutine AD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%BldNd_NumOuts) call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList, kind=B8Ki), ubound(InData%BldNd_OutList, kind=B8Ki)) call RegPack(Buf, InData%BldNd_OutList) end if call RegPack(Buf, InData%BldNd_BlOutNd_Str) @@ -2795,9 +2795,9 @@ subroutine AD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%UAEndRad) call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotInputFile(Buf, InData%rotors(i1)) end do @@ -2809,8 +2809,8 @@ subroutine AD_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInputFile' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3046,16 +3046,16 @@ subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%rotors)) then - LB(1:1) = lbound(SrcContStateData%rotors) - UB(1:1) = ubound(SrcContStateData%rotors) + LB(1:1) = lbound(SrcContStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%rotors, kind=B8Ki) if (.not. allocated(DstContStateData%rotors)) then allocate(DstContStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3078,16 +3078,16 @@ subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) type(AD_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%rotors)) then - LB(1:1) = lbound(ContStateData%rotors) - UB(1:1) = ubound(ContStateData%rotors) + LB(1:1) = lbound(ContStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(ContStateData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotContinuousStateType(ContStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3102,14 +3102,14 @@ subroutine AD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotContinuousStateType(Buf, InData%rotors(i1)) end do @@ -3122,8 +3122,8 @@ subroutine AD_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3204,16 +3204,16 @@ subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%rotors)) then - LB(1:1) = lbound(SrcDiscStateData%rotors) - UB(1:1) = ubound(SrcDiscStateData%rotors) + LB(1:1) = lbound(SrcDiscStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%rotors, kind=B8Ki) if (.not. allocated(DstDiscStateData%rotors)) then allocate(DstDiscStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3236,16 +3236,16 @@ subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(AD_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%rotors)) then - LB(1:1) = lbound(DiscStateData%rotors) - UB(1:1) = ubound(DiscStateData%rotors) + LB(1:1) = lbound(DiscStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotDiscreteStateType(DiscStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3260,14 +3260,14 @@ subroutine AD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotDiscreteStateType(Buf, InData%rotors(i1)) end do @@ -3280,8 +3280,8 @@ subroutine AD_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3362,16 +3362,16 @@ subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%rotors)) then - LB(1:1) = lbound(SrcConstrStateData%rotors) - UB(1:1) = ubound(SrcConstrStateData%rotors) + LB(1:1) = lbound(SrcConstrStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%rotors, kind=B8Ki) if (.not. allocated(DstConstrStateData%rotors)) then allocate(DstConstrStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3394,16 +3394,16 @@ subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(AD_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%rotors)) then - LB(1:1) = lbound(ConstrStateData%rotors) - UB(1:1) = ubound(ConstrStateData%rotors) + LB(1:1) = lbound(ConstrStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotConstraintStateType(ConstrStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3418,14 +3418,14 @@ subroutine AD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotConstraintStateType(Buf, InData%rotors(i1)) end do @@ -3438,8 +3438,8 @@ subroutine AD_UnPackConstrState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3520,16 +3520,16 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%rotors)) then - LB(1:1) = lbound(SrcOtherStateData%rotors) - UB(1:1) = ubound(SrcOtherStateData%rotors) + LB(1:1) = lbound(SrcOtherStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%rotors, kind=B8Ki) if (.not. allocated(DstOtherStateData%rotors)) then allocate(DstOtherStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3547,8 +3547,8 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOtherStateData%WakeLocationPoints)) then - LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints) - UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints) + LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints, kind=B8Ki) if (.not. allocated(DstOtherStateData%WakeLocationPoints)) then allocate(DstOtherStateData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3564,16 +3564,16 @@ subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(AD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%rotors)) then - LB(1:1) = lbound(OtherStateData%rotors) - UB(1:1) = ubound(OtherStateData%rotors) + LB(1:1) = lbound(OtherStateData%rotors, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotOtherStateType(OtherStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3591,14 +3591,14 @@ subroutine AD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotOtherStateType(Buf, InData%rotors(i1)) end do @@ -3606,7 +3606,7 @@ subroutine AD_PackOtherState(Buf, Indata) call FVW_PackOtherState(Buf, InData%FVW) call RegPack(Buf, allocated(InData%WakeLocationPoints)) if (allocated(InData%WakeLocationPoints)) then - call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints), ubound(InData%WakeLocationPoints)) + call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints, kind=B8Ki), ubound(InData%WakeLocationPoints, kind=B8Ki)) call RegPack(Buf, InData%WakeLocationPoints) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3616,8 +3616,8 @@ subroutine AD_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3659,8 +3659,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' @@ -3672,8 +3672,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3689,8 +3689,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) - UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3701,8 +3701,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow end if if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) - UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3713,8 +3713,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus end if if (allocated(SrcRotMiscVarTypeData%R_li)) then - LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li) - UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li) + LB(1:4) = lbound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) + UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%R_li)) then allocate(DstRotMiscVarTypeData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3725,8 +3725,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li end if if (allocated(SrcRotMiscVarTypeData%AllOuts)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) - UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3737,8 +3737,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts end if if (allocated(SrcRotMiscVarTypeData%W_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) - UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3749,8 +3749,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr end if if (allocated(SrcRotMiscVarTypeData%X_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) - UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3761,8 +3761,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr end if if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) - UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3773,8 +3773,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr end if if (allocated(SrcRotMiscVarTypeData%Curve)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Curve) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Curve, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Curve)) then allocate(DstRotMiscVarTypeData%Curve(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3785,8 +3785,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve end if if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3797,8 +3797,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc end if if (allocated(SrcRotMiscVarTypeData%X)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%X) - UB(1:2) = ubound(SrcRotMiscVarTypeData%X) + LB(1:2) = lbound(SrcRotMiscVarTypeData%X, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%X)) then allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3809,8 +3809,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X end if if (allocated(SrcRotMiscVarTypeData%Y)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Y)) then allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3821,8 +3821,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y end if if (allocated(SrcRotMiscVarTypeData%Z)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Z)) then allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3833,8 +3833,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z end if if (allocated(SrcRotMiscVarTypeData%M)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%M) - UB(1:2) = ubound(SrcRotMiscVarTypeData%M) + LB(1:2) = lbound(SrcRotMiscVarTypeData%M, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%M)) then allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3845,8 +3845,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M end if if (allocated(SrcRotMiscVarTypeData%Mx)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Mx)) then allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3857,8 +3857,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx end if if (allocated(SrcRotMiscVarTypeData%My)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%My) - UB(1:2) = ubound(SrcRotMiscVarTypeData%My) + LB(1:2) = lbound(SrcRotMiscVarTypeData%My, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%My)) then allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3869,8 +3869,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My end if if (allocated(SrcRotMiscVarTypeData%Mz)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Mz)) then allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3881,8 +3881,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz end if if (allocated(SrcRotMiscVarTypeData%Vind_i)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i) - UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i) + LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) + UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%Vind_i)) then allocate(DstRotMiscVarTypeData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3896,8 +3896,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) - UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3912,8 +3912,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3928,8 +3928,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3940,8 +3940,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit end if if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3952,8 +3952,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit end if if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) - UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3964,8 +3964,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet end if if (allocated(SrcRotMiscVarTypeData%TwrFB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3976,8 +3976,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB end if if (allocated(SrcRotMiscVarTypeData%TwrMB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3988,8 +3988,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB end if if (allocated(SrcRotMiscVarTypeData%HubFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4000,8 +4000,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB end if if (allocated(SrcRotMiscVarTypeData%HubMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4012,8 +4012,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB end if if (allocated(SrcRotMiscVarTypeData%NacFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4024,8 +4024,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB end if if (allocated(SrcRotMiscVarTypeData%NacMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4036,8 +4036,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB end if if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4052,8 +4052,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4068,8 +4068,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4084,8 +4084,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4100,8 +4100,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end do end if if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4142,8 +4142,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' @@ -4153,8 +4153,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) - UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4222,8 +4222,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4258,8 +4258,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%NacMB) end if if (allocated(RotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) - UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4267,8 +4267,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%BladeRootLoad) end if if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4276,8 +4276,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%B_L_2_R_P) end if if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4285,8 +4285,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) end if if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4294,8 +4294,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) deallocate(RotMiscVarTypeData%BladeBuoyLoad) end if if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) - UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4314,13 +4314,13 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotMiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call BEMT_PackMisc(Buf, InData%BEMT) call BEMT_PackOutput(Buf, InData%BEMT_y) - LB(1:1) = lbound(InData%BEMT_u) - UB(1:1) = ubound(InData%BEMT_u) + LB(1:1) = lbound(InData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(InData%BEMT_u, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_PackInput(Buf, InData%BEMT_u(i1)) end do @@ -4329,87 +4329,87 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call AA_PackInput(Buf, InData%AA_u) call RegPack(Buf, allocated(InData%DisturbedInflow)) if (allocated(InData%DisturbedInflow)) then - call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow), ubound(InData%DisturbedInflow)) + call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow, kind=B8Ki), ubound(InData%DisturbedInflow, kind=B8Ki)) call RegPack(Buf, InData%DisturbedInflow) end if call RegPack(Buf, allocated(InData%orientationAnnulus)) if (allocated(InData%orientationAnnulus)) then - call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus), ubound(InData%orientationAnnulus)) + call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus, kind=B8Ki), ubound(InData%orientationAnnulus, kind=B8Ki)) call RegPack(Buf, InData%orientationAnnulus) end if call RegPack(Buf, allocated(InData%R_li)) if (allocated(InData%R_li)) then - call RegPackBounds(Buf, 4, lbound(InData%R_li), ubound(InData%R_li)) + call RegPackBounds(Buf, 4, lbound(InData%R_li, kind=B8Ki), ubound(InData%R_li, kind=B8Ki)) call RegPack(Buf, InData%R_li) end if call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, allocated(InData%W_Twr)) if (allocated(InData%W_Twr)) then - call RegPackBounds(Buf, 1, lbound(InData%W_Twr), ubound(InData%W_Twr)) + call RegPackBounds(Buf, 1, lbound(InData%W_Twr, kind=B8Ki), ubound(InData%W_Twr, kind=B8Ki)) call RegPack(Buf, InData%W_Twr) end if call RegPack(Buf, allocated(InData%X_Twr)) if (allocated(InData%X_Twr)) then - call RegPackBounds(Buf, 1, lbound(InData%X_Twr), ubound(InData%X_Twr)) + call RegPackBounds(Buf, 1, lbound(InData%X_Twr, kind=B8Ki), ubound(InData%X_Twr, kind=B8Ki)) call RegPack(Buf, InData%X_Twr) end if call RegPack(Buf, allocated(InData%Y_Twr)) if (allocated(InData%Y_Twr)) then - call RegPackBounds(Buf, 1, lbound(InData%Y_Twr), ubound(InData%Y_Twr)) + call RegPackBounds(Buf, 1, lbound(InData%Y_Twr, kind=B8Ki), ubound(InData%Y_Twr, kind=B8Ki)) call RegPack(Buf, InData%Y_Twr) end if call RegPack(Buf, allocated(InData%Curve)) if (allocated(InData%Curve)) then - call RegPackBounds(Buf, 2, lbound(InData%Curve), ubound(InData%Curve)) + call RegPackBounds(Buf, 2, lbound(InData%Curve, kind=B8Ki), ubound(InData%Curve, kind=B8Ki)) call RegPack(Buf, InData%Curve) end if call RegPack(Buf, allocated(InData%TwrClrnc)) if (allocated(InData%TwrClrnc)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc), ubound(InData%TwrClrnc)) + call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc, kind=B8Ki), ubound(InData%TwrClrnc, kind=B8Ki)) call RegPack(Buf, InData%TwrClrnc) end if call RegPack(Buf, allocated(InData%X)) if (allocated(InData%X)) then - call RegPackBounds(Buf, 2, lbound(InData%X), ubound(InData%X)) + call RegPackBounds(Buf, 2, lbound(InData%X, kind=B8Ki), ubound(InData%X, kind=B8Ki)) call RegPack(Buf, InData%X) end if call RegPack(Buf, allocated(InData%Y)) if (allocated(InData%Y)) then - call RegPackBounds(Buf, 2, lbound(InData%Y), ubound(InData%Y)) + call RegPackBounds(Buf, 2, lbound(InData%Y, kind=B8Ki), ubound(InData%Y, kind=B8Ki)) call RegPack(Buf, InData%Y) end if call RegPack(Buf, allocated(InData%Z)) if (allocated(InData%Z)) then - call RegPackBounds(Buf, 2, lbound(InData%Z), ubound(InData%Z)) + call RegPackBounds(Buf, 2, lbound(InData%Z, kind=B8Ki), ubound(InData%Z, kind=B8Ki)) call RegPack(Buf, InData%Z) end if call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then - call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) + call RegPackBounds(Buf, 2, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) call RegPack(Buf, InData%M) end if call RegPack(Buf, allocated(InData%Mx)) if (allocated(InData%Mx)) then - call RegPackBounds(Buf, 2, lbound(InData%Mx), ubound(InData%Mx)) + call RegPackBounds(Buf, 2, lbound(InData%Mx, kind=B8Ki), ubound(InData%Mx, kind=B8Ki)) call RegPack(Buf, InData%Mx) end if call RegPack(Buf, allocated(InData%My)) if (allocated(InData%My)) then - call RegPackBounds(Buf, 2, lbound(InData%My), ubound(InData%My)) + call RegPackBounds(Buf, 2, lbound(InData%My, kind=B8Ki), ubound(InData%My, kind=B8Ki)) call RegPack(Buf, InData%My) end if call RegPack(Buf, allocated(InData%Mz)) if (allocated(InData%Mz)) then - call RegPackBounds(Buf, 2, lbound(InData%Mz), ubound(InData%Mz)) + call RegPackBounds(Buf, 2, lbound(InData%Mz, kind=B8Ki), ubound(InData%Mz, kind=B8Ki)) call RegPack(Buf, InData%Mz) end if call RegPack(Buf, allocated(InData%Vind_i)) if (allocated(InData%Vind_i)) then - call RegPackBounds(Buf, 3, lbound(InData%Vind_i), ubound(InData%Vind_i)) + call RegPackBounds(Buf, 3, lbound(InData%Vind_i, kind=B8Ki), ubound(InData%Vind_i, kind=B8Ki)) call RegPack(Buf, InData%Vind_i) end if call RegPack(Buf, InData%V_DiskAvg) @@ -4417,106 +4417,106 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call RegPack(Buf, InData%tilt) call RegPack(Buf, allocated(InData%hub_theta_x_root)) if (allocated(InData%hub_theta_x_root)) then - call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root), ubound(InData%hub_theta_x_root)) + call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root, kind=B8Ki), ubound(InData%hub_theta_x_root, kind=B8Ki)) call RegPack(Buf, InData%hub_theta_x_root) end if call RegPack(Buf, InData%V_dot_x) call MeshPack(Buf, InData%HubLoad) call RegPack(Buf, allocated(InData%B_L_2_H_P)) if (allocated(InData%B_L_2_H_P)) then - call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) - LB(1:1) = lbound(InData%B_L_2_H_P) - UB(1:1) = ubound(InData%B_L_2_H_P) + call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) + LB(1:1) = lbound(InData%B_L_2_H_P, kind=B8Ki) + UB(1:1) = ubound(InData%B_L_2_H_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_H_P(i1)) end do end if call RegPack(Buf, allocated(InData%SigmaCavitCrit)) if (allocated(InData%SigmaCavitCrit)) then - call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit), ubound(InData%SigmaCavitCrit)) + call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit, kind=B8Ki), ubound(InData%SigmaCavitCrit, kind=B8Ki)) call RegPack(Buf, InData%SigmaCavitCrit) end if call RegPack(Buf, allocated(InData%SigmaCavit)) if (allocated(InData%SigmaCavit)) then - call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit), ubound(InData%SigmaCavit)) + call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit, kind=B8Ki), ubound(InData%SigmaCavit, kind=B8Ki)) call RegPack(Buf, InData%SigmaCavit) end if call RegPack(Buf, allocated(InData%CavitWarnSet)) if (allocated(InData%CavitWarnSet)) then - call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet), ubound(InData%CavitWarnSet)) + call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet, kind=B8Ki), ubound(InData%CavitWarnSet, kind=B8Ki)) call RegPack(Buf, InData%CavitWarnSet) end if call RegPack(Buf, allocated(InData%TwrFB)) if (allocated(InData%TwrFB)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrFB), ubound(InData%TwrFB)) + call RegPackBounds(Buf, 2, lbound(InData%TwrFB, kind=B8Ki), ubound(InData%TwrFB, kind=B8Ki)) call RegPack(Buf, InData%TwrFB) end if call RegPack(Buf, allocated(InData%TwrMB)) if (allocated(InData%TwrMB)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrMB), ubound(InData%TwrMB)) + call RegPackBounds(Buf, 2, lbound(InData%TwrMB, kind=B8Ki), ubound(InData%TwrMB, kind=B8Ki)) call RegPack(Buf, InData%TwrMB) end if call RegPack(Buf, allocated(InData%HubFB)) if (allocated(InData%HubFB)) then - call RegPackBounds(Buf, 1, lbound(InData%HubFB), ubound(InData%HubFB)) + call RegPackBounds(Buf, 1, lbound(InData%HubFB, kind=B8Ki), ubound(InData%HubFB, kind=B8Ki)) call RegPack(Buf, InData%HubFB) end if call RegPack(Buf, allocated(InData%HubMB)) if (allocated(InData%HubMB)) then - call RegPackBounds(Buf, 1, lbound(InData%HubMB), ubound(InData%HubMB)) + call RegPackBounds(Buf, 1, lbound(InData%HubMB, kind=B8Ki), ubound(InData%HubMB, kind=B8Ki)) call RegPack(Buf, InData%HubMB) end if call RegPack(Buf, allocated(InData%NacFB)) if (allocated(InData%NacFB)) then - call RegPackBounds(Buf, 1, lbound(InData%NacFB), ubound(InData%NacFB)) + call RegPackBounds(Buf, 1, lbound(InData%NacFB, kind=B8Ki), ubound(InData%NacFB, kind=B8Ki)) call RegPack(Buf, InData%NacFB) end if call RegPack(Buf, allocated(InData%NacMB)) if (allocated(InData%NacMB)) then - call RegPackBounds(Buf, 1, lbound(InData%NacMB), ubound(InData%NacMB)) + call RegPackBounds(Buf, 1, lbound(InData%NacMB, kind=B8Ki), ubound(InData%NacMB, kind=B8Ki)) call RegPack(Buf, InData%NacMB) end if call RegPack(Buf, allocated(InData%BladeRootLoad)) if (allocated(InData%BladeRootLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) - LB(1:1) = lbound(InData%BladeRootLoad) - UB(1:1) = ubound(InData%BladeRootLoad) + call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeRootLoad, kind=B8Ki) + UB(1:1) = ubound(InData%BladeRootLoad, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeRootLoad(i1)) end do end if call RegPack(Buf, allocated(InData%B_L_2_R_P)) if (allocated(InData%B_L_2_R_P)) then - call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) - LB(1:1) = lbound(InData%B_L_2_R_P) - UB(1:1) = ubound(InData%B_L_2_R_P) + call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) + LB(1:1) = lbound(InData%B_L_2_R_P, kind=B8Ki) + UB(1:1) = ubound(InData%B_L_2_R_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_R_P(i1)) end do end if call RegPack(Buf, allocated(InData%BladeBuoyLoadPoint)) if (allocated(InData%BladeBuoyLoadPoint)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) - LB(1:1) = lbound(InData%BladeBuoyLoadPoint) - UB(1:1) = ubound(InData%BladeBuoyLoadPoint) + call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint, kind=B8Ki) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeBuoyLoadPoint(i1)) end do end if call RegPack(Buf, allocated(InData%BladeBuoyLoad)) if (allocated(InData%BladeBuoyLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) - LB(1:1) = lbound(InData%BladeBuoyLoad) - UB(1:1) = ubound(InData%BladeBuoyLoad) + call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeBuoyLoad, kind=B8Ki) + UB(1:1) = ubound(InData%BladeBuoyLoad, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeBuoyLoad(i1)) end do end if call RegPack(Buf, allocated(InData%B_P_2_B_L)) if (allocated(InData%B_P_2_B_L)) then - call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) - LB(1:1) = lbound(InData%B_P_2_B_L) - UB(1:1) = ubound(InData%B_P_2_B_L) + call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) + LB(1:1) = lbound(InData%B_P_2_B_L, kind=B8Ki) + UB(1:1) = ubound(InData%B_P_2_B_L, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%B_P_2_B_L(i1)) end do @@ -4543,15 +4543,15 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotMiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return call BEMT_UnpackMisc(Buf, OutData%BEMT) ! BEMT call BEMT_UnpackOutput(Buf, OutData%BEMT_y) ! BEMT_y - LB(1:1) = lbound(OutData%BEMT_u) - UB(1:1) = ubound(OutData%BEMT_u) + LB(1:1) = lbound(OutData%BEMT_u, kind=B8Ki) + UB(1:1) = ubound(OutData%BEMT_u, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_UnpackInput(Buf, OutData%BEMT_u(i1)) ! BEMT_u end do @@ -5070,16 +5070,16 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%rotors)) then - LB(1:1) = lbound(SrcMiscData%rotors) - UB(1:1) = ubound(SrcMiscData%rotors) + LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) if (.not. allocated(DstMiscData%rotors)) then allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5094,8 +5094,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%FVW_u)) then - LB(1:1) = lbound(SrcMiscData%FVW_u) - UB(1:1) = ubound(SrcMiscData%FVW_u) + LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) if (.not. allocated(DstMiscData%FVW_u)) then allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5116,8 +5116,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%WindPos)) then - LB(1:2) = lbound(SrcMiscData%WindPos) - UB(1:2) = ubound(SrcMiscData%WindPos) + LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) if (.not. allocated(DstMiscData%WindPos)) then allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5128,8 +5128,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WindPos = SrcMiscData%WindPos end if if (allocated(SrcMiscData%WindVel)) then - LB(1:2) = lbound(SrcMiscData%WindVel) - UB(1:2) = ubound(SrcMiscData%WindVel) + LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) if (.not. allocated(DstMiscData%WindVel)) then allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5140,8 +5140,8 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WindVel = SrcMiscData%WindVel end if if (allocated(SrcMiscData%WindAcc)) then - LB(1:2) = lbound(SrcMiscData%WindAcc) - UB(1:2) = ubound(SrcMiscData%WindAcc) + LB(1:2) = lbound(SrcMiscData%WindAcc, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) if (.not. allocated(DstMiscData%WindAcc)) then allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5157,16 +5157,16 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(AD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%rotors)) then - LB(1:1) = lbound(MiscData%rotors) - UB(1:1) = ubound(MiscData%rotors) + LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) + UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5174,8 +5174,8 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%rotors) end if if (allocated(MiscData%FVW_u)) then - LB(1:1) = lbound(MiscData%FVW_u) - UB(1:1) = ubound(MiscData%FVW_u) + LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5201,23 +5201,23 @@ subroutine AD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotMiscVarType(Buf, InData%rotors(i1)) end do end if call RegPack(Buf, allocated(InData%FVW_u)) if (allocated(InData%FVW_u)) then - call RegPackBounds(Buf, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) - LB(1:1) = lbound(InData%FVW_u) - UB(1:1) = ubound(InData%FVW_u) + call RegPackBounds(Buf, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) + LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) + UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackInput(Buf, InData%FVW_u(i1)) end do @@ -5226,17 +5226,17 @@ subroutine AD_PackMisc(Buf, Indata) call FVW_PackMisc(Buf, InData%FVW) call RegPack(Buf, allocated(InData%WindPos)) if (allocated(InData%WindPos)) then - call RegPackBounds(Buf, 2, lbound(InData%WindPos), ubound(InData%WindPos)) + call RegPackBounds(Buf, 2, lbound(InData%WindPos, kind=B8Ki), ubound(InData%WindPos, kind=B8Ki)) call RegPack(Buf, InData%WindPos) end if call RegPack(Buf, allocated(InData%WindVel)) if (allocated(InData%WindVel)) then - call RegPackBounds(Buf, 2, lbound(InData%WindVel), ubound(InData%WindVel)) + call RegPackBounds(Buf, 2, lbound(InData%WindVel, kind=B8Ki), ubound(InData%WindVel, kind=B8Ki)) call RegPack(Buf, InData%WindVel) end if call RegPack(Buf, allocated(InData%WindAcc)) if (allocated(InData%WindAcc)) then - call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) + call RegPackBounds(Buf, 2, lbound(InData%WindAcc, kind=B8Ki), ubound(InData%WindAcc, kind=B8Ki)) call RegPack(Buf, InData%WindAcc) end if if (RegCheckErr(Buf, RoutineName)) return @@ -5246,8 +5246,8 @@ subroutine AD_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5333,8 +5333,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' @@ -5344,8 +5344,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds if (allocated(SrcRotParameterTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5356,8 +5356,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam end if if (allocated(SrcRotParameterTypeData%TwrCd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrCd)) then allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5368,8 +5368,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd end if if (allocated(SrcRotParameterTypeData%TwrTI)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrTI)) then allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5380,8 +5380,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI end if if (allocated(SrcRotParameterTypeData%BlTwist)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlTwist)) then allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5392,8 +5392,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist end if if (allocated(SrcRotParameterTypeData%TwrCb)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrCb)) then allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5404,8 +5404,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb end if if (allocated(SrcRotParameterTypeData%BlCenBn)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5416,8 +5416,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn end if if (allocated(SrcRotParameterTypeData%BlCenBt)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5434,8 +5434,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr if (allocated(SrcRotParameterTypeData%BlRad)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) - UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlRad)) then allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5446,8 +5446,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad end if if (allocated(SrcRotParameterTypeData%BlDL)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) - UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlDL)) then allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5458,8 +5458,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL end if if (allocated(SrcRotParameterTypeData%BlTaper)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlTaper)) then allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5470,8 +5470,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper end if if (allocated(SrcRotParameterTypeData%BlAxCent)) then - LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5482,8 +5482,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent end if if (allocated(SrcRotParameterTypeData%TwrRad)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrRad)) then allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5494,8 +5494,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad end if if (allocated(SrcRotParameterTypeData%TwrDL)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrDL)) then allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5506,8 +5506,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL end if if (allocated(SrcRotParameterTypeData%TwrTaper)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5518,8 +5518,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper end if if (allocated(SrcRotParameterTypeData%TwrAxCent)) then - LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5536,8 +5536,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx) - UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx) + LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5548,8 +5548,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx end if if (allocated(SrcRotParameterTypeData%du)) then - LB(1:1) = lbound(SrcRotParameterTypeData%du) - UB(1:1) = ubound(SrcRotParameterTypeData%du) + LB(1:1) = lbound(SrcRotParameterTypeData%du, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%du, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%du)) then allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5560,8 +5560,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%du = SrcRotParameterTypeData%du end if if (allocated(SrcRotParameterTypeData%dx)) then - LB(1:1) = lbound(SrcRotParameterTypeData%dx) - UB(1:1) = ubound(SrcRotParameterTypeData%dx) + LB(1:1) = lbound(SrcRotParameterTypeData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%dx, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%dx)) then allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5594,8 +5594,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName if (allocated(SrcRotParameterTypeData%OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) - UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%OutParam)) then allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5616,8 +5616,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5632,8 +5632,8 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end do end if if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5654,8 +5654,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) type(RotParameterType), intent(inout) :: RotParameterTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' @@ -5720,8 +5720,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) deallocate(RotParameterTypeData%dx) end if if (allocated(RotParameterTypeData%OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%OutParam) - UB(1:1) = ubound(RotParameterTypeData%OutParam) + LB(1:1) = lbound(RotParameterTypeData%OutParam, kind=B8Ki) + UB(1:1) = ubound(RotParameterTypeData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5729,8 +5729,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) deallocate(RotParameterTypeData%OutParam) end if if (allocated(RotParameterTypeData%BldNd_OutParam)) then - LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) - UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5748,45 +5748,45 @@ subroutine AD_PackRotParameterType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotParameterType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumBlades) call RegPack(Buf, InData%NumBlNds) call RegPack(Buf, InData%NumTwrNds) call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam, kind=B8Ki), ubound(InData%TwrDiam, kind=B8Ki)) call RegPack(Buf, InData%TwrDiam) end if call RegPack(Buf, allocated(InData%TwrCd)) if (allocated(InData%TwrCd)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCd, kind=B8Ki), ubound(InData%TwrCd, kind=B8Ki)) call RegPack(Buf, InData%TwrCd) end if call RegPack(Buf, allocated(InData%TwrTI)) if (allocated(InData%TwrTI)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) + call RegPackBounds(Buf, 1, lbound(InData%TwrTI, kind=B8Ki), ubound(InData%TwrTI, kind=B8Ki)) call RegPack(Buf, InData%TwrTI) end if call RegPack(Buf, allocated(InData%BlTwist)) if (allocated(InData%BlTwist)) then - call RegPackBounds(Buf, 2, lbound(InData%BlTwist), ubound(InData%BlTwist)) + call RegPackBounds(Buf, 2, lbound(InData%BlTwist, kind=B8Ki), ubound(InData%BlTwist, kind=B8Ki)) call RegPack(Buf, InData%BlTwist) end if call RegPack(Buf, allocated(InData%TwrCb)) if (allocated(InData%TwrCb)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) + call RegPackBounds(Buf, 1, lbound(InData%TwrCb, kind=B8Ki), ubound(InData%TwrCb, kind=B8Ki)) call RegPack(Buf, InData%TwrCb) end if call RegPack(Buf, allocated(InData%BlCenBn)) if (allocated(InData%BlCenBn)) then - call RegPackBounds(Buf, 2, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) + call RegPackBounds(Buf, 2, lbound(InData%BlCenBn, kind=B8Ki), ubound(InData%BlCenBn, kind=B8Ki)) call RegPack(Buf, InData%BlCenBn) end if call RegPack(Buf, allocated(InData%BlCenBt)) if (allocated(InData%BlCenBt)) then - call RegPackBounds(Buf, 2, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) + call RegPackBounds(Buf, 2, lbound(InData%BlCenBt, kind=B8Ki), ubound(InData%BlCenBt, kind=B8Ki)) call RegPack(Buf, InData%BlCenBt) end if call RegPack(Buf, InData%VolHub) @@ -5797,59 +5797,59 @@ subroutine AD_PackRotParameterType(Buf, Indata) call RegPack(Buf, InData%VolTwr) call RegPack(Buf, allocated(InData%BlRad)) if (allocated(InData%BlRad)) then - call RegPackBounds(Buf, 2, lbound(InData%BlRad), ubound(InData%BlRad)) + call RegPackBounds(Buf, 2, lbound(InData%BlRad, kind=B8Ki), ubound(InData%BlRad, kind=B8Ki)) call RegPack(Buf, InData%BlRad) end if call RegPack(Buf, allocated(InData%BlDL)) if (allocated(InData%BlDL)) then - call RegPackBounds(Buf, 2, lbound(InData%BlDL), ubound(InData%BlDL)) + call RegPackBounds(Buf, 2, lbound(InData%BlDL, kind=B8Ki), ubound(InData%BlDL, kind=B8Ki)) call RegPack(Buf, InData%BlDL) end if call RegPack(Buf, allocated(InData%BlTaper)) if (allocated(InData%BlTaper)) then - call RegPackBounds(Buf, 2, lbound(InData%BlTaper), ubound(InData%BlTaper)) + call RegPackBounds(Buf, 2, lbound(InData%BlTaper, kind=B8Ki), ubound(InData%BlTaper, kind=B8Ki)) call RegPack(Buf, InData%BlTaper) end if call RegPack(Buf, allocated(InData%BlAxCent)) if (allocated(InData%BlAxCent)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAxCent), ubound(InData%BlAxCent)) + call RegPackBounds(Buf, 2, lbound(InData%BlAxCent, kind=B8Ki), ubound(InData%BlAxCent, kind=B8Ki)) call RegPack(Buf, InData%BlAxCent) end if call RegPack(Buf, allocated(InData%TwrRad)) if (allocated(InData%TwrRad)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrRad), ubound(InData%TwrRad)) + call RegPackBounds(Buf, 1, lbound(InData%TwrRad, kind=B8Ki), ubound(InData%TwrRad, kind=B8Ki)) call RegPack(Buf, InData%TwrRad) end if call RegPack(Buf, allocated(InData%TwrDL)) if (allocated(InData%TwrDL)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDL), ubound(InData%TwrDL)) + call RegPackBounds(Buf, 1, lbound(InData%TwrDL, kind=B8Ki), ubound(InData%TwrDL, kind=B8Ki)) call RegPack(Buf, InData%TwrDL) end if call RegPack(Buf, allocated(InData%TwrTaper)) if (allocated(InData%TwrTaper)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrTaper), ubound(InData%TwrTaper)) + call RegPackBounds(Buf, 1, lbound(InData%TwrTaper, kind=B8Ki), ubound(InData%TwrTaper, kind=B8Ki)) call RegPack(Buf, InData%TwrTaper) end if call RegPack(Buf, allocated(InData%TwrAxCent)) if (allocated(InData%TwrAxCent)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent), ubound(InData%TwrAxCent)) + call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent, kind=B8Ki), ubound(InData%TwrAxCent, kind=B8Ki)) call RegPack(Buf, InData%TwrAxCent) end if call BEMT_PackParam(Buf, InData%BEMT) call AA_PackParam(Buf, InData%AA) call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) call RegPack(Buf, InData%dx) end if call RegPack(Buf, InData%Jac_ny) @@ -5876,9 +5876,9 @@ subroutine AD_PackRotParameterType(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -5891,16 +5891,16 @@ subroutine AD_PackRotParameterType(Buf, Indata) call RegPack(Buf, InData%BldNd_TotNumOuts) call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) - LB(1:1) = lbound(InData%BldNd_OutParam) - UB(1:1) = ubound(InData%BldNd_OutParam) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) end do end if call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd, kind=B8Ki), ubound(InData%BldNd_BlOutNd, kind=B8Ki)) call RegPack(Buf, InData%BldNd_BlOutNd) end if call RegPack(Buf, InData%BldNd_BladesOut) @@ -5913,8 +5913,8 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6303,16 +6303,16 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%rotors)) then - LB(1:1) = lbound(SrcParamData%rotors) - UB(1:1) = ubound(SrcParamData%rotors) + LB(1:1) = lbound(SrcParamData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotors, kind=B8Ki) if (.not. allocated(DstParamData%rotors)) then allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6329,8 +6329,8 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DT = SrcParamData%DT DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%AFI)) then - LB(1:1) = lbound(SrcParamData%AFI) - UB(1:1) = ubound(SrcParamData%AFI) + LB(1:1) = lbound(SrcParamData%AFI, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AFI, kind=B8Ki) if (.not. allocated(DstParamData%AFI)) then allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6358,16 +6358,16 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) type(AD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%rotors)) then - LB(1:1) = lbound(ParamData%rotors) - UB(1:1) = ubound(ParamData%rotors) + LB(1:1) = lbound(ParamData%rotors, kind=B8Ki) + UB(1:1) = ubound(ParamData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6375,8 +6375,8 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%rotors) end if if (allocated(ParamData%AFI)) then - LB(1:1) = lbound(ParamData%AFI) - UB(1:1) = ubound(ParamData%AFI) + LB(1:1) = lbound(ParamData%AFI, kind=B8Ki) + UB(1:1) = ubound(ParamData%AFI, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6392,15 +6392,15 @@ subroutine AD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotParameterType(Buf, InData%rotors(i1)) end do @@ -6409,9 +6409,9 @@ subroutine AD_PackParam(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%AFI)) if (allocated(InData%AFI)) then - call RegPackBounds(Buf, 1, lbound(InData%AFI), ubound(InData%AFI)) - LB(1:1) = lbound(InData%AFI) - UB(1:1) = ubound(InData%AFI) + call RegPackBounds(Buf, 1, lbound(InData%AFI, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) + LB(1:1) = lbound(InData%AFI, kind=B8Ki) + UB(1:1) = ubound(InData%AFI, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_PackParam(Buf, InData%AFI(i1)) end do @@ -6435,11 +6435,11 @@ subroutine AD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) @@ -6513,14 +6513,14 @@ subroutine AD_CopyBldInputType(SrcBldInputTypeData, DstBldInputTypeData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBldInputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBldInputTypeData%InflowOnBlade)) then - LB(1:2) = lbound(SrcBldInputTypeData%InflowOnBlade) - UB(1:2) = ubound(SrcBldInputTypeData%InflowOnBlade) + LB(1:2) = lbound(SrcBldInputTypeData%InflowOnBlade, kind=B8Ki) + UB(1:2) = ubound(SrcBldInputTypeData%InflowOnBlade, kind=B8Ki) if (.not. allocated(DstBldInputTypeData%InflowOnBlade)) then allocate(DstBldInputTypeData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6531,8 +6531,8 @@ subroutine AD_CopyBldInputType(SrcBldInputTypeData, DstBldInputTypeData, CtrlCod DstBldInputTypeData%InflowOnBlade = SrcBldInputTypeData%InflowOnBlade end if if (allocated(SrcBldInputTypeData%AccelOnBlade)) then - LB(1:2) = lbound(SrcBldInputTypeData%AccelOnBlade) - UB(1:2) = ubound(SrcBldInputTypeData%AccelOnBlade) + LB(1:2) = lbound(SrcBldInputTypeData%AccelOnBlade, kind=B8Ki) + UB(1:2) = ubound(SrcBldInputTypeData%AccelOnBlade, kind=B8Ki) if (.not. allocated(DstBldInputTypeData%AccelOnBlade)) then allocate(DstBldInputTypeData%AccelOnBlade(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6566,12 +6566,12 @@ subroutine AD_PackBldInputType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%InflowOnBlade)) if (allocated(InData%InflowOnBlade)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowOnBlade), ubound(InData%InflowOnBlade)) + call RegPackBounds(Buf, 2, lbound(InData%InflowOnBlade, kind=B8Ki), ubound(InData%InflowOnBlade, kind=B8Ki)) call RegPack(Buf, InData%InflowOnBlade) end if call RegPack(Buf, allocated(InData%AccelOnBlade)) if (allocated(InData%AccelOnBlade)) then - call RegPackBounds(Buf, 2, lbound(InData%AccelOnBlade), ubound(InData%AccelOnBlade)) + call RegPackBounds(Buf, 2, lbound(InData%AccelOnBlade, kind=B8Ki), ubound(InData%AccelOnBlade, kind=B8Ki)) call RegPack(Buf, InData%AccelOnBlade) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6581,7 +6581,7 @@ subroutine AD_UnPackBldInputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BldInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBldInputType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6621,8 +6621,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInputType' @@ -6638,8 +6638,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) - UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6654,8 +6654,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod end do end if if (allocated(SrcRotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) - UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) if (.not. allocated(DstRotInputTypeData%BladeMotion)) then allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6673,8 +6673,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotInputTypeData%Bld)) then - LB(1:1) = lbound(SrcRotInputTypeData%Bld) - UB(1:1) = ubound(SrcRotInputTypeData%Bld) + LB(1:1) = lbound(SrcRotInputTypeData%Bld, kind=B8Ki) + UB(1:1) = ubound(SrcRotInputTypeData%Bld, kind=B8Ki) if (.not. allocated(DstRotInputTypeData%Bld)) then allocate(DstRotInputTypeData%Bld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6689,8 +6689,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod end do end if if (allocated(SrcRotInputTypeData%InflowOnTower)) then - LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower) - UB(1:2) = ubound(SrcRotInputTypeData%InflowOnTower) + LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower, kind=B8Ki) + UB(1:2) = ubound(SrcRotInputTypeData%InflowOnTower, kind=B8Ki) if (.not. allocated(DstRotInputTypeData%InflowOnTower)) then allocate(DstRotInputTypeData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6701,8 +6701,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower end if if (allocated(SrcRotInputTypeData%AccelOnTower)) then - LB(1:2) = lbound(SrcRotInputTypeData%AccelOnTower) - UB(1:2) = ubound(SrcRotInputTypeData%AccelOnTower) + LB(1:2) = lbound(SrcRotInputTypeData%AccelOnTower, kind=B8Ki) + UB(1:2) = ubound(SrcRotInputTypeData%AccelOnTower, kind=B8Ki) if (.not. allocated(DstRotInputTypeData%AccelOnTower)) then allocate(DstRotInputTypeData%AccelOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6717,8 +6717,8 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin DstRotInputTypeData%AvgDiskVel = SrcRotInputTypeData%AvgDiskVel if (allocated(SrcRotInputTypeData%UserProp)) then - LB(1:2) = lbound(SrcRotInputTypeData%UserProp) - UB(1:2) = ubound(SrcRotInputTypeData%UserProp) + LB(1:2) = lbound(SrcRotInputTypeData%UserProp, kind=B8Ki) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp, kind=B8Ki) if (.not. allocated(DstRotInputTypeData%UserProp)) then allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6734,8 +6734,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) type(RotInputType), intent(inout) :: RotInputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' @@ -6748,8 +6748,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) - UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6757,8 +6757,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) deallocate(RotInputTypeData%BladeRootMotion) end if if (allocated(RotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeMotion) - UB(1:1) = ubound(RotInputTypeData%BladeMotion) + LB(1:1) = lbound(RotInputTypeData%BladeMotion, kind=B8Ki) + UB(1:1) = ubound(RotInputTypeData%BladeMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6768,8 +6768,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotInputTypeData%Bld)) then - LB(1:1) = lbound(RotInputTypeData%Bld) - UB(1:1) = ubound(RotInputTypeData%Bld) + LB(1:1) = lbound(RotInputTypeData%Bld, kind=B8Ki) + UB(1:1) = ubound(RotInputTypeData%Bld, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyBldInputType(RotInputTypeData%Bld(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6791,26 +6791,26 @@ subroutine AD_PackRotInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%NacelleMotion) call MeshPack(Buf, InData%TowerMotion) call MeshPack(Buf, InData%HubMotion) call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) - LB(1:1) = lbound(InData%BladeRootMotion) - UB(1:1) = ubound(InData%BladeRootMotion) + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeRootMotion(i1)) end do end if call RegPack(Buf, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) - LB(1:1) = lbound(InData%BladeMotion) - UB(1:1) = ubound(InData%BladeMotion) + call RegPackBounds(Buf, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) + UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeMotion(i1)) end do @@ -6818,21 +6818,21 @@ subroutine AD_PackRotInputType(Buf, Indata) call MeshPack(Buf, InData%TFinMotion) call RegPack(Buf, allocated(InData%Bld)) if (allocated(InData%Bld)) then - call RegPackBounds(Buf, 1, lbound(InData%Bld), ubound(InData%Bld)) - LB(1:1) = lbound(InData%Bld) - UB(1:1) = ubound(InData%Bld) + call RegPackBounds(Buf, 1, lbound(InData%Bld, kind=B8Ki), ubound(InData%Bld, kind=B8Ki)) + LB(1:1) = lbound(InData%Bld, kind=B8Ki) + UB(1:1) = ubound(InData%Bld, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackBldInputType(Buf, InData%Bld(i1)) end do end if call RegPack(Buf, allocated(InData%InflowOnTower)) if (allocated(InData%InflowOnTower)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower), ubound(InData%InflowOnTower)) + call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower, kind=B8Ki), ubound(InData%InflowOnTower, kind=B8Ki)) call RegPack(Buf, InData%InflowOnTower) end if call RegPack(Buf, allocated(InData%AccelOnTower)) if (allocated(InData%AccelOnTower)) then - call RegPackBounds(Buf, 2, lbound(InData%AccelOnTower), ubound(InData%AccelOnTower)) + call RegPackBounds(Buf, 2, lbound(InData%AccelOnTower, kind=B8Ki), ubound(InData%AccelOnTower, kind=B8Ki)) call RegPack(Buf, InData%AccelOnTower) end if call RegPack(Buf, InData%InflowOnHub) @@ -6841,7 +6841,7 @@ subroutine AD_PackRotInputType(Buf, Indata) call RegPack(Buf, InData%AvgDiskVel) call RegPack(Buf, allocated(InData%UserProp)) if (allocated(InData%UserProp)) then - call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) + call RegPackBounds(Buf, 2, lbound(InData%UserProp, kind=B8Ki), ubound(InData%UserProp, kind=B8Ki)) call RegPack(Buf, InData%UserProp) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6851,8 +6851,8 @@ subroutine AD_UnPackRotInputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6963,16 +6963,16 @@ subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors) - UB(1:1) = ubound(SrcInputData%rotors) + LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) if (.not. allocated(DstInputData%rotors)) then allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6987,8 +6987,8 @@ subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%InflowWakeVel)) then - LB(1:2) = lbound(SrcInputData%InflowWakeVel) - UB(1:2) = ubound(SrcInputData%InflowWakeVel) + LB(1:2) = lbound(SrcInputData%InflowWakeVel, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%InflowWakeVel, kind=B8Ki) if (.not. allocated(DstInputData%InflowWakeVel)) then allocate(DstInputData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7004,16 +7004,16 @@ subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) type(AD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors) - UB(1:1) = ubound(InputData%rotors) + LB(1:1) = lbound(InputData%rotors, kind=B8Ki) + UB(1:1) = ubound(InputData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7029,21 +7029,21 @@ subroutine AD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotInputType(Buf, InData%rotors(i1)) end do end if call RegPack(Buf, allocated(InData%InflowWakeVel)) if (allocated(InData%InflowWakeVel)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel), ubound(InData%InflowWakeVel)) + call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel, kind=B8Ki), ubound(InData%InflowWakeVel, kind=B8Ki)) call RegPack(Buf, InData%InflowWakeVel) end if if (RegCheckErr(Buf, RoutineName)) return @@ -7053,8 +7053,8 @@ subroutine AD_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7095,8 +7095,8 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' @@ -7112,8 +7112,8 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) - UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7131,8 +7131,8 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotOutputTypeData%WriteOutput)) then - LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) - UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7148,8 +7148,8 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) type(RotOutputType), intent(inout) :: RotOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' @@ -7162,8 +7162,8 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(RotOutputTypeData%BladeLoad) - UB(1:1) = ubound(RotOutputTypeData%BladeLoad) + LB(1:1) = lbound(RotOutputTypeData%BladeLoad, kind=B8Ki) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7181,17 +7181,17 @@ subroutine AD_PackRotOutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotOutputType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%NacelleLoad) call MeshPack(Buf, InData%HubLoad) call MeshPack(Buf, InData%TowerLoad) call RegPack(Buf, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) - LB(1:1) = lbound(InData%BladeLoad) - UB(1:1) = ubound(InData%BladeLoad) + call RegPackBounds(Buf, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) + UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeLoad(i1)) end do @@ -7199,7 +7199,7 @@ subroutine AD_PackRotOutputType(Buf, Indata) call MeshPack(Buf, InData%TFinLoad) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -7209,8 +7209,8 @@ subroutine AD_UnPackRotOutputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(RotOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7255,16 +7255,16 @@ subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%rotors)) then - LB(1:1) = lbound(SrcOutputData%rotors) - UB(1:1) = ubound(SrcOutputData%rotors) + LB(1:1) = lbound(SrcOutputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%rotors, kind=B8Ki) if (.not. allocated(DstOutputData%rotors)) then allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7284,16 +7284,16 @@ subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) type(AD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%rotors)) then - LB(1:1) = lbound(OutputData%rotors) - UB(1:1) = ubound(OutputData%rotors) + LB(1:1) = lbound(OutputData%rotors, kind=B8Ki) + UB(1:1) = ubound(OutputData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7306,14 +7306,14 @@ subroutine AD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackRotOutputType(Buf, InData%rotors(i1)) end do @@ -7325,8 +7325,8 @@ subroutine AD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7449,75 +7449,75 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) + DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) + DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%Bld) .AND. ALLOCATED(u1%rotors(i01)%Bld)) THEN - DO i11 = LBOUND(u_out%rotors(i01)%Bld,1),UBOUND(u_out%rotors(i01)%Bld,1) + DO i11 = LBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%Bld(i11)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%Bld(i11)%InflowOnBlade)) THEN u_out%rotors(i01)%Bld(i11)%InflowOnBlade = a1*u1%rotors(i01)%Bld(i11)%InflowOnBlade + a2*u2%rotors(i01)%Bld(i11)%InflowOnBlade END IF ! check if allocated END DO - DO i11 = LBOUND(u_out%rotors(i01)%Bld,1),UBOUND(u_out%rotors(i01)%Bld,1) + DO i11 = LBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%Bld(i11)%AccelOnBlade) .AND. ALLOCATED(u1%rotors(i01)%Bld(i11)%AccelOnBlade)) THEN u_out%rotors(i01)%Bld(i11)%AccelOnBlade = a1*u1%rotors(i01)%Bld(i11)%AccelOnBlade + a2*u2%rotors(i01)%Bld(i11)%AccelOnBlade END IF ! check if allocated END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN u_out%rotors(i01)%InflowOnTower = a1*u1%rotors(i01)%InflowOnTower + a2*u2%rotors(i01)%InflowOnTower END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%AccelOnTower) .AND. ALLOCATED(u1%rotors(i01)%AccelOnTower)) THEN u_out%rotors(i01)%AccelOnTower = a1*u1%rotors(i01)%AccelOnTower + a2*u2%rotors(i01)%AccelOnTower END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%InflowOnHub = a1*u1%rotors(i01)%InflowOnHub + a2*u2%rotors(i01)%InflowOnHub END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%InflowOnNacelle = a1*u1%rotors(i01)%InflowOnNacelle + a2*u2%rotors(i01)%InflowOnNacelle END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%InflowOnTailFin = a1*u1%rotors(i01)%InflowOnTailFin + a2*u2%rotors(i01)%InflowOnTailFin END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%AvgDiskVel = a1*u1%rotors(i01)%AvgDiskVel + a2*u2%rotors(i01)%AvgDiskVel END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp END IF ! check if allocated @@ -7588,75 +7588,75 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) + DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) + DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%Bld) .AND. ALLOCATED(u1%rotors(i01)%Bld)) THEN - DO i11 = LBOUND(u_out%rotors(i01)%Bld,1),UBOUND(u_out%rotors(i01)%Bld,1) + DO i11 = LBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%Bld(i11)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%Bld(i11)%InflowOnBlade)) THEN u_out%rotors(i01)%Bld(i11)%InflowOnBlade = a1*u1%rotors(i01)%Bld(i11)%InflowOnBlade + a2*u2%rotors(i01)%Bld(i11)%InflowOnBlade + a3*u3%rotors(i01)%Bld(i11)%InflowOnBlade END IF ! check if allocated END DO - DO i11 = LBOUND(u_out%rotors(i01)%Bld,1),UBOUND(u_out%rotors(i01)%Bld,1) + DO i11 = LBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%Bld,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%Bld(i11)%AccelOnBlade) .AND. ALLOCATED(u1%rotors(i01)%Bld(i11)%AccelOnBlade)) THEN u_out%rotors(i01)%Bld(i11)%AccelOnBlade = a1*u1%rotors(i01)%Bld(i11)%AccelOnBlade + a2*u2%rotors(i01)%Bld(i11)%AccelOnBlade + a3*u3%rotors(i01)%Bld(i11)%AccelOnBlade END IF ! check if allocated END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN u_out%rotors(i01)%InflowOnTower = a1*u1%rotors(i01)%InflowOnTower + a2*u2%rotors(i01)%InflowOnTower + a3*u3%rotors(i01)%InflowOnTower END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%AccelOnTower) .AND. ALLOCATED(u1%rotors(i01)%AccelOnTower)) THEN u_out%rotors(i01)%AccelOnTower = a1*u1%rotors(i01)%AccelOnTower + a2*u2%rotors(i01)%AccelOnTower + a3*u3%rotors(i01)%AccelOnTower END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%InflowOnHub = a1*u1%rotors(i01)%InflowOnHub + a2*u2%rotors(i01)%InflowOnHub + a3*u3%rotors(i01)%InflowOnHub END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%InflowOnNacelle = a1*u1%rotors(i01)%InflowOnNacelle + a2*u2%rotors(i01)%InflowOnNacelle + a3*u3%rotors(i01)%InflowOnNacelle END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%InflowOnTailFin = a1*u1%rotors(i01)%InflowOnTailFin + a2*u2%rotors(i01)%InflowOnTailFin + a3*u3%rotors(i01)%InflowOnTailFin END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%AvgDiskVel = a1*u1%rotors(i01)%AvgDiskVel + a2*u2%rotors(i01)%AvgDiskVel + a3*u3%rotors(i01)%AvgDiskVel END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + a3*u3%rotors(i01)%UserProp END IF ! check if allocated @@ -7765,31 +7765,31 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) + DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki),UBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput END IF ! check if allocated @@ -7853,31 +7853,31 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) + DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki),UBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + a3*y3%rotors(i01)%WriteOutput END IF ! check if allocated diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index ec227a4ad7..48668f43af 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -608,15 +608,15 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_CopyTable_Type' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcTable_TypeData%Alpha)) then - LB(1:1) = lbound(SrcTable_TypeData%Alpha) - UB(1:1) = ubound(SrcTable_TypeData%Alpha) + LB(1:1) = lbound(SrcTable_TypeData%Alpha, kind=B8Ki) + UB(1:1) = ubound(SrcTable_TypeData%Alpha, kind=B8Ki) if (.not. allocated(DstTable_TypeData%Alpha)) then allocate(DstTable_TypeData%Alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -627,8 +627,8 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha end if if (allocated(SrcTable_TypeData%Coefs)) then - LB(1:2) = lbound(SrcTable_TypeData%Coefs) - UB(1:2) = ubound(SrcTable_TypeData%Coefs) + LB(1:2) = lbound(SrcTable_TypeData%Coefs, kind=B8Ki) + UB(1:2) = ubound(SrcTable_TypeData%Coefs, kind=B8Ki) if (.not. allocated(DstTable_TypeData%Coefs)) then allocate(DstTable_TypeData%Coefs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -639,8 +639,8 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs end if if (allocated(SrcTable_TypeData%SplineCoefs)) then - LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) - UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs) + LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs, kind=B8Ki) + UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs, kind=B8Ki) if (.not. allocated(DstTable_TypeData%SplineCoefs)) then allocate(DstTable_TypeData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -689,17 +689,17 @@ subroutine AFI_PackTable_Type(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Alpha)) if (allocated(InData%Alpha)) then - call RegPackBounds(Buf, 1, lbound(InData%Alpha), ubound(InData%Alpha)) + call RegPackBounds(Buf, 1, lbound(InData%Alpha, kind=B8Ki), ubound(InData%Alpha, kind=B8Ki)) call RegPack(Buf, InData%Alpha) end if call RegPack(Buf, allocated(InData%Coefs)) if (allocated(InData%Coefs)) then - call RegPackBounds(Buf, 2, lbound(InData%Coefs), ubound(InData%Coefs)) + call RegPackBounds(Buf, 2, lbound(InData%Coefs, kind=B8Ki), ubound(InData%Coefs, kind=B8Ki)) call RegPack(Buf, InData%Coefs) end if call RegPack(Buf, allocated(InData%SplineCoefs)) if (allocated(InData%SplineCoefs)) then - call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs), ubound(InData%SplineCoefs)) + call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs, kind=B8Ki), ubound(InData%SplineCoefs, kind=B8Ki)) call RegPack(Buf, InData%SplineCoefs) end if call RegPack(Buf, InData%UserProp) @@ -715,7 +715,7 @@ subroutine AFI_UnPackTable_Type(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AFI_Table_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -893,8 +893,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_CopyParam' @@ -907,8 +907,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ColUAf = SrcParamData%ColUAf DstParamData%AFTabMod = SrcParamData%AFTabMod if (allocated(SrcParamData%secondVals)) then - LB(1:1) = lbound(SrcParamData%secondVals) - UB(1:1) = ubound(SrcParamData%secondVals) + LB(1:1) = lbound(SrcParamData%secondVals, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%secondVals, kind=B8Ki) if (.not. allocated(DstParamData%secondVals)) then allocate(DstParamData%secondVals(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -923,8 +923,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NonDimArea = SrcParamData%NonDimArea DstParamData%NumCoords = SrcParamData%NumCoords if (allocated(SrcParamData%X_Coord)) then - LB(1:1) = lbound(SrcParamData%X_Coord) - UB(1:1) = ubound(SrcParamData%X_Coord) + LB(1:1) = lbound(SrcParamData%X_Coord, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%X_Coord, kind=B8Ki) if (.not. allocated(DstParamData%X_Coord)) then allocate(DstParamData%X_Coord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -935,8 +935,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%X_Coord = SrcParamData%X_Coord end if if (allocated(SrcParamData%Y_Coord)) then - LB(1:1) = lbound(SrcParamData%Y_Coord) - UB(1:1) = ubound(SrcParamData%Y_Coord) + LB(1:1) = lbound(SrcParamData%Y_Coord, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Y_Coord, kind=B8Ki) if (.not. allocated(DstParamData%Y_Coord)) then allocate(DstParamData%Y_Coord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -948,8 +948,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NumTabs = SrcParamData%NumTabs if (allocated(SrcParamData%Table)) then - LB(1:1) = lbound(SrcParamData%Table) - UB(1:1) = ubound(SrcParamData%Table) + LB(1:1) = lbound(SrcParamData%Table, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Table, kind=B8Ki) if (.not. allocated(DstParamData%Table)) then allocate(DstParamData%Table(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -971,8 +971,8 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) type(AFI_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_DestroyParam' @@ -988,8 +988,8 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Y_Coord) end if if (allocated(ParamData%Table)) then - LB(1:1) = lbound(ParamData%Table) - UB(1:1) = ubound(ParamData%Table) + LB(1:1) = lbound(ParamData%Table, kind=B8Ki) + UB(1:1) = ubound(ParamData%Table, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_DestroyTable_Type(ParamData%Table(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1002,8 +1002,8 @@ subroutine AFI_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%ColCd) call RegPack(Buf, InData%ColCl) @@ -1013,7 +1013,7 @@ subroutine AFI_PackParam(Buf, Indata) call RegPack(Buf, InData%AFTabMod) call RegPack(Buf, allocated(InData%secondVals)) if (allocated(InData%secondVals)) then - call RegPackBounds(Buf, 1, lbound(InData%secondVals), ubound(InData%secondVals)) + call RegPackBounds(Buf, 1, lbound(InData%secondVals, kind=B8Ki), ubound(InData%secondVals, kind=B8Ki)) call RegPack(Buf, InData%secondVals) end if call RegPack(Buf, InData%InterpOrd) @@ -1022,20 +1022,20 @@ subroutine AFI_PackParam(Buf, Indata) call RegPack(Buf, InData%NumCoords) call RegPack(Buf, allocated(InData%X_Coord)) if (allocated(InData%X_Coord)) then - call RegPackBounds(Buf, 1, lbound(InData%X_Coord), ubound(InData%X_Coord)) + call RegPackBounds(Buf, 1, lbound(InData%X_Coord, kind=B8Ki), ubound(InData%X_Coord, kind=B8Ki)) call RegPack(Buf, InData%X_Coord) end if call RegPack(Buf, allocated(InData%Y_Coord)) if (allocated(InData%Y_Coord)) then - call RegPackBounds(Buf, 1, lbound(InData%Y_Coord), ubound(InData%Y_Coord)) + call RegPackBounds(Buf, 1, lbound(InData%Y_Coord, kind=B8Ki), ubound(InData%Y_Coord, kind=B8Ki)) call RegPack(Buf, InData%Y_Coord) end if call RegPack(Buf, InData%NumTabs) call RegPack(Buf, allocated(InData%Table)) if (allocated(InData%Table)) then - call RegPackBounds(Buf, 1, lbound(InData%Table), ubound(InData%Table)) - LB(1:1) = lbound(InData%Table) - UB(1:1) = ubound(InData%Table) + call RegPackBounds(Buf, 1, lbound(InData%Table, kind=B8Ki), ubound(InData%Table, kind=B8Ki)) + LB(1:1) = lbound(InData%Table, kind=B8Ki) + UB(1:1) = ubound(InData%Table, kind=B8Ki) do i1 = LB(1), UB(1) call AFI_PackTable_Type(Buf, InData%Table(i1)) end do @@ -1049,8 +1049,8 @@ subroutine AFI_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AFI_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 9242628999..c8acce2fc8 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -235,14 +235,14 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitInputData%chord)) then - LB(1:2) = lbound(SrcInitInputData%chord) - UB(1:2) = ubound(SrcInitInputData%chord) + LB(1:2) = lbound(SrcInitInputData%chord, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%chord, kind=B8Ki) if (.not. allocated(DstInitInputData%chord)) then allocate(DstInitInputData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -268,8 +268,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%numReIterations = SrcInitInputData%numReIterations DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations if (allocated(SrcInitInputData%AFindx)) then - LB(1:2) = lbound(SrcInitInputData%AFindx) - UB(1:2) = ubound(SrcInitInputData%AFindx) + LB(1:2) = lbound(SrcInitInputData%AFindx, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%AFindx, kind=B8Ki) if (.not. allocated(DstInitInputData%AFindx)) then allocate(DstInitInputData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -280,8 +280,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%AFindx = SrcInitInputData%AFindx end if if (allocated(SrcInitInputData%zHub)) then - LB(1:1) = lbound(SrcInitInputData%zHub) - UB(1:1) = ubound(SrcInitInputData%zHub) + LB(1:1) = lbound(SrcInitInputData%zHub, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%zHub, kind=B8Ki) if (.not. allocated(DstInitInputData%zHub)) then allocate(DstInitInputData%zHub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -292,8 +292,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zHub = SrcInitInputData%zHub end if if (allocated(SrcInitInputData%zLocal)) then - LB(1:2) = lbound(SrcInitInputData%zLocal) - UB(1:2) = ubound(SrcInitInputData%zLocal) + LB(1:2) = lbound(SrcInitInputData%zLocal, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%zLocal, kind=B8Ki) if (.not. allocated(DstInitInputData%zLocal)) then allocate(DstInitInputData%zLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -304,8 +304,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zLocal = SrcInitInputData%zLocal end if if (allocated(SrcInitInputData%zTip)) then - LB(1:1) = lbound(SrcInitInputData%zTip) - UB(1:1) = ubound(SrcInitInputData%zTip) + LB(1:1) = lbound(SrcInitInputData%zTip, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%zTip, kind=B8Ki) if (.not. allocated(DstInitInputData%zTip)) then allocate(DstInitInputData%zTip(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -316,8 +316,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zTip = SrcInitInputData%zTip end if if (allocated(SrcInitInputData%rLocal)) then - LB(1:2) = lbound(SrcInitInputData%rLocal) - UB(1:2) = ubound(SrcInitInputData%rLocal) + LB(1:2) = lbound(SrcInitInputData%rLocal, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%rLocal, kind=B8Ki) if (.not. allocated(DstInitInputData%rLocal)) then allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -328,8 +328,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%rLocal = SrcInitInputData%rLocal end if if (allocated(SrcInitInputData%rTipFix)) then - LB(1:1) = lbound(SrcInitInputData%rTipFix) - UB(1:1) = ubound(SrcInitInputData%rTipFix) + LB(1:1) = lbound(SrcInitInputData%rTipFix, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%rTipFix, kind=B8Ki) if (.not. allocated(DstInitInputData%rTipFix)) then allocate(DstInitInputData%rTipFix(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -347,8 +347,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%tau1_const = SrcInitInputData%tau1_const DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor if (allocated(SrcInitInputData%UAOff_innerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) - UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) if (.not. allocated(DstInitInputData%UAOff_innerNode)) then allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -359,8 +359,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode end if if (allocated(SrcInitInputData%UAOff_outerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) - UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) if (.not. allocated(DstInitInputData%UAOff_outerNode)) then allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -418,7 +418,7 @@ subroutine BEMT_PackInitInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then - call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) + call RegPackBounds(Buf, 2, lbound(InData%chord, kind=B8Ki), ubound(InData%chord, kind=B8Ki)) call RegPack(Buf, InData%chord) end if call RegPack(Buf, InData%numBlades) @@ -438,32 +438,32 @@ subroutine BEMT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%maxIndIterations) call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) call RegPack(Buf, InData%AFindx) end if call RegPack(Buf, allocated(InData%zHub)) if (allocated(InData%zHub)) then - call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) + call RegPackBounds(Buf, 1, lbound(InData%zHub, kind=B8Ki), ubound(InData%zHub, kind=B8Ki)) call RegPack(Buf, InData%zHub) end if call RegPack(Buf, allocated(InData%zLocal)) if (allocated(InData%zLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%zLocal), ubound(InData%zLocal)) + call RegPackBounds(Buf, 2, lbound(InData%zLocal, kind=B8Ki), ubound(InData%zLocal, kind=B8Ki)) call RegPack(Buf, InData%zLocal) end if call RegPack(Buf, allocated(InData%zTip)) if (allocated(InData%zTip)) then - call RegPackBounds(Buf, 1, lbound(InData%zTip), ubound(InData%zTip)) + call RegPackBounds(Buf, 1, lbound(InData%zTip, kind=B8Ki), ubound(InData%zTip, kind=B8Ki)) call RegPack(Buf, InData%zTip) end if call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPackBounds(Buf, 2, lbound(InData%rLocal, kind=B8Ki), ubound(InData%rLocal, kind=B8Ki)) call RegPack(Buf, InData%rLocal) end if call RegPack(Buf, allocated(InData%rTipFix)) if (allocated(InData%rTipFix)) then - call RegPackBounds(Buf, 1, lbound(InData%rTipFix), ubound(InData%rTipFix)) + call RegPackBounds(Buf, 1, lbound(InData%rTipFix, kind=B8Ki), ubound(InData%rTipFix, kind=B8Ki)) call RegPack(Buf, InData%rTipFix) end if call RegPack(Buf, InData%UAMod) @@ -475,12 +475,12 @@ subroutine BEMT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%yawCorrFactor) call RegPack(Buf, allocated(InData%UAOff_innerNode)) if (allocated(InData%UAOff_innerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) + call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode, kind=B8Ki), ubound(InData%UAOff_innerNode, kind=B8Ki)) call RegPack(Buf, InData%UAOff_innerNode) end if call RegPack(Buf, allocated(InData%UAOff_outerNode)) if (allocated(InData%UAOff_outerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) + call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode, kind=B8Ki), ubound(InData%UAOff_outerNode, kind=B8Ki)) call RegPack(Buf, InData%UAOff_outerNode) end if call RegPack(Buf, InData%RootName) @@ -493,7 +493,7 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -877,14 +877,14 @@ subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%phi)) then - LB(1:2) = lbound(SrcConstrStateData%phi) - UB(1:2) = ubound(SrcConstrStateData%phi) + LB(1:2) = lbound(SrcConstrStateData%phi, kind=B8Ki) + UB(1:2) = ubound(SrcConstrStateData%phi, kind=B8Ki) if (.not. allocated(DstConstrStateData%phi)) then allocate(DstConstrStateData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -915,7 +915,7 @@ subroutine BEMT_PackConstrState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then - call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPackBounds(Buf, 2, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) call RegPack(Buf, InData%phi) end if if (RegCheckErr(Buf, RoutineName)) return @@ -925,7 +925,7 @@ subroutine BEMT_UnPackConstrState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -951,8 +951,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyOtherState' @@ -965,8 +965,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOtherStateData%ValidPhi)) then - LB(1:2) = lbound(SrcOtherStateData%ValidPhi) - UB(1:2) = ubound(SrcOtherStateData%ValidPhi) + LB(1:2) = lbound(SrcOtherStateData%ValidPhi, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%ValidPhi, kind=B8Ki) if (.not. allocated(DstOtherStateData%ValidPhi)) then allocate(DstOtherStateData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -977,8 +977,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi end if DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -991,8 +991,8 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(BEMT_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' @@ -1005,8 +1005,8 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%ValidPhi)) then deallocate(OtherStateData%ValidPhi) end if - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1017,19 +1017,19 @@ subroutine BEMT_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call UA_PackOtherState(Buf, InData%UA) call DBEMT_PackOtherState(Buf, InData%DBEMT) call RegPack(Buf, allocated(InData%ValidPhi)) if (allocated(InData%ValidPhi)) then - call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) + call RegPackBounds(Buf, 2, lbound(InData%ValidPhi, kind=B8Ki), ubound(InData%ValidPhi, kind=B8Ki)) call RegPack(Buf, InData%ValidPhi) end if call RegPack(Buf, InData%nodesInitialized) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_PackContState(Buf, InData%xdot(i1)) end do @@ -1041,8 +1041,8 @@ subroutine BEMT_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1064,8 +1064,8 @@ subroutine BEMT_UnPackOtherState(Buf, OutData) end if call RegUnpack(Buf, OutData%nodesInitialized) if (RegCheckErr(Buf, RoutineName)) return - LB(1:1) = lbound(OutData%xdot) - UB(1:1) = ubound(OutData%xdot) + LB(1:1) = lbound(OutData%xdot, kind=B8Ki) + UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do @@ -1079,8 +1079,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyMisc' @@ -1099,8 +1099,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%u_UA)) then - LB(1:3) = lbound(SrcMiscData%u_UA) - UB(1:3) = ubound(SrcMiscData%u_UA) + LB(1:3) = lbound(SrcMiscData%u_UA, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%u_UA, kind=B8Ki) if (.not. allocated(DstMiscData%u_UA)) then allocate(DstMiscData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1118,23 +1118,23 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end do end if - LB(1:1) = lbound(SrcMiscData%u_DBEMT) - UB(1:1) = ubound(SrcMiscData%u_DBEMT) + LB(1:1) = lbound(SrcMiscData%u_DBEMT, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%u_DBEMT, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMiscData%u_SkewWake) - UB(1:1) = ubound(SrcMiscData%u_SkewWake) + LB(1:1) = lbound(SrcMiscData%u_SkewWake, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%u_SkewWake, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcMiscData%TnInd_op)) then - LB(1:2) = lbound(SrcMiscData%TnInd_op) - UB(1:2) = ubound(SrcMiscData%TnInd_op) + LB(1:2) = lbound(SrcMiscData%TnInd_op, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%TnInd_op, kind=B8Ki) if (.not. allocated(DstMiscData%TnInd_op)) then allocate(DstMiscData%TnInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1145,8 +1145,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TnInd_op = SrcMiscData%TnInd_op end if if (allocated(SrcMiscData%AxInd_op)) then - LB(1:2) = lbound(SrcMiscData%AxInd_op) - UB(1:2) = ubound(SrcMiscData%AxInd_op) + LB(1:2) = lbound(SrcMiscData%AxInd_op, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AxInd_op, kind=B8Ki) if (.not. allocated(DstMiscData%AxInd_op)) then allocate(DstMiscData%AxInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1157,8 +1157,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AxInd_op = SrcMiscData%AxInd_op end if if (allocated(SrcMiscData%AxInduction)) then - LB(1:2) = lbound(SrcMiscData%AxInduction) - UB(1:2) = ubound(SrcMiscData%AxInduction) + LB(1:2) = lbound(SrcMiscData%AxInduction, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AxInduction, kind=B8Ki) if (.not. allocated(DstMiscData%AxInduction)) then allocate(DstMiscData%AxInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1169,8 +1169,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AxInduction = SrcMiscData%AxInduction end if if (allocated(SrcMiscData%TanInduction)) then - LB(1:2) = lbound(SrcMiscData%TanInduction) - UB(1:2) = ubound(SrcMiscData%TanInduction) + LB(1:2) = lbound(SrcMiscData%TanInduction, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%TanInduction, kind=B8Ki) if (.not. allocated(DstMiscData%TanInduction)) then allocate(DstMiscData%TanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1182,8 +1182,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake if (allocated(SrcMiscData%Rtip)) then - LB(1:1) = lbound(SrcMiscData%Rtip) - UB(1:1) = ubound(SrcMiscData%Rtip) + LB(1:1) = lbound(SrcMiscData%Rtip, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Rtip, kind=B8Ki) if (.not. allocated(DstMiscData%Rtip)) then allocate(DstMiscData%Rtip(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1194,8 +1194,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Rtip = SrcMiscData%Rtip end if if (allocated(SrcMiscData%phi)) then - LB(1:2) = lbound(SrcMiscData%phi) - UB(1:2) = ubound(SrcMiscData%phi) + LB(1:2) = lbound(SrcMiscData%phi, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%phi, kind=B8Ki) if (.not. allocated(DstMiscData%phi)) then allocate(DstMiscData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1206,8 +1206,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%phi = SrcMiscData%phi end if if (allocated(SrcMiscData%chi)) then - LB(1:2) = lbound(SrcMiscData%chi) - UB(1:2) = ubound(SrcMiscData%chi) + LB(1:2) = lbound(SrcMiscData%chi, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%chi, kind=B8Ki) if (.not. allocated(DstMiscData%chi)) then allocate(DstMiscData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1218,8 +1218,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%chi = SrcMiscData%chi end if if (allocated(SrcMiscData%ValidPhi)) then - LB(1:2) = lbound(SrcMiscData%ValidPhi) - UB(1:2) = ubound(SrcMiscData%ValidPhi) + LB(1:2) = lbound(SrcMiscData%ValidPhi, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%ValidPhi, kind=B8Ki) if (.not. allocated(DstMiscData%ValidPhi)) then allocate(DstMiscData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1236,8 +1236,8 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) type(BEMT_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' @@ -1250,8 +1250,8 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) call UA_DestroyOutput(MiscData%y_UA, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_UA)) then - LB(1:3) = lbound(MiscData%u_UA) - UB(1:3) = ubound(MiscData%u_UA) + LB(1:3) = lbound(MiscData%u_UA, kind=B8Ki) + UB(1:3) = ubound(MiscData%u_UA, kind=B8Ki) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) @@ -1262,14 +1262,14 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%u_UA) end if - LB(1:1) = lbound(MiscData%u_DBEMT) - UB(1:1) = ubound(MiscData%u_DBEMT) + LB(1:1) = lbound(MiscData%u_DBEMT, kind=B8Ki) + UB(1:1) = ubound(MiscData%u_DBEMT, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_DestroyInput(MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MiscData%u_SkewWake) - UB(1:1) = ubound(MiscData%u_SkewWake) + LB(1:1) = lbound(MiscData%u_SkewWake, kind=B8Ki) + UB(1:1) = ubound(MiscData%u_SkewWake, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_DestroySkewWake_InputType(MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1304,8 +1304,8 @@ subroutine BEMT_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackMisc' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FirstWarn_Skew) call RegPack(Buf, InData%FirstWarn_Phi) @@ -1315,9 +1315,9 @@ subroutine BEMT_PackMisc(Buf, Indata) call UA_PackOutput(Buf, InData%y_UA) call RegPack(Buf, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(Buf, 3, lbound(InData%u_UA), ubound(InData%u_UA)) - LB(1:3) = lbound(InData%u_UA) - UB(1:3) = ubound(InData%u_UA) + call RegPackBounds(Buf, 3, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) + LB(1:3) = lbound(InData%u_UA, kind=B8Ki) + UB(1:3) = ubound(InData%u_UA, kind=B8Ki) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) @@ -1326,55 +1326,55 @@ subroutine BEMT_PackMisc(Buf, Indata) end do end do end if - LB(1:1) = lbound(InData%u_DBEMT) - UB(1:1) = ubound(InData%u_DBEMT) + LB(1:1) = lbound(InData%u_DBEMT, kind=B8Ki) + UB(1:1) = ubound(InData%u_DBEMT, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_PackInput(Buf, InData%u_DBEMT(i1)) end do - LB(1:1) = lbound(InData%u_SkewWake) - UB(1:1) = ubound(InData%u_SkewWake) + LB(1:1) = lbound(InData%u_SkewWake, kind=B8Ki) + UB(1:1) = ubound(InData%u_SkewWake, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_PackSkewWake_InputType(Buf, InData%u_SkewWake(i1)) end do call RegPack(Buf, allocated(InData%TnInd_op)) if (allocated(InData%TnInd_op)) then - call RegPackBounds(Buf, 2, lbound(InData%TnInd_op), ubound(InData%TnInd_op)) + call RegPackBounds(Buf, 2, lbound(InData%TnInd_op, kind=B8Ki), ubound(InData%TnInd_op, kind=B8Ki)) call RegPack(Buf, InData%TnInd_op) end if call RegPack(Buf, allocated(InData%AxInd_op)) if (allocated(InData%AxInd_op)) then - call RegPackBounds(Buf, 2, lbound(InData%AxInd_op), ubound(InData%AxInd_op)) + call RegPackBounds(Buf, 2, lbound(InData%AxInd_op, kind=B8Ki), ubound(InData%AxInd_op, kind=B8Ki)) call RegPack(Buf, InData%AxInd_op) end if call RegPack(Buf, allocated(InData%AxInduction)) if (allocated(InData%AxInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%AxInduction), ubound(InData%AxInduction)) + call RegPackBounds(Buf, 2, lbound(InData%AxInduction, kind=B8Ki), ubound(InData%AxInduction, kind=B8Ki)) call RegPack(Buf, InData%AxInduction) end if call RegPack(Buf, allocated(InData%TanInduction)) if (allocated(InData%TanInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%TanInduction), ubound(InData%TanInduction)) + call RegPackBounds(Buf, 2, lbound(InData%TanInduction, kind=B8Ki), ubound(InData%TanInduction, kind=B8Ki)) call RegPack(Buf, InData%TanInduction) end if call RegPack(Buf, InData%UseFrozenWake) call RegPack(Buf, allocated(InData%Rtip)) if (allocated(InData%Rtip)) then - call RegPackBounds(Buf, 1, lbound(InData%Rtip), ubound(InData%Rtip)) + call RegPackBounds(Buf, 1, lbound(InData%Rtip, kind=B8Ki), ubound(InData%Rtip, kind=B8Ki)) call RegPack(Buf, InData%Rtip) end if call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then - call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPackBounds(Buf, 2, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) call RegPack(Buf, InData%phi) end if call RegPack(Buf, allocated(InData%chi)) if (allocated(InData%chi)) then - call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) + call RegPackBounds(Buf, 2, lbound(InData%chi, kind=B8Ki), ubound(InData%chi, kind=B8Ki)) call RegPack(Buf, InData%chi) end if call RegPack(Buf, allocated(InData%ValidPhi)) if (allocated(InData%ValidPhi)) then - call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) + call RegPackBounds(Buf, 2, lbound(InData%ValidPhi, kind=B8Ki), ubound(InData%ValidPhi, kind=B8Ki)) call RegPack(Buf, InData%ValidPhi) end if call RegPack(Buf, InData%BEM_weight) @@ -1385,8 +1385,8 @@ subroutine BEMT_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1418,13 +1418,13 @@ subroutine BEMT_UnPackMisc(Buf, OutData) end do end do end if - LB(1:1) = lbound(OutData%u_DBEMT) - UB(1:1) = ubound(OutData%u_DBEMT) + LB(1:1) = lbound(OutData%u_DBEMT, kind=B8Ki) + UB(1:1) = ubound(OutData%u_DBEMT, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_UnpackInput(Buf, OutData%u_DBEMT(i1)) ! u_DBEMT end do - LB(1:1) = lbound(OutData%u_SkewWake) - UB(1:1) = ubound(OutData%u_SkewWake) + LB(1:1) = lbound(OutData%u_SkewWake, kind=B8Ki) + UB(1:1) = ubound(OutData%u_SkewWake, kind=B8Ki) do i1 = LB(1), UB(1) call BEMT_UnpackSkewWake_InputType(Buf, OutData%u_SkewWake(i1)) ! u_SkewWake end do @@ -1552,7 +1552,7 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyParam' @@ -1560,8 +1560,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%chord)) then - LB(1:2) = lbound(SrcParamData%chord) - UB(1:2) = ubound(SrcParamData%chord) + LB(1:2) = lbound(SrcParamData%chord, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%chord, kind=B8Ki) if (.not. allocated(DstParamData%chord)) then allocate(DstParamData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1586,8 +1586,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%numReIterations = SrcParamData%numReIterations DstParamData%maxIndIterations = SrcParamData%maxIndIterations if (allocated(SrcParamData%AFindx)) then - LB(1:2) = lbound(SrcParamData%AFindx) - UB(1:2) = ubound(SrcParamData%AFindx) + LB(1:2) = lbound(SrcParamData%AFindx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AFindx, kind=B8Ki) if (.not. allocated(DstParamData%AFindx)) then allocate(DstParamData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1598,8 +1598,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFindx = SrcParamData%AFindx end if if (allocated(SrcParamData%tipLossConst)) then - LB(1:2) = lbound(SrcParamData%tipLossConst) - UB(1:2) = ubound(SrcParamData%tipLossConst) + LB(1:2) = lbound(SrcParamData%tipLossConst, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%tipLossConst, kind=B8Ki) if (.not. allocated(DstParamData%tipLossConst)) then allocate(DstParamData%tipLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1610,8 +1610,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%tipLossConst = SrcParamData%tipLossConst end if if (allocated(SrcParamData%hubLossConst)) then - LB(1:2) = lbound(SrcParamData%hubLossConst) - UB(1:2) = ubound(SrcParamData%hubLossConst) + LB(1:2) = lbound(SrcParamData%hubLossConst, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%hubLossConst, kind=B8Ki) if (.not. allocated(DstParamData%hubLossConst)) then allocate(DstParamData%hubLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1622,8 +1622,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%hubLossConst = SrcParamData%hubLossConst end if if (allocated(SrcParamData%zHub)) then - LB(1:1) = lbound(SrcParamData%zHub) - UB(1:1) = ubound(SrcParamData%zHub) + LB(1:1) = lbound(SrcParamData%zHub, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%zHub, kind=B8Ki) if (.not. allocated(DstParamData%zHub)) then allocate(DstParamData%zHub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1643,8 +1643,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor if (allocated(SrcParamData%FixedInductions)) then - LB(1:2) = lbound(SrcParamData%FixedInductions) - UB(1:2) = ubound(SrcParamData%FixedInductions) + LB(1:2) = lbound(SrcParamData%FixedInductions, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%FixedInductions, kind=B8Ki) if (.not. allocated(DstParamData%FixedInductions)) then allocate(DstParamData%FixedInductions(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1657,8 +1657,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MomentumCorr = SrcParamData%MomentumCorr DstParamData%rTipFixMax = SrcParamData%rTipFixMax if (allocated(SrcParamData%IntegrateWeight)) then - LB(1:2) = lbound(SrcParamData%IntegrateWeight) - UB(1:2) = ubound(SrcParamData%IntegrateWeight) + LB(1:2) = lbound(SrcParamData%IntegrateWeight, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%IntegrateWeight, kind=B8Ki) if (.not. allocated(DstParamData%IntegrateWeight)) then allocate(DstParamData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1716,7 +1716,7 @@ subroutine BEMT_PackParam(Buf, Indata) call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then - call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) + call RegPackBounds(Buf, 2, lbound(InData%chord, kind=B8Ki), ubound(InData%chord, kind=B8Ki)) call RegPack(Buf, InData%chord) end if call RegPack(Buf, InData%numBlades) @@ -1735,22 +1735,22 @@ subroutine BEMT_PackParam(Buf, Indata) call RegPack(Buf, InData%maxIndIterations) call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) call RegPack(Buf, InData%AFindx) end if call RegPack(Buf, allocated(InData%tipLossConst)) if (allocated(InData%tipLossConst)) then - call RegPackBounds(Buf, 2, lbound(InData%tipLossConst), ubound(InData%tipLossConst)) + call RegPackBounds(Buf, 2, lbound(InData%tipLossConst, kind=B8Ki), ubound(InData%tipLossConst, kind=B8Ki)) call RegPack(Buf, InData%tipLossConst) end if call RegPack(Buf, allocated(InData%hubLossConst)) if (allocated(InData%hubLossConst)) then - call RegPackBounds(Buf, 2, lbound(InData%hubLossConst), ubound(InData%hubLossConst)) + call RegPackBounds(Buf, 2, lbound(InData%hubLossConst, kind=B8Ki), ubound(InData%hubLossConst, kind=B8Ki)) call RegPack(Buf, InData%hubLossConst) end if call RegPack(Buf, allocated(InData%zHub)) if (allocated(InData%zHub)) then - call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) + call RegPackBounds(Buf, 1, lbound(InData%zHub, kind=B8Ki), ubound(InData%zHub, kind=B8Ki)) call RegPack(Buf, InData%zHub) end if call UA_PackParam(Buf, InData%UA) @@ -1760,14 +1760,14 @@ subroutine BEMT_PackParam(Buf, Indata) call RegPack(Buf, InData%yawCorrFactor) call RegPack(Buf, allocated(InData%FixedInductions)) if (allocated(InData%FixedInductions)) then - call RegPackBounds(Buf, 2, lbound(InData%FixedInductions), ubound(InData%FixedInductions)) + call RegPackBounds(Buf, 2, lbound(InData%FixedInductions, kind=B8Ki), ubound(InData%FixedInductions, kind=B8Ki)) call RegPack(Buf, InData%FixedInductions) end if call RegPack(Buf, InData%MomentumCorr) call RegPack(Buf, InData%rTipFixMax) call RegPack(Buf, allocated(InData%IntegrateWeight)) if (allocated(InData%IntegrateWeight)) then - call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight), ubound(InData%IntegrateWeight)) + call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight, kind=B8Ki), ubound(InData%IntegrateWeight, kind=B8Ki)) call RegPack(Buf, InData%IntegrateWeight) end if call RegPack(Buf, InData%lin_nx) @@ -1779,7 +1779,7 @@ subroutine BEMT_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1935,14 +1935,14 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%theta)) then - LB(1:2) = lbound(SrcInputData%theta) - UB(1:2) = ubound(SrcInputData%theta) + LB(1:2) = lbound(SrcInputData%theta, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%theta, kind=B8Ki) if (.not. allocated(DstInputData%theta)) then allocate(DstInputData%theta(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1955,8 +1955,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%chi0 = SrcInputData%chi0 DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset if (allocated(SrcInputData%psi_s)) then - LB(1:1) = lbound(SrcInputData%psi_s) - UB(1:1) = ubound(SrcInputData%psi_s) + LB(1:1) = lbound(SrcInputData%psi_s, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%psi_s, kind=B8Ki) if (.not. allocated(DstInputData%psi_s)) then allocate(DstInputData%psi_s(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1969,8 +1969,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%omega = SrcInputData%omega DstInputData%TSR = SrcInputData%TSR if (allocated(SrcInputData%Vx)) then - LB(1:2) = lbound(SrcInputData%Vx) - UB(1:2) = ubound(SrcInputData%Vx) + LB(1:2) = lbound(SrcInputData%Vx, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%Vx, kind=B8Ki) if (.not. allocated(DstInputData%Vx)) then allocate(DstInputData%Vx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1981,8 +1981,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vx = SrcInputData%Vx end if if (allocated(SrcInputData%Vy)) then - LB(1:2) = lbound(SrcInputData%Vy) - UB(1:2) = ubound(SrcInputData%Vy) + LB(1:2) = lbound(SrcInputData%Vy, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%Vy, kind=B8Ki) if (.not. allocated(DstInputData%Vy)) then allocate(DstInputData%Vy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1993,8 +1993,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vy = SrcInputData%Vy end if if (allocated(SrcInputData%Vz)) then - LB(1:2) = lbound(SrcInputData%Vz) - UB(1:2) = ubound(SrcInputData%Vz) + LB(1:2) = lbound(SrcInputData%Vz, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%Vz, kind=B8Ki) if (.not. allocated(DstInputData%Vz)) then allocate(DstInputData%Vz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2005,8 +2005,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vz = SrcInputData%Vz end if if (allocated(SrcInputData%omega_z)) then - LB(1:2) = lbound(SrcInputData%omega_z) - UB(1:2) = ubound(SrcInputData%omega_z) + LB(1:2) = lbound(SrcInputData%omega_z, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%omega_z, kind=B8Ki) if (.not. allocated(DstInputData%omega_z)) then allocate(DstInputData%omega_z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2017,8 +2017,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%omega_z = SrcInputData%omega_z end if if (allocated(SrcInputData%xVelCorr)) then - LB(1:2) = lbound(SrcInputData%xVelCorr) - UB(1:2) = ubound(SrcInputData%xVelCorr) + LB(1:2) = lbound(SrcInputData%xVelCorr, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%xVelCorr, kind=B8Ki) if (.not. allocated(DstInputData%xVelCorr)) then allocate(DstInputData%xVelCorr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2029,8 +2029,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xVelCorr = SrcInputData%xVelCorr end if if (allocated(SrcInputData%rLocal)) then - LB(1:2) = lbound(SrcInputData%rLocal) - UB(1:2) = ubound(SrcInputData%rLocal) + LB(1:2) = lbound(SrcInputData%rLocal, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%rLocal, kind=B8Ki) if (.not. allocated(DstInputData%rLocal)) then allocate(DstInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2044,8 +2044,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%V0 = SrcInputData%V0 DstInputData%x_hat_disk = SrcInputData%x_hat_disk if (allocated(SrcInputData%UserProp)) then - LB(1:2) = lbound(SrcInputData%UserProp) - UB(1:2) = ubound(SrcInputData%UserProp) + LB(1:2) = lbound(SrcInputData%UserProp, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%UserProp, kind=B8Ki) if (.not. allocated(DstInputData%UserProp)) then allocate(DstInputData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2056,8 +2056,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%UserProp = SrcInputData%UserProp end if if (allocated(SrcInputData%CantAngle)) then - LB(1:2) = lbound(SrcInputData%CantAngle) - UB(1:2) = ubound(SrcInputData%CantAngle) + LB(1:2) = lbound(SrcInputData%CantAngle, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%CantAngle, kind=B8Ki) if (.not. allocated(DstInputData%CantAngle)) then allocate(DstInputData%CantAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2068,8 +2068,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CantAngle = SrcInputData%CantAngle end if if (allocated(SrcInputData%drdz)) then - LB(1:2) = lbound(SrcInputData%drdz) - UB(1:2) = ubound(SrcInputData%drdz) + LB(1:2) = lbound(SrcInputData%drdz, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%drdz, kind=B8Ki) if (.not. allocated(DstInputData%drdz)) then allocate(DstInputData%drdz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2080,8 +2080,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%drdz = SrcInputData%drdz end if if (allocated(SrcInputData%toeAngle)) then - LB(1:2) = lbound(SrcInputData%toeAngle) - UB(1:2) = ubound(SrcInputData%toeAngle) + LB(1:2) = lbound(SrcInputData%toeAngle, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%toeAngle, kind=B8Ki) if (.not. allocated(DstInputData%toeAngle)) then allocate(DstInputData%toeAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2145,46 +2145,46 @@ subroutine BEMT_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%theta)) if (allocated(InData%theta)) then - call RegPackBounds(Buf, 2, lbound(InData%theta), ubound(InData%theta)) + call RegPackBounds(Buf, 2, lbound(InData%theta, kind=B8Ki), ubound(InData%theta, kind=B8Ki)) call RegPack(Buf, InData%theta) end if call RegPack(Buf, InData%chi0) call RegPack(Buf, InData%psiSkewOffset) call RegPack(Buf, allocated(InData%psi_s)) if (allocated(InData%psi_s)) then - call RegPackBounds(Buf, 1, lbound(InData%psi_s), ubound(InData%psi_s)) + call RegPackBounds(Buf, 1, lbound(InData%psi_s, kind=B8Ki), ubound(InData%psi_s, kind=B8Ki)) call RegPack(Buf, InData%psi_s) end if call RegPack(Buf, InData%omega) call RegPack(Buf, InData%TSR) call RegPack(Buf, allocated(InData%Vx)) if (allocated(InData%Vx)) then - call RegPackBounds(Buf, 2, lbound(InData%Vx), ubound(InData%Vx)) + call RegPackBounds(Buf, 2, lbound(InData%Vx, kind=B8Ki), ubound(InData%Vx, kind=B8Ki)) call RegPack(Buf, InData%Vx) end if call RegPack(Buf, allocated(InData%Vy)) if (allocated(InData%Vy)) then - call RegPackBounds(Buf, 2, lbound(InData%Vy), ubound(InData%Vy)) + call RegPackBounds(Buf, 2, lbound(InData%Vy, kind=B8Ki), ubound(InData%Vy, kind=B8Ki)) call RegPack(Buf, InData%Vy) end if call RegPack(Buf, allocated(InData%Vz)) if (allocated(InData%Vz)) then - call RegPackBounds(Buf, 2, lbound(InData%Vz), ubound(InData%Vz)) + call RegPackBounds(Buf, 2, lbound(InData%Vz, kind=B8Ki), ubound(InData%Vz, kind=B8Ki)) call RegPack(Buf, InData%Vz) end if call RegPack(Buf, allocated(InData%omega_z)) if (allocated(InData%omega_z)) then - call RegPackBounds(Buf, 2, lbound(InData%omega_z), ubound(InData%omega_z)) + call RegPackBounds(Buf, 2, lbound(InData%omega_z, kind=B8Ki), ubound(InData%omega_z, kind=B8Ki)) call RegPack(Buf, InData%omega_z) end if call RegPack(Buf, allocated(InData%xVelCorr)) if (allocated(InData%xVelCorr)) then - call RegPackBounds(Buf, 2, lbound(InData%xVelCorr), ubound(InData%xVelCorr)) + call RegPackBounds(Buf, 2, lbound(InData%xVelCorr, kind=B8Ki), ubound(InData%xVelCorr, kind=B8Ki)) call RegPack(Buf, InData%xVelCorr) end if call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPackBounds(Buf, 2, lbound(InData%rLocal, kind=B8Ki), ubound(InData%rLocal, kind=B8Ki)) call RegPack(Buf, InData%rLocal) end if call RegPack(Buf, InData%Un_disk) @@ -2192,22 +2192,22 @@ subroutine BEMT_PackInput(Buf, Indata) call RegPack(Buf, InData%x_hat_disk) call RegPack(Buf, allocated(InData%UserProp)) if (allocated(InData%UserProp)) then - call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) + call RegPackBounds(Buf, 2, lbound(InData%UserProp, kind=B8Ki), ubound(InData%UserProp, kind=B8Ki)) call RegPack(Buf, InData%UserProp) end if call RegPack(Buf, allocated(InData%CantAngle)) if (allocated(InData%CantAngle)) then - call RegPackBounds(Buf, 2, lbound(InData%CantAngle), ubound(InData%CantAngle)) + call RegPackBounds(Buf, 2, lbound(InData%CantAngle, kind=B8Ki), ubound(InData%CantAngle, kind=B8Ki)) call RegPack(Buf, InData%CantAngle) end if call RegPack(Buf, allocated(InData%drdz)) if (allocated(InData%drdz)) then - call RegPackBounds(Buf, 2, lbound(InData%drdz), ubound(InData%drdz)) + call RegPackBounds(Buf, 2, lbound(InData%drdz, kind=B8Ki), ubound(InData%drdz, kind=B8Ki)) call RegPack(Buf, InData%drdz) end if call RegPack(Buf, allocated(InData%toeAngle)) if (allocated(InData%toeAngle)) then - call RegPackBounds(Buf, 2, lbound(InData%toeAngle), ubound(InData%toeAngle)) + call RegPackBounds(Buf, 2, lbound(InData%toeAngle, kind=B8Ki), ubound(InData%toeAngle, kind=B8Ki)) call RegPack(Buf, InData%toeAngle) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2217,7 +2217,7 @@ subroutine BEMT_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2411,14 +2411,14 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Vrel)) then - LB(1:2) = lbound(SrcOutputData%Vrel) - UB(1:2) = ubound(SrcOutputData%Vrel) + LB(1:2) = lbound(SrcOutputData%Vrel, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Vrel, kind=B8Ki) if (.not. allocated(DstOutputData%Vrel)) then allocate(DstOutputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2429,8 +2429,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Vrel = SrcOutputData%Vrel end if if (allocated(SrcOutputData%phi)) then - LB(1:2) = lbound(SrcOutputData%phi) - UB(1:2) = ubound(SrcOutputData%phi) + LB(1:2) = lbound(SrcOutputData%phi, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%phi, kind=B8Ki) if (.not. allocated(DstOutputData%phi)) then allocate(DstOutputData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2441,8 +2441,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%phi = SrcOutputData%phi end if if (allocated(SrcOutputData%axInduction)) then - LB(1:2) = lbound(SrcOutputData%axInduction) - UB(1:2) = ubound(SrcOutputData%axInduction) + LB(1:2) = lbound(SrcOutputData%axInduction, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%axInduction, kind=B8Ki) if (.not. allocated(DstOutputData%axInduction)) then allocate(DstOutputData%axInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2453,8 +2453,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%axInduction = SrcOutputData%axInduction end if if (allocated(SrcOutputData%tanInduction)) then - LB(1:2) = lbound(SrcOutputData%tanInduction) - UB(1:2) = ubound(SrcOutputData%tanInduction) + LB(1:2) = lbound(SrcOutputData%tanInduction, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%tanInduction, kind=B8Ki) if (.not. allocated(DstOutputData%tanInduction)) then allocate(DstOutputData%tanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2465,8 +2465,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%tanInduction = SrcOutputData%tanInduction end if if (allocated(SrcOutputData%axInduction_qs)) then - LB(1:2) = lbound(SrcOutputData%axInduction_qs) - UB(1:2) = ubound(SrcOutputData%axInduction_qs) + LB(1:2) = lbound(SrcOutputData%axInduction_qs, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%axInduction_qs, kind=B8Ki) if (.not. allocated(DstOutputData%axInduction_qs)) then allocate(DstOutputData%axInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2477,8 +2477,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%axInduction_qs = SrcOutputData%axInduction_qs end if if (allocated(SrcOutputData%tanInduction_qs)) then - LB(1:2) = lbound(SrcOutputData%tanInduction_qs) - UB(1:2) = ubound(SrcOutputData%tanInduction_qs) + LB(1:2) = lbound(SrcOutputData%tanInduction_qs, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%tanInduction_qs, kind=B8Ki) if (.not. allocated(DstOutputData%tanInduction_qs)) then allocate(DstOutputData%tanInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2489,8 +2489,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%tanInduction_qs = SrcOutputData%tanInduction_qs end if if (allocated(SrcOutputData%k)) then - LB(1:2) = lbound(SrcOutputData%k) - UB(1:2) = ubound(SrcOutputData%k) + LB(1:2) = lbound(SrcOutputData%k, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%k, kind=B8Ki) if (.not. allocated(DstOutputData%k)) then allocate(DstOutputData%k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2501,8 +2501,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%k = SrcOutputData%k end if if (allocated(SrcOutputData%k_p)) then - LB(1:2) = lbound(SrcOutputData%k_p) - UB(1:2) = ubound(SrcOutputData%k_p) + LB(1:2) = lbound(SrcOutputData%k_p, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%k_p, kind=B8Ki) if (.not. allocated(DstOutputData%k_p)) then allocate(DstOutputData%k_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2513,8 +2513,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%k_p = SrcOutputData%k_p end if if (allocated(SrcOutputData%F)) then - LB(1:2) = lbound(SrcOutputData%F) - UB(1:2) = ubound(SrcOutputData%F) + LB(1:2) = lbound(SrcOutputData%F, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%F, kind=B8Ki) if (.not. allocated(DstOutputData%F)) then allocate(DstOutputData%F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2525,8 +2525,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%F = SrcOutputData%F end if if (allocated(SrcOutputData%Re)) then - LB(1:2) = lbound(SrcOutputData%Re) - UB(1:2) = ubound(SrcOutputData%Re) + LB(1:2) = lbound(SrcOutputData%Re, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Re, kind=B8Ki) if (.not. allocated(DstOutputData%Re)) then allocate(DstOutputData%Re(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2537,8 +2537,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Re = SrcOutputData%Re end if if (allocated(SrcOutputData%AOA)) then - LB(1:2) = lbound(SrcOutputData%AOA) - UB(1:2) = ubound(SrcOutputData%AOA) + LB(1:2) = lbound(SrcOutputData%AOA, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%AOA, kind=B8Ki) if (.not. allocated(DstOutputData%AOA)) then allocate(DstOutputData%AOA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2549,8 +2549,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%AOA = SrcOutputData%AOA end if if (allocated(SrcOutputData%Cx)) then - LB(1:2) = lbound(SrcOutputData%Cx) - UB(1:2) = ubound(SrcOutputData%Cx) + LB(1:2) = lbound(SrcOutputData%Cx, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cx, kind=B8Ki) if (.not. allocated(DstOutputData%Cx)) then allocate(DstOutputData%Cx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2561,8 +2561,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cx = SrcOutputData%Cx end if if (allocated(SrcOutputData%Cy)) then - LB(1:2) = lbound(SrcOutputData%Cy) - UB(1:2) = ubound(SrcOutputData%Cy) + LB(1:2) = lbound(SrcOutputData%Cy, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cy, kind=B8Ki) if (.not. allocated(DstOutputData%Cy)) then allocate(DstOutputData%Cy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2573,8 +2573,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cy = SrcOutputData%Cy end if if (allocated(SrcOutputData%Cz)) then - LB(1:2) = lbound(SrcOutputData%Cz) - UB(1:2) = ubound(SrcOutputData%Cz) + LB(1:2) = lbound(SrcOutputData%Cz, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cz, kind=B8Ki) if (.not. allocated(DstOutputData%Cz)) then allocate(DstOutputData%Cz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2585,8 +2585,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cz = SrcOutputData%Cz end if if (allocated(SrcOutputData%Cmx)) then - LB(1:2) = lbound(SrcOutputData%Cmx) - UB(1:2) = ubound(SrcOutputData%Cmx) + LB(1:2) = lbound(SrcOutputData%Cmx, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cmx, kind=B8Ki) if (.not. allocated(DstOutputData%Cmx)) then allocate(DstOutputData%Cmx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2597,8 +2597,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmx = SrcOutputData%Cmx end if if (allocated(SrcOutputData%Cmy)) then - LB(1:2) = lbound(SrcOutputData%Cmy) - UB(1:2) = ubound(SrcOutputData%Cmy) + LB(1:2) = lbound(SrcOutputData%Cmy, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cmy, kind=B8Ki) if (.not. allocated(DstOutputData%Cmy)) then allocate(DstOutputData%Cmy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2609,8 +2609,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmy = SrcOutputData%Cmy end if if (allocated(SrcOutputData%Cmz)) then - LB(1:2) = lbound(SrcOutputData%Cmz) - UB(1:2) = ubound(SrcOutputData%Cmz) + LB(1:2) = lbound(SrcOutputData%Cmz, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cmz, kind=B8Ki) if (.not. allocated(DstOutputData%Cmz)) then allocate(DstOutputData%Cmz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2621,8 +2621,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmz = SrcOutputData%Cmz end if if (allocated(SrcOutputData%Cm)) then - LB(1:2) = lbound(SrcOutputData%Cm) - UB(1:2) = ubound(SrcOutputData%Cm) + LB(1:2) = lbound(SrcOutputData%Cm, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cm, kind=B8Ki) if (.not. allocated(DstOutputData%Cm)) then allocate(DstOutputData%Cm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2633,8 +2633,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cm = SrcOutputData%Cm end if if (allocated(SrcOutputData%Cl)) then - LB(1:2) = lbound(SrcOutputData%Cl) - UB(1:2) = ubound(SrcOutputData%Cl) + LB(1:2) = lbound(SrcOutputData%Cl, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cl, kind=B8Ki) if (.not. allocated(DstOutputData%Cl)) then allocate(DstOutputData%Cl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2645,8 +2645,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cl = SrcOutputData%Cl end if if (allocated(SrcOutputData%Cd)) then - LB(1:2) = lbound(SrcOutputData%Cd) - UB(1:2) = ubound(SrcOutputData%Cd) + LB(1:2) = lbound(SrcOutputData%Cd, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cd, kind=B8Ki) if (.not. allocated(DstOutputData%Cd)) then allocate(DstOutputData%Cd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2657,8 +2657,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cd = SrcOutputData%Cd end if if (allocated(SrcOutputData%chi)) then - LB(1:2) = lbound(SrcOutputData%chi) - UB(1:2) = ubound(SrcOutputData%chi) + LB(1:2) = lbound(SrcOutputData%chi, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%chi, kind=B8Ki) if (.not. allocated(DstOutputData%chi)) then allocate(DstOutputData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2669,8 +2669,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%chi = SrcOutputData%chi end if if (allocated(SrcOutputData%Cpmin)) then - LB(1:2) = lbound(SrcOutputData%Cpmin) - UB(1:2) = ubound(SrcOutputData%Cpmin) + LB(1:2) = lbound(SrcOutputData%Cpmin, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Cpmin, kind=B8Ki) if (.not. allocated(DstOutputData%Cpmin)) then allocate(DstOutputData%Cpmin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2764,112 +2764,112 @@ subroutine BEMT_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Vrel)) if (allocated(InData%Vrel)) then - call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) + call RegPackBounds(Buf, 2, lbound(InData%Vrel, kind=B8Ki), ubound(InData%Vrel, kind=B8Ki)) call RegPack(Buf, InData%Vrel) end if call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then - call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPackBounds(Buf, 2, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) call RegPack(Buf, InData%phi) end if call RegPack(Buf, allocated(InData%axInduction)) if (allocated(InData%axInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%axInduction), ubound(InData%axInduction)) + call RegPackBounds(Buf, 2, lbound(InData%axInduction, kind=B8Ki), ubound(InData%axInduction, kind=B8Ki)) call RegPack(Buf, InData%axInduction) end if call RegPack(Buf, allocated(InData%tanInduction)) if (allocated(InData%tanInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%tanInduction), ubound(InData%tanInduction)) + call RegPackBounds(Buf, 2, lbound(InData%tanInduction, kind=B8Ki), ubound(InData%tanInduction, kind=B8Ki)) call RegPack(Buf, InData%tanInduction) end if call RegPack(Buf, allocated(InData%axInduction_qs)) if (allocated(InData%axInduction_qs)) then - call RegPackBounds(Buf, 2, lbound(InData%axInduction_qs), ubound(InData%axInduction_qs)) + call RegPackBounds(Buf, 2, lbound(InData%axInduction_qs, kind=B8Ki), ubound(InData%axInduction_qs, kind=B8Ki)) call RegPack(Buf, InData%axInduction_qs) end if call RegPack(Buf, allocated(InData%tanInduction_qs)) if (allocated(InData%tanInduction_qs)) then - call RegPackBounds(Buf, 2, lbound(InData%tanInduction_qs), ubound(InData%tanInduction_qs)) + call RegPackBounds(Buf, 2, lbound(InData%tanInduction_qs, kind=B8Ki), ubound(InData%tanInduction_qs, kind=B8Ki)) call RegPack(Buf, InData%tanInduction_qs) end if call RegPack(Buf, allocated(InData%k)) if (allocated(InData%k)) then - call RegPackBounds(Buf, 2, lbound(InData%k), ubound(InData%k)) + call RegPackBounds(Buf, 2, lbound(InData%k, kind=B8Ki), ubound(InData%k, kind=B8Ki)) call RegPack(Buf, InData%k) end if call RegPack(Buf, allocated(InData%k_p)) if (allocated(InData%k_p)) then - call RegPackBounds(Buf, 2, lbound(InData%k_p), ubound(InData%k_p)) + call RegPackBounds(Buf, 2, lbound(InData%k_p, kind=B8Ki), ubound(InData%k_p, kind=B8Ki)) call RegPack(Buf, InData%k_p) end if call RegPack(Buf, allocated(InData%F)) if (allocated(InData%F)) then - call RegPackBounds(Buf, 2, lbound(InData%F), ubound(InData%F)) + call RegPackBounds(Buf, 2, lbound(InData%F, kind=B8Ki), ubound(InData%F, kind=B8Ki)) call RegPack(Buf, InData%F) end if call RegPack(Buf, allocated(InData%Re)) if (allocated(InData%Re)) then - call RegPackBounds(Buf, 2, lbound(InData%Re), ubound(InData%Re)) + call RegPackBounds(Buf, 2, lbound(InData%Re, kind=B8Ki), ubound(InData%Re, kind=B8Ki)) call RegPack(Buf, InData%Re) end if call RegPack(Buf, allocated(InData%AOA)) if (allocated(InData%AOA)) then - call RegPackBounds(Buf, 2, lbound(InData%AOA), ubound(InData%AOA)) + call RegPackBounds(Buf, 2, lbound(InData%AOA, kind=B8Ki), ubound(InData%AOA, kind=B8Ki)) call RegPack(Buf, InData%AOA) end if call RegPack(Buf, allocated(InData%Cx)) if (allocated(InData%Cx)) then - call RegPackBounds(Buf, 2, lbound(InData%Cx), ubound(InData%Cx)) + call RegPackBounds(Buf, 2, lbound(InData%Cx, kind=B8Ki), ubound(InData%Cx, kind=B8Ki)) call RegPack(Buf, InData%Cx) end if call RegPack(Buf, allocated(InData%Cy)) if (allocated(InData%Cy)) then - call RegPackBounds(Buf, 2, lbound(InData%Cy), ubound(InData%Cy)) + call RegPackBounds(Buf, 2, lbound(InData%Cy, kind=B8Ki), ubound(InData%Cy, kind=B8Ki)) call RegPack(Buf, InData%Cy) end if call RegPack(Buf, allocated(InData%Cz)) if (allocated(InData%Cz)) then - call RegPackBounds(Buf, 2, lbound(InData%Cz), ubound(InData%Cz)) + call RegPackBounds(Buf, 2, lbound(InData%Cz, kind=B8Ki), ubound(InData%Cz, kind=B8Ki)) call RegPack(Buf, InData%Cz) end if call RegPack(Buf, allocated(InData%Cmx)) if (allocated(InData%Cmx)) then - call RegPackBounds(Buf, 2, lbound(InData%Cmx), ubound(InData%Cmx)) + call RegPackBounds(Buf, 2, lbound(InData%Cmx, kind=B8Ki), ubound(InData%Cmx, kind=B8Ki)) call RegPack(Buf, InData%Cmx) end if call RegPack(Buf, allocated(InData%Cmy)) if (allocated(InData%Cmy)) then - call RegPackBounds(Buf, 2, lbound(InData%Cmy), ubound(InData%Cmy)) + call RegPackBounds(Buf, 2, lbound(InData%Cmy, kind=B8Ki), ubound(InData%Cmy, kind=B8Ki)) call RegPack(Buf, InData%Cmy) end if call RegPack(Buf, allocated(InData%Cmz)) if (allocated(InData%Cmz)) then - call RegPackBounds(Buf, 2, lbound(InData%Cmz), ubound(InData%Cmz)) + call RegPackBounds(Buf, 2, lbound(InData%Cmz, kind=B8Ki), ubound(InData%Cmz, kind=B8Ki)) call RegPack(Buf, InData%Cmz) end if call RegPack(Buf, allocated(InData%Cm)) if (allocated(InData%Cm)) then - call RegPackBounds(Buf, 2, lbound(InData%Cm), ubound(InData%Cm)) + call RegPackBounds(Buf, 2, lbound(InData%Cm, kind=B8Ki), ubound(InData%Cm, kind=B8Ki)) call RegPack(Buf, InData%Cm) end if call RegPack(Buf, allocated(InData%Cl)) if (allocated(InData%Cl)) then - call RegPackBounds(Buf, 2, lbound(InData%Cl), ubound(InData%Cl)) + call RegPackBounds(Buf, 2, lbound(InData%Cl, kind=B8Ki), ubound(InData%Cl, kind=B8Ki)) call RegPack(Buf, InData%Cl) end if call RegPack(Buf, allocated(InData%Cd)) if (allocated(InData%Cd)) then - call RegPackBounds(Buf, 2, lbound(InData%Cd), ubound(InData%Cd)) + call RegPackBounds(Buf, 2, lbound(InData%Cd, kind=B8Ki), ubound(InData%Cd, kind=B8Ki)) call RegPack(Buf, InData%Cd) end if call RegPack(Buf, allocated(InData%chi)) if (allocated(InData%chi)) then - call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) + call RegPackBounds(Buf, 2, lbound(InData%chi, kind=B8Ki), ubound(InData%chi, kind=B8Ki)) call RegPack(Buf, InData%chi) end if call RegPack(Buf, allocated(InData%Cpmin)) if (allocated(InData%Cpmin)) then - call RegPackBounds(Buf, 2, lbound(InData%Cpmin), ubound(InData%Cpmin)) + call RegPackBounds(Buf, 2, lbound(InData%Cpmin, kind=B8Ki), ubound(InData%Cpmin, kind=B8Ki)) call RegPack(Buf, InData%Cpmin) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2879,7 +2879,7 @@ subroutine BEMT_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 76ad84f50f..dbc59138e3 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -125,7 +125,7 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyInitInput' ErrStat = ErrID_None @@ -135,8 +135,8 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%tau1_const = SrcInitInputData%tau1_const DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod if (allocated(SrcInitInputData%rLocal)) then - LB(1:2) = lbound(SrcInitInputData%rLocal) - UB(1:2) = ubound(SrcInitInputData%rLocal) + LB(1:2) = lbound(SrcInitInputData%rLocal, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%rLocal, kind=B8Ki) if (.not. allocated(DstInitInputData%rLocal)) then allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -171,7 +171,7 @@ subroutine DBEMT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%DBEMT_Mod) call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPackBounds(Buf, 2, lbound(InData%rLocal, kind=B8Ki), ubound(InData%rLocal, kind=B8Ki)) call RegPack(Buf, InData%rLocal) end if if (RegCheckErr(Buf, RoutineName)) return @@ -181,7 +181,7 @@ subroutine DBEMT_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DBEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -304,16 +304,16 @@ subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%element)) then - LB(1:2) = lbound(SrcContStateData%element) - UB(1:2) = ubound(SrcContStateData%element) + LB(1:2) = lbound(SrcContStateData%element, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%element, kind=B8Ki) if (.not. allocated(DstContStateData%element)) then allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -335,16 +335,16 @@ subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) type(DBEMT_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%element)) then - LB(1:2) = lbound(ContStateData%element) - UB(1:2) = ubound(ContStateData%element) + LB(1:2) = lbound(ContStateData%element, kind=B8Ki) + UB(1:2) = ubound(ContStateData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) @@ -359,14 +359,14 @@ subroutine DBEMT_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackContState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) - LB(1:2) = lbound(InData%element) - UB(1:2) = ubound(InData%element) + call RegPackBounds(Buf, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) + LB(1:2) = lbound(InData%element, kind=B8Ki) + UB(1:2) = ubound(InData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_PackElementContinuousStateType(Buf, InData%element(i1,i2)) @@ -380,8 +380,8 @@ subroutine DBEMT_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -488,16 +488,16 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%areStatesInitialized)) then - LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized) - UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized) + LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized, kind=B8Ki) if (.not. allocated(DstOtherStateData%areStatesInitialized)) then allocate(DstOtherStateData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -510,8 +510,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%tau1 = SrcOtherStateData%tau1 DstOtherStateData%tau2 = SrcOtherStateData%tau2 if (allocated(SrcOtherStateData%n)) then - LB(1:2) = lbound(SrcOtherStateData%n) - UB(1:2) = ubound(SrcOtherStateData%n) + LB(1:2) = lbound(SrcOtherStateData%n, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%n, kind=B8Ki) if (.not. allocated(DstOtherStateData%n)) then allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -521,8 +521,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, end if DstOtherStateData%n = SrcOtherStateData%n end if - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -534,8 +534,8 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(DBEMT_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyOtherState' @@ -547,8 +547,8 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -559,23 +559,23 @@ subroutine DBEMT_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%areStatesInitialized)) if (allocated(InData%areStatesInitialized)) then - call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized), ubound(InData%areStatesInitialized)) + call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized, kind=B8Ki), ubound(InData%areStatesInitialized, kind=B8Ki)) call RegPack(Buf, InData%areStatesInitialized) end if call RegPack(Buf, InData%tau1) call RegPack(Buf, InData%tau2) call RegPack(Buf, allocated(InData%n)) if (allocated(InData%n)) then - call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) + call RegPackBounds(Buf, 2, lbound(InData%n, kind=B8Ki), ubound(InData%n, kind=B8Ki)) call RegPack(Buf, InData%n) end if - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_PackContState(Buf, InData%xdot(i1)) end do @@ -586,8 +586,8 @@ subroutine DBEMT_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DBEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -623,8 +623,8 @@ subroutine DBEMT_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end if - LB(1:1) = lbound(OutData%xdot) - UB(1:1) = ubound(OutData%xdot) + LB(1:1) = lbound(OutData%xdot, kind=B8Ki) + UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call DBEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do @@ -675,7 +675,7 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyParam' ErrStat = ErrID_None @@ -687,8 +687,8 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%k_0ye = SrcParamData%k_0ye DstParamData%tau1_const = SrcParamData%tau1_const if (allocated(SrcParamData%spanRatio)) then - LB(1:2) = lbound(SrcParamData%spanRatio) - UB(1:2) = ubound(SrcParamData%spanRatio) + LB(1:2) = lbound(SrcParamData%spanRatio, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%spanRatio, kind=B8Ki) if (.not. allocated(DstParamData%spanRatio)) then allocate(DstParamData%spanRatio(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -726,7 +726,7 @@ subroutine DBEMT_PackParam(Buf, Indata) call RegPack(Buf, InData%tau1_const) call RegPack(Buf, allocated(InData%spanRatio)) if (allocated(InData%spanRatio)) then - call RegPackBounds(Buf, 2, lbound(InData%spanRatio), ubound(InData%spanRatio)) + call RegPackBounds(Buf, 2, lbound(InData%spanRatio, kind=B8Ki), ubound(InData%spanRatio, kind=B8Ki)) call RegPack(Buf, InData%spanRatio) end if call RegPack(Buf, InData%DBEMT_Mod) @@ -737,7 +737,7 @@ subroutine DBEMT_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -820,8 +820,8 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyInput' @@ -831,8 +831,8 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%Un_disk = SrcInputData%Un_disk DstInputData%R_disk = SrcInputData%R_disk if (allocated(SrcInputData%element)) then - LB(1:2) = lbound(SrcInputData%element) - UB(1:2) = ubound(SrcInputData%element) + LB(1:2) = lbound(SrcInputData%element, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%element, kind=B8Ki) if (.not. allocated(DstInputData%element)) then allocate(DstInputData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -854,16 +854,16 @@ subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) type(DBEMT_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%element)) then - LB(1:2) = lbound(InputData%element) - UB(1:2) = ubound(InputData%element) + LB(1:2) = lbound(InputData%element, kind=B8Ki) + UB(1:2) = ubound(InputData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_DestroyElementInputType(InputData%element(i1,i2), ErrStat2, ErrMsg2) @@ -878,17 +878,17 @@ subroutine DBEMT_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AxInd_disk) call RegPack(Buf, InData%Un_disk) call RegPack(Buf, InData%R_disk) call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) - LB(1:2) = lbound(InData%element) - UB(1:2) = ubound(InData%element) + call RegPackBounds(Buf, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) + LB(1:2) = lbound(InData%element, kind=B8Ki) + UB(1:2) = ubound(InData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_PackElementInputType(Buf, InData%element(i1,i2)) @@ -902,8 +902,8 @@ subroutine DBEMT_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DBEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -938,14 +938,14 @@ subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%vind)) then - LB(1:3) = lbound(SrcOutputData%vind) - UB(1:3) = ubound(SrcOutputData%vind) + LB(1:3) = lbound(SrcOutputData%vind, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%vind, kind=B8Ki) if (.not. allocated(DstOutputData%vind)) then allocate(DstOutputData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -976,7 +976,7 @@ subroutine DBEMT_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%vind)) if (allocated(InData%vind)) then - call RegPackBounds(Buf, 3, lbound(InData%vind), ubound(InData%vind)) + call RegPackBounds(Buf, 3, lbound(InData%vind, kind=B8Ki), ubound(InData%vind, kind=B8Ki)) call RegPack(Buf, InData%vind) end if if (RegCheckErr(Buf, RoutineName)) return @@ -986,7 +986,7 @@ subroutine DBEMT_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DBEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1269,13 +1269,13 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) + DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s END DO END DO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) + DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio END DO END DO @@ -1343,13 +1343,13 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + a3*u3%R_disk IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) + DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + a3*u3%element(i01,i02)%vind_s END DO END DO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) + DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + a3*u3%element(i01,i02)%spanRatio END DO END DO diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 537f0b06b5..bd59dc4a50 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -363,7 +363,7 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyGridOutType' ErrStat = ErrID_None @@ -383,8 +383,8 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, DstGridOutTypeData%ny = SrcGridOutTypeData%ny DstGridOutTypeData%nz = SrcGridOutTypeData%nz if (allocated(SrcGridOutTypeData%uGrid)) then - LB(1:4) = lbound(SrcGridOutTypeData%uGrid) - UB(1:4) = ubound(SrcGridOutTypeData%uGrid) + LB(1:4) = lbound(SrcGridOutTypeData%uGrid, kind=B8Ki) + UB(1:4) = ubound(SrcGridOutTypeData%uGrid, kind=B8Ki) if (.not. allocated(DstGridOutTypeData%uGrid)) then allocate(DstGridOutTypeData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -395,8 +395,8 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid end if if (allocated(SrcGridOutTypeData%omGrid)) then - LB(1:4) = lbound(SrcGridOutTypeData%omGrid) - UB(1:4) = ubound(SrcGridOutTypeData%omGrid) + LB(1:4) = lbound(SrcGridOutTypeData%omGrid, kind=B8Ki) + UB(1:4) = ubound(SrcGridOutTypeData%omGrid, kind=B8Ki) if (.not. allocated(DstGridOutTypeData%omGrid)) then allocate(DstGridOutTypeData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -445,12 +445,12 @@ subroutine FVW_PackGridOutType(Buf, Indata) call RegPack(Buf, InData%nz) call RegPack(Buf, allocated(InData%uGrid)) if (allocated(InData%uGrid)) then - call RegPackBounds(Buf, 4, lbound(InData%uGrid), ubound(InData%uGrid)) + call RegPackBounds(Buf, 4, lbound(InData%uGrid, kind=B8Ki), ubound(InData%uGrid, kind=B8Ki)) call RegPack(Buf, InData%uGrid) end if call RegPack(Buf, allocated(InData%omGrid)) if (allocated(InData%omGrid)) then - call RegPackBounds(Buf, 4, lbound(InData%omGrid), ubound(InData%omGrid)) + call RegPackBounds(Buf, 4, lbound(InData%omGrid, kind=B8Ki), ubound(InData%omGrid, kind=B8Ki)) call RegPack(Buf, InData%omGrid) end if call RegPack(Buf, InData%tLastOutput) @@ -461,7 +461,7 @@ subroutine FVW_UnPackGridOutType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(GridOutType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -531,14 +531,14 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyT_Sgmt' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcT_SgmtData%Points)) then - LB(1:2) = lbound(SrcT_SgmtData%Points) - UB(1:2) = ubound(SrcT_SgmtData%Points) + LB(1:2) = lbound(SrcT_SgmtData%Points, kind=B8Ki) + UB(1:2) = ubound(SrcT_SgmtData%Points, kind=B8Ki) if (.not. allocated(DstT_SgmtData%Points)) then allocate(DstT_SgmtData%Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -549,8 +549,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Points = SrcT_SgmtData%Points end if if (allocated(SrcT_SgmtData%Connct)) then - LB(1:2) = lbound(SrcT_SgmtData%Connct) - UB(1:2) = ubound(SrcT_SgmtData%Connct) + LB(1:2) = lbound(SrcT_SgmtData%Connct, kind=B8Ki) + UB(1:2) = ubound(SrcT_SgmtData%Connct, kind=B8Ki) if (.not. allocated(DstT_SgmtData%Connct)) then allocate(DstT_SgmtData%Connct(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -561,8 +561,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Connct = SrcT_SgmtData%Connct end if if (allocated(SrcT_SgmtData%Gamma)) then - LB(1:1) = lbound(SrcT_SgmtData%Gamma) - UB(1:1) = ubound(SrcT_SgmtData%Gamma) + LB(1:1) = lbound(SrcT_SgmtData%Gamma, kind=B8Ki) + UB(1:1) = ubound(SrcT_SgmtData%Gamma, kind=B8Ki) if (.not. allocated(DstT_SgmtData%Gamma)) then allocate(DstT_SgmtData%Gamma(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -573,8 +573,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma end if if (allocated(SrcT_SgmtData%Epsilon)) then - LB(1:1) = lbound(SrcT_SgmtData%Epsilon) - UB(1:1) = ubound(SrcT_SgmtData%Epsilon) + LB(1:1) = lbound(SrcT_SgmtData%Epsilon, kind=B8Ki) + UB(1:1) = ubound(SrcT_SgmtData%Epsilon, kind=B8Ki) if (.not. allocated(DstT_SgmtData%Epsilon)) then allocate(DstT_SgmtData%Epsilon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -617,22 +617,22 @@ subroutine FVW_PackT_Sgmt(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Points)) if (allocated(InData%Points)) then - call RegPackBounds(Buf, 2, lbound(InData%Points), ubound(InData%Points)) + call RegPackBounds(Buf, 2, lbound(InData%Points, kind=B8Ki), ubound(InData%Points, kind=B8Ki)) call RegPack(Buf, InData%Points) end if call RegPack(Buf, allocated(InData%Connct)) if (allocated(InData%Connct)) then - call RegPackBounds(Buf, 2, lbound(InData%Connct), ubound(InData%Connct)) + call RegPackBounds(Buf, 2, lbound(InData%Connct, kind=B8Ki), ubound(InData%Connct, kind=B8Ki)) call RegPack(Buf, InData%Connct) end if call RegPack(Buf, allocated(InData%Gamma)) if (allocated(InData%Gamma)) then - call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) + call RegPackBounds(Buf, 1, lbound(InData%Gamma, kind=B8Ki), ubound(InData%Gamma, kind=B8Ki)) call RegPack(Buf, InData%Gamma) end if call RegPack(Buf, allocated(InData%Epsilon)) if (allocated(InData%Epsilon)) then - call RegPackBounds(Buf, 1, lbound(InData%Epsilon), ubound(InData%Epsilon)) + call RegPackBounds(Buf, 1, lbound(InData%Epsilon, kind=B8Ki), ubound(InData%Epsilon, kind=B8Ki)) call RegPack(Buf, InData%Epsilon) end if call RegPack(Buf, InData%RegFunction) @@ -645,7 +645,7 @@ subroutine FVW_UnPackT_Sgmt(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(T_Sgmt), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -719,14 +719,14 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyT_Part' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcT_PartData%P)) then - LB(1:2) = lbound(SrcT_PartData%P) - UB(1:2) = ubound(SrcT_PartData%P) + LB(1:2) = lbound(SrcT_PartData%P, kind=B8Ki) + UB(1:2) = ubound(SrcT_PartData%P, kind=B8Ki) if (.not. allocated(DstT_PartData%P)) then allocate(DstT_PartData%P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -737,8 +737,8 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs DstT_PartData%P = SrcT_PartData%P end if if (allocated(SrcT_PartData%Alpha)) then - LB(1:2) = lbound(SrcT_PartData%Alpha) - UB(1:2) = ubound(SrcT_PartData%Alpha) + LB(1:2) = lbound(SrcT_PartData%Alpha, kind=B8Ki) + UB(1:2) = ubound(SrcT_PartData%Alpha, kind=B8Ki) if (.not. allocated(DstT_PartData%Alpha)) then allocate(DstT_PartData%Alpha(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -749,8 +749,8 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs DstT_PartData%Alpha = SrcT_PartData%Alpha end if if (allocated(SrcT_PartData%RegParam)) then - LB(1:1) = lbound(SrcT_PartData%RegParam) - UB(1:1) = ubound(SrcT_PartData%RegParam) + LB(1:1) = lbound(SrcT_PartData%RegParam, kind=B8Ki) + UB(1:1) = ubound(SrcT_PartData%RegParam, kind=B8Ki) if (.not. allocated(DstT_PartData%RegParam)) then allocate(DstT_PartData%RegParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -789,17 +789,17 @@ subroutine FVW_PackT_Part(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%P)) if (allocated(InData%P)) then - call RegPackBounds(Buf, 2, lbound(InData%P), ubound(InData%P)) + call RegPackBounds(Buf, 2, lbound(InData%P, kind=B8Ki), ubound(InData%P, kind=B8Ki)) call RegPack(Buf, InData%P) end if call RegPack(Buf, allocated(InData%Alpha)) if (allocated(InData%Alpha)) then - call RegPackBounds(Buf, 2, lbound(InData%Alpha), ubound(InData%Alpha)) + call RegPackBounds(Buf, 2, lbound(InData%Alpha, kind=B8Ki), ubound(InData%Alpha, kind=B8Ki)) call RegPack(Buf, InData%Alpha) end if call RegPack(Buf, allocated(InData%RegParam)) if (allocated(InData%RegParam)) then - call RegPackBounds(Buf, 1, lbound(InData%RegParam), ubound(InData%RegParam)) + call RegPackBounds(Buf, 1, lbound(InData%RegParam, kind=B8Ki), ubound(InData%RegParam, kind=B8Ki)) call RegPack(Buf, InData%RegParam) end if call RegPack(Buf, InData%RegFunction) @@ -811,7 +811,7 @@ subroutine FVW_UnPackT_Part(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(T_Part), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -869,14 +869,14 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ParameterType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ParameterTypeData%chord_LL)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL) - UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL) + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL, kind=B8Ki) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL, kind=B8Ki) if (.not. allocated(DstWng_ParameterTypeData%chord_LL)) then allocate(DstWng_ParameterTypeData%chord_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -887,8 +887,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL end if if (allocated(SrcWng_ParameterTypeData%chord_CP)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) - UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP) + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP, kind=B8Ki) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP, kind=B8Ki) if (.not. allocated(DstWng_ParameterTypeData%chord_CP)) then allocate(DstWng_ParameterTypeData%chord_CP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -899,8 +899,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP end if if (allocated(SrcWng_ParameterTypeData%s_LL)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) - UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL) + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL, kind=B8Ki) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL, kind=B8Ki) if (.not. allocated(DstWng_ParameterTypeData%s_LL)) then allocate(DstWng_ParameterTypeData%s_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -911,8 +911,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL end if if (allocated(SrcWng_ParameterTypeData%s_CP)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) - UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP) + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP, kind=B8Ki) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP, kind=B8Ki) if (.not. allocated(DstWng_ParameterTypeData%s_CP)) then allocate(DstWng_ParameterTypeData%s_CP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -924,8 +924,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor if (allocated(SrcWng_ParameterTypeData%AFindx)) then - LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx) - UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx) + LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx, kind=B8Ki) + UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx, kind=B8Ki) if (.not. allocated(DstWng_ParameterTypeData%AFindx)) then allocate(DstWng_ParameterTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -937,8 +937,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation) - UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation) + LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation, kind=B8Ki) + UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation, kind=B8Ki) if (.not. allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then allocate(DstWng_ParameterTypeData%PrescribedCirculation(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -984,34 +984,34 @@ subroutine FVW_PackWng_ParameterType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%chord_LL)) if (allocated(InData%chord_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%chord_LL), ubound(InData%chord_LL)) + call RegPackBounds(Buf, 1, lbound(InData%chord_LL, kind=B8Ki), ubound(InData%chord_LL, kind=B8Ki)) call RegPack(Buf, InData%chord_LL) end if call RegPack(Buf, allocated(InData%chord_CP)) if (allocated(InData%chord_CP)) then - call RegPackBounds(Buf, 1, lbound(InData%chord_CP), ubound(InData%chord_CP)) + call RegPackBounds(Buf, 1, lbound(InData%chord_CP, kind=B8Ki), ubound(InData%chord_CP, kind=B8Ki)) call RegPack(Buf, InData%chord_CP) end if call RegPack(Buf, allocated(InData%s_LL)) if (allocated(InData%s_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%s_LL), ubound(InData%s_LL)) + call RegPackBounds(Buf, 1, lbound(InData%s_LL, kind=B8Ki), ubound(InData%s_LL, kind=B8Ki)) call RegPack(Buf, InData%s_LL) end if call RegPack(Buf, allocated(InData%s_CP)) if (allocated(InData%s_CP)) then - call RegPackBounds(Buf, 1, lbound(InData%s_CP), ubound(InData%s_CP)) + call RegPackBounds(Buf, 1, lbound(InData%s_CP, kind=B8Ki), ubound(InData%s_CP, kind=B8Ki)) call RegPack(Buf, InData%s_CP) end if call RegPack(Buf, InData%iRotor) call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) call RegPack(Buf, InData%AFindx) end if call RegPack(Buf, InData%nSpan) call RegPack(Buf, allocated(InData%PrescribedCirculation)) if (allocated(InData%PrescribedCirculation)) then - call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation), ubound(InData%PrescribedCirculation)) + call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation, kind=B8Ki), ubound(InData%PrescribedCirculation, kind=B8Ki)) call RegPack(Buf, InData%PrescribedCirculation) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1021,7 +1021,7 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1121,8 +1121,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyParam' @@ -1131,8 +1131,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nRotors = SrcParamData%nRotors DstParamData%nWings = SrcParamData%nWings if (allocated(SrcParamData%W)) then - LB(1:1) = lbound(SrcParamData%W) - UB(1:1) = ubound(SrcParamData%W) + LB(1:1) = lbound(SrcParamData%W, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%W, kind=B8Ki) if (.not. allocated(DstParamData%W)) then allocate(DstParamData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1147,8 +1147,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%Bld2Wings)) then - LB(1:2) = lbound(SrcParamData%Bld2Wings) - UB(1:2) = ubound(SrcParamData%Bld2Wings) + LB(1:2) = lbound(SrcParamData%Bld2Wings, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Bld2Wings, kind=B8Ki) if (.not. allocated(DstParamData%Bld2Wings)) then allocate(DstParamData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1209,16 +1209,16 @@ subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) type(FVW_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%W)) then - LB(1:1) = lbound(ParamData%W) - UB(1:1) = ubound(ParamData%W) + LB(1:1) = lbound(ParamData%W, kind=B8Ki) + UB(1:1) = ubound(ParamData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_ParameterType(ParamData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1234,23 +1234,23 @@ subroutine FVW_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nRotors) call RegPack(Buf, InData%nWings) call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_ParameterType(Buf, InData%W(i1)) end do end if call RegPack(Buf, allocated(InData%Bld2Wings)) if (allocated(InData%Bld2Wings)) then - call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings), ubound(InData%Bld2Wings)) + call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings, kind=B8Ki), ubound(InData%Bld2Wings, kind=B8Ki)) call RegPack(Buf, InData%Bld2Wings) end if call RegPack(Buf, InData%iNWStart) @@ -1305,8 +1305,8 @@ subroutine FVW_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1441,14 +1441,14 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ContinuousStateType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ContinuousStateTypeData%Gamma_NW)) then - LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW) - UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW) + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW, kind=B8Ki) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW, kind=B8Ki) if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then allocate(DstWng_ContinuousStateTypeData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1459,8 +1459,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW end if if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then - LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) - UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW) + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW, kind=B8Ki) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW, kind=B8Ki) if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then allocate(DstWng_ContinuousStateTypeData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1471,8 +1471,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW, kind=B8Ki) if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then allocate(DstWng_ContinuousStateTypeData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1483,8 +1483,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW, kind=B8Ki) if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then allocate(DstWng_ContinuousStateTypeData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1495,8 +1495,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW end if if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW, kind=B8Ki) if (.not. allocated(DstWng_ContinuousStateTypeData%r_NW)) then allocate(DstWng_ContinuousStateTypeData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1507,8 +1507,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW end if if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW, kind=B8Ki) if (.not. allocated(DstWng_ContinuousStateTypeData%r_FW)) then allocate(DstWng_ContinuousStateTypeData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1554,32 +1554,32 @@ subroutine FVW_PackWng_ContinuousStateType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Gamma_NW)) if (allocated(InData%Gamma_NW)) then - call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW), ubound(InData%Gamma_NW)) + call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW, kind=B8Ki), ubound(InData%Gamma_NW, kind=B8Ki)) call RegPack(Buf, InData%Gamma_NW) end if call RegPack(Buf, allocated(InData%Gamma_FW)) if (allocated(InData%Gamma_FW)) then - call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW), ubound(InData%Gamma_FW)) + call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW, kind=B8Ki), ubound(InData%Gamma_FW, kind=B8Ki)) call RegPack(Buf, InData%Gamma_FW) end if call RegPack(Buf, allocated(InData%Eps_NW)) if (allocated(InData%Eps_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%Eps_NW), ubound(InData%Eps_NW)) + call RegPackBounds(Buf, 3, lbound(InData%Eps_NW, kind=B8Ki), ubound(InData%Eps_NW, kind=B8Ki)) call RegPack(Buf, InData%Eps_NW) end if call RegPack(Buf, allocated(InData%Eps_FW)) if (allocated(InData%Eps_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%Eps_FW), ubound(InData%Eps_FW)) + call RegPackBounds(Buf, 3, lbound(InData%Eps_FW, kind=B8Ki), ubound(InData%Eps_FW, kind=B8Ki)) call RegPack(Buf, InData%Eps_FW) end if call RegPack(Buf, allocated(InData%r_NW)) if (allocated(InData%r_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%r_NW), ubound(InData%r_NW)) + call RegPackBounds(Buf, 3, lbound(InData%r_NW, kind=B8Ki), ubound(InData%r_NW, kind=B8Ki)) call RegPack(Buf, InData%r_NW) end if call RegPack(Buf, allocated(InData%r_FW)) if (allocated(InData%r_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%r_FW), ubound(InData%r_FW)) + call RegPackBounds(Buf, 3, lbound(InData%r_FW, kind=B8Ki), ubound(InData%r_FW, kind=B8Ki)) call RegPack(Buf, InData%r_FW) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1589,7 +1589,7 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1685,16 +1685,16 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%W)) then - LB(1:1) = lbound(SrcContStateData%W) - UB(1:1) = ubound(SrcContStateData%W) + LB(1:1) = lbound(SrcContStateData%W, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%W, kind=B8Ki) if (.not. allocated(DstContStateData%W)) then allocate(DstContStateData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1709,8 +1709,8 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt end do end if if (allocated(SrcContStateData%UA)) then - LB(1:1) = lbound(SrcContStateData%UA) - UB(1:1) = ubound(SrcContStateData%UA) + LB(1:1) = lbound(SrcContStateData%UA, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%UA, kind=B8Ki) if (.not. allocated(DstContStateData%UA)) then allocate(DstContStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1730,16 +1730,16 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) type(FVW_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%W)) then - LB(1:1) = lbound(ContStateData%W) - UB(1:1) = ubound(ContStateData%W) + LB(1:1) = lbound(ContStateData%W, kind=B8Ki) + UB(1:1) = ubound(ContStateData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_ContinuousStateType(ContStateData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1747,8 +1747,8 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%W) end if if (allocated(ContStateData%UA)) then - LB(1:1) = lbound(ContStateData%UA) - UB(1:1) = ubound(ContStateData%UA) + LB(1:1) = lbound(ContStateData%UA, kind=B8Ki) + UB(1:1) = ubound(ContStateData%UA, kind=B8Ki) do i1 = LB(1), UB(1) call UA_DestroyContState(ContStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1761,23 +1761,23 @@ subroutine FVW_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_ContinuousStateType(Buf, InData%W(i1)) end do end if call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) - LB(1:1) = lbound(InData%UA) - UB(1:1) = ubound(InData%UA) + call RegPackBounds(Buf, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) + LB(1:1) = lbound(InData%UA, kind=B8Ki) + UB(1:1) = ubound(InData%UA, kind=B8Ki) do i1 = LB(1), UB(1) call UA_PackContState(Buf, InData%UA(i1)) end do @@ -1789,8 +1789,8 @@ subroutine FVW_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1832,14 +1832,14 @@ subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_OutputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_OutputTypeData%Vind)) then - LB(1:2) = lbound(SrcWng_OutputTypeData%Vind) - UB(1:2) = ubound(SrcWng_OutputTypeData%Vind) + LB(1:2) = lbound(SrcWng_OutputTypeData%Vind, kind=B8Ki) + UB(1:2) = ubound(SrcWng_OutputTypeData%Vind, kind=B8Ki) if (.not. allocated(DstWng_OutputTypeData%Vind)) then allocate(DstWng_OutputTypeData%Vind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1870,7 +1870,7 @@ subroutine FVW_PackWng_OutputType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Vind)) if (allocated(InData%Vind)) then - call RegPackBounds(Buf, 2, lbound(InData%Vind), ubound(InData%Vind)) + call RegPackBounds(Buf, 2, lbound(InData%Vind, kind=B8Ki), ubound(InData%Vind, kind=B8Ki)) call RegPack(Buf, InData%Vind) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1880,7 +1880,7 @@ subroutine FVW_UnPackWng_OutputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1906,16 +1906,16 @@ subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%W)) then - LB(1:1) = lbound(SrcOutputData%W) - UB(1:1) = ubound(SrcOutputData%W) + LB(1:1) = lbound(SrcOutputData%W, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%W, kind=B8Ki) if (.not. allocated(DstOutputData%W)) then allocate(DstOutputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1935,16 +1935,16 @@ subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) type(FVW_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%W)) then - LB(1:1) = lbound(OutputData%W) - UB(1:1) = ubound(OutputData%W) + LB(1:1) = lbound(OutputData%W, kind=B8Ki) + UB(1:1) = ubound(OutputData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_OutputType(OutputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1957,14 +1957,14 @@ subroutine FVW_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_OutputType(Buf, InData%W(i1)) end do @@ -1976,8 +1976,8 @@ subroutine FVW_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2004,16 +2004,16 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyWng_MiscVarType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_MiscVarTypeData%LE)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%LE)) then allocate(DstWng_MiscVarTypeData%LE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2024,8 +2024,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE end if if (allocated(SrcWng_MiscVarTypeData%TE)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%TE)) then allocate(DstWng_MiscVarTypeData%TE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2036,8 +2036,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE end if if (allocated(SrcWng_MiscVarTypeData%r_LL)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL, kind=B8Ki) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%r_LL)) then allocate(DstWng_MiscVarTypeData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2048,8 +2048,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL end if if (allocated(SrcWng_MiscVarTypeData%CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%CP)) then allocate(DstWng_MiscVarTypeData%CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2060,8 +2060,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP end if if (allocated(SrcWng_MiscVarTypeData%Tang)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Tang)) then allocate(DstWng_MiscVarTypeData%Tang(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2072,8 +2072,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang end if if (allocated(SrcWng_MiscVarTypeData%Norm)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Norm)) then allocate(DstWng_MiscVarTypeData%Norm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2084,8 +2084,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm end if if (allocated(SrcWng_MiscVarTypeData%Orth)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Orth)) then allocate(DstWng_MiscVarTypeData%Orth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2096,8 +2096,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth end if if (allocated(SrcWng_MiscVarTypeData%dl)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%dl)) then allocate(DstWng_MiscVarTypeData%dl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2108,8 +2108,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl end if if (allocated(SrcWng_MiscVarTypeData%Area)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Area)) then allocate(DstWng_MiscVarTypeData%Area(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2120,8 +2120,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area end if if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%diag_LL)) then allocate(DstWng_MiscVarTypeData%diag_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2132,8 +2132,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL end if if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vind_CP)) then allocate(DstWng_MiscVarTypeData%Vind_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2144,8 +2144,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP end if if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vtot_CP)) then allocate(DstWng_MiscVarTypeData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2156,8 +2156,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP end if if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vstr_CP)) then allocate(DstWng_MiscVarTypeData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2168,8 +2168,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then allocate(DstWng_MiscVarTypeData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2180,8 +2180,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then allocate(DstWng_MiscVarTypeData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2192,8 +2192,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then allocate(DstWng_MiscVarTypeData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2204,8 +2204,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW end if if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vind_NW)) then allocate(DstWng_MiscVarTypeData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2216,8 +2216,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW end if if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW, kind=B8Ki) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vind_FW)) then allocate(DstWng_MiscVarTypeData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2228,8 +2228,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW end if if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then allocate(DstWng_MiscVarTypeData%PitchAndTwist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2242,8 +2242,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot if (allocated(SrcWng_MiscVarTypeData%alpha_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%alpha_LL)) then allocate(DstWng_MiscVarTypeData%alpha_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2254,8 +2254,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL end if if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vreln_LL)) then allocate(DstWng_MiscVarTypeData%Vreln_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2266,8 +2266,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL end if if (allocated(SrcWng_MiscVarTypeData%u_UA)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%u_UA)) then allocate(DstWng_MiscVarTypeData%u_UA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2293,8 +2293,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcWng_MiscVarTypeData%Vind_LL)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%Vind_LL)) then allocate(DstWng_MiscVarTypeData%Vind_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2305,8 +2305,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL end if if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_AxInd)) then allocate(DstWng_MiscVarTypeData%BN_AxInd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2317,8 +2317,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd end if if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_TanInd)) then allocate(DstWng_MiscVarTypeData%BN_TanInd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2329,8 +2329,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd end if if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Vrel)) then allocate(DstWng_MiscVarTypeData%BN_Vrel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2341,8 +2341,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel end if if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_alpha)) then allocate(DstWng_MiscVarTypeData%BN_alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2353,8 +2353,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha end if if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_phi)) then allocate(DstWng_MiscVarTypeData%BN_phi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2365,8 +2365,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi end if if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Re)) then allocate(DstWng_MiscVarTypeData%BN_Re(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2377,8 +2377,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re end if if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s, kind=B8Ki) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then allocate(DstWng_MiscVarTypeData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2389,8 +2389,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cl_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2401,8 +2401,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cd_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2413,8 +2413,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cm_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2425,8 +2425,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then allocate(DstWng_MiscVarTypeData%BN_Cpmin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2437,8 +2437,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl)) then allocate(DstWng_MiscVarTypeData%BN_Cl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2449,8 +2449,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd)) then allocate(DstWng_MiscVarTypeData%BN_Cd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2461,8 +2461,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm)) then allocate(DstWng_MiscVarTypeData%BN_Cm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2473,8 +2473,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm end if if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cx)) then allocate(DstWng_MiscVarTypeData%BN_Cx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2485,8 +2485,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx end if if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy, kind=B8Ki) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy, kind=B8Ki) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cy)) then allocate(DstWng_MiscVarTypeData%BN_Cy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2502,8 +2502,8 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) type(Wng_MiscVarType), intent(inout) :: Wng_MiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyWng_MiscVarType' @@ -2573,8 +2573,8 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) deallocate(Wng_MiscVarTypeData%Vreln_LL) end if if (allocated(Wng_MiscVarTypeData%u_UA)) then - LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA) - UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA) + LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA, kind=B8Ki) + UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_DestroyInput(Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2) @@ -2646,121 +2646,121 @@ subroutine FVW_PackWng_MiscVarType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%LE)) if (allocated(InData%LE)) then - call RegPackBounds(Buf, 2, lbound(InData%LE), ubound(InData%LE)) + call RegPackBounds(Buf, 2, lbound(InData%LE, kind=B8Ki), ubound(InData%LE, kind=B8Ki)) call RegPack(Buf, InData%LE) end if call RegPack(Buf, allocated(InData%TE)) if (allocated(InData%TE)) then - call RegPackBounds(Buf, 2, lbound(InData%TE), ubound(InData%TE)) + call RegPackBounds(Buf, 2, lbound(InData%TE, kind=B8Ki), ubound(InData%TE, kind=B8Ki)) call RegPack(Buf, InData%TE) end if call RegPack(Buf, allocated(InData%r_LL)) if (allocated(InData%r_LL)) then - call RegPackBounds(Buf, 3, lbound(InData%r_LL), ubound(InData%r_LL)) + call RegPackBounds(Buf, 3, lbound(InData%r_LL, kind=B8Ki), ubound(InData%r_LL, kind=B8Ki)) call RegPack(Buf, InData%r_LL) end if call RegPack(Buf, allocated(InData%CP)) if (allocated(InData%CP)) then - call RegPackBounds(Buf, 2, lbound(InData%CP), ubound(InData%CP)) + call RegPackBounds(Buf, 2, lbound(InData%CP, kind=B8Ki), ubound(InData%CP, kind=B8Ki)) call RegPack(Buf, InData%CP) end if call RegPack(Buf, allocated(InData%Tang)) if (allocated(InData%Tang)) then - call RegPackBounds(Buf, 2, lbound(InData%Tang), ubound(InData%Tang)) + call RegPackBounds(Buf, 2, lbound(InData%Tang, kind=B8Ki), ubound(InData%Tang, kind=B8Ki)) call RegPack(Buf, InData%Tang) end if call RegPack(Buf, allocated(InData%Norm)) if (allocated(InData%Norm)) then - call RegPackBounds(Buf, 2, lbound(InData%Norm), ubound(InData%Norm)) + call RegPackBounds(Buf, 2, lbound(InData%Norm, kind=B8Ki), ubound(InData%Norm, kind=B8Ki)) call RegPack(Buf, InData%Norm) end if call RegPack(Buf, allocated(InData%Orth)) if (allocated(InData%Orth)) then - call RegPackBounds(Buf, 2, lbound(InData%Orth), ubound(InData%Orth)) + call RegPackBounds(Buf, 2, lbound(InData%Orth, kind=B8Ki), ubound(InData%Orth, kind=B8Ki)) call RegPack(Buf, InData%Orth) end if call RegPack(Buf, allocated(InData%dl)) if (allocated(InData%dl)) then - call RegPackBounds(Buf, 2, lbound(InData%dl), ubound(InData%dl)) + call RegPackBounds(Buf, 2, lbound(InData%dl, kind=B8Ki), ubound(InData%dl, kind=B8Ki)) call RegPack(Buf, InData%dl) end if call RegPack(Buf, allocated(InData%Area)) if (allocated(InData%Area)) then - call RegPackBounds(Buf, 1, lbound(InData%Area), ubound(InData%Area)) + call RegPackBounds(Buf, 1, lbound(InData%Area, kind=B8Ki), ubound(InData%Area, kind=B8Ki)) call RegPack(Buf, InData%Area) end if call RegPack(Buf, allocated(InData%diag_LL)) if (allocated(InData%diag_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%diag_LL), ubound(InData%diag_LL)) + call RegPackBounds(Buf, 1, lbound(InData%diag_LL, kind=B8Ki), ubound(InData%diag_LL, kind=B8Ki)) call RegPack(Buf, InData%diag_LL) end if call RegPack(Buf, allocated(InData%Vind_CP)) if (allocated(InData%Vind_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vind_CP), ubound(InData%Vind_CP)) + call RegPackBounds(Buf, 2, lbound(InData%Vind_CP, kind=B8Ki), ubound(InData%Vind_CP, kind=B8Ki)) call RegPack(Buf, InData%Vind_CP) end if call RegPack(Buf, allocated(InData%Vtot_CP)) if (allocated(InData%Vtot_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP), ubound(InData%Vtot_CP)) + call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP, kind=B8Ki), ubound(InData%Vtot_CP, kind=B8Ki)) call RegPack(Buf, InData%Vtot_CP) end if call RegPack(Buf, allocated(InData%Vstr_CP)) if (allocated(InData%Vstr_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP), ubound(InData%Vstr_CP)) + call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP, kind=B8Ki), ubound(InData%Vstr_CP, kind=B8Ki)) call RegPack(Buf, InData%Vstr_CP) end if call RegPack(Buf, allocated(InData%Vwnd_CP)) if (allocated(InData%Vwnd_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP), ubound(InData%Vwnd_CP)) + call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP, kind=B8Ki), ubound(InData%Vwnd_CP, kind=B8Ki)) call RegPack(Buf, InData%Vwnd_CP) end if call RegPack(Buf, allocated(InData%Vwnd_NW)) if (allocated(InData%Vwnd_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW), ubound(InData%Vwnd_NW)) + call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW, kind=B8Ki), ubound(InData%Vwnd_NW, kind=B8Ki)) call RegPack(Buf, InData%Vwnd_NW) end if call RegPack(Buf, allocated(InData%Vwnd_FW)) if (allocated(InData%Vwnd_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW), ubound(InData%Vwnd_FW)) + call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW, kind=B8Ki), ubound(InData%Vwnd_FW, kind=B8Ki)) call RegPack(Buf, InData%Vwnd_FW) end if call RegPack(Buf, allocated(InData%Vind_NW)) if (allocated(InData%Vind_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vind_NW), ubound(InData%Vind_NW)) + call RegPackBounds(Buf, 3, lbound(InData%Vind_NW, kind=B8Ki), ubound(InData%Vind_NW, kind=B8Ki)) call RegPack(Buf, InData%Vind_NW) end if call RegPack(Buf, allocated(InData%Vind_FW)) if (allocated(InData%Vind_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vind_FW), ubound(InData%Vind_FW)) + call RegPackBounds(Buf, 3, lbound(InData%Vind_FW, kind=B8Ki), ubound(InData%Vind_FW, kind=B8Ki)) call RegPack(Buf, InData%Vind_FW) end if call RegPack(Buf, allocated(InData%PitchAndTwist)) if (allocated(InData%PitchAndTwist)) then - call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist), ubound(InData%PitchAndTwist)) + call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist, kind=B8Ki), ubound(InData%PitchAndTwist, kind=B8Ki)) call RegPack(Buf, InData%PitchAndTwist) end if call RegPack(Buf, InData%iTip) call RegPack(Buf, InData%iRoot) call RegPack(Buf, allocated(InData%alpha_LL)) if (allocated(InData%alpha_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha_LL), ubound(InData%alpha_LL)) + call RegPackBounds(Buf, 1, lbound(InData%alpha_LL, kind=B8Ki), ubound(InData%alpha_LL, kind=B8Ki)) call RegPack(Buf, InData%alpha_LL) end if call RegPack(Buf, allocated(InData%Vreln_LL)) if (allocated(InData%Vreln_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL), ubound(InData%Vreln_LL)) + call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL, kind=B8Ki), ubound(InData%Vreln_LL, kind=B8Ki)) call RegPack(Buf, InData%Vreln_LL) end if call RegPack(Buf, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(Buf, 2, lbound(InData%u_UA), ubound(InData%u_UA)) - LB(1:2) = lbound(InData%u_UA) - UB(1:2) = ubound(InData%u_UA) + call RegPackBounds(Buf, 2, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) + LB(1:2) = lbound(InData%u_UA, kind=B8Ki) + UB(1:2) = ubound(InData%u_UA, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_PackInput(Buf, InData%u_UA(i1,i2)) @@ -2772,87 +2772,87 @@ subroutine FVW_PackWng_MiscVarType(Buf, Indata) call UA_PackParam(Buf, InData%p_UA) call RegPack(Buf, allocated(InData%Vind_LL)) if (allocated(InData%Vind_LL)) then - call RegPackBounds(Buf, 2, lbound(InData%Vind_LL), ubound(InData%Vind_LL)) + call RegPackBounds(Buf, 2, lbound(InData%Vind_LL, kind=B8Ki), ubound(InData%Vind_LL, kind=B8Ki)) call RegPack(Buf, InData%Vind_LL) end if call RegPack(Buf, allocated(InData%BN_AxInd)) if (allocated(InData%BN_AxInd)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd), ubound(InData%BN_AxInd)) + call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd, kind=B8Ki), ubound(InData%BN_AxInd, kind=B8Ki)) call RegPack(Buf, InData%BN_AxInd) end if call RegPack(Buf, allocated(InData%BN_TanInd)) if (allocated(InData%BN_TanInd)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd), ubound(InData%BN_TanInd)) + call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd, kind=B8Ki), ubound(InData%BN_TanInd, kind=B8Ki)) call RegPack(Buf, InData%BN_TanInd) end if call RegPack(Buf, allocated(InData%BN_Vrel)) if (allocated(InData%BN_Vrel)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel), ubound(InData%BN_Vrel)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel, kind=B8Ki), ubound(InData%BN_Vrel, kind=B8Ki)) call RegPack(Buf, InData%BN_Vrel) end if call RegPack(Buf, allocated(InData%BN_alpha)) if (allocated(InData%BN_alpha)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_alpha), ubound(InData%BN_alpha)) + call RegPackBounds(Buf, 1, lbound(InData%BN_alpha, kind=B8Ki), ubound(InData%BN_alpha, kind=B8Ki)) call RegPack(Buf, InData%BN_alpha) end if call RegPack(Buf, allocated(InData%BN_phi)) if (allocated(InData%BN_phi)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_phi), ubound(InData%BN_phi)) + call RegPackBounds(Buf, 1, lbound(InData%BN_phi, kind=B8Ki), ubound(InData%BN_phi, kind=B8Ki)) call RegPack(Buf, InData%BN_phi) end if call RegPack(Buf, allocated(InData%BN_Re)) if (allocated(InData%BN_Re)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Re), ubound(InData%BN_Re)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Re, kind=B8Ki), ubound(InData%BN_Re, kind=B8Ki)) call RegPack(Buf, InData%BN_Re) end if call RegPack(Buf, allocated(InData%BN_URelWind_s)) if (allocated(InData%BN_URelWind_s)) then - call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s), ubound(InData%BN_URelWind_s)) + call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s, kind=B8Ki), ubound(InData%BN_URelWind_s, kind=B8Ki)) call RegPack(Buf, InData%BN_URelWind_s) end if call RegPack(Buf, allocated(InData%BN_Cl_Static)) if (allocated(InData%BN_Cl_Static)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static), ubound(InData%BN_Cl_Static)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static, kind=B8Ki), ubound(InData%BN_Cl_Static, kind=B8Ki)) call RegPack(Buf, InData%BN_Cl_Static) end if call RegPack(Buf, allocated(InData%BN_Cd_Static)) if (allocated(InData%BN_Cd_Static)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static), ubound(InData%BN_Cd_Static)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static, kind=B8Ki), ubound(InData%BN_Cd_Static, kind=B8Ki)) call RegPack(Buf, InData%BN_Cd_Static) end if call RegPack(Buf, allocated(InData%BN_Cm_Static)) if (allocated(InData%BN_Cm_Static)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static), ubound(InData%BN_Cm_Static)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static, kind=B8Ki), ubound(InData%BN_Cm_Static, kind=B8Ki)) call RegPack(Buf, InData%BN_Cm_Static) end if call RegPack(Buf, allocated(InData%BN_Cpmin)) if (allocated(InData%BN_Cpmin)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin), ubound(InData%BN_Cpmin)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin, kind=B8Ki), ubound(InData%BN_Cpmin, kind=B8Ki)) call RegPack(Buf, InData%BN_Cpmin) end if call RegPack(Buf, allocated(InData%BN_Cl)) if (allocated(InData%BN_Cl)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cl), ubound(InData%BN_Cl)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cl, kind=B8Ki), ubound(InData%BN_Cl, kind=B8Ki)) call RegPack(Buf, InData%BN_Cl) end if call RegPack(Buf, allocated(InData%BN_Cd)) if (allocated(InData%BN_Cd)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cd), ubound(InData%BN_Cd)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cd, kind=B8Ki), ubound(InData%BN_Cd, kind=B8Ki)) call RegPack(Buf, InData%BN_Cd) end if call RegPack(Buf, allocated(InData%BN_Cm)) if (allocated(InData%BN_Cm)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cm), ubound(InData%BN_Cm)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cm, kind=B8Ki), ubound(InData%BN_Cm, kind=B8Ki)) call RegPack(Buf, InData%BN_Cm) end if call RegPack(Buf, allocated(InData%BN_Cx)) if (allocated(InData%BN_Cx)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cx), ubound(InData%BN_Cx)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cx, kind=B8Ki), ubound(InData%BN_Cx, kind=B8Ki)) call RegPack(Buf, InData%BN_Cx) end if call RegPack(Buf, allocated(InData%BN_Cy)) if (allocated(InData%BN_Cy)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cy), ubound(InData%BN_Cy)) + call RegPackBounds(Buf, 1, lbound(InData%BN_Cy, kind=B8Ki), ubound(InData%BN_Cy, kind=B8Ki)) call RegPack(Buf, InData%BN_Cy) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2862,8 +2862,8 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3431,16 +3431,16 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%W)) then - LB(1:1) = lbound(SrcMiscData%W) - UB(1:1) = ubound(SrcMiscData%W) + LB(1:1) = lbound(SrcMiscData%W, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%W, kind=B8Ki) if (.not. allocated(DstMiscData%W)) then allocate(DstMiscData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3461,8 +3461,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%VTKstep = SrcMiscData%VTKstep DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime if (allocated(SrcMiscData%r_wind)) then - LB(1:2) = lbound(SrcMiscData%r_wind) - UB(1:2) = ubound(SrcMiscData%r_wind) + LB(1:2) = lbound(SrcMiscData%r_wind, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%r_wind, kind=B8Ki) if (.not. allocated(DstMiscData%r_wind)) then allocate(DstMiscData%r_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3493,8 +3493,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%CPs)) then - LB(1:2) = lbound(SrcMiscData%CPs) - UB(1:2) = ubound(SrcMiscData%CPs) + LB(1:2) = lbound(SrcMiscData%CPs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CPs, kind=B8Ki) if (.not. allocated(DstMiscData%CPs)) then allocate(DstMiscData%CPs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3505,8 +3505,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CPs = SrcMiscData%CPs end if if (allocated(SrcMiscData%Uind)) then - LB(1:2) = lbound(SrcMiscData%Uind) - UB(1:2) = ubound(SrcMiscData%Uind) + LB(1:2) = lbound(SrcMiscData%Uind, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%Uind, kind=B8Ki) if (.not. allocated(DstMiscData%Uind)) then allocate(DstMiscData%Uind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3517,8 +3517,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Uind = SrcMiscData%Uind end if if (allocated(SrcMiscData%GridOutputs)) then - LB(1:1) = lbound(SrcMiscData%GridOutputs) - UB(1:1) = ubound(SrcMiscData%GridOutputs) + LB(1:1) = lbound(SrcMiscData%GridOutputs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%GridOutputs, kind=B8Ki) if (.not. allocated(DstMiscData%GridOutputs)) then allocate(DstMiscData%GridOutputs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3539,16 +3539,16 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FVW_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%W)) then - LB(1:1) = lbound(MiscData%W) - UB(1:1) = ubound(MiscData%W) + LB(1:1) = lbound(MiscData%W, kind=B8Ki) + UB(1:1) = ubound(MiscData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_MiscVarType(MiscData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3575,8 +3575,8 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Uind) end if if (allocated(MiscData%GridOutputs)) then - LB(1:1) = lbound(MiscData%GridOutputs) - UB(1:1) = ubound(MiscData%GridOutputs) + LB(1:1) = lbound(MiscData%GridOutputs, kind=B8Ki) + UB(1:1) = ubound(MiscData%GridOutputs, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyGridOutType(MiscData%GridOutputs(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3589,14 +3589,14 @@ subroutine FVW_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_MiscVarType(Buf, InData%W(i1)) end do @@ -3609,7 +3609,7 @@ subroutine FVW_PackMisc(Buf, Indata) call RegPack(Buf, InData%VTKlastTime) call RegPack(Buf, allocated(InData%r_wind)) if (allocated(InData%r_wind)) then - call RegPackBounds(Buf, 2, lbound(InData%r_wind), ubound(InData%r_wind)) + call RegPackBounds(Buf, 2, lbound(InData%r_wind, kind=B8Ki), ubound(InData%r_wind, kind=B8Ki)) call RegPack(Buf, InData%r_wind) end if call RegPack(Buf, InData%ComputeWakeInduced) @@ -3624,19 +3624,19 @@ subroutine FVW_PackMisc(Buf, Indata) call FVW_PackT_Part(Buf, InData%Part) call RegPack(Buf, allocated(InData%CPs)) if (allocated(InData%CPs)) then - call RegPackBounds(Buf, 2, lbound(InData%CPs), ubound(InData%CPs)) + call RegPackBounds(Buf, 2, lbound(InData%CPs, kind=B8Ki), ubound(InData%CPs, kind=B8Ki)) call RegPack(Buf, InData%CPs) end if call RegPack(Buf, allocated(InData%Uind)) if (allocated(InData%Uind)) then - call RegPackBounds(Buf, 2, lbound(InData%Uind), ubound(InData%Uind)) + call RegPackBounds(Buf, 2, lbound(InData%Uind, kind=B8Ki), ubound(InData%Uind, kind=B8Ki)) call RegPack(Buf, InData%Uind) end if call RegPack(Buf, allocated(InData%GridOutputs)) if (allocated(InData%GridOutputs)) then - call RegPackBounds(Buf, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) - LB(1:1) = lbound(InData%GridOutputs) - UB(1:1) = ubound(InData%GridOutputs) + call RegPackBounds(Buf, 1, lbound(InData%GridOutputs, kind=B8Ki), ubound(InData%GridOutputs, kind=B8Ki)) + LB(1:1) = lbound(InData%GridOutputs, kind=B8Ki) + UB(1:1) = ubound(InData%GridOutputs, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackGridOutType(Buf, InData%GridOutputs(i1)) end do @@ -3649,8 +3649,8 @@ subroutine FVW_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3806,14 +3806,14 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_InputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_InputTypeData%Vwnd_LL)) then - LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL) - UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL) + LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL, kind=B8Ki) + UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL, kind=B8Ki) if (.not. allocated(DstWng_InputTypeData%Vwnd_LL)) then allocate(DstWng_InputTypeData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3824,8 +3824,8 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL end if if (allocated(SrcWng_InputTypeData%omega_z)) then - LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) - UB(1:1) = ubound(SrcWng_InputTypeData%omega_z) + LB(1:1) = lbound(SrcWng_InputTypeData%omega_z, kind=B8Ki) + UB(1:1) = ubound(SrcWng_InputTypeData%omega_z, kind=B8Ki) if (.not. allocated(DstWng_InputTypeData%omega_z)) then allocate(DstWng_InputTypeData%omega_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3859,12 +3859,12 @@ subroutine FVW_PackWng_InputType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Vwnd_LL)) if (allocated(InData%Vwnd_LL)) then - call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL), ubound(InData%Vwnd_LL)) + call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL, kind=B8Ki), ubound(InData%Vwnd_LL, kind=B8Ki)) call RegPack(Buf, InData%Vwnd_LL) end if call RegPack(Buf, allocated(InData%omega_z)) if (allocated(InData%omega_z)) then - call RegPackBounds(Buf, 1, lbound(InData%omega_z), ubound(InData%omega_z)) + call RegPackBounds(Buf, 1, lbound(InData%omega_z, kind=B8Ki), ubound(InData%omega_z, kind=B8Ki)) call RegPack(Buf, InData%omega_z) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3874,7 +3874,7 @@ subroutine FVW_UnPackWng_InputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3914,16 +3914,16 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors) - UB(1:1) = ubound(SrcInputData%rotors) + LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) if (.not. allocated(DstInputData%rotors)) then allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3938,8 +3938,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%W)) then - LB(1:1) = lbound(SrcInputData%W) - UB(1:1) = ubound(SrcInputData%W) + LB(1:1) = lbound(SrcInputData%W, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%W, kind=B8Ki) if (.not. allocated(DstInputData%W)) then allocate(DstInputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3954,8 +3954,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%WingsMesh)) then - LB(1:1) = lbound(SrcInputData%WingsMesh) - UB(1:1) = ubound(SrcInputData%WingsMesh) + LB(1:1) = lbound(SrcInputData%WingsMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%WingsMesh, kind=B8Ki) if (.not. allocated(DstInputData%WingsMesh)) then allocate(DstInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3970,8 +3970,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%V_wind)) then - LB(1:2) = lbound(SrcInputData%V_wind) - UB(1:2) = ubound(SrcInputData%V_wind) + LB(1:2) = lbound(SrcInputData%V_wind, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%V_wind, kind=B8Ki) if (.not. allocated(DstInputData%V_wind)) then allocate(DstInputData%V_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3987,16 +3987,16 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) type(FVW_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors) - UB(1:1) = ubound(InputData%rotors) + LB(1:1) = lbound(InputData%rotors, kind=B8Ki) + UB(1:1) = ubound(InputData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyRot_InputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4004,8 +4004,8 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%rotors) end if if (allocated(InputData%W)) then - LB(1:1) = lbound(InputData%W) - UB(1:1) = ubound(InputData%W) + LB(1:1) = lbound(InputData%W, kind=B8Ki) + UB(1:1) = ubound(InputData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_InputType(InputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4013,8 +4013,8 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%W) end if if (allocated(InputData%WingsMesh)) then - LB(1:1) = lbound(InputData%WingsMesh) - UB(1:1) = ubound(InputData%WingsMesh) + LB(1:1) = lbound(InputData%WingsMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%WingsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4030,39 +4030,39 @@ subroutine FVW_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) - LB(1:1) = lbound(InData%rotors) - UB(1:1) = ubound(InData%rotors) + call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + LB(1:1) = lbound(InData%rotors, kind=B8Ki) + UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackRot_InputType(Buf, InData%rotors(i1)) end do end if call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_InputType(Buf, InData%W(i1)) end do end if call RegPack(Buf, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) - LB(1:1) = lbound(InData%WingsMesh) - UB(1:1) = ubound(InData%WingsMesh) + call RegPackBounds(Buf, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) + UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%WingsMesh(i1)) end do end if call RegPack(Buf, allocated(InData%V_wind)) if (allocated(InData%V_wind)) then - call RegPackBounds(Buf, 2, lbound(InData%V_wind), ubound(InData%V_wind)) + call RegPackBounds(Buf, 2, lbound(InData%V_wind, kind=B8Ki), ubound(InData%V_wind, kind=B8Ki)) call RegPack(Buf, InData%V_wind) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4072,8 +4072,8 @@ subroutine FVW_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4144,8 +4144,8 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyDiscState' @@ -4153,8 +4153,8 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ErrMsg = '' DstDiscStateData%Dummy = SrcDiscStateData%Dummy if (allocated(SrcDiscStateData%UA)) then - LB(1:1) = lbound(SrcDiscStateData%UA) - UB(1:1) = ubound(SrcDiscStateData%UA) + LB(1:1) = lbound(SrcDiscStateData%UA, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%UA, kind=B8Ki) if (.not. allocated(DstDiscStateData%UA)) then allocate(DstDiscStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4174,16 +4174,16 @@ subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(FVW_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%UA)) then - LB(1:1) = lbound(DiscStateData%UA) - UB(1:1) = ubound(DiscStateData%UA) + LB(1:1) = lbound(DiscStateData%UA, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%UA, kind=B8Ki) do i1 = LB(1), UB(1) call UA_DestroyDiscState(DiscStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4196,15 +4196,15 @@ subroutine FVW_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Dummy) call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) - LB(1:1) = lbound(InData%UA) - UB(1:1) = ubound(InData%UA) + call RegPackBounds(Buf, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) + LB(1:1) = lbound(InData%UA, kind=B8Ki) + UB(1:1) = ubound(InData%UA, kind=B8Ki) do i1 = LB(1), UB(1) call UA_PackDiscState(Buf, InData%UA(i1)) end do @@ -4216,8 +4216,8 @@ subroutine FVW_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4246,14 +4246,14 @@ subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWn integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ConstraintStateType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ConstraintStateTypeData%Gamma_LL)) then - LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL) - UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL) + LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL, kind=B8Ki) + UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL, kind=B8Ki) if (.not. allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then allocate(DstWng_ConstraintStateTypeData%Gamma_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4284,7 +4284,7 @@ subroutine FVW_PackWng_ConstraintStateType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Gamma_LL)) if (allocated(InData%Gamma_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%Gamma_LL), ubound(InData%Gamma_LL)) + call RegPackBounds(Buf, 1, lbound(InData%Gamma_LL, kind=B8Ki), ubound(InData%Gamma_LL, kind=B8Ki)) call RegPack(Buf, InData%Gamma_LL) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4294,7 +4294,7 @@ subroutine FVW_UnPackWng_ConstraintStateType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4320,16 +4320,16 @@ subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%W)) then - LB(1:1) = lbound(SrcConstrStateData%W) - UB(1:1) = ubound(SrcConstrStateData%W) + LB(1:1) = lbound(SrcConstrStateData%W, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%W, kind=B8Ki) if (.not. allocated(DstConstrStateData%W)) then allocate(DstConstrStateData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4350,16 +4350,16 @@ subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(FVW_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%W)) then - LB(1:1) = lbound(ConstrStateData%W) - UB(1:1) = ubound(ConstrStateData%W) + LB(1:1) = lbound(ConstrStateData%W, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_ConstraintStateType(ConstrStateData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4372,14 +4372,14 @@ subroutine FVW_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_ConstraintStateType(Buf, InData%W(i1)) end do @@ -4392,8 +4392,8 @@ subroutine FVW_UnPackConstrState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4422,8 +4422,8 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyOtherState' @@ -4431,8 +4431,8 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er ErrMsg = '' DstOtherStateData%Dummy = SrcOtherStateData%Dummy if (allocated(SrcOtherStateData%UA)) then - LB(1:1) = lbound(SrcOtherStateData%UA) - UB(1:1) = ubound(SrcOtherStateData%UA) + LB(1:1) = lbound(SrcOtherStateData%UA, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%UA, kind=B8Ki) if (.not. allocated(DstOtherStateData%UA)) then allocate(DstOtherStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4452,16 +4452,16 @@ subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(FVW_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%UA)) then - LB(1:1) = lbound(OtherStateData%UA) - UB(1:1) = ubound(OtherStateData%UA) + LB(1:1) = lbound(OtherStateData%UA, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%UA, kind=B8Ki) do i1 = LB(1), UB(1) call UA_DestroyOtherState(OtherStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4474,15 +4474,15 @@ subroutine FVW_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Dummy) call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) - LB(1:1) = lbound(InData%UA) - UB(1:1) = ubound(InData%UA) + call RegPackBounds(Buf, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) + LB(1:1) = lbound(InData%UA, kind=B8Ki) + UB(1:1) = ubound(InData%UA, kind=B8Ki) do i1 = LB(1), UB(1) call UA_PackOtherState(Buf, InData%UA(i1)) end do @@ -4494,8 +4494,8 @@ subroutine FVW_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4524,14 +4524,14 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_InitInputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_InitInputTypeData%AFindx)) then - LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx) - UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx) + LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx, kind=B8Ki) + UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx, kind=B8Ki) if (.not. allocated(DstWng_InitInputTypeData%AFindx)) then allocate(DstWng_InitInputTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4542,8 +4542,8 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx end if if (allocated(SrcWng_InitInputTypeData%chord)) then - LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) - UB(1:1) = ubound(SrcWng_InitInputTypeData%chord) + LB(1:1) = lbound(SrcWng_InitInputTypeData%chord, kind=B8Ki) + UB(1:1) = ubound(SrcWng_InitInputTypeData%chord, kind=B8Ki) if (.not. allocated(DstWng_InitInputTypeData%chord)) then allocate(DstWng_InitInputTypeData%chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4554,8 +4554,8 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord end if if (allocated(SrcWng_InitInputTypeData%RElm)) then - LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) - UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm) + LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm, kind=B8Ki) + UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm, kind=B8Ki) if (.not. allocated(DstWng_InitInputTypeData%RElm)) then allocate(DstWng_InitInputTypeData%RElm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4595,17 +4595,17 @@ subroutine FVW_PackWng_InitInputType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) call RegPack(Buf, InData%AFindx) end if call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then - call RegPackBounds(Buf, 1, lbound(InData%chord), ubound(InData%chord)) + call RegPackBounds(Buf, 1, lbound(InData%chord, kind=B8Ki), ubound(InData%chord, kind=B8Ki)) call RegPack(Buf, InData%chord) end if call RegPack(Buf, allocated(InData%RElm)) if (allocated(InData%RElm)) then - call RegPackBounds(Buf, 1, lbound(InData%RElm), ubound(InData%RElm)) + call RegPackBounds(Buf, 1, lbound(InData%RElm, kind=B8Ki), ubound(InData%RElm, kind=B8Ki)) call RegPack(Buf, InData%RElm) end if call RegPack(Buf, InData%iRotor) @@ -4618,7 +4618,7 @@ subroutine FVW_UnPackWng_InitInputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Wng_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4678,8 +4678,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyInitInput' @@ -4688,8 +4688,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%W)) then - LB(1:1) = lbound(SrcInitInputData%W) - UB(1:1) = ubound(SrcInitInputData%W) + LB(1:1) = lbound(SrcInitInputData%W, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%W, kind=B8Ki) if (.not. allocated(DstInitInputData%W)) then allocate(DstInitInputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4704,8 +4704,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end do end if if (allocated(SrcInitInputData%WingsMesh)) then - LB(1:1) = lbound(SrcInitInputData%WingsMesh) - UB(1:1) = ubound(SrcInitInputData%WingsMesh) + LB(1:1) = lbound(SrcInitInputData%WingsMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WingsMesh, kind=B8Ki) if (.not. allocated(DstInitInputData%WingsMesh)) then allocate(DstInitInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4735,16 +4735,16 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(FVW_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%W)) then - LB(1:1) = lbound(InitInputData%W) - UB(1:1) = ubound(InitInputData%W) + LB(1:1) = lbound(InitInputData%W, kind=B8Ki) + UB(1:1) = ubound(InitInputData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_DestroyWng_InitInputType(InitInputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4752,8 +4752,8 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%W) end if if (allocated(InitInputData%WingsMesh)) then - LB(1:1) = lbound(InitInputData%WingsMesh) - UB(1:1) = ubound(InitInputData%WingsMesh) + LB(1:1) = lbound(InitInputData%WingsMesh, kind=B8Ki) + UB(1:1) = ubound(InitInputData%WingsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4766,25 +4766,25 @@ subroutine FVW_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInitInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FVWFileName) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) - LB(1:1) = lbound(InData%W) - UB(1:1) = ubound(InData%W) + call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + LB(1:1) = lbound(InData%W, kind=B8Ki) + UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) call FVW_PackWng_InitInputType(Buf, InData%W(i1)) end do end if call RegPack(Buf, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) - LB(1:1) = lbound(InData%WingsMesh) - UB(1:1) = ubound(InData%WingsMesh) + call RegPackBounds(Buf, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) + UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%WingsMesh(i1)) end do @@ -4806,8 +4806,8 @@ subroutine FVW_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FVW_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5169,27 +5169,27 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition END DO END IF ! check if allocated IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z END IF ! check if allocated END DO END IF ! check if allocated IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + DO i1 = LBOUND(u_out%WingsMesh,1, kind=B8Ki),UBOUND(u_out%WingsMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -5257,27 +5257,27 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + a3*u3%rotors(i01)%HubOrientation END DO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + a3*u3%rotors(i01)%HubPosition END DO END IF ! check if allocated IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + a3*u3%W(i01)%Vwnd_LL END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + a3*u3%W(i01)%omega_z END IF ! check if allocated END DO END IF ! check if allocated IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + DO i1 = LBOUND(u_out%WingsMesh,1, kind=B8Ki),UBOUND(u_out%WingsMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -5387,7 +5387,7 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) + DO i01 = LBOUND(y_out%W,1, kind=B8Ki),UBOUND(y_out%W,1, kind=B8Ki) IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind END IF ! check if allocated @@ -5453,7 +5453,7 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) + DO i01 = LBOUND(y_out%W,1, kind=B8Ki),UBOUND(y_out%W,1, kind=B8Ki) IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + a3*y3%W(i01)%Vind END IF ! check if allocated diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 23a120ec97..af725dc88d 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -254,7 +254,7 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyInitInput' ErrStat = ErrID_None @@ -262,8 +262,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%dt = SrcInitInputData%dt DstInitInputData%OutRootName = SrcInitInputData%OutRootName if (allocated(SrcInitInputData%c)) then - LB(1:2) = lbound(SrcInitInputData%c) - UB(1:2) = ubound(SrcInitInputData%c) + LB(1:2) = lbound(SrcInitInputData%c, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%c, kind=B8Ki) if (.not. allocated(DstInitInputData%c)) then allocate(DstInitInputData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -281,8 +281,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect DstInitInputData%WrSum = SrcInitInputData%WrSum if (allocated(SrcInitInputData%UAOff_innerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) - UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) if (.not. allocated(DstInitInputData%UAOff_innerNode)) then allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -293,8 +293,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode end if if (allocated(SrcInitInputData%UAOff_outerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) - UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) if (.not. allocated(DstInitInputData%UAOff_outerNode)) then allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -333,7 +333,7 @@ subroutine UA_PackInitInput(Buf, Indata) call RegPack(Buf, InData%OutRootName) call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then - call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) + call RegPackBounds(Buf, 2, lbound(InData%c, kind=B8Ki), ubound(InData%c, kind=B8Ki)) call RegPack(Buf, InData%c) end if call RegPack(Buf, InData%numBlades) @@ -345,12 +345,12 @@ subroutine UA_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WrSum) call RegPack(Buf, allocated(InData%UAOff_innerNode)) if (allocated(InData%UAOff_innerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) + call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode, kind=B8Ki), ubound(InData%UAOff_innerNode, kind=B8Ki)) call RegPack(Buf, InData%UAOff_innerNode) end if call RegPack(Buf, allocated(InData%UAOff_outerNode)) if (allocated(InData%UAOff_outerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) + call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode, kind=B8Ki), ubound(InData%UAOff_outerNode, kind=B8Ki)) call RegPack(Buf, InData%UAOff_outerNode) end if if (RegCheckErr(Buf, RoutineName)) return @@ -360,7 +360,7 @@ subroutine UA_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -432,7 +432,7 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyInitOutput' @@ -442,8 +442,8 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -454,8 +454,8 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -494,12 +494,12 @@ subroutine UA_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Version) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -509,7 +509,7 @@ subroutine UA_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -828,16 +828,16 @@ subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%element)) then - LB(1:2) = lbound(SrcContStateData%element) - UB(1:2) = ubound(SrcContStateData%element) + LB(1:2) = lbound(SrcContStateData%element, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%element, kind=B8Ki) if (.not. allocated(DstContStateData%element)) then allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -859,16 +859,16 @@ subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) type(UA_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%element)) then - LB(1:2) = lbound(ContStateData%element) - UB(1:2) = ubound(ContStateData%element) + LB(1:2) = lbound(ContStateData%element, kind=B8Ki) + UB(1:2) = ubound(ContStateData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) @@ -883,14 +883,14 @@ subroutine UA_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackContState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) - LB(1:2) = lbound(InData%element) - UB(1:2) = ubound(InData%element) + call RegPackBounds(Buf, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) + LB(1:2) = lbound(InData%element, kind=B8Ki) + UB(1:2) = ubound(InData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_PackElementContinuousStateType(Buf, InData%element(i1,i2)) @@ -904,8 +904,8 @@ subroutine UA_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackContState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -934,14 +934,14 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%alpha_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_minus1) - UB(1:2) = ubound(SrcDiscStateData%alpha_minus1) + LB(1:2) = lbound(SrcDiscStateData%alpha_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%alpha_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%alpha_minus1)) then allocate(DstDiscStateData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -952,8 +952,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 end if if (allocated(SrcDiscStateData%alpha_filt_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) - UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1) + LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%alpha_filt_minus1)) then allocate(DstDiscStateData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -964,8 +964,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 end if if (allocated(SrcDiscStateData%alpha_dot)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_dot) - UB(1:2) = ubound(SrcDiscStateData%alpha_dot) + LB(1:2) = lbound(SrcDiscStateData%alpha_dot, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot, kind=B8Ki) if (.not. allocated(DstDiscStateData%alpha_dot)) then allocate(DstDiscStateData%alpha_dot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -976,8 +976,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot end if if (allocated(SrcDiscStateData%alpha_dot_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) - UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1) + LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%alpha_dot_minus1)) then allocate(DstDiscStateData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -988,8 +988,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 end if if (allocated(SrcDiscStateData%q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%q_minus1) - UB(1:2) = ubound(SrcDiscStateData%q_minus1) + LB(1:2) = lbound(SrcDiscStateData%q_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%q_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%q_minus1)) then allocate(DstDiscStateData%q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1000,8 +1000,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 end if if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) - UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1) + LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Kalpha_f_minus1)) then allocate(DstDiscStateData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1012,8 +1012,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 end if if (allocated(SrcDiscStateData%Kq_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) - UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1) + LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Kq_f_minus1)) then allocate(DstDiscStateData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1024,8 +1024,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 end if if (allocated(SrcDiscStateData%q_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) - UB(1:2) = ubound(SrcDiscStateData%q_f_minus1) + LB(1:2) = lbound(SrcDiscStateData%q_f_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%q_f_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%q_f_minus1)) then allocate(DstDiscStateData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1036,8 +1036,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 end if if (allocated(SrcDiscStateData%X1_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X1_minus1) - UB(1:2) = ubound(SrcDiscStateData%X1_minus1) + LB(1:2) = lbound(SrcDiscStateData%X1_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%X1_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%X1_minus1)) then allocate(DstDiscStateData%X1_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1048,8 +1048,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 end if if (allocated(SrcDiscStateData%X2_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X2_minus1) - UB(1:2) = ubound(SrcDiscStateData%X2_minus1) + LB(1:2) = lbound(SrcDiscStateData%X2_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%X2_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%X2_minus1)) then allocate(DstDiscStateData%X2_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1060,8 +1060,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 end if if (allocated(SrcDiscStateData%X3_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X3_minus1) - UB(1:2) = ubound(SrcDiscStateData%X3_minus1) + LB(1:2) = lbound(SrcDiscStateData%X3_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%X3_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%X3_minus1)) then allocate(DstDiscStateData%X3_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1072,8 +1072,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 end if if (allocated(SrcDiscStateData%X4_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X4_minus1) - UB(1:2) = ubound(SrcDiscStateData%X4_minus1) + LB(1:2) = lbound(SrcDiscStateData%X4_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%X4_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%X4_minus1)) then allocate(DstDiscStateData%X4_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1084,8 +1084,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 end if if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) - UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1) + LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Kprime_alpha_minus1)) then allocate(DstDiscStateData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1096,8 +1096,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 end if if (allocated(SrcDiscStateData%Kprime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) - UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1) + LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Kprime_q_minus1)) then allocate(DstDiscStateData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1108,8 +1108,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 end if if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) - UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1) + LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Kprimeprime_q_minus1)) then allocate(DstDiscStateData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1120,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 end if if (allocated(SrcDiscStateData%K3prime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) - UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1) + LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%K3prime_q_minus1)) then allocate(DstDiscStateData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1132,8 +1132,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 end if if (allocated(SrcDiscStateData%Dp_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) - UB(1:2) = ubound(SrcDiscStateData%Dp_minus1) + LB(1:2) = lbound(SrcDiscStateData%Dp_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Dp_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Dp_minus1)) then allocate(DstDiscStateData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1144,8 +1144,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 end if if (allocated(SrcDiscStateData%Cn_pot_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) - UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1) + LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Cn_pot_minus1)) then allocate(DstDiscStateData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1156,8 +1156,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%fprimeprime_minus1)) then allocate(DstDiscStateData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1168,8 +1168,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%fprimeprime_c_minus1)) then allocate(DstDiscStateData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1180,8 +1180,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%fprimeprime_m_minus1)) then allocate(DstDiscStateData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1192,8 +1192,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 end if if (allocated(SrcDiscStateData%Df_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_minus1) - UB(1:2) = ubound(SrcDiscStateData%Df_minus1) + LB(1:2) = lbound(SrcDiscStateData%Df_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Df_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Df_minus1)) then allocate(DstDiscStateData%Df_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1204,8 +1204,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 end if if (allocated(SrcDiscStateData%Df_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) - UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1) + LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Df_c_minus1)) then allocate(DstDiscStateData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1216,8 +1216,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 end if if (allocated(SrcDiscStateData%Df_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) - UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1) + LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Df_m_minus1)) then allocate(DstDiscStateData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,8 +1228,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 end if if (allocated(SrcDiscStateData%Dalphaf_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) - UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1) + LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Dalphaf_minus1)) then allocate(DstDiscStateData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1240,8 +1240,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 end if if (allocated(SrcDiscStateData%alphaf_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) - UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1) + LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%alphaf_minus1)) then allocate(DstDiscStateData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1252,8 +1252,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 end if if (allocated(SrcDiscStateData%fprime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) - UB(1:2) = ubound(SrcDiscStateData%fprime_minus1) + LB(1:2) = lbound(SrcDiscStateData%fprime_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%fprime_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%fprime_minus1)) then allocate(DstDiscStateData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1264,8 +1264,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 end if if (allocated(SrcDiscStateData%fprime_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) - UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1) + LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%fprime_c_minus1)) then allocate(DstDiscStateData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1276,8 +1276,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 end if if (allocated(SrcDiscStateData%fprime_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) - UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1) + LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%fprime_m_minus1)) then allocate(DstDiscStateData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1288,8 +1288,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 end if if (allocated(SrcDiscStateData%tau_V)) then - LB(1:2) = lbound(SrcDiscStateData%tau_V) - UB(1:2) = ubound(SrcDiscStateData%tau_V) + LB(1:2) = lbound(SrcDiscStateData%tau_V, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%tau_V, kind=B8Ki) if (.not. allocated(DstDiscStateData%tau_V)) then allocate(DstDiscStateData%tau_V(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1300,8 +1300,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%tau_V = SrcDiscStateData%tau_V end if if (allocated(SrcDiscStateData%tau_V_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) - UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1) + LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%tau_V_minus1)) then allocate(DstDiscStateData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1312,8 +1312,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 end if if (allocated(SrcDiscStateData%Cn_v_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) - UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1) + LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Cn_v_minus1)) then allocate(DstDiscStateData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1324,8 +1324,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 end if if (allocated(SrcDiscStateData%C_V_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) - UB(1:2) = ubound(SrcDiscStateData%C_V_minus1) + LB(1:2) = lbound(SrcDiscStateData%C_V_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%C_V_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%C_V_minus1)) then allocate(DstDiscStateData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1336,8 +1336,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 end if if (allocated(SrcDiscStateData%Cn_prime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) - UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1) + LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1, kind=B8Ki) if (.not. allocated(DstDiscStateData%Cn_prime_minus1)) then allocate(DstDiscStateData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1467,172 +1467,172 @@ subroutine UA_PackDiscState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%alpha_minus1)) if (allocated(InData%alpha_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1), ubound(InData%alpha_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1, kind=B8Ki), ubound(InData%alpha_minus1, kind=B8Ki)) call RegPack(Buf, InData%alpha_minus1) end if call RegPack(Buf, allocated(InData%alpha_filt_minus1)) if (allocated(InData%alpha_filt_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1), ubound(InData%alpha_filt_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1, kind=B8Ki), ubound(InData%alpha_filt_minus1, kind=B8Ki)) call RegPack(Buf, InData%alpha_filt_minus1) end if call RegPack(Buf, allocated(InData%alpha_dot)) if (allocated(InData%alpha_dot)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_dot), ubound(InData%alpha_dot)) + call RegPackBounds(Buf, 2, lbound(InData%alpha_dot, kind=B8Ki), ubound(InData%alpha_dot, kind=B8Ki)) call RegPack(Buf, InData%alpha_dot) end if call RegPack(Buf, allocated(InData%alpha_dot_minus1)) if (allocated(InData%alpha_dot_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1), ubound(InData%alpha_dot_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1, kind=B8Ki), ubound(InData%alpha_dot_minus1, kind=B8Ki)) call RegPack(Buf, InData%alpha_dot_minus1) end if call RegPack(Buf, allocated(InData%q_minus1)) if (allocated(InData%q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%q_minus1), ubound(InData%q_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%q_minus1, kind=B8Ki), ubound(InData%q_minus1, kind=B8Ki)) call RegPack(Buf, InData%q_minus1) end if call RegPack(Buf, allocated(InData%Kalpha_f_minus1)) if (allocated(InData%Kalpha_f_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1), ubound(InData%Kalpha_f_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1, kind=B8Ki), ubound(InData%Kalpha_f_minus1, kind=B8Ki)) call RegPack(Buf, InData%Kalpha_f_minus1) end if call RegPack(Buf, allocated(InData%Kq_f_minus1)) if (allocated(InData%Kq_f_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1), ubound(InData%Kq_f_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1, kind=B8Ki), ubound(InData%Kq_f_minus1, kind=B8Ki)) call RegPack(Buf, InData%Kq_f_minus1) end if call RegPack(Buf, allocated(InData%q_f_minus1)) if (allocated(InData%q_f_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1), ubound(InData%q_f_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1, kind=B8Ki), ubound(InData%q_f_minus1, kind=B8Ki)) call RegPack(Buf, InData%q_f_minus1) end if call RegPack(Buf, allocated(InData%X1_minus1)) if (allocated(InData%X1_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X1_minus1), ubound(InData%X1_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%X1_minus1, kind=B8Ki), ubound(InData%X1_minus1, kind=B8Ki)) call RegPack(Buf, InData%X1_minus1) end if call RegPack(Buf, allocated(InData%X2_minus1)) if (allocated(InData%X2_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X2_minus1), ubound(InData%X2_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%X2_minus1, kind=B8Ki), ubound(InData%X2_minus1, kind=B8Ki)) call RegPack(Buf, InData%X2_minus1) end if call RegPack(Buf, allocated(InData%X3_minus1)) if (allocated(InData%X3_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X3_minus1), ubound(InData%X3_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%X3_minus1, kind=B8Ki), ubound(InData%X3_minus1, kind=B8Ki)) call RegPack(Buf, InData%X3_minus1) end if call RegPack(Buf, allocated(InData%X4_minus1)) if (allocated(InData%X4_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X4_minus1), ubound(InData%X4_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%X4_minus1, kind=B8Ki), ubound(InData%X4_minus1, kind=B8Ki)) call RegPack(Buf, InData%X4_minus1) end if call RegPack(Buf, allocated(InData%Kprime_alpha_minus1)) if (allocated(InData%Kprime_alpha_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1), ubound(InData%Kprime_alpha_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1, kind=B8Ki), ubound(InData%Kprime_alpha_minus1, kind=B8Ki)) call RegPack(Buf, InData%Kprime_alpha_minus1) end if call RegPack(Buf, allocated(InData%Kprime_q_minus1)) if (allocated(InData%Kprime_q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1), ubound(InData%Kprime_q_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1, kind=B8Ki), ubound(InData%Kprime_q_minus1, kind=B8Ki)) call RegPack(Buf, InData%Kprime_q_minus1) end if call RegPack(Buf, allocated(InData%Kprimeprime_q_minus1)) if (allocated(InData%Kprimeprime_q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1), ubound(InData%Kprimeprime_q_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1, kind=B8Ki), ubound(InData%Kprimeprime_q_minus1, kind=B8Ki)) call RegPack(Buf, InData%Kprimeprime_q_minus1) end if call RegPack(Buf, allocated(InData%K3prime_q_minus1)) if (allocated(InData%K3prime_q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1), ubound(InData%K3prime_q_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1, kind=B8Ki), ubound(InData%K3prime_q_minus1, kind=B8Ki)) call RegPack(Buf, InData%K3prime_q_minus1) end if call RegPack(Buf, allocated(InData%Dp_minus1)) if (allocated(InData%Dp_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1), ubound(InData%Dp_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1, kind=B8Ki), ubound(InData%Dp_minus1, kind=B8Ki)) call RegPack(Buf, InData%Dp_minus1) end if call RegPack(Buf, allocated(InData%Cn_pot_minus1)) if (allocated(InData%Cn_pot_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1), ubound(InData%Cn_pot_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1, kind=B8Ki), ubound(InData%Cn_pot_minus1, kind=B8Ki)) call RegPack(Buf, InData%Cn_pot_minus1) end if call RegPack(Buf, allocated(InData%fprimeprime_minus1)) if (allocated(InData%fprimeprime_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1), ubound(InData%fprimeprime_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1, kind=B8Ki), ubound(InData%fprimeprime_minus1, kind=B8Ki)) call RegPack(Buf, InData%fprimeprime_minus1) end if call RegPack(Buf, allocated(InData%fprimeprime_c_minus1)) if (allocated(InData%fprimeprime_c_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1), ubound(InData%fprimeprime_c_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1, kind=B8Ki), ubound(InData%fprimeprime_c_minus1, kind=B8Ki)) call RegPack(Buf, InData%fprimeprime_c_minus1) end if call RegPack(Buf, allocated(InData%fprimeprime_m_minus1)) if (allocated(InData%fprimeprime_m_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1), ubound(InData%fprimeprime_m_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1, kind=B8Ki), ubound(InData%fprimeprime_m_minus1, kind=B8Ki)) call RegPack(Buf, InData%fprimeprime_m_minus1) end if call RegPack(Buf, allocated(InData%Df_minus1)) if (allocated(InData%Df_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Df_minus1), ubound(InData%Df_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Df_minus1, kind=B8Ki), ubound(InData%Df_minus1, kind=B8Ki)) call RegPack(Buf, InData%Df_minus1) end if call RegPack(Buf, allocated(InData%Df_c_minus1)) if (allocated(InData%Df_c_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1), ubound(InData%Df_c_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1, kind=B8Ki), ubound(InData%Df_c_minus1, kind=B8Ki)) call RegPack(Buf, InData%Df_c_minus1) end if call RegPack(Buf, allocated(InData%Df_m_minus1)) if (allocated(InData%Df_m_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1), ubound(InData%Df_m_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1, kind=B8Ki), ubound(InData%Df_m_minus1, kind=B8Ki)) call RegPack(Buf, InData%Df_m_minus1) end if call RegPack(Buf, allocated(InData%Dalphaf_minus1)) if (allocated(InData%Dalphaf_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1), ubound(InData%Dalphaf_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1, kind=B8Ki), ubound(InData%Dalphaf_minus1, kind=B8Ki)) call RegPack(Buf, InData%Dalphaf_minus1) end if call RegPack(Buf, allocated(InData%alphaf_minus1)) if (allocated(InData%alphaf_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1), ubound(InData%alphaf_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1, kind=B8Ki), ubound(InData%alphaf_minus1, kind=B8Ki)) call RegPack(Buf, InData%alphaf_minus1) end if call RegPack(Buf, allocated(InData%fprime_minus1)) if (allocated(InData%fprime_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1), ubound(InData%fprime_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1, kind=B8Ki), ubound(InData%fprime_minus1, kind=B8Ki)) call RegPack(Buf, InData%fprime_minus1) end if call RegPack(Buf, allocated(InData%fprime_c_minus1)) if (allocated(InData%fprime_c_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1), ubound(InData%fprime_c_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1, kind=B8Ki), ubound(InData%fprime_c_minus1, kind=B8Ki)) call RegPack(Buf, InData%fprime_c_minus1) end if call RegPack(Buf, allocated(InData%fprime_m_minus1)) if (allocated(InData%fprime_m_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1), ubound(InData%fprime_m_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1, kind=B8Ki), ubound(InData%fprime_m_minus1, kind=B8Ki)) call RegPack(Buf, InData%fprime_m_minus1) end if call RegPack(Buf, allocated(InData%tau_V)) if (allocated(InData%tau_V)) then - call RegPackBounds(Buf, 2, lbound(InData%tau_V), ubound(InData%tau_V)) + call RegPackBounds(Buf, 2, lbound(InData%tau_V, kind=B8Ki), ubound(InData%tau_V, kind=B8Ki)) call RegPack(Buf, InData%tau_V) end if call RegPack(Buf, allocated(InData%tau_V_minus1)) if (allocated(InData%tau_V_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1), ubound(InData%tau_V_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1, kind=B8Ki), ubound(InData%tau_V_minus1, kind=B8Ki)) call RegPack(Buf, InData%tau_V_minus1) end if call RegPack(Buf, allocated(InData%Cn_v_minus1)) if (allocated(InData%Cn_v_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1), ubound(InData%Cn_v_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1, kind=B8Ki), ubound(InData%Cn_v_minus1, kind=B8Ki)) call RegPack(Buf, InData%Cn_v_minus1) end if call RegPack(Buf, allocated(InData%C_V_minus1)) if (allocated(InData%C_V_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1), ubound(InData%C_V_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1, kind=B8Ki), ubound(InData%C_V_minus1, kind=B8Ki)) call RegPack(Buf, InData%C_V_minus1) end if call RegPack(Buf, allocated(InData%Cn_prime_minus1)) if (allocated(InData%Cn_prime_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1), ubound(InData%Cn_prime_minus1)) + call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1, kind=B8Ki), ubound(InData%Cn_prime_minus1, kind=B8Ki)) call RegPack(Buf, InData%Cn_prime_minus1) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1642,7 +1642,7 @@ subroutine UA_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackDiscState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2169,16 +2169,16 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%FirstPass)) then - LB(1:2) = lbound(SrcOtherStateData%FirstPass) - UB(1:2) = ubound(SrcOtherStateData%FirstPass) + LB(1:2) = lbound(SrcOtherStateData%FirstPass, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%FirstPass, kind=B8Ki) if (.not. allocated(DstOtherStateData%FirstPass)) then allocate(DstOtherStateData%FirstPass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2189,8 +2189,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass end if if (allocated(SrcOtherStateData%sigma1)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1) - UB(1:2) = ubound(SrcOtherStateData%sigma1) + LB(1:2) = lbound(SrcOtherStateData%sigma1, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%sigma1, kind=B8Ki) if (.not. allocated(DstOtherStateData%sigma1)) then allocate(DstOtherStateData%sigma1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2201,8 +2201,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 end if if (allocated(SrcOtherStateData%sigma1c)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1c) - UB(1:2) = ubound(SrcOtherStateData%sigma1c) + LB(1:2) = lbound(SrcOtherStateData%sigma1c, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%sigma1c, kind=B8Ki) if (.not. allocated(DstOtherStateData%sigma1c)) then allocate(DstOtherStateData%sigma1c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2213,8 +2213,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c end if if (allocated(SrcOtherStateData%sigma1m)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1m) - UB(1:2) = ubound(SrcOtherStateData%sigma1m) + LB(1:2) = lbound(SrcOtherStateData%sigma1m, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%sigma1m, kind=B8Ki) if (.not. allocated(DstOtherStateData%sigma1m)) then allocate(DstOtherStateData%sigma1m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2225,8 +2225,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m end if if (allocated(SrcOtherStateData%sigma3)) then - LB(1:2) = lbound(SrcOtherStateData%sigma3) - UB(1:2) = ubound(SrcOtherStateData%sigma3) + LB(1:2) = lbound(SrcOtherStateData%sigma3, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%sigma3, kind=B8Ki) if (.not. allocated(DstOtherStateData%sigma3)) then allocate(DstOtherStateData%sigma3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2237,8 +2237,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 end if if (allocated(SrcOtherStateData%n)) then - LB(1:2) = lbound(SrcOtherStateData%n) - UB(1:2) = ubound(SrcOtherStateData%n) + LB(1:2) = lbound(SrcOtherStateData%n, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%n, kind=B8Ki) if (.not. allocated(DstOtherStateData%n)) then allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2248,23 +2248,23 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if DstOtherStateData%n = SrcOtherStateData%n end if - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcOtherStateData%xHistory) - UB(1:1) = ubound(SrcOtherStateData%xHistory) + LB(1:1) = lbound(SrcOtherStateData%xHistory, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xHistory, kind=B8Ki) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xHistory(i1), DstOtherStateData%xHistory(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcOtherStateData%t_vortexBegin)) then - LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin) - UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin) + LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin, kind=B8Ki) if (.not. allocated(DstOtherStateData%t_vortexBegin)) then allocate(DstOtherStateData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2275,8 +2275,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin end if if (allocated(SrcOtherStateData%SignOfOmega)) then - LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) - UB(1:2) = ubound(SrcOtherStateData%SignOfOmega) + LB(1:2) = lbound(SrcOtherStateData%SignOfOmega, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%SignOfOmega, kind=B8Ki) if (.not. allocated(DstOtherStateData%SignOfOmega)) then allocate(DstOtherStateData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2287,8 +2287,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega end if if (allocated(SrcOtherStateData%PositivePressure)) then - LB(1:2) = lbound(SrcOtherStateData%PositivePressure) - UB(1:2) = ubound(SrcOtherStateData%PositivePressure) + LB(1:2) = lbound(SrcOtherStateData%PositivePressure, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%PositivePressure, kind=B8Ki) if (.not. allocated(DstOtherStateData%PositivePressure)) then allocate(DstOtherStateData%PositivePressure(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2299,8 +2299,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure end if if (allocated(SrcOtherStateData%vortexOn)) then - LB(1:2) = lbound(SrcOtherStateData%vortexOn) - UB(1:2) = ubound(SrcOtherStateData%vortexOn) + LB(1:2) = lbound(SrcOtherStateData%vortexOn, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%vortexOn, kind=B8Ki) if (.not. allocated(DstOtherStateData%vortexOn)) then allocate(DstOtherStateData%vortexOn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2311,8 +2311,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn end if if (allocated(SrcOtherStateData%BelowThreshold)) then - LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) - UB(1:2) = ubound(SrcOtherStateData%BelowThreshold) + LB(1:2) = lbound(SrcOtherStateData%BelowThreshold, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%BelowThreshold, kind=B8Ki) if (.not. allocated(DstOtherStateData%BelowThreshold)) then allocate(DstOtherStateData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2323,8 +2323,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold end if if (allocated(SrcOtherStateData%activeL)) then - LB(1:2) = lbound(SrcOtherStateData%activeL) - UB(1:2) = ubound(SrcOtherStateData%activeL) + LB(1:2) = lbound(SrcOtherStateData%activeL, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%activeL, kind=B8Ki) if (.not. allocated(DstOtherStateData%activeL)) then allocate(DstOtherStateData%activeL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2335,8 +2335,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%activeL = SrcOtherStateData%activeL end if if (allocated(SrcOtherStateData%activeD)) then - LB(1:2) = lbound(SrcOtherStateData%activeD) - UB(1:2) = ubound(SrcOtherStateData%activeD) + LB(1:2) = lbound(SrcOtherStateData%activeD, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%activeD, kind=B8Ki) if (.not. allocated(DstOtherStateData%activeD)) then allocate(DstOtherStateData%activeD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2352,8 +2352,8 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(UA_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_DestroyOtherState' @@ -2377,14 +2377,14 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call UA_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(OtherStateData%xHistory) - UB(1:1) = ubound(OtherStateData%xHistory) + LB(1:1) = lbound(OtherStateData%xHistory, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xHistory, kind=B8Ki) do i1 = LB(1), UB(1) call UA_DestroyContState(OtherStateData%xHistory(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2416,82 +2416,82 @@ subroutine UA_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%FirstPass)) if (allocated(InData%FirstPass)) then - call RegPackBounds(Buf, 2, lbound(InData%FirstPass), ubound(InData%FirstPass)) + call RegPackBounds(Buf, 2, lbound(InData%FirstPass, kind=B8Ki), ubound(InData%FirstPass, kind=B8Ki)) call RegPack(Buf, InData%FirstPass) end if call RegPack(Buf, allocated(InData%sigma1)) if (allocated(InData%sigma1)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma1), ubound(InData%sigma1)) + call RegPackBounds(Buf, 2, lbound(InData%sigma1, kind=B8Ki), ubound(InData%sigma1, kind=B8Ki)) call RegPack(Buf, InData%sigma1) end if call RegPack(Buf, allocated(InData%sigma1c)) if (allocated(InData%sigma1c)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma1c), ubound(InData%sigma1c)) + call RegPackBounds(Buf, 2, lbound(InData%sigma1c, kind=B8Ki), ubound(InData%sigma1c, kind=B8Ki)) call RegPack(Buf, InData%sigma1c) end if call RegPack(Buf, allocated(InData%sigma1m)) if (allocated(InData%sigma1m)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma1m), ubound(InData%sigma1m)) + call RegPackBounds(Buf, 2, lbound(InData%sigma1m, kind=B8Ki), ubound(InData%sigma1m, kind=B8Ki)) call RegPack(Buf, InData%sigma1m) end if call RegPack(Buf, allocated(InData%sigma3)) if (allocated(InData%sigma3)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma3), ubound(InData%sigma3)) + call RegPackBounds(Buf, 2, lbound(InData%sigma3, kind=B8Ki), ubound(InData%sigma3, kind=B8Ki)) call RegPack(Buf, InData%sigma3) end if call RegPack(Buf, allocated(InData%n)) if (allocated(InData%n)) then - call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) + call RegPackBounds(Buf, 2, lbound(InData%n, kind=B8Ki), ubound(InData%n, kind=B8Ki)) call RegPack(Buf, InData%n) end if - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call UA_PackContState(Buf, InData%xdot(i1)) end do - LB(1:1) = lbound(InData%xHistory) - UB(1:1) = ubound(InData%xHistory) + LB(1:1) = lbound(InData%xHistory, kind=B8Ki) + UB(1:1) = ubound(InData%xHistory, kind=B8Ki) do i1 = LB(1), UB(1) call UA_PackContState(Buf, InData%xHistory(i1)) end do call RegPack(Buf, allocated(InData%t_vortexBegin)) if (allocated(InData%t_vortexBegin)) then - call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin), ubound(InData%t_vortexBegin)) + call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin, kind=B8Ki), ubound(InData%t_vortexBegin, kind=B8Ki)) call RegPack(Buf, InData%t_vortexBegin) end if call RegPack(Buf, allocated(InData%SignOfOmega)) if (allocated(InData%SignOfOmega)) then - call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega), ubound(InData%SignOfOmega)) + call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega, kind=B8Ki), ubound(InData%SignOfOmega, kind=B8Ki)) call RegPack(Buf, InData%SignOfOmega) end if call RegPack(Buf, allocated(InData%PositivePressure)) if (allocated(InData%PositivePressure)) then - call RegPackBounds(Buf, 2, lbound(InData%PositivePressure), ubound(InData%PositivePressure)) + call RegPackBounds(Buf, 2, lbound(InData%PositivePressure, kind=B8Ki), ubound(InData%PositivePressure, kind=B8Ki)) call RegPack(Buf, InData%PositivePressure) end if call RegPack(Buf, allocated(InData%vortexOn)) if (allocated(InData%vortexOn)) then - call RegPackBounds(Buf, 2, lbound(InData%vortexOn), ubound(InData%vortexOn)) + call RegPackBounds(Buf, 2, lbound(InData%vortexOn, kind=B8Ki), ubound(InData%vortexOn, kind=B8Ki)) call RegPack(Buf, InData%vortexOn) end if call RegPack(Buf, allocated(InData%BelowThreshold)) if (allocated(InData%BelowThreshold)) then - call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold), ubound(InData%BelowThreshold)) + call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold, kind=B8Ki), ubound(InData%BelowThreshold, kind=B8Ki)) call RegPack(Buf, InData%BelowThreshold) end if call RegPack(Buf, allocated(InData%activeL)) if (allocated(InData%activeL)) then - call RegPackBounds(Buf, 2, lbound(InData%activeL), ubound(InData%activeL)) + call RegPackBounds(Buf, 2, lbound(InData%activeL, kind=B8Ki), ubound(InData%activeL, kind=B8Ki)) call RegPack(Buf, InData%activeL) end if call RegPack(Buf, allocated(InData%activeD)) if (allocated(InData%activeD)) then - call RegPackBounds(Buf, 2, lbound(InData%activeD), ubound(InData%activeD)) + call RegPackBounds(Buf, 2, lbound(InData%activeD, kind=B8Ki), ubound(InData%activeD, kind=B8Ki)) call RegPack(Buf, InData%activeD) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2501,8 +2501,8 @@ subroutine UA_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOtherState' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2590,13 +2590,13 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end if - LB(1:1) = lbound(OutData%xdot) - UB(1:1) = ubound(OutData%xdot) + LB(1:1) = lbound(OutData%xdot, kind=B8Ki) + UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call UA_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do - LB(1:1) = lbound(OutData%xHistory) - UB(1:1) = ubound(OutData%xHistory) + LB(1:1) = lbound(OutData%xHistory, kind=B8Ki) + UB(1:1) = ubound(OutData%xHistory, kind=B8Ki) do i1 = LB(1), UB(1) call UA_UnpackContState(Buf, OutData%xHistory(i1)) ! xHistory end do @@ -2706,7 +2706,7 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyMisc' ErrStat = ErrID_None @@ -2715,8 +2715,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off if (allocated(SrcMiscData%TESF)) then - LB(1:2) = lbound(SrcMiscData%TESF) - UB(1:2) = ubound(SrcMiscData%TESF) + LB(1:2) = lbound(SrcMiscData%TESF, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%TESF, kind=B8Ki) if (.not. allocated(DstMiscData%TESF)) then allocate(DstMiscData%TESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2727,8 +2727,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TESF = SrcMiscData%TESF end if if (allocated(SrcMiscData%LESF)) then - LB(1:2) = lbound(SrcMiscData%LESF) - UB(1:2) = ubound(SrcMiscData%LESF) + LB(1:2) = lbound(SrcMiscData%LESF, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%LESF, kind=B8Ki) if (.not. allocated(DstMiscData%LESF)) then allocate(DstMiscData%LESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2739,8 +2739,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LESF = SrcMiscData%LESF end if if (allocated(SrcMiscData%VRTX)) then - LB(1:2) = lbound(SrcMiscData%VRTX) - UB(1:2) = ubound(SrcMiscData%VRTX) + LB(1:2) = lbound(SrcMiscData%VRTX, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%VRTX, kind=B8Ki) if (.not. allocated(DstMiscData%VRTX)) then allocate(DstMiscData%VRTX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2751,8 +2751,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%VRTX = SrcMiscData%VRTX end if if (allocated(SrcMiscData%T_Sh)) then - LB(1:2) = lbound(SrcMiscData%T_Sh) - UB(1:2) = ubound(SrcMiscData%T_Sh) + LB(1:2) = lbound(SrcMiscData%T_Sh, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%T_Sh, kind=B8Ki) if (.not. allocated(DstMiscData%T_Sh)) then allocate(DstMiscData%T_Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2763,8 +2763,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%T_Sh = SrcMiscData%T_Sh end if if (allocated(SrcMiscData%BEDSEP)) then - LB(1:2) = lbound(SrcMiscData%BEDSEP) - UB(1:2) = ubound(SrcMiscData%BEDSEP) + LB(1:2) = lbound(SrcMiscData%BEDSEP, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%BEDSEP, kind=B8Ki) if (.not. allocated(DstMiscData%BEDSEP)) then allocate(DstMiscData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2775,8 +2775,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BEDSEP = SrcMiscData%BEDSEP end if if (allocated(SrcMiscData%weight)) then - LB(1:2) = lbound(SrcMiscData%weight) - UB(1:2) = ubound(SrcMiscData%weight) + LB(1:2) = lbound(SrcMiscData%weight, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%weight, kind=B8Ki) if (.not. allocated(DstMiscData%weight)) then allocate(DstMiscData%weight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2825,32 +2825,32 @@ subroutine UA_PackMisc(Buf, Indata) call RegPack(Buf, InData%FirstWarn_UA_off) call RegPack(Buf, allocated(InData%TESF)) if (allocated(InData%TESF)) then - call RegPackBounds(Buf, 2, lbound(InData%TESF), ubound(InData%TESF)) + call RegPackBounds(Buf, 2, lbound(InData%TESF, kind=B8Ki), ubound(InData%TESF, kind=B8Ki)) call RegPack(Buf, InData%TESF) end if call RegPack(Buf, allocated(InData%LESF)) if (allocated(InData%LESF)) then - call RegPackBounds(Buf, 2, lbound(InData%LESF), ubound(InData%LESF)) + call RegPackBounds(Buf, 2, lbound(InData%LESF, kind=B8Ki), ubound(InData%LESF, kind=B8Ki)) call RegPack(Buf, InData%LESF) end if call RegPack(Buf, allocated(InData%VRTX)) if (allocated(InData%VRTX)) then - call RegPackBounds(Buf, 2, lbound(InData%VRTX), ubound(InData%VRTX)) + call RegPackBounds(Buf, 2, lbound(InData%VRTX, kind=B8Ki), ubound(InData%VRTX, kind=B8Ki)) call RegPack(Buf, InData%VRTX) end if call RegPack(Buf, allocated(InData%T_Sh)) if (allocated(InData%T_Sh)) then - call RegPackBounds(Buf, 2, lbound(InData%T_Sh), ubound(InData%T_Sh)) + call RegPackBounds(Buf, 2, lbound(InData%T_Sh, kind=B8Ki), ubound(InData%T_Sh, kind=B8Ki)) call RegPack(Buf, InData%T_Sh) end if call RegPack(Buf, allocated(InData%BEDSEP)) if (allocated(InData%BEDSEP)) then - call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) + call RegPackBounds(Buf, 2, lbound(InData%BEDSEP, kind=B8Ki), ubound(InData%BEDSEP, kind=B8Ki)) call RegPack(Buf, InData%BEDSEP) end if call RegPack(Buf, allocated(InData%weight)) if (allocated(InData%weight)) then - call RegPackBounds(Buf, 2, lbound(InData%weight), ubound(InData%weight)) + call RegPackBounds(Buf, 2, lbound(InData%weight, kind=B8Ki), ubound(InData%weight, kind=B8Ki)) call RegPack(Buf, InData%weight) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2860,7 +2860,7 @@ subroutine UA_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackMisc' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2962,15 +2962,15 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%dt = SrcParamData%dt if (allocated(SrcParamData%c)) then - LB(1:2) = lbound(SrcParamData%c) - UB(1:2) = ubound(SrcParamData%c) + LB(1:2) = lbound(SrcParamData%c, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%c, kind=B8Ki) if (.not. allocated(DstParamData%c)) then allocate(DstParamData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2994,8 +2994,8 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ShedEffect = SrcParamData%ShedEffect DstParamData%lin_nx = SrcParamData%lin_nx if (allocated(SrcParamData%UA_off_forGood)) then - LB(1:2) = lbound(SrcParamData%UA_off_forGood) - UB(1:2) = ubound(SrcParamData%UA_off_forGood) + LB(1:2) = lbound(SrcParamData%UA_off_forGood, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%UA_off_forGood, kind=B8Ki) if (.not. allocated(DstParamData%UA_off_forGood)) then allocate(DstParamData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3006,8 +3006,8 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood end if if (allocated(SrcParamData%lin_xIndx)) then - LB(1:2) = lbound(SrcParamData%lin_xIndx) - UB(1:2) = ubound(SrcParamData%lin_xIndx) + LB(1:2) = lbound(SrcParamData%lin_xIndx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%lin_xIndx, kind=B8Ki) if (.not. allocated(DstParamData%lin_xIndx)) then allocate(DstParamData%lin_xIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3046,7 +3046,7 @@ subroutine UA_PackParam(Buf, Indata) call RegPack(Buf, InData%dt) call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then - call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) + call RegPackBounds(Buf, 2, lbound(InData%c, kind=B8Ki), ubound(InData%c, kind=B8Ki)) call RegPack(Buf, InData%c) end if call RegPack(Buf, InData%numBlades) @@ -3064,12 +3064,12 @@ subroutine UA_PackParam(Buf, Indata) call RegPack(Buf, InData%lin_nx) call RegPack(Buf, allocated(InData%UA_off_forGood)) if (allocated(InData%UA_off_forGood)) then - call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood), ubound(InData%UA_off_forGood)) + call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood, kind=B8Ki), ubound(InData%UA_off_forGood, kind=B8Ki)) call RegPack(Buf, InData%UA_off_forGood) end if call RegPack(Buf, allocated(InData%lin_xIndx)) if (allocated(InData%lin_xIndx)) then - call RegPackBounds(Buf, 2, lbound(InData%lin_xIndx), ubound(InData%lin_xIndx)) + call RegPackBounds(Buf, 2, lbound(InData%lin_xIndx, kind=B8Ki), ubound(InData%lin_xIndx, kind=B8Ki)) call RegPack(Buf, InData%lin_xIndx) end if call RegPack(Buf, InData%dx) @@ -3080,7 +3080,7 @@ subroutine UA_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3223,7 +3223,7 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyOutput' ErrStat = ErrID_None @@ -3234,8 +3234,8 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Cl = SrcOutputData%Cl DstOutputData%Cd = SrcOutputData%Cd if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3271,7 +3271,7 @@ subroutine UA_PackOutput(Buf, Indata) call RegPack(Buf, InData%Cd) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3281,7 +3281,7 @@ subroutine UA_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 291c7bdd81..add62bbcfe 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -528,16 +528,16 @@ subroutine AD14_CopyAeroConfig(SrcAeroConfigData, DstAeroConfigData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_CopyAeroConfig' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcAeroConfigData%Blade)) then - LB(1:1) = lbound(SrcAeroConfigData%Blade) - UB(1:1) = ubound(SrcAeroConfigData%Blade) + LB(1:1) = lbound(SrcAeroConfigData%Blade, kind=B8Ki) + UB(1:1) = ubound(SrcAeroConfigData%Blade, kind=B8Ki) if (.not. allocated(DstAeroConfigData%Blade)) then allocate(DstAeroConfigData%Blade(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -579,16 +579,16 @@ subroutine AD14_DestroyAeroConfig(AeroConfigData, ErrStat, ErrMsg) type(AeroConfig), intent(inout) :: AeroConfigData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_DestroyAeroConfig' ErrStat = ErrID_None ErrMsg = '' if (allocated(AeroConfigData%Blade)) then - LB(1:1) = lbound(AeroConfigData%Blade) - UB(1:1) = ubound(AeroConfigData%Blade) + LB(1:1) = lbound(AeroConfigData%Blade, kind=B8Ki) + UB(1:1) = ubound(AeroConfigData%Blade, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_DestroyMarker(AeroConfigData%Blade(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -615,14 +615,14 @@ subroutine AD14_PackAeroConfig(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AeroConfig), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackAeroConfig' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Blade)) if (allocated(InData%Blade)) then - call RegPackBounds(Buf, 1, lbound(InData%Blade), ubound(InData%Blade)) - LB(1:1) = lbound(InData%Blade) - UB(1:1) = ubound(InData%Blade) + call RegPackBounds(Buf, 1, lbound(InData%Blade, kind=B8Ki), ubound(InData%Blade, kind=B8Ki)) + LB(1:1) = lbound(InData%Blade, kind=B8Ki) + UB(1:1) = ubound(InData%Blade, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_PackMarker(Buf, InData%Blade(i1)) end do @@ -642,8 +642,8 @@ subroutine AD14_UnPackAeroConfig(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AeroConfig), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackAeroConfig' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -679,14 +679,14 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyAirFoil' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcAirFoilData%AL)) then - LB(1:2) = lbound(SrcAirFoilData%AL) - UB(1:2) = ubound(SrcAirFoilData%AL) + LB(1:2) = lbound(SrcAirFoilData%AL, kind=B8Ki) + UB(1:2) = ubound(SrcAirFoilData%AL, kind=B8Ki) if (.not. allocated(DstAirFoilData%AL)) then allocate(DstAirFoilData%AL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -697,8 +697,8 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E DstAirFoilData%AL = SrcAirFoilData%AL end if if (allocated(SrcAirFoilData%CD)) then - LB(1:3) = lbound(SrcAirFoilData%CD) - UB(1:3) = ubound(SrcAirFoilData%CD) + LB(1:3) = lbound(SrcAirFoilData%CD, kind=B8Ki) + UB(1:3) = ubound(SrcAirFoilData%CD, kind=B8Ki) if (.not. allocated(DstAirFoilData%CD)) then allocate(DstAirFoilData%CD(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -709,8 +709,8 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E DstAirFoilData%CD = SrcAirFoilData%CD end if if (allocated(SrcAirFoilData%CL)) then - LB(1:3) = lbound(SrcAirFoilData%CL) - UB(1:3) = ubound(SrcAirFoilData%CL) + LB(1:3) = lbound(SrcAirFoilData%CL, kind=B8Ki) + UB(1:3) = ubound(SrcAirFoilData%CL, kind=B8Ki) if (.not. allocated(DstAirFoilData%CL)) then allocate(DstAirFoilData%CL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -721,8 +721,8 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E DstAirFoilData%CL = SrcAirFoilData%CL end if if (allocated(SrcAirFoilData%CM)) then - LB(1:3) = lbound(SrcAirFoilData%CM) - UB(1:3) = ubound(SrcAirFoilData%CM) + LB(1:3) = lbound(SrcAirFoilData%CM, kind=B8Ki) + UB(1:3) = ubound(SrcAirFoilData%CM, kind=B8Ki) if (.not. allocated(DstAirFoilData%CM)) then allocate(DstAirFoilData%CM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -764,22 +764,22 @@ subroutine AD14_PackAirFoil(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AL)) if (allocated(InData%AL)) then - call RegPackBounds(Buf, 2, lbound(InData%AL), ubound(InData%AL)) + call RegPackBounds(Buf, 2, lbound(InData%AL, kind=B8Ki), ubound(InData%AL, kind=B8Ki)) call RegPack(Buf, InData%AL) end if call RegPack(Buf, allocated(InData%CD)) if (allocated(InData%CD)) then - call RegPackBounds(Buf, 3, lbound(InData%CD), ubound(InData%CD)) + call RegPackBounds(Buf, 3, lbound(InData%CD, kind=B8Ki), ubound(InData%CD, kind=B8Ki)) call RegPack(Buf, InData%CD) end if call RegPack(Buf, allocated(InData%CL)) if (allocated(InData%CL)) then - call RegPackBounds(Buf, 3, lbound(InData%CL), ubound(InData%CL)) + call RegPackBounds(Buf, 3, lbound(InData%CL, kind=B8Ki), ubound(InData%CL, kind=B8Ki)) call RegPack(Buf, InData%CL) end if call RegPack(Buf, allocated(InData%CM)) if (allocated(InData%CM)) then - call RegPackBounds(Buf, 3, lbound(InData%CM), ubound(InData%CM)) + call RegPackBounds(Buf, 3, lbound(InData%CM, kind=B8Ki), ubound(InData%CM, kind=B8Ki)) call RegPack(Buf, InData%CM) end if call RegPack(Buf, InData%PMC) @@ -791,7 +791,7 @@ subroutine AD14_UnPackAirFoil(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AirFoil), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackAirFoil' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -863,15 +863,15 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyAirFoilParms' ErrStat = ErrID_None ErrMsg = '' DstAirFoilParmsData%MaxTable = SrcAirFoilParmsData%MaxTable if (allocated(SrcAirFoilParmsData%NTables)) then - LB(1:1) = lbound(SrcAirFoilParmsData%NTables) - UB(1:1) = ubound(SrcAirFoilParmsData%NTables) + LB(1:1) = lbound(SrcAirFoilParmsData%NTables, kind=B8Ki) + UB(1:1) = ubound(SrcAirFoilParmsData%NTables, kind=B8Ki) if (.not. allocated(DstAirFoilParmsData%NTables)) then allocate(DstAirFoilParmsData%NTables(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -882,8 +882,8 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables end if if (allocated(SrcAirFoilParmsData%NLift)) then - LB(1:1) = lbound(SrcAirFoilParmsData%NLift) - UB(1:1) = ubound(SrcAirFoilParmsData%NLift) + LB(1:1) = lbound(SrcAirFoilParmsData%NLift, kind=B8Ki) + UB(1:1) = ubound(SrcAirFoilParmsData%NLift, kind=B8Ki) if (.not. allocated(DstAirFoilParmsData%NLift)) then allocate(DstAirFoilParmsData%NLift(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -896,8 +896,8 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil if (allocated(SrcAirFoilParmsData%NFoil)) then - LB(1:1) = lbound(SrcAirFoilParmsData%NFoil) - UB(1:1) = ubound(SrcAirFoilParmsData%NFoil) + LB(1:1) = lbound(SrcAirFoilParmsData%NFoil, kind=B8Ki) + UB(1:1) = ubound(SrcAirFoilParmsData%NFoil, kind=B8Ki) if (.not. allocated(DstAirFoilParmsData%NFoil)) then allocate(DstAirFoilParmsData%NFoil(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -908,8 +908,8 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil end if if (allocated(SrcAirFoilParmsData%MulTabMet)) then - LB(1:2) = lbound(SrcAirFoilParmsData%MulTabMet) - UB(1:2) = ubound(SrcAirFoilParmsData%MulTabMet) + LB(1:2) = lbound(SrcAirFoilParmsData%MulTabMet, kind=B8Ki) + UB(1:2) = ubound(SrcAirFoilParmsData%MulTabMet, kind=B8Ki) if (.not. allocated(DstAirFoilParmsData%MulTabMet)) then allocate(DstAirFoilParmsData%MulTabMet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -920,8 +920,8 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet end if if (allocated(SrcAirFoilParmsData%FoilNm)) then - LB(1:1) = lbound(SrcAirFoilParmsData%FoilNm) - UB(1:1) = ubound(SrcAirFoilParmsData%FoilNm) + LB(1:1) = lbound(SrcAirFoilParmsData%FoilNm, kind=B8Ki) + UB(1:1) = ubound(SrcAirFoilParmsData%FoilNm, kind=B8Ki) if (.not. allocated(DstAirFoilParmsData%FoilNm)) then allocate(DstAirFoilParmsData%FoilNm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -965,29 +965,29 @@ subroutine AD14_PackAirFoilParms(Buf, Indata) call RegPack(Buf, InData%MaxTable) call RegPack(Buf, allocated(InData%NTables)) if (allocated(InData%NTables)) then - call RegPackBounds(Buf, 1, lbound(InData%NTables), ubound(InData%NTables)) + call RegPackBounds(Buf, 1, lbound(InData%NTables, kind=B8Ki), ubound(InData%NTables, kind=B8Ki)) call RegPack(Buf, InData%NTables) end if call RegPack(Buf, allocated(InData%NLift)) if (allocated(InData%NLift)) then - call RegPackBounds(Buf, 1, lbound(InData%NLift), ubound(InData%NLift)) + call RegPackBounds(Buf, 1, lbound(InData%NLift, kind=B8Ki), ubound(InData%NLift, kind=B8Ki)) call RegPack(Buf, InData%NLift) end if call RegPack(Buf, InData%NumCL) call RegPack(Buf, InData%NumFoil) call RegPack(Buf, allocated(InData%NFoil)) if (allocated(InData%NFoil)) then - call RegPackBounds(Buf, 1, lbound(InData%NFoil), ubound(InData%NFoil)) + call RegPackBounds(Buf, 1, lbound(InData%NFoil, kind=B8Ki), ubound(InData%NFoil, kind=B8Ki)) call RegPack(Buf, InData%NFoil) end if call RegPack(Buf, allocated(InData%MulTabMet)) if (allocated(InData%MulTabMet)) then - call RegPackBounds(Buf, 2, lbound(InData%MulTabMet), ubound(InData%MulTabMet)) + call RegPackBounds(Buf, 2, lbound(InData%MulTabMet, kind=B8Ki), ubound(InData%MulTabMet, kind=B8Ki)) call RegPack(Buf, InData%MulTabMet) end if call RegPack(Buf, allocated(InData%FoilNm)) if (allocated(InData%FoilNm)) then - call RegPackBounds(Buf, 1, lbound(InData%FoilNm), ubound(InData%FoilNm)) + call RegPackBounds(Buf, 1, lbound(InData%FoilNm, kind=B8Ki), ubound(InData%FoilNm, kind=B8Ki)) call RegPack(Buf, InData%FoilNm) end if if (RegCheckErr(Buf, RoutineName)) return @@ -997,7 +997,7 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AirFoilParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackAirFoilParms' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1085,14 +1085,14 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyBeddoes' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBeddoesData%ADOT)) then - LB(1:2) = lbound(SrcBeddoesData%ADOT) - UB(1:2) = ubound(SrcBeddoesData%ADOT) + LB(1:2) = lbound(SrcBeddoesData%ADOT, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%ADOT, kind=B8Ki) if (.not. allocated(DstBeddoesData%ADOT)) then allocate(DstBeddoesData%ADOT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1103,8 +1103,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%ADOT = SrcBeddoesData%ADOT end if if (allocated(SrcBeddoesData%ADOT1)) then - LB(1:2) = lbound(SrcBeddoesData%ADOT1) - UB(1:2) = ubound(SrcBeddoesData%ADOT1) + LB(1:2) = lbound(SrcBeddoesData%ADOT1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%ADOT1, kind=B8Ki) if (.not. allocated(DstBeddoesData%ADOT1)) then allocate(DstBeddoesData%ADOT1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1115,8 +1115,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 end if if (allocated(SrcBeddoesData%AFE)) then - LB(1:2) = lbound(SrcBeddoesData%AFE) - UB(1:2) = ubound(SrcBeddoesData%AFE) + LB(1:2) = lbound(SrcBeddoesData%AFE, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%AFE, kind=B8Ki) if (.not. allocated(DstBeddoesData%AFE)) then allocate(DstBeddoesData%AFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1127,8 +1127,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%AFE = SrcBeddoesData%AFE end if if (allocated(SrcBeddoesData%AFE1)) then - LB(1:2) = lbound(SrcBeddoesData%AFE1) - UB(1:2) = ubound(SrcBeddoesData%AFE1) + LB(1:2) = lbound(SrcBeddoesData%AFE1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%AFE1, kind=B8Ki) if (.not. allocated(DstBeddoesData%AFE1)) then allocate(DstBeddoesData%AFE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1140,8 +1140,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if DstBeddoesData%AN = SrcBeddoesData%AN if (allocated(SrcBeddoesData%ANE)) then - LB(1:2) = lbound(SrcBeddoesData%ANE) - UB(1:2) = ubound(SrcBeddoesData%ANE) + LB(1:2) = lbound(SrcBeddoesData%ANE, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%ANE, kind=B8Ki) if (.not. allocated(DstBeddoesData%ANE)) then allocate(DstBeddoesData%ANE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1152,8 +1152,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%ANE = SrcBeddoesData%ANE end if if (allocated(SrcBeddoesData%ANE1)) then - LB(1:2) = lbound(SrcBeddoesData%ANE1) - UB(1:2) = ubound(SrcBeddoesData%ANE1) + LB(1:2) = lbound(SrcBeddoesData%ANE1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%ANE1, kind=B8Ki) if (.not. allocated(DstBeddoesData%ANE1)) then allocate(DstBeddoesData%ANE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1164,8 +1164,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 end if if (allocated(SrcBeddoesData%AOD)) then - LB(1:2) = lbound(SrcBeddoesData%AOD) - UB(1:2) = ubound(SrcBeddoesData%AOD) + LB(1:2) = lbound(SrcBeddoesData%AOD, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%AOD, kind=B8Ki) if (.not. allocated(DstBeddoesData%AOD)) then allocate(DstBeddoesData%AOD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1176,8 +1176,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%AOD = SrcBeddoesData%AOD end if if (allocated(SrcBeddoesData%AOL)) then - LB(1:2) = lbound(SrcBeddoesData%AOL) - UB(1:2) = ubound(SrcBeddoesData%AOL) + LB(1:2) = lbound(SrcBeddoesData%AOL, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%AOL, kind=B8Ki) if (.not. allocated(DstBeddoesData%AOL)) then allocate(DstBeddoesData%AOL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1188,8 +1188,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%AOL = SrcBeddoesData%AOL end if if (allocated(SrcBeddoesData%BEDSEP)) then - LB(1:2) = lbound(SrcBeddoesData%BEDSEP) - UB(1:2) = ubound(SrcBeddoesData%BEDSEP) + LB(1:2) = lbound(SrcBeddoesData%BEDSEP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%BEDSEP, kind=B8Ki) if (.not. allocated(DstBeddoesData%BEDSEP)) then allocate(DstBeddoesData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1200,8 +1200,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP end if if (allocated(SrcBeddoesData%OLDSEP)) then - LB(1:2) = lbound(SrcBeddoesData%OLDSEP) - UB(1:2) = ubound(SrcBeddoesData%OLDSEP) + LB(1:2) = lbound(SrcBeddoesData%OLDSEP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDSEP, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDSEP)) then allocate(DstBeddoesData%OLDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1213,8 +1213,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if DstBeddoesData%CC = SrcBeddoesData%CC if (allocated(SrcBeddoesData%CDO)) then - LB(1:2) = lbound(SrcBeddoesData%CDO) - UB(1:2) = ubound(SrcBeddoesData%CDO) + LB(1:2) = lbound(SrcBeddoesData%CDO, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CDO, kind=B8Ki) if (.not. allocated(DstBeddoesData%CDO)) then allocate(DstBeddoesData%CDO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,8 +1228,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CMQ = SrcBeddoesData%CMQ DstBeddoesData%CN = SrcBeddoesData%CN if (allocated(SrcBeddoesData%CNA)) then - LB(1:2) = lbound(SrcBeddoesData%CNA) - UB(1:2) = ubound(SrcBeddoesData%CNA) + LB(1:2) = lbound(SrcBeddoesData%CNA, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNA, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNA)) then allocate(DstBeddoesData%CNA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1242,8 +1242,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNCP = SrcBeddoesData%CNCP DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ if (allocated(SrcBeddoesData%CNP)) then - LB(1:2) = lbound(SrcBeddoesData%CNP) - UB(1:2) = ubound(SrcBeddoesData%CNP) + LB(1:2) = lbound(SrcBeddoesData%CNP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNP, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNP)) then allocate(DstBeddoesData%CNP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1254,8 +1254,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNP = SrcBeddoesData%CNP end if if (allocated(SrcBeddoesData%CNP1)) then - LB(1:2) = lbound(SrcBeddoesData%CNP1) - UB(1:2) = ubound(SrcBeddoesData%CNP1) + LB(1:2) = lbound(SrcBeddoesData%CNP1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNP1, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNP1)) then allocate(DstBeddoesData%CNP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1266,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 end if if (allocated(SrcBeddoesData%CNPD)) then - LB(1:2) = lbound(SrcBeddoesData%CNPD) - UB(1:2) = ubound(SrcBeddoesData%CNPD) + LB(1:2) = lbound(SrcBeddoesData%CNPD, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNPD, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNPD)) then allocate(DstBeddoesData%CNPD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1278,8 +1278,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNPD = SrcBeddoesData%CNPD end if if (allocated(SrcBeddoesData%CNPD1)) then - LB(1:2) = lbound(SrcBeddoesData%CNPD1) - UB(1:2) = ubound(SrcBeddoesData%CNPD1) + LB(1:2) = lbound(SrcBeddoesData%CNPD1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNPD1, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNPD1)) then allocate(DstBeddoesData%CNPD1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1290,8 +1290,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 end if if (allocated(SrcBeddoesData%CNPOT)) then - LB(1:2) = lbound(SrcBeddoesData%CNPOT) - UB(1:2) = ubound(SrcBeddoesData%CNPOT) + LB(1:2) = lbound(SrcBeddoesData%CNPOT, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNPOT, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNPOT)) then allocate(DstBeddoesData%CNPOT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1302,8 +1302,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT end if if (allocated(SrcBeddoesData%CNPOT1)) then - LB(1:2) = lbound(SrcBeddoesData%CNPOT1) - UB(1:2) = ubound(SrcBeddoesData%CNPOT1) + LB(1:2) = lbound(SrcBeddoesData%CNPOT1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNPOT1, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNPOT1)) then allocate(DstBeddoesData%CNPOT1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1314,8 +1314,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 end if if (allocated(SrcBeddoesData%CNS)) then - LB(1:2) = lbound(SrcBeddoesData%CNS) - UB(1:2) = ubound(SrcBeddoesData%CNS) + LB(1:2) = lbound(SrcBeddoesData%CNS, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNS, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNS)) then allocate(DstBeddoesData%CNS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1326,8 +1326,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNS = SrcBeddoesData%CNS end if if (allocated(SrcBeddoesData%CNSL)) then - LB(1:2) = lbound(SrcBeddoesData%CNSL) - UB(1:2) = ubound(SrcBeddoesData%CNSL) + LB(1:2) = lbound(SrcBeddoesData%CNSL, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNSL, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNSL)) then allocate(DstBeddoesData%CNSL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1338,8 +1338,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNSL = SrcBeddoesData%CNSL end if if (allocated(SrcBeddoesData%CNV)) then - LB(1:2) = lbound(SrcBeddoesData%CNV) - UB(1:2) = ubound(SrcBeddoesData%CNV) + LB(1:2) = lbound(SrcBeddoesData%CNV, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CNV, kind=B8Ki) if (.not. allocated(DstBeddoesData%CNV)) then allocate(DstBeddoesData%CNV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1350,8 +1350,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CNV = SrcBeddoesData%CNV end if if (allocated(SrcBeddoesData%CVN)) then - LB(1:2) = lbound(SrcBeddoesData%CVN) - UB(1:2) = ubound(SrcBeddoesData%CVN) + LB(1:2) = lbound(SrcBeddoesData%CVN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CVN, kind=B8Ki) if (.not. allocated(DstBeddoesData%CVN)) then allocate(DstBeddoesData%CVN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1362,8 +1362,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CVN = SrcBeddoesData%CVN end if if (allocated(SrcBeddoesData%CVN1)) then - LB(1:2) = lbound(SrcBeddoesData%CVN1) - UB(1:2) = ubound(SrcBeddoesData%CVN1) + LB(1:2) = lbound(SrcBeddoesData%CVN1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%CVN1, kind=B8Ki) if (.not. allocated(DstBeddoesData%CVN1)) then allocate(DstBeddoesData%CVN1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1374,8 +1374,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 end if if (allocated(SrcBeddoesData%DF)) then - LB(1:2) = lbound(SrcBeddoesData%DF) - UB(1:2) = ubound(SrcBeddoesData%DF) + LB(1:2) = lbound(SrcBeddoesData%DF, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DF, kind=B8Ki) if (.not. allocated(DstBeddoesData%DF)) then allocate(DstBeddoesData%DF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1386,8 +1386,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DF = SrcBeddoesData%DF end if if (allocated(SrcBeddoesData%DFAFE)) then - LB(1:2) = lbound(SrcBeddoesData%DFAFE) - UB(1:2) = ubound(SrcBeddoesData%DFAFE) + LB(1:2) = lbound(SrcBeddoesData%DFAFE, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DFAFE, kind=B8Ki) if (.not. allocated(DstBeddoesData%DFAFE)) then allocate(DstBeddoesData%DFAFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1398,8 +1398,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE end if if (allocated(SrcBeddoesData%DFAFE1)) then - LB(1:2) = lbound(SrcBeddoesData%DFAFE1) - UB(1:2) = ubound(SrcBeddoesData%DFAFE1) + LB(1:2) = lbound(SrcBeddoesData%DFAFE1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DFAFE1, kind=B8Ki) if (.not. allocated(DstBeddoesData%DFAFE1)) then allocate(DstBeddoesData%DFAFE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1410,8 +1410,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 end if if (allocated(SrcBeddoesData%DFC)) then - LB(1:2) = lbound(SrcBeddoesData%DFC) - UB(1:2) = ubound(SrcBeddoesData%DFC) + LB(1:2) = lbound(SrcBeddoesData%DFC, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DFC, kind=B8Ki) if (.not. allocated(DstBeddoesData%DFC)) then allocate(DstBeddoesData%DFC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1422,8 +1422,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DFC = SrcBeddoesData%DFC end if if (allocated(SrcBeddoesData%DN)) then - LB(1:2) = lbound(SrcBeddoesData%DN) - UB(1:2) = ubound(SrcBeddoesData%DN) + LB(1:2) = lbound(SrcBeddoesData%DN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DN, kind=B8Ki) if (.not. allocated(DstBeddoesData%DN)) then allocate(DstBeddoesData%DN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1434,8 +1434,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DN = SrcBeddoesData%DN end if if (allocated(SrcBeddoesData%DPP)) then - LB(1:2) = lbound(SrcBeddoesData%DPP) - UB(1:2) = ubound(SrcBeddoesData%DPP) + LB(1:2) = lbound(SrcBeddoesData%DPP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DPP, kind=B8Ki) if (.not. allocated(DstBeddoesData%DPP)) then allocate(DstBeddoesData%DPP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1446,8 +1446,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DPP = SrcBeddoesData%DPP end if if (allocated(SrcBeddoesData%DQ)) then - LB(1:2) = lbound(SrcBeddoesData%DQ) - UB(1:2) = ubound(SrcBeddoesData%DQ) + LB(1:2) = lbound(SrcBeddoesData%DQ, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DQ, kind=B8Ki) if (.not. allocated(DstBeddoesData%DQ)) then allocate(DstBeddoesData%DQ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1458,8 +1458,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DQ = SrcBeddoesData%DQ end if if (allocated(SrcBeddoesData%DQP)) then - LB(1:2) = lbound(SrcBeddoesData%DQP) - UB(1:2) = ubound(SrcBeddoesData%DQP) + LB(1:2) = lbound(SrcBeddoesData%DQP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DQP, kind=B8Ki) if (.not. allocated(DstBeddoesData%DQP)) then allocate(DstBeddoesData%DQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1470,8 +1470,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%DQP = SrcBeddoesData%DQP end if if (allocated(SrcBeddoesData%DQP1)) then - LB(1:2) = lbound(SrcBeddoesData%DQP1) - UB(1:2) = ubound(SrcBeddoesData%DQP1) + LB(1:2) = lbound(SrcBeddoesData%DQP1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%DQP1, kind=B8Ki) if (.not. allocated(DstBeddoesData%DQP1)) then allocate(DstBeddoesData%DQP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1486,8 +1486,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FP = SrcBeddoesData%FP DstBeddoesData%FPC = SrcBeddoesData%FPC if (allocated(SrcBeddoesData%FSP)) then - LB(1:2) = lbound(SrcBeddoesData%FSP) - UB(1:2) = ubound(SrcBeddoesData%FSP) + LB(1:2) = lbound(SrcBeddoesData%FSP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%FSP, kind=B8Ki) if (.not. allocated(DstBeddoesData%FSP)) then allocate(DstBeddoesData%FSP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1498,8 +1498,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FSP = SrcBeddoesData%FSP end if if (allocated(SrcBeddoesData%FSP1)) then - LB(1:2) = lbound(SrcBeddoesData%FSP1) - UB(1:2) = ubound(SrcBeddoesData%FSP1) + LB(1:2) = lbound(SrcBeddoesData%FSP1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%FSP1, kind=B8Ki) if (.not. allocated(DstBeddoesData%FSP1)) then allocate(DstBeddoesData%FSP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1510,8 +1510,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 end if if (allocated(SrcBeddoesData%FSPC)) then - LB(1:2) = lbound(SrcBeddoesData%FSPC) - UB(1:2) = ubound(SrcBeddoesData%FSPC) + LB(1:2) = lbound(SrcBeddoesData%FSPC, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%FSPC, kind=B8Ki) if (.not. allocated(DstBeddoesData%FSPC)) then allocate(DstBeddoesData%FSPC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1522,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FSPC = SrcBeddoesData%FSPC end if if (allocated(SrcBeddoesData%FSPC1)) then - LB(1:2) = lbound(SrcBeddoesData%FSPC1) - UB(1:2) = ubound(SrcBeddoesData%FSPC1) + LB(1:2) = lbound(SrcBeddoesData%FSPC1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%FSPC1, kind=B8Ki) if (.not. allocated(DstBeddoesData%FSPC1)) then allocate(DstBeddoesData%FSPC1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1534,8 +1534,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 end if if (allocated(SrcBeddoesData%FTB)) then - LB(1:3) = lbound(SrcBeddoesData%FTB) - UB(1:3) = ubound(SrcBeddoesData%FTB) + LB(1:3) = lbound(SrcBeddoesData%FTB, kind=B8Ki) + UB(1:3) = ubound(SrcBeddoesData%FTB, kind=B8Ki) if (.not. allocated(DstBeddoesData%FTB)) then allocate(DstBeddoesData%FTB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1546,8 +1546,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FTB = SrcBeddoesData%FTB end if if (allocated(SrcBeddoesData%FTBC)) then - LB(1:3) = lbound(SrcBeddoesData%FTBC) - UB(1:3) = ubound(SrcBeddoesData%FTBC) + LB(1:3) = lbound(SrcBeddoesData%FTBC, kind=B8Ki) + UB(1:3) = ubound(SrcBeddoesData%FTBC, kind=B8Ki) if (.not. allocated(DstBeddoesData%FTBC)) then allocate(DstBeddoesData%FTBC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1558,8 +1558,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%FTBC = SrcBeddoesData%FTBC end if if (allocated(SrcBeddoesData%OLDCNV)) then - LB(1:2) = lbound(SrcBeddoesData%OLDCNV) - UB(1:2) = ubound(SrcBeddoesData%OLDCNV) + LB(1:2) = lbound(SrcBeddoesData%OLDCNV, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDCNV, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDCNV)) then allocate(DstBeddoesData%OLDCNV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1570,8 +1570,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV end if if (allocated(SrcBeddoesData%OLDDF)) then - LB(1:2) = lbound(SrcBeddoesData%OLDDF) - UB(1:2) = ubound(SrcBeddoesData%OLDDF) + LB(1:2) = lbound(SrcBeddoesData%OLDDF, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDDF, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDDF)) then allocate(DstBeddoesData%OLDDF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1582,8 +1582,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF end if if (allocated(SrcBeddoesData%OLDDFC)) then - LB(1:2) = lbound(SrcBeddoesData%OLDDFC) - UB(1:2) = ubound(SrcBeddoesData%OLDDFC) + LB(1:2) = lbound(SrcBeddoesData%OLDDFC, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDDFC, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDDFC)) then allocate(DstBeddoesData%OLDDFC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1594,8 +1594,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC end if if (allocated(SrcBeddoesData%OLDDN)) then - LB(1:2) = lbound(SrcBeddoesData%OLDDN) - UB(1:2) = ubound(SrcBeddoesData%OLDDN) + LB(1:2) = lbound(SrcBeddoesData%OLDDN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDDN, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDDN)) then allocate(DstBeddoesData%OLDDN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1606,8 +1606,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN end if if (allocated(SrcBeddoesData%OLDDPP)) then - LB(1:2) = lbound(SrcBeddoesData%OLDDPP) - UB(1:2) = ubound(SrcBeddoesData%OLDDPP) + LB(1:2) = lbound(SrcBeddoesData%OLDDPP, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDDPP, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDDPP)) then allocate(DstBeddoesData%OLDDPP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1618,8 +1618,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP end if if (allocated(SrcBeddoesData%OLDDQ)) then - LB(1:2) = lbound(SrcBeddoesData%OLDDQ) - UB(1:2) = ubound(SrcBeddoesData%OLDDQ) + LB(1:2) = lbound(SrcBeddoesData%OLDDQ, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDDQ, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDDQ)) then allocate(DstBeddoesData%OLDDQ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1630,8 +1630,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ end if if (allocated(SrcBeddoesData%OLDTAU)) then - LB(1:2) = lbound(SrcBeddoesData%OLDTAU) - UB(1:2) = ubound(SrcBeddoesData%OLDTAU) + LB(1:2) = lbound(SrcBeddoesData%OLDTAU, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDTAU, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDTAU)) then allocate(DstBeddoesData%OLDTAU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1642,8 +1642,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU end if if (allocated(SrcBeddoesData%OLDXN)) then - LB(1:2) = lbound(SrcBeddoesData%OLDXN) - UB(1:2) = ubound(SrcBeddoesData%OLDXN) + LB(1:2) = lbound(SrcBeddoesData%OLDXN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDXN, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDXN)) then allocate(DstBeddoesData%OLDXN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1654,8 +1654,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN end if if (allocated(SrcBeddoesData%OLDYN)) then - LB(1:2) = lbound(SrcBeddoesData%OLDYN) - UB(1:2) = ubound(SrcBeddoesData%OLDYN) + LB(1:2) = lbound(SrcBeddoesData%OLDYN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%OLDYN, kind=B8Ki) if (.not. allocated(DstBeddoesData%OLDYN)) then allocate(DstBeddoesData%OLDYN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1666,8 +1666,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN end if if (allocated(SrcBeddoesData%QX)) then - LB(1:2) = lbound(SrcBeddoesData%QX) - UB(1:2) = ubound(SrcBeddoesData%QX) + LB(1:2) = lbound(SrcBeddoesData%QX, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%QX, kind=B8Ki) if (.not. allocated(DstBeddoesData%QX)) then allocate(DstBeddoesData%QX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1678,8 +1678,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%QX = SrcBeddoesData%QX end if if (allocated(SrcBeddoesData%QX1)) then - LB(1:2) = lbound(SrcBeddoesData%QX1) - UB(1:2) = ubound(SrcBeddoesData%QX1) + LB(1:2) = lbound(SrcBeddoesData%QX1, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%QX1, kind=B8Ki) if (.not. allocated(DstBeddoesData%QX1)) then allocate(DstBeddoesData%QX1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1690,8 +1690,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%QX1 = SrcBeddoesData%QX1 end if if (allocated(SrcBeddoesData%TAU)) then - LB(1:2) = lbound(SrcBeddoesData%TAU) - UB(1:2) = ubound(SrcBeddoesData%TAU) + LB(1:2) = lbound(SrcBeddoesData%TAU, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%TAU, kind=B8Ki) if (.not. allocated(DstBeddoesData%TAU)) then allocate(DstBeddoesData%TAU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1702,8 +1702,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%TAU = SrcBeddoesData%TAU end if if (allocated(SrcBeddoesData%XN)) then - LB(1:2) = lbound(SrcBeddoesData%XN) - UB(1:2) = ubound(SrcBeddoesData%XN) + LB(1:2) = lbound(SrcBeddoesData%XN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%XN, kind=B8Ki) if (.not. allocated(DstBeddoesData%XN)) then allocate(DstBeddoesData%XN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1714,8 +1714,8 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E DstBeddoesData%XN = SrcBeddoesData%XN end if if (allocated(SrcBeddoesData%YN)) then - LB(1:2) = lbound(SrcBeddoesData%YN) - UB(1:2) = ubound(SrcBeddoesData%YN) + LB(1:2) = lbound(SrcBeddoesData%YN, kind=B8Ki) + UB(1:2) = ubound(SrcBeddoesData%YN, kind=B8Ki) if (.not. allocated(DstBeddoesData%YN)) then allocate(DstBeddoesData%YN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1901,59 +1901,59 @@ subroutine AD14_PackBeddoes(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%ADOT)) if (allocated(InData%ADOT)) then - call RegPackBounds(Buf, 2, lbound(InData%ADOT), ubound(InData%ADOT)) + call RegPackBounds(Buf, 2, lbound(InData%ADOT, kind=B8Ki), ubound(InData%ADOT, kind=B8Ki)) call RegPack(Buf, InData%ADOT) end if call RegPack(Buf, allocated(InData%ADOT1)) if (allocated(InData%ADOT1)) then - call RegPackBounds(Buf, 2, lbound(InData%ADOT1), ubound(InData%ADOT1)) + call RegPackBounds(Buf, 2, lbound(InData%ADOT1, kind=B8Ki), ubound(InData%ADOT1, kind=B8Ki)) call RegPack(Buf, InData%ADOT1) end if call RegPack(Buf, allocated(InData%AFE)) if (allocated(InData%AFE)) then - call RegPackBounds(Buf, 2, lbound(InData%AFE), ubound(InData%AFE)) + call RegPackBounds(Buf, 2, lbound(InData%AFE, kind=B8Ki), ubound(InData%AFE, kind=B8Ki)) call RegPack(Buf, InData%AFE) end if call RegPack(Buf, allocated(InData%AFE1)) if (allocated(InData%AFE1)) then - call RegPackBounds(Buf, 2, lbound(InData%AFE1), ubound(InData%AFE1)) + call RegPackBounds(Buf, 2, lbound(InData%AFE1, kind=B8Ki), ubound(InData%AFE1, kind=B8Ki)) call RegPack(Buf, InData%AFE1) end if call RegPack(Buf, InData%AN) call RegPack(Buf, allocated(InData%ANE)) if (allocated(InData%ANE)) then - call RegPackBounds(Buf, 2, lbound(InData%ANE), ubound(InData%ANE)) + call RegPackBounds(Buf, 2, lbound(InData%ANE, kind=B8Ki), ubound(InData%ANE, kind=B8Ki)) call RegPack(Buf, InData%ANE) end if call RegPack(Buf, allocated(InData%ANE1)) if (allocated(InData%ANE1)) then - call RegPackBounds(Buf, 2, lbound(InData%ANE1), ubound(InData%ANE1)) + call RegPackBounds(Buf, 2, lbound(InData%ANE1, kind=B8Ki), ubound(InData%ANE1, kind=B8Ki)) call RegPack(Buf, InData%ANE1) end if call RegPack(Buf, allocated(InData%AOD)) if (allocated(InData%AOD)) then - call RegPackBounds(Buf, 2, lbound(InData%AOD), ubound(InData%AOD)) + call RegPackBounds(Buf, 2, lbound(InData%AOD, kind=B8Ki), ubound(InData%AOD, kind=B8Ki)) call RegPack(Buf, InData%AOD) end if call RegPack(Buf, allocated(InData%AOL)) if (allocated(InData%AOL)) then - call RegPackBounds(Buf, 2, lbound(InData%AOL), ubound(InData%AOL)) + call RegPackBounds(Buf, 2, lbound(InData%AOL, kind=B8Ki), ubound(InData%AOL, kind=B8Ki)) call RegPack(Buf, InData%AOL) end if call RegPack(Buf, allocated(InData%BEDSEP)) if (allocated(InData%BEDSEP)) then - call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) + call RegPackBounds(Buf, 2, lbound(InData%BEDSEP, kind=B8Ki), ubound(InData%BEDSEP, kind=B8Ki)) call RegPack(Buf, InData%BEDSEP) end if call RegPack(Buf, allocated(InData%OLDSEP)) if (allocated(InData%OLDSEP)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDSEP), ubound(InData%OLDSEP)) + call RegPackBounds(Buf, 2, lbound(InData%OLDSEP, kind=B8Ki), ubound(InData%OLDSEP, kind=B8Ki)) call RegPack(Buf, InData%OLDSEP) end if call RegPack(Buf, InData%CC) call RegPack(Buf, allocated(InData%CDO)) if (allocated(InData%CDO)) then - call RegPackBounds(Buf, 2, lbound(InData%CDO), ubound(InData%CDO)) + call RegPackBounds(Buf, 2, lbound(InData%CDO, kind=B8Ki), ubound(InData%CDO, kind=B8Ki)) call RegPack(Buf, InData%CDO) end if call RegPack(Buf, InData%CMI) @@ -1961,109 +1961,109 @@ subroutine AD14_PackBeddoes(Buf, Indata) call RegPack(Buf, InData%CN) call RegPack(Buf, allocated(InData%CNA)) if (allocated(InData%CNA)) then - call RegPackBounds(Buf, 2, lbound(InData%CNA), ubound(InData%CNA)) + call RegPackBounds(Buf, 2, lbound(InData%CNA, kind=B8Ki), ubound(InData%CNA, kind=B8Ki)) call RegPack(Buf, InData%CNA) end if call RegPack(Buf, InData%CNCP) call RegPack(Buf, InData%CNIQ) call RegPack(Buf, allocated(InData%CNP)) if (allocated(InData%CNP)) then - call RegPackBounds(Buf, 2, lbound(InData%CNP), ubound(InData%CNP)) + call RegPackBounds(Buf, 2, lbound(InData%CNP, kind=B8Ki), ubound(InData%CNP, kind=B8Ki)) call RegPack(Buf, InData%CNP) end if call RegPack(Buf, allocated(InData%CNP1)) if (allocated(InData%CNP1)) then - call RegPackBounds(Buf, 2, lbound(InData%CNP1), ubound(InData%CNP1)) + call RegPackBounds(Buf, 2, lbound(InData%CNP1, kind=B8Ki), ubound(InData%CNP1, kind=B8Ki)) call RegPack(Buf, InData%CNP1) end if call RegPack(Buf, allocated(InData%CNPD)) if (allocated(InData%CNPD)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPD), ubound(InData%CNPD)) + call RegPackBounds(Buf, 2, lbound(InData%CNPD, kind=B8Ki), ubound(InData%CNPD, kind=B8Ki)) call RegPack(Buf, InData%CNPD) end if call RegPack(Buf, allocated(InData%CNPD1)) if (allocated(InData%CNPD1)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPD1), ubound(InData%CNPD1)) + call RegPackBounds(Buf, 2, lbound(InData%CNPD1, kind=B8Ki), ubound(InData%CNPD1, kind=B8Ki)) call RegPack(Buf, InData%CNPD1) end if call RegPack(Buf, allocated(InData%CNPOT)) if (allocated(InData%CNPOT)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPOT), ubound(InData%CNPOT)) + call RegPackBounds(Buf, 2, lbound(InData%CNPOT, kind=B8Ki), ubound(InData%CNPOT, kind=B8Ki)) call RegPack(Buf, InData%CNPOT) end if call RegPack(Buf, allocated(InData%CNPOT1)) if (allocated(InData%CNPOT1)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPOT1), ubound(InData%CNPOT1)) + call RegPackBounds(Buf, 2, lbound(InData%CNPOT1, kind=B8Ki), ubound(InData%CNPOT1, kind=B8Ki)) call RegPack(Buf, InData%CNPOT1) end if call RegPack(Buf, allocated(InData%CNS)) if (allocated(InData%CNS)) then - call RegPackBounds(Buf, 2, lbound(InData%CNS), ubound(InData%CNS)) + call RegPackBounds(Buf, 2, lbound(InData%CNS, kind=B8Ki), ubound(InData%CNS, kind=B8Ki)) call RegPack(Buf, InData%CNS) end if call RegPack(Buf, allocated(InData%CNSL)) if (allocated(InData%CNSL)) then - call RegPackBounds(Buf, 2, lbound(InData%CNSL), ubound(InData%CNSL)) + call RegPackBounds(Buf, 2, lbound(InData%CNSL, kind=B8Ki), ubound(InData%CNSL, kind=B8Ki)) call RegPack(Buf, InData%CNSL) end if call RegPack(Buf, allocated(InData%CNV)) if (allocated(InData%CNV)) then - call RegPackBounds(Buf, 2, lbound(InData%CNV), ubound(InData%CNV)) + call RegPackBounds(Buf, 2, lbound(InData%CNV, kind=B8Ki), ubound(InData%CNV, kind=B8Ki)) call RegPack(Buf, InData%CNV) end if call RegPack(Buf, allocated(InData%CVN)) if (allocated(InData%CVN)) then - call RegPackBounds(Buf, 2, lbound(InData%CVN), ubound(InData%CVN)) + call RegPackBounds(Buf, 2, lbound(InData%CVN, kind=B8Ki), ubound(InData%CVN, kind=B8Ki)) call RegPack(Buf, InData%CVN) end if call RegPack(Buf, allocated(InData%CVN1)) if (allocated(InData%CVN1)) then - call RegPackBounds(Buf, 2, lbound(InData%CVN1), ubound(InData%CVN1)) + call RegPackBounds(Buf, 2, lbound(InData%CVN1, kind=B8Ki), ubound(InData%CVN1, kind=B8Ki)) call RegPack(Buf, InData%CVN1) end if call RegPack(Buf, allocated(InData%DF)) if (allocated(InData%DF)) then - call RegPackBounds(Buf, 2, lbound(InData%DF), ubound(InData%DF)) + call RegPackBounds(Buf, 2, lbound(InData%DF, kind=B8Ki), ubound(InData%DF, kind=B8Ki)) call RegPack(Buf, InData%DF) end if call RegPack(Buf, allocated(InData%DFAFE)) if (allocated(InData%DFAFE)) then - call RegPackBounds(Buf, 2, lbound(InData%DFAFE), ubound(InData%DFAFE)) + call RegPackBounds(Buf, 2, lbound(InData%DFAFE, kind=B8Ki), ubound(InData%DFAFE, kind=B8Ki)) call RegPack(Buf, InData%DFAFE) end if call RegPack(Buf, allocated(InData%DFAFE1)) if (allocated(InData%DFAFE1)) then - call RegPackBounds(Buf, 2, lbound(InData%DFAFE1), ubound(InData%DFAFE1)) + call RegPackBounds(Buf, 2, lbound(InData%DFAFE1, kind=B8Ki), ubound(InData%DFAFE1, kind=B8Ki)) call RegPack(Buf, InData%DFAFE1) end if call RegPack(Buf, allocated(InData%DFC)) if (allocated(InData%DFC)) then - call RegPackBounds(Buf, 2, lbound(InData%DFC), ubound(InData%DFC)) + call RegPackBounds(Buf, 2, lbound(InData%DFC, kind=B8Ki), ubound(InData%DFC, kind=B8Ki)) call RegPack(Buf, InData%DFC) end if call RegPack(Buf, allocated(InData%DN)) if (allocated(InData%DN)) then - call RegPackBounds(Buf, 2, lbound(InData%DN), ubound(InData%DN)) + call RegPackBounds(Buf, 2, lbound(InData%DN, kind=B8Ki), ubound(InData%DN, kind=B8Ki)) call RegPack(Buf, InData%DN) end if call RegPack(Buf, allocated(InData%DPP)) if (allocated(InData%DPP)) then - call RegPackBounds(Buf, 2, lbound(InData%DPP), ubound(InData%DPP)) + call RegPackBounds(Buf, 2, lbound(InData%DPP, kind=B8Ki), ubound(InData%DPP, kind=B8Ki)) call RegPack(Buf, InData%DPP) end if call RegPack(Buf, allocated(InData%DQ)) if (allocated(InData%DQ)) then - call RegPackBounds(Buf, 2, lbound(InData%DQ), ubound(InData%DQ)) + call RegPackBounds(Buf, 2, lbound(InData%DQ, kind=B8Ki), ubound(InData%DQ, kind=B8Ki)) call RegPack(Buf, InData%DQ) end if call RegPack(Buf, allocated(InData%DQP)) if (allocated(InData%DQP)) then - call RegPackBounds(Buf, 2, lbound(InData%DQP), ubound(InData%DQP)) + call RegPackBounds(Buf, 2, lbound(InData%DQP, kind=B8Ki), ubound(InData%DQP, kind=B8Ki)) call RegPack(Buf, InData%DQP) end if call RegPack(Buf, allocated(InData%DQP1)) if (allocated(InData%DQP1)) then - call RegPackBounds(Buf, 2, lbound(InData%DQP1), ubound(InData%DQP1)) + call RegPackBounds(Buf, 2, lbound(InData%DQP1, kind=B8Ki), ubound(InData%DQP1, kind=B8Ki)) call RegPack(Buf, InData%DQP1) end if call RegPack(Buf, InData%DS) @@ -2072,102 +2072,102 @@ subroutine AD14_PackBeddoes(Buf, Indata) call RegPack(Buf, InData%FPC) call RegPack(Buf, allocated(InData%FSP)) if (allocated(InData%FSP)) then - call RegPackBounds(Buf, 2, lbound(InData%FSP), ubound(InData%FSP)) + call RegPackBounds(Buf, 2, lbound(InData%FSP, kind=B8Ki), ubound(InData%FSP, kind=B8Ki)) call RegPack(Buf, InData%FSP) end if call RegPack(Buf, allocated(InData%FSP1)) if (allocated(InData%FSP1)) then - call RegPackBounds(Buf, 2, lbound(InData%FSP1), ubound(InData%FSP1)) + call RegPackBounds(Buf, 2, lbound(InData%FSP1, kind=B8Ki), ubound(InData%FSP1, kind=B8Ki)) call RegPack(Buf, InData%FSP1) end if call RegPack(Buf, allocated(InData%FSPC)) if (allocated(InData%FSPC)) then - call RegPackBounds(Buf, 2, lbound(InData%FSPC), ubound(InData%FSPC)) + call RegPackBounds(Buf, 2, lbound(InData%FSPC, kind=B8Ki), ubound(InData%FSPC, kind=B8Ki)) call RegPack(Buf, InData%FSPC) end if call RegPack(Buf, allocated(InData%FSPC1)) if (allocated(InData%FSPC1)) then - call RegPackBounds(Buf, 2, lbound(InData%FSPC1), ubound(InData%FSPC1)) + call RegPackBounds(Buf, 2, lbound(InData%FSPC1, kind=B8Ki), ubound(InData%FSPC1, kind=B8Ki)) call RegPack(Buf, InData%FSPC1) end if call RegPack(Buf, allocated(InData%FTB)) if (allocated(InData%FTB)) then - call RegPackBounds(Buf, 3, lbound(InData%FTB), ubound(InData%FTB)) + call RegPackBounds(Buf, 3, lbound(InData%FTB, kind=B8Ki), ubound(InData%FTB, kind=B8Ki)) call RegPack(Buf, InData%FTB) end if call RegPack(Buf, allocated(InData%FTBC)) if (allocated(InData%FTBC)) then - call RegPackBounds(Buf, 3, lbound(InData%FTBC), ubound(InData%FTBC)) + call RegPackBounds(Buf, 3, lbound(InData%FTBC, kind=B8Ki), ubound(InData%FTBC, kind=B8Ki)) call RegPack(Buf, InData%FTBC) end if call RegPack(Buf, allocated(InData%OLDCNV)) if (allocated(InData%OLDCNV)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDCNV), ubound(InData%OLDCNV)) + call RegPackBounds(Buf, 2, lbound(InData%OLDCNV, kind=B8Ki), ubound(InData%OLDCNV, kind=B8Ki)) call RegPack(Buf, InData%OLDCNV) end if call RegPack(Buf, allocated(InData%OLDDF)) if (allocated(InData%OLDDF)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDF), ubound(InData%OLDDF)) + call RegPackBounds(Buf, 2, lbound(InData%OLDDF, kind=B8Ki), ubound(InData%OLDDF, kind=B8Ki)) call RegPack(Buf, InData%OLDDF) end if call RegPack(Buf, allocated(InData%OLDDFC)) if (allocated(InData%OLDDFC)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDFC), ubound(InData%OLDDFC)) + call RegPackBounds(Buf, 2, lbound(InData%OLDDFC, kind=B8Ki), ubound(InData%OLDDFC, kind=B8Ki)) call RegPack(Buf, InData%OLDDFC) end if call RegPack(Buf, allocated(InData%OLDDN)) if (allocated(InData%OLDDN)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDN), ubound(InData%OLDDN)) + call RegPackBounds(Buf, 2, lbound(InData%OLDDN, kind=B8Ki), ubound(InData%OLDDN, kind=B8Ki)) call RegPack(Buf, InData%OLDDN) end if call RegPack(Buf, allocated(InData%OLDDPP)) if (allocated(InData%OLDDPP)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDPP), ubound(InData%OLDDPP)) + call RegPackBounds(Buf, 2, lbound(InData%OLDDPP, kind=B8Ki), ubound(InData%OLDDPP, kind=B8Ki)) call RegPack(Buf, InData%OLDDPP) end if call RegPack(Buf, allocated(InData%OLDDQ)) if (allocated(InData%OLDDQ)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDQ), ubound(InData%OLDDQ)) + call RegPackBounds(Buf, 2, lbound(InData%OLDDQ, kind=B8Ki), ubound(InData%OLDDQ, kind=B8Ki)) call RegPack(Buf, InData%OLDDQ) end if call RegPack(Buf, allocated(InData%OLDTAU)) if (allocated(InData%OLDTAU)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDTAU), ubound(InData%OLDTAU)) + call RegPackBounds(Buf, 2, lbound(InData%OLDTAU, kind=B8Ki), ubound(InData%OLDTAU, kind=B8Ki)) call RegPack(Buf, InData%OLDTAU) end if call RegPack(Buf, allocated(InData%OLDXN)) if (allocated(InData%OLDXN)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDXN), ubound(InData%OLDXN)) + call RegPackBounds(Buf, 2, lbound(InData%OLDXN, kind=B8Ki), ubound(InData%OLDXN, kind=B8Ki)) call RegPack(Buf, InData%OLDXN) end if call RegPack(Buf, allocated(InData%OLDYN)) if (allocated(InData%OLDYN)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDYN), ubound(InData%OLDYN)) + call RegPackBounds(Buf, 2, lbound(InData%OLDYN, kind=B8Ki), ubound(InData%OLDYN, kind=B8Ki)) call RegPack(Buf, InData%OLDYN) end if call RegPack(Buf, allocated(InData%QX)) if (allocated(InData%QX)) then - call RegPackBounds(Buf, 2, lbound(InData%QX), ubound(InData%QX)) + call RegPackBounds(Buf, 2, lbound(InData%QX, kind=B8Ki), ubound(InData%QX, kind=B8Ki)) call RegPack(Buf, InData%QX) end if call RegPack(Buf, allocated(InData%QX1)) if (allocated(InData%QX1)) then - call RegPackBounds(Buf, 2, lbound(InData%QX1), ubound(InData%QX1)) + call RegPackBounds(Buf, 2, lbound(InData%QX1, kind=B8Ki), ubound(InData%QX1, kind=B8Ki)) call RegPack(Buf, InData%QX1) end if call RegPack(Buf, allocated(InData%TAU)) if (allocated(InData%TAU)) then - call RegPackBounds(Buf, 2, lbound(InData%TAU), ubound(InData%TAU)) + call RegPackBounds(Buf, 2, lbound(InData%TAU, kind=B8Ki), ubound(InData%TAU, kind=B8Ki)) call RegPack(Buf, InData%TAU) end if call RegPack(Buf, allocated(InData%XN)) if (allocated(InData%XN)) then - call RegPackBounds(Buf, 2, lbound(InData%XN), ubound(InData%XN)) + call RegPackBounds(Buf, 2, lbound(InData%XN, kind=B8Ki), ubound(InData%XN, kind=B8Ki)) call RegPack(Buf, InData%XN) end if call RegPack(Buf, allocated(InData%YN)) if (allocated(InData%YN)) then - call RegPackBounds(Buf, 2, lbound(InData%YN), ubound(InData%YN)) + call RegPackBounds(Buf, 2, lbound(InData%YN, kind=B8Ki), ubound(InData%YN, kind=B8Ki)) call RegPack(Buf, InData%YN) end if call RegPack(Buf, InData%SHIFT) @@ -2179,7 +2179,7 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Beddoes), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackBeddoes' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3000,14 +3000,14 @@ subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyBladeParms' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladeParmsData%C)) then - LB(1:1) = lbound(SrcBladeParmsData%C) - UB(1:1) = ubound(SrcBladeParmsData%C) + LB(1:1) = lbound(SrcBladeParmsData%C, kind=B8Ki) + UB(1:1) = ubound(SrcBladeParmsData%C, kind=B8Ki) if (.not. allocated(DstBladeParmsData%C)) then allocate(DstBladeParmsData%C(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3018,8 +3018,8 @@ subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, E DstBladeParmsData%C = SrcBladeParmsData%C end if if (allocated(SrcBladeParmsData%DR)) then - LB(1:1) = lbound(SrcBladeParmsData%DR) - UB(1:1) = ubound(SrcBladeParmsData%DR) + LB(1:1) = lbound(SrcBladeParmsData%DR, kind=B8Ki) + UB(1:1) = ubound(SrcBladeParmsData%DR, kind=B8Ki) if (.not. allocated(DstBladeParmsData%DR)) then allocate(DstBladeParmsData%DR(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3055,12 +3055,12 @@ subroutine AD14_PackBladeParms(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then - call RegPackBounds(Buf, 1, lbound(InData%C), ubound(InData%C)) + call RegPackBounds(Buf, 1, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) call RegPack(Buf, InData%C) end if call RegPack(Buf, allocated(InData%DR)) if (allocated(InData%DR)) then - call RegPackBounds(Buf, 1, lbound(InData%DR), ubound(InData%DR)) + call RegPackBounds(Buf, 1, lbound(InData%DR, kind=B8Ki), ubound(InData%DR, kind=B8Ki)) call RegPack(Buf, InData%DR) end if call RegPack(Buf, InData%R) @@ -3072,7 +3072,7 @@ subroutine AD14_UnPackBladeParms(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BladeParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackBladeParms' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3116,7 +3116,7 @@ subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyDynInflow' ErrStat = ErrID_None @@ -3132,8 +3132,8 @@ subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrS DstDynInflowData%PhiLqS = SrcDynInflowData%PhiLqS DstDynInflowData%Pzero = SrcDynInflowData%Pzero if (allocated(SrcDynInflowData%RMC_SAVE)) then - LB(1:3) = lbound(SrcDynInflowData%RMC_SAVE) - UB(1:3) = ubound(SrcDynInflowData%RMC_SAVE) + LB(1:3) = lbound(SrcDynInflowData%RMC_SAVE, kind=B8Ki) + UB(1:3) = ubound(SrcDynInflowData%RMC_SAVE, kind=B8Ki) if (.not. allocated(DstDynInflowData%RMC_SAVE)) then allocate(DstDynInflowData%RMC_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3144,8 +3144,8 @@ subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrS DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE end if if (allocated(SrcDynInflowData%RMS_SAVE)) then - LB(1:3) = lbound(SrcDynInflowData%RMS_SAVE) - UB(1:3) = ubound(SrcDynInflowData%RMS_SAVE) + LB(1:3) = lbound(SrcDynInflowData%RMS_SAVE, kind=B8Ki) + UB(1:3) = ubound(SrcDynInflowData%RMS_SAVE, kind=B8Ki) if (.not. allocated(DstDynInflowData%RMS_SAVE)) then allocate(DstDynInflowData%RMS_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3203,12 +3203,12 @@ subroutine AD14_PackDynInflow(Buf, Indata) call RegPack(Buf, InData%Pzero) call RegPack(Buf, allocated(InData%RMC_SAVE)) if (allocated(InData%RMC_SAVE)) then - call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE), ubound(InData%RMC_SAVE)) + call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE, kind=B8Ki), ubound(InData%RMC_SAVE, kind=B8Ki)) call RegPack(Buf, InData%RMC_SAVE) end if call RegPack(Buf, allocated(InData%RMS_SAVE)) if (allocated(InData%RMS_SAVE)) then - call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE), ubound(InData%RMS_SAVE)) + call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE, kind=B8Ki), ubound(InData%RMS_SAVE, kind=B8Ki)) call RegPack(Buf, InData%RMS_SAVE) end if call RegPack(Buf, InData%TipSpeed) @@ -3232,7 +3232,7 @@ subroutine AD14_UnPackDynInflow(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DynInflow), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackDynInflow' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3363,14 +3363,14 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyElement' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcElementData%A)) then - LB(1:2) = lbound(SrcElementData%A) - UB(1:2) = ubound(SrcElementData%A) + LB(1:2) = lbound(SrcElementData%A, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%A, kind=B8Ki) if (.not. allocated(DstElementData%A)) then allocate(DstElementData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3381,8 +3381,8 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E DstElementData%A = SrcElementData%A end if if (allocated(SrcElementData%AP)) then - LB(1:2) = lbound(SrcElementData%AP) - UB(1:2) = ubound(SrcElementData%AP) + LB(1:2) = lbound(SrcElementData%AP, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%AP, kind=B8Ki) if (.not. allocated(DstElementData%AP)) then allocate(DstElementData%AP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3393,8 +3393,8 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E DstElementData%AP = SrcElementData%AP end if if (allocated(SrcElementData%ALPHA)) then - LB(1:2) = lbound(SrcElementData%ALPHA) - UB(1:2) = ubound(SrcElementData%ALPHA) + LB(1:2) = lbound(SrcElementData%ALPHA, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%ALPHA, kind=B8Ki) if (.not. allocated(DstElementData%ALPHA)) then allocate(DstElementData%ALPHA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3405,8 +3405,8 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E DstElementData%ALPHA = SrcElementData%ALPHA end if if (allocated(SrcElementData%W2)) then - LB(1:2) = lbound(SrcElementData%W2) - UB(1:2) = ubound(SrcElementData%W2) + LB(1:2) = lbound(SrcElementData%W2, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%W2, kind=B8Ki) if (.not. allocated(DstElementData%W2)) then allocate(DstElementData%W2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3417,8 +3417,8 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E DstElementData%W2 = SrcElementData%W2 end if if (allocated(SrcElementData%OLD_A_NS)) then - LB(1:2) = lbound(SrcElementData%OLD_A_NS) - UB(1:2) = ubound(SrcElementData%OLD_A_NS) + LB(1:2) = lbound(SrcElementData%OLD_A_NS, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%OLD_A_NS, kind=B8Ki) if (.not. allocated(DstElementData%OLD_A_NS)) then allocate(DstElementData%OLD_A_NS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3429,8 +3429,8 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS end if if (allocated(SrcElementData%OLD_AP_NS)) then - LB(1:2) = lbound(SrcElementData%OLD_AP_NS) - UB(1:2) = ubound(SrcElementData%OLD_AP_NS) + LB(1:2) = lbound(SrcElementData%OLD_AP_NS, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%OLD_AP_NS, kind=B8Ki) if (.not. allocated(DstElementData%OLD_AP_NS)) then allocate(DstElementData%OLD_AP_NS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3441,8 +3441,8 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS end if if (allocated(SrcElementData%PITNOW)) then - LB(1:2) = lbound(SrcElementData%PITNOW) - UB(1:2) = ubound(SrcElementData%PITNOW) + LB(1:2) = lbound(SrcElementData%PITNOW, kind=B8Ki) + UB(1:2) = ubound(SrcElementData%PITNOW, kind=B8Ki) if (.not. allocated(DstElementData%PITNOW)) then allocate(DstElementData%PITNOW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3491,37 +3491,37 @@ subroutine AD14_PackElement(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) call RegPack(Buf, InData%A) end if call RegPack(Buf, allocated(InData%AP)) if (allocated(InData%AP)) then - call RegPackBounds(Buf, 2, lbound(InData%AP), ubound(InData%AP)) + call RegPackBounds(Buf, 2, lbound(InData%AP, kind=B8Ki), ubound(InData%AP, kind=B8Ki)) call RegPack(Buf, InData%AP) end if call RegPack(Buf, allocated(InData%ALPHA)) if (allocated(InData%ALPHA)) then - call RegPackBounds(Buf, 2, lbound(InData%ALPHA), ubound(InData%ALPHA)) + call RegPackBounds(Buf, 2, lbound(InData%ALPHA, kind=B8Ki), ubound(InData%ALPHA, kind=B8Ki)) call RegPack(Buf, InData%ALPHA) end if call RegPack(Buf, allocated(InData%W2)) if (allocated(InData%W2)) then - call RegPackBounds(Buf, 2, lbound(InData%W2), ubound(InData%W2)) + call RegPackBounds(Buf, 2, lbound(InData%W2, kind=B8Ki), ubound(InData%W2, kind=B8Ki)) call RegPack(Buf, InData%W2) end if call RegPack(Buf, allocated(InData%OLD_A_NS)) if (allocated(InData%OLD_A_NS)) then - call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS), ubound(InData%OLD_A_NS)) + call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS, kind=B8Ki), ubound(InData%OLD_A_NS, kind=B8Ki)) call RegPack(Buf, InData%OLD_A_NS) end if call RegPack(Buf, allocated(InData%OLD_AP_NS)) if (allocated(InData%OLD_AP_NS)) then - call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS), ubound(InData%OLD_AP_NS)) + call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS, kind=B8Ki), ubound(InData%OLD_AP_NS, kind=B8Ki)) call RegPack(Buf, InData%OLD_AP_NS) end if call RegPack(Buf, allocated(InData%PITNOW)) if (allocated(InData%PITNOW)) then - call RegPackBounds(Buf, 2, lbound(InData%PITNOW), ubound(InData%PITNOW)) + call RegPackBounds(Buf, 2, lbound(InData%PITNOW, kind=B8Ki), ubound(InData%PITNOW, kind=B8Ki)) call RegPack(Buf, InData%PITNOW) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3531,7 +3531,7 @@ subroutine AD14_UnPackElement(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Element), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackElement' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3641,15 +3641,15 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyElementParms' ErrStat = ErrID_None ErrMsg = '' DstElementParmsData%NELM = SrcElementParmsData%NELM if (allocated(SrcElementParmsData%TWIST)) then - LB(1:1) = lbound(SrcElementParmsData%TWIST) - UB(1:1) = ubound(SrcElementParmsData%TWIST) + LB(1:1) = lbound(SrcElementParmsData%TWIST, kind=B8Ki) + UB(1:1) = ubound(SrcElementParmsData%TWIST, kind=B8Ki) if (.not. allocated(DstElementParmsData%TWIST)) then allocate(DstElementParmsData%TWIST(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3660,8 +3660,8 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC DstElementParmsData%TWIST = SrcElementParmsData%TWIST end if if (allocated(SrcElementParmsData%RELM)) then - LB(1:1) = lbound(SrcElementParmsData%RELM) - UB(1:1) = ubound(SrcElementParmsData%RELM) + LB(1:1) = lbound(SrcElementParmsData%RELM, kind=B8Ki) + UB(1:1) = ubound(SrcElementParmsData%RELM, kind=B8Ki) if (.not. allocated(DstElementParmsData%RELM)) then allocate(DstElementParmsData%RELM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3672,8 +3672,8 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC DstElementParmsData%RELM = SrcElementParmsData%RELM end if if (allocated(SrcElementParmsData%HLCNST)) then - LB(1:1) = lbound(SrcElementParmsData%HLCNST) - UB(1:1) = ubound(SrcElementParmsData%HLCNST) + LB(1:1) = lbound(SrcElementParmsData%HLCNST, kind=B8Ki) + UB(1:1) = ubound(SrcElementParmsData%HLCNST, kind=B8Ki) if (.not. allocated(DstElementParmsData%HLCNST)) then allocate(DstElementParmsData%HLCNST(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3684,8 +3684,8 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST end if if (allocated(SrcElementParmsData%TLCNST)) then - LB(1:1) = lbound(SrcElementParmsData%TLCNST) - UB(1:1) = ubound(SrcElementParmsData%TLCNST) + LB(1:1) = lbound(SrcElementParmsData%TLCNST, kind=B8Ki) + UB(1:1) = ubound(SrcElementParmsData%TLCNST, kind=B8Ki) if (.not. allocated(DstElementParmsData%TLCNST)) then allocate(DstElementParmsData%TLCNST(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3726,22 +3726,22 @@ subroutine AD14_PackElementParms(Buf, Indata) call RegPack(Buf, InData%NELM) call RegPack(Buf, allocated(InData%TWIST)) if (allocated(InData%TWIST)) then - call RegPackBounds(Buf, 1, lbound(InData%TWIST), ubound(InData%TWIST)) + call RegPackBounds(Buf, 1, lbound(InData%TWIST, kind=B8Ki), ubound(InData%TWIST, kind=B8Ki)) call RegPack(Buf, InData%TWIST) end if call RegPack(Buf, allocated(InData%RELM)) if (allocated(InData%RELM)) then - call RegPackBounds(Buf, 1, lbound(InData%RELM), ubound(InData%RELM)) + call RegPackBounds(Buf, 1, lbound(InData%RELM, kind=B8Ki), ubound(InData%RELM, kind=B8Ki)) call RegPack(Buf, InData%RELM) end if call RegPack(Buf, allocated(InData%HLCNST)) if (allocated(InData%HLCNST)) then - call RegPackBounds(Buf, 1, lbound(InData%HLCNST), ubound(InData%HLCNST)) + call RegPackBounds(Buf, 1, lbound(InData%HLCNST, kind=B8Ki), ubound(InData%HLCNST, kind=B8Ki)) call RegPack(Buf, InData%HLCNST) end if call RegPack(Buf, allocated(InData%TLCNST)) if (allocated(InData%TLCNST)) then - call RegPackBounds(Buf, 1, lbound(InData%TLCNST), ubound(InData%TLCNST)) + call RegPackBounds(Buf, 1, lbound(InData%TLCNST, kind=B8Ki), ubound(InData%TLCNST, kind=B8Ki)) call RegPack(Buf, InData%TLCNST) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3751,7 +3751,7 @@ subroutine AD14_UnPackElementParms(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ElementParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackElementParms' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3821,14 +3821,14 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyElOutParms' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcElOutParmsData%AAA)) then - LB(1:1) = lbound(SrcElOutParmsData%AAA) - UB(1:1) = ubound(SrcElOutParmsData%AAA) + LB(1:1) = lbound(SrcElOutParmsData%AAA, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%AAA, kind=B8Ki) if (.not. allocated(DstElOutParmsData%AAA)) then allocate(DstElOutParmsData%AAA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3839,8 +3839,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%AAA = SrcElOutParmsData%AAA end if if (allocated(SrcElOutParmsData%AAP)) then - LB(1:1) = lbound(SrcElOutParmsData%AAP) - UB(1:1) = ubound(SrcElOutParmsData%AAP) + LB(1:1) = lbound(SrcElOutParmsData%AAP, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%AAP, kind=B8Ki) if (.not. allocated(DstElOutParmsData%AAP)) then allocate(DstElOutParmsData%AAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3851,8 +3851,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%AAP = SrcElOutParmsData%AAP end if if (allocated(SrcElOutParmsData%ALF)) then - LB(1:1) = lbound(SrcElOutParmsData%ALF) - UB(1:1) = ubound(SrcElOutParmsData%ALF) + LB(1:1) = lbound(SrcElOutParmsData%ALF, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%ALF, kind=B8Ki) if (.not. allocated(DstElOutParmsData%ALF)) then allocate(DstElOutParmsData%ALF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3863,8 +3863,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%ALF = SrcElOutParmsData%ALF end if if (allocated(SrcElOutParmsData%CDD)) then - LB(1:1) = lbound(SrcElOutParmsData%CDD) - UB(1:1) = ubound(SrcElOutParmsData%CDD) + LB(1:1) = lbound(SrcElOutParmsData%CDD, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%CDD, kind=B8Ki) if (.not. allocated(DstElOutParmsData%CDD)) then allocate(DstElOutParmsData%CDD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3875,8 +3875,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%CDD = SrcElOutParmsData%CDD end if if (allocated(SrcElOutParmsData%CLL)) then - LB(1:1) = lbound(SrcElOutParmsData%CLL) - UB(1:1) = ubound(SrcElOutParmsData%CLL) + LB(1:1) = lbound(SrcElOutParmsData%CLL, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%CLL, kind=B8Ki) if (.not. allocated(DstElOutParmsData%CLL)) then allocate(DstElOutParmsData%CLL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3887,8 +3887,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%CLL = SrcElOutParmsData%CLL end if if (allocated(SrcElOutParmsData%CMM)) then - LB(1:1) = lbound(SrcElOutParmsData%CMM) - UB(1:1) = ubound(SrcElOutParmsData%CMM) + LB(1:1) = lbound(SrcElOutParmsData%CMM, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%CMM, kind=B8Ki) if (.not. allocated(DstElOutParmsData%CMM)) then allocate(DstElOutParmsData%CMM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3899,8 +3899,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%CMM = SrcElOutParmsData%CMM end if if (allocated(SrcElOutParmsData%CNN)) then - LB(1:1) = lbound(SrcElOutParmsData%CNN) - UB(1:1) = ubound(SrcElOutParmsData%CNN) + LB(1:1) = lbound(SrcElOutParmsData%CNN, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%CNN, kind=B8Ki) if (.not. allocated(DstElOutParmsData%CNN)) then allocate(DstElOutParmsData%CNN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3911,8 +3911,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%CNN = SrcElOutParmsData%CNN end if if (allocated(SrcElOutParmsData%CTT)) then - LB(1:1) = lbound(SrcElOutParmsData%CTT) - UB(1:1) = ubound(SrcElOutParmsData%CTT) + LB(1:1) = lbound(SrcElOutParmsData%CTT, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%CTT, kind=B8Ki) if (.not. allocated(DstElOutParmsData%CTT)) then allocate(DstElOutParmsData%CTT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3923,8 +3923,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%CTT = SrcElOutParmsData%CTT end if if (allocated(SrcElOutParmsData%DFNSAV)) then - LB(1:1) = lbound(SrcElOutParmsData%DFNSAV) - UB(1:1) = ubound(SrcElOutParmsData%DFNSAV) + LB(1:1) = lbound(SrcElOutParmsData%DFNSAV, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%DFNSAV, kind=B8Ki) if (.not. allocated(DstElOutParmsData%DFNSAV)) then allocate(DstElOutParmsData%DFNSAV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3935,8 +3935,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV end if if (allocated(SrcElOutParmsData%DFTSAV)) then - LB(1:1) = lbound(SrcElOutParmsData%DFTSAV) - UB(1:1) = ubound(SrcElOutParmsData%DFTSAV) + LB(1:1) = lbound(SrcElOutParmsData%DFTSAV, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%DFTSAV, kind=B8Ki) if (.not. allocated(DstElOutParmsData%DFTSAV)) then allocate(DstElOutParmsData%DFTSAV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3947,8 +3947,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV end if if (allocated(SrcElOutParmsData%DynPres)) then - LB(1:1) = lbound(SrcElOutParmsData%DynPres) - UB(1:1) = ubound(SrcElOutParmsData%DynPres) + LB(1:1) = lbound(SrcElOutParmsData%DynPres, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%DynPres, kind=B8Ki) if (.not. allocated(DstElOutParmsData%DynPres)) then allocate(DstElOutParmsData%DynPres(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3959,8 +3959,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres end if if (allocated(SrcElOutParmsData%PMM)) then - LB(1:1) = lbound(SrcElOutParmsData%PMM) - UB(1:1) = ubound(SrcElOutParmsData%PMM) + LB(1:1) = lbound(SrcElOutParmsData%PMM, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%PMM, kind=B8Ki) if (.not. allocated(DstElOutParmsData%PMM)) then allocate(DstElOutParmsData%PMM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3971,8 +3971,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%PMM = SrcElOutParmsData%PMM end if if (allocated(SrcElOutParmsData%PITSAV)) then - LB(1:1) = lbound(SrcElOutParmsData%PITSAV) - UB(1:1) = ubound(SrcElOutParmsData%PITSAV) + LB(1:1) = lbound(SrcElOutParmsData%PITSAV, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%PITSAV, kind=B8Ki) if (.not. allocated(DstElOutParmsData%PITSAV)) then allocate(DstElOutParmsData%PITSAV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3983,8 +3983,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV end if if (allocated(SrcElOutParmsData%ReyNum)) then - LB(1:1) = lbound(SrcElOutParmsData%ReyNum) - UB(1:1) = ubound(SrcElOutParmsData%ReyNum) + LB(1:1) = lbound(SrcElOutParmsData%ReyNum, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%ReyNum, kind=B8Ki) if (.not. allocated(DstElOutParmsData%ReyNum)) then allocate(DstElOutParmsData%ReyNum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3995,8 +3995,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum end if if (allocated(SrcElOutParmsData%Gamma)) then - LB(1:1) = lbound(SrcElOutParmsData%Gamma) - UB(1:1) = ubound(SrcElOutParmsData%Gamma) + LB(1:1) = lbound(SrcElOutParmsData%Gamma, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%Gamma, kind=B8Ki) if (.not. allocated(DstElOutParmsData%Gamma)) then allocate(DstElOutParmsData%Gamma(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4007,8 +4007,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma end if if (allocated(SrcElOutParmsData%SaveVX)) then - LB(1:2) = lbound(SrcElOutParmsData%SaveVX) - UB(1:2) = ubound(SrcElOutParmsData%SaveVX) + LB(1:2) = lbound(SrcElOutParmsData%SaveVX, kind=B8Ki) + UB(1:2) = ubound(SrcElOutParmsData%SaveVX, kind=B8Ki) if (.not. allocated(DstElOutParmsData%SaveVX)) then allocate(DstElOutParmsData%SaveVX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4019,8 +4019,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX end if if (allocated(SrcElOutParmsData%SaveVY)) then - LB(1:2) = lbound(SrcElOutParmsData%SaveVY) - UB(1:2) = ubound(SrcElOutParmsData%SaveVY) + LB(1:2) = lbound(SrcElOutParmsData%SaveVY, kind=B8Ki) + UB(1:2) = ubound(SrcElOutParmsData%SaveVY, kind=B8Ki) if (.not. allocated(DstElOutParmsData%SaveVY)) then allocate(DstElOutParmsData%SaveVY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4031,8 +4031,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY end if if (allocated(SrcElOutParmsData%SaveVZ)) then - LB(1:2) = lbound(SrcElOutParmsData%SaveVZ) - UB(1:2) = ubound(SrcElOutParmsData%SaveVZ) + LB(1:2) = lbound(SrcElOutParmsData%SaveVZ, kind=B8Ki) + UB(1:2) = ubound(SrcElOutParmsData%SaveVZ, kind=B8Ki) if (.not. allocated(DstElOutParmsData%SaveVZ)) then allocate(DstElOutParmsData%SaveVZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4047,8 +4047,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%VZSAV = SrcElOutParmsData%VZSAV DstElOutParmsData%NumWndElOut = SrcElOutParmsData%NumWndElOut if (allocated(SrcElOutParmsData%WndElPrList)) then - LB(1:1) = lbound(SrcElOutParmsData%WndElPrList) - UB(1:1) = ubound(SrcElOutParmsData%WndElPrList) + LB(1:1) = lbound(SrcElOutParmsData%WndElPrList, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%WndElPrList, kind=B8Ki) if (.not. allocated(DstElOutParmsData%WndElPrList)) then allocate(DstElOutParmsData%WndElPrList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4059,8 +4059,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList end if if (allocated(SrcElOutParmsData%WndElPrNum)) then - LB(1:1) = lbound(SrcElOutParmsData%WndElPrNum) - UB(1:1) = ubound(SrcElOutParmsData%WndElPrNum) + LB(1:1) = lbound(SrcElOutParmsData%WndElPrNum, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%WndElPrNum, kind=B8Ki) if (.not. allocated(DstElOutParmsData%WndElPrNum)) then allocate(DstElOutParmsData%WndElPrNum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4071,8 +4071,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum end if if (allocated(SrcElOutParmsData%ElPrList)) then - LB(1:1) = lbound(SrcElOutParmsData%ElPrList) - UB(1:1) = ubound(SrcElOutParmsData%ElPrList) + LB(1:1) = lbound(SrcElOutParmsData%ElPrList, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%ElPrList, kind=B8Ki) if (.not. allocated(DstElOutParmsData%ElPrList)) then allocate(DstElOutParmsData%ElPrList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4083,8 +4083,8 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList end if if (allocated(SrcElOutParmsData%ElPrNum)) then - LB(1:1) = lbound(SrcElOutParmsData%ElPrNum) - UB(1:1) = ubound(SrcElOutParmsData%ElPrNum) + LB(1:1) = lbound(SrcElOutParmsData%ElPrNum, kind=B8Ki) + UB(1:1) = ubound(SrcElOutParmsData%ElPrNum, kind=B8Ki) if (.not. allocated(DstElOutParmsData%ElPrNum)) then allocate(DstElOutParmsData%ElPrNum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4179,92 +4179,92 @@ subroutine AD14_PackElOutParms(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AAA)) if (allocated(InData%AAA)) then - call RegPackBounds(Buf, 1, lbound(InData%AAA), ubound(InData%AAA)) + call RegPackBounds(Buf, 1, lbound(InData%AAA, kind=B8Ki), ubound(InData%AAA, kind=B8Ki)) call RegPack(Buf, InData%AAA) end if call RegPack(Buf, allocated(InData%AAP)) if (allocated(InData%AAP)) then - call RegPackBounds(Buf, 1, lbound(InData%AAP), ubound(InData%AAP)) + call RegPackBounds(Buf, 1, lbound(InData%AAP, kind=B8Ki), ubound(InData%AAP, kind=B8Ki)) call RegPack(Buf, InData%AAP) end if call RegPack(Buf, allocated(InData%ALF)) if (allocated(InData%ALF)) then - call RegPackBounds(Buf, 1, lbound(InData%ALF), ubound(InData%ALF)) + call RegPackBounds(Buf, 1, lbound(InData%ALF, kind=B8Ki), ubound(InData%ALF, kind=B8Ki)) call RegPack(Buf, InData%ALF) end if call RegPack(Buf, allocated(InData%CDD)) if (allocated(InData%CDD)) then - call RegPackBounds(Buf, 1, lbound(InData%CDD), ubound(InData%CDD)) + call RegPackBounds(Buf, 1, lbound(InData%CDD, kind=B8Ki), ubound(InData%CDD, kind=B8Ki)) call RegPack(Buf, InData%CDD) end if call RegPack(Buf, allocated(InData%CLL)) if (allocated(InData%CLL)) then - call RegPackBounds(Buf, 1, lbound(InData%CLL), ubound(InData%CLL)) + call RegPackBounds(Buf, 1, lbound(InData%CLL, kind=B8Ki), ubound(InData%CLL, kind=B8Ki)) call RegPack(Buf, InData%CLL) end if call RegPack(Buf, allocated(InData%CMM)) if (allocated(InData%CMM)) then - call RegPackBounds(Buf, 1, lbound(InData%CMM), ubound(InData%CMM)) + call RegPackBounds(Buf, 1, lbound(InData%CMM, kind=B8Ki), ubound(InData%CMM, kind=B8Ki)) call RegPack(Buf, InData%CMM) end if call RegPack(Buf, allocated(InData%CNN)) if (allocated(InData%CNN)) then - call RegPackBounds(Buf, 1, lbound(InData%CNN), ubound(InData%CNN)) + call RegPackBounds(Buf, 1, lbound(InData%CNN, kind=B8Ki), ubound(InData%CNN, kind=B8Ki)) call RegPack(Buf, InData%CNN) end if call RegPack(Buf, allocated(InData%CTT)) if (allocated(InData%CTT)) then - call RegPackBounds(Buf, 1, lbound(InData%CTT), ubound(InData%CTT)) + call RegPackBounds(Buf, 1, lbound(InData%CTT, kind=B8Ki), ubound(InData%CTT, kind=B8Ki)) call RegPack(Buf, InData%CTT) end if call RegPack(Buf, allocated(InData%DFNSAV)) if (allocated(InData%DFNSAV)) then - call RegPackBounds(Buf, 1, lbound(InData%DFNSAV), ubound(InData%DFNSAV)) + call RegPackBounds(Buf, 1, lbound(InData%DFNSAV, kind=B8Ki), ubound(InData%DFNSAV, kind=B8Ki)) call RegPack(Buf, InData%DFNSAV) end if call RegPack(Buf, allocated(InData%DFTSAV)) if (allocated(InData%DFTSAV)) then - call RegPackBounds(Buf, 1, lbound(InData%DFTSAV), ubound(InData%DFTSAV)) + call RegPackBounds(Buf, 1, lbound(InData%DFTSAV, kind=B8Ki), ubound(InData%DFTSAV, kind=B8Ki)) call RegPack(Buf, InData%DFTSAV) end if call RegPack(Buf, allocated(InData%DynPres)) if (allocated(InData%DynPres)) then - call RegPackBounds(Buf, 1, lbound(InData%DynPres), ubound(InData%DynPres)) + call RegPackBounds(Buf, 1, lbound(InData%DynPres, kind=B8Ki), ubound(InData%DynPres, kind=B8Ki)) call RegPack(Buf, InData%DynPres) end if call RegPack(Buf, allocated(InData%PMM)) if (allocated(InData%PMM)) then - call RegPackBounds(Buf, 1, lbound(InData%PMM), ubound(InData%PMM)) + call RegPackBounds(Buf, 1, lbound(InData%PMM, kind=B8Ki), ubound(InData%PMM, kind=B8Ki)) call RegPack(Buf, InData%PMM) end if call RegPack(Buf, allocated(InData%PITSAV)) if (allocated(InData%PITSAV)) then - call RegPackBounds(Buf, 1, lbound(InData%PITSAV), ubound(InData%PITSAV)) + call RegPackBounds(Buf, 1, lbound(InData%PITSAV, kind=B8Ki), ubound(InData%PITSAV, kind=B8Ki)) call RegPack(Buf, InData%PITSAV) end if call RegPack(Buf, allocated(InData%ReyNum)) if (allocated(InData%ReyNum)) then - call RegPackBounds(Buf, 1, lbound(InData%ReyNum), ubound(InData%ReyNum)) + call RegPackBounds(Buf, 1, lbound(InData%ReyNum, kind=B8Ki), ubound(InData%ReyNum, kind=B8Ki)) call RegPack(Buf, InData%ReyNum) end if call RegPack(Buf, allocated(InData%Gamma)) if (allocated(InData%Gamma)) then - call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) + call RegPackBounds(Buf, 1, lbound(InData%Gamma, kind=B8Ki), ubound(InData%Gamma, kind=B8Ki)) call RegPack(Buf, InData%Gamma) end if call RegPack(Buf, allocated(InData%SaveVX)) if (allocated(InData%SaveVX)) then - call RegPackBounds(Buf, 2, lbound(InData%SaveVX), ubound(InData%SaveVX)) + call RegPackBounds(Buf, 2, lbound(InData%SaveVX, kind=B8Ki), ubound(InData%SaveVX, kind=B8Ki)) call RegPack(Buf, InData%SaveVX) end if call RegPack(Buf, allocated(InData%SaveVY)) if (allocated(InData%SaveVY)) then - call RegPackBounds(Buf, 2, lbound(InData%SaveVY), ubound(InData%SaveVY)) + call RegPackBounds(Buf, 2, lbound(InData%SaveVY, kind=B8Ki), ubound(InData%SaveVY, kind=B8Ki)) call RegPack(Buf, InData%SaveVY) end if call RegPack(Buf, allocated(InData%SaveVZ)) if (allocated(InData%SaveVZ)) then - call RegPackBounds(Buf, 2, lbound(InData%SaveVZ), ubound(InData%SaveVZ)) + call RegPackBounds(Buf, 2, lbound(InData%SaveVZ, kind=B8Ki), ubound(InData%SaveVZ, kind=B8Ki)) call RegPack(Buf, InData%SaveVZ) end if call RegPack(Buf, InData%VXSAV) @@ -4273,22 +4273,22 @@ subroutine AD14_PackElOutParms(Buf, Indata) call RegPack(Buf, InData%NumWndElOut) call RegPack(Buf, allocated(InData%WndElPrList)) if (allocated(InData%WndElPrList)) then - call RegPackBounds(Buf, 1, lbound(InData%WndElPrList), ubound(InData%WndElPrList)) + call RegPackBounds(Buf, 1, lbound(InData%WndElPrList, kind=B8Ki), ubound(InData%WndElPrList, kind=B8Ki)) call RegPack(Buf, InData%WndElPrList) end if call RegPack(Buf, allocated(InData%WndElPrNum)) if (allocated(InData%WndElPrNum)) then - call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum), ubound(InData%WndElPrNum)) + call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum, kind=B8Ki), ubound(InData%WndElPrNum, kind=B8Ki)) call RegPack(Buf, InData%WndElPrNum) end if call RegPack(Buf, allocated(InData%ElPrList)) if (allocated(InData%ElPrList)) then - call RegPackBounds(Buf, 1, lbound(InData%ElPrList), ubound(InData%ElPrList)) + call RegPackBounds(Buf, 1, lbound(InData%ElPrList, kind=B8Ki), ubound(InData%ElPrList, kind=B8Ki)) call RegPack(Buf, InData%ElPrList) end if call RegPack(Buf, allocated(InData%ElPrNum)) if (allocated(InData%ElPrNum)) then - call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) + call RegPackBounds(Buf, 1, lbound(InData%ElPrNum, kind=B8Ki), ubound(InData%ElPrNum, kind=B8Ki)) call RegPack(Buf, InData%ElPrNum) end if call RegPack(Buf, InData%NumElOut) @@ -4299,7 +4299,7 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ElOutParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackElOutParms' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4841,14 +4841,14 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD14_CopyTwrPropsParms' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcTwrPropsParmsData%TwrHtFr)) then - LB(1:1) = lbound(SrcTwrPropsParmsData%TwrHtFr) - UB(1:1) = ubound(SrcTwrPropsParmsData%TwrHtFr) + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrHtFr, kind=B8Ki) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrHtFr, kind=B8Ki) if (.not. allocated(DstTwrPropsParmsData%TwrHtFr)) then allocate(DstTwrPropsParmsData%TwrHtFr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4859,8 +4859,8 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr end if if (allocated(SrcTwrPropsParmsData%TwrWid)) then - LB(1:1) = lbound(SrcTwrPropsParmsData%TwrWid) - UB(1:1) = ubound(SrcTwrPropsParmsData%TwrWid) + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrWid, kind=B8Ki) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrWid, kind=B8Ki) if (.not. allocated(DstTwrPropsParmsData%TwrWid)) then allocate(DstTwrPropsParmsData%TwrWid(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4871,8 +4871,8 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid end if if (allocated(SrcTwrPropsParmsData%TwrCD)) then - LB(1:2) = lbound(SrcTwrPropsParmsData%TwrCD) - UB(1:2) = ubound(SrcTwrPropsParmsData%TwrCD) + LB(1:2) = lbound(SrcTwrPropsParmsData%TwrCD, kind=B8Ki) + UB(1:2) = ubound(SrcTwrPropsParmsData%TwrCD, kind=B8Ki) if (.not. allocated(DstTwrPropsParmsData%TwrCD)) then allocate(DstTwrPropsParmsData%TwrCD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4883,8 +4883,8 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD end if if (allocated(SrcTwrPropsParmsData%TwrRe)) then - LB(1:1) = lbound(SrcTwrPropsParmsData%TwrRe) - UB(1:1) = ubound(SrcTwrPropsParmsData%TwrRe) + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrRe, kind=B8Ki) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrRe, kind=B8Ki) if (.not. allocated(DstTwrPropsParmsData%TwrRe)) then allocate(DstTwrPropsParmsData%TwrRe(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4897,8 +4897,8 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant if (allocated(SrcTwrPropsParmsData%NTwrCDCol)) then - LB(1:1) = lbound(SrcTwrPropsParmsData%NTwrCDCol) - UB(1:1) = ubound(SrcTwrPropsParmsData%NTwrCDCol) + LB(1:1) = lbound(SrcTwrPropsParmsData%NTwrCDCol, kind=B8Ki) + UB(1:1) = ubound(SrcTwrPropsParmsData%NTwrCDCol, kind=B8Ki) if (.not. allocated(DstTwrPropsParmsData%NTwrCDCol)) then allocate(DstTwrPropsParmsData%NTwrCDCol(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4923,8 +4923,8 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct DstTwrPropsParmsData%CalcTwrAero = SrcTwrPropsParmsData%CalcTwrAero DstTwrPropsParmsData%NumTwrNodes = SrcTwrPropsParmsData%NumTwrNodes if (allocated(SrcTwrPropsParmsData%TwrNodeWidth)) then - LB(1:1) = lbound(SrcTwrPropsParmsData%TwrNodeWidth) - UB(1:1) = ubound(SrcTwrPropsParmsData%TwrNodeWidth) + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrNodeWidth, kind=B8Ki) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrNodeWidth, kind=B8Ki) if (.not. allocated(DstTwrPropsParmsData%TwrNodeWidth)) then allocate(DstTwrPropsParmsData%TwrNodeWidth(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4970,29 +4970,29 @@ subroutine AD14_PackTwrPropsParms(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%TwrHtFr)) if (allocated(InData%TwrHtFr)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr), ubound(InData%TwrHtFr)) + call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr, kind=B8Ki), ubound(InData%TwrHtFr, kind=B8Ki)) call RegPack(Buf, InData%TwrHtFr) end if call RegPack(Buf, allocated(InData%TwrWid)) if (allocated(InData%TwrWid)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrWid), ubound(InData%TwrWid)) + call RegPackBounds(Buf, 1, lbound(InData%TwrWid, kind=B8Ki), ubound(InData%TwrWid, kind=B8Ki)) call RegPack(Buf, InData%TwrWid) end if call RegPack(Buf, allocated(InData%TwrCD)) if (allocated(InData%TwrCD)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrCD), ubound(InData%TwrCD)) + call RegPackBounds(Buf, 2, lbound(InData%TwrCD, kind=B8Ki), ubound(InData%TwrCD, kind=B8Ki)) call RegPack(Buf, InData%TwrCD) end if call RegPack(Buf, allocated(InData%TwrRe)) if (allocated(InData%TwrRe)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrRe), ubound(InData%TwrRe)) + call RegPackBounds(Buf, 1, lbound(InData%TwrRe, kind=B8Ki), ubound(InData%TwrRe, kind=B8Ki)) call RegPack(Buf, InData%TwrRe) end if call RegPack(Buf, InData%VTwr) call RegPack(Buf, InData%Tower_Wake_Constant) call RegPack(Buf, allocated(InData%NTwrCDCol)) if (allocated(InData%NTwrCDCol)) then - call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol), ubound(InData%NTwrCDCol)) + call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol, kind=B8Ki), ubound(InData%NTwrCDCol, kind=B8Ki)) call RegPack(Buf, InData%NTwrCDCol) end if call RegPack(Buf, InData%NTwrHT) @@ -5011,7 +5011,7 @@ subroutine AD14_PackTwrPropsParms(Buf, Indata) call RegPack(Buf, InData%NumTwrNodes) call RegPack(Buf, allocated(InData%TwrNodeWidth)) if (allocated(InData%TwrNodeWidth)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth), ubound(InData%TwrNodeWidth)) + call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth, kind=B8Ki), ubound(InData%TwrNodeWidth, kind=B8Ki)) call RegPack(Buf, InData%TwrNodeWidth) end if if (RegCheckErr(Buf, RoutineName)) return @@ -5021,7 +5021,7 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(TwrPropsParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackTwrPropsParms' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5329,7 +5329,7 @@ subroutine AD14_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_CopyInitInput' @@ -5348,8 +5348,8 @@ subroutine AD14_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS if (ErrStat >= AbortErrLev) return DstInitInputData%NumTwrNodes = SrcInitInputData%NumTwrNodes if (allocated(SrcInitInputData%TwrNodeLocs)) then - LB(1:2) = lbound(SrcInitInputData%TwrNodeLocs) - UB(1:2) = ubound(SrcInitInputData%TwrNodeLocs) + LB(1:2) = lbound(SrcInitInputData%TwrNodeLocs, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%TwrNodeLocs, kind=B8Ki) if (.not. allocated(DstInitInputData%TwrNodeLocs)) then allocate(DstInitInputData%TwrNodeLocs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5400,7 +5400,7 @@ subroutine AD14_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NumTwrNodes) call RegPack(Buf, allocated(InData%TwrNodeLocs)) if (allocated(InData%TwrNodeLocs)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs), ubound(InData%TwrNodeLocs)) + call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs, kind=B8Ki), ubound(InData%TwrNodeLocs, kind=B8Ki)) call RegPack(Buf, InData%TwrNodeLocs) end if call RegPack(Buf, InData%HubHt) @@ -5412,7 +5412,7 @@ subroutine AD14_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD14_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5701,7 +5701,7 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_CopyMisc' @@ -5718,8 +5718,8 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return DstMiscData%DT = SrcMiscData%DT if (allocated(SrcMiscData%ElPrNum)) then - LB(1:1) = lbound(SrcMiscData%ElPrNum) - UB(1:1) = ubound(SrcMiscData%ElPrNum) + LB(1:1) = lbound(SrcMiscData%ElPrNum, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ElPrNum, kind=B8Ki) if (.not. allocated(DstMiscData%ElPrNum)) then allocate(DstMiscData%ElPrNum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5769,8 +5769,8 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DynInit = SrcMiscData%DynInit DstMiscData%FirstWarn = SrcMiscData%FirstWarn if (allocated(SrcMiscData%StoredForces)) then - LB(1:3) = lbound(SrcMiscData%StoredForces) - UB(1:3) = ubound(SrcMiscData%StoredForces) + LB(1:3) = lbound(SrcMiscData%StoredForces, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%StoredForces, kind=B8Ki) if (.not. allocated(DstMiscData%StoredForces)) then allocate(DstMiscData%StoredForces(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5781,8 +5781,8 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StoredForces = SrcMiscData%StoredForces end if if (allocated(SrcMiscData%StoredMoments)) then - LB(1:3) = lbound(SrcMiscData%StoredMoments) - UB(1:3) = ubound(SrcMiscData%StoredMoments) + LB(1:3) = lbound(SrcMiscData%StoredMoments, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%StoredMoments, kind=B8Ki) if (.not. allocated(DstMiscData%StoredMoments)) then allocate(DstMiscData%StoredMoments(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5847,7 +5847,7 @@ subroutine AD14_PackMisc(Buf, Indata) call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%ElPrNum)) if (allocated(InData%ElPrNum)) then - call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) + call RegPackBounds(Buf, 1, lbound(InData%ElPrNum, kind=B8Ki), ubound(InData%ElPrNum, kind=B8Ki)) call RegPack(Buf, InData%ElPrNum) end if call RegPack(Buf, InData%OldTime) @@ -5875,12 +5875,12 @@ subroutine AD14_PackMisc(Buf, Indata) call RegPack(Buf, InData%FirstWarn) call RegPack(Buf, allocated(InData%StoredForces)) if (allocated(InData%StoredForces)) then - call RegPackBounds(Buf, 3, lbound(InData%StoredForces), ubound(InData%StoredForces)) + call RegPackBounds(Buf, 3, lbound(InData%StoredForces, kind=B8Ki), ubound(InData%StoredForces, kind=B8Ki)) call RegPack(Buf, InData%StoredForces) end if call RegPack(Buf, allocated(InData%StoredMoments)) if (allocated(InData%StoredMoments)) then - call RegPackBounds(Buf, 3, lbound(InData%StoredMoments), ubound(InData%StoredMoments)) + call RegPackBounds(Buf, 3, lbound(InData%StoredMoments, kind=B8Ki), ubound(InData%StoredMoments, kind=B8Ki)) call RegPack(Buf, InData%StoredMoments) end if if (RegCheckErr(Buf, RoutineName)) return @@ -5890,7 +5890,7 @@ subroutine AD14_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD14_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackMisc' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6196,16 +6196,16 @@ subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%InputMarkers)) then - LB(1:1) = lbound(SrcInputData%InputMarkers) - UB(1:1) = ubound(SrcInputData%InputMarkers) + LB(1:1) = lbound(SrcInputData%InputMarkers, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%InputMarkers, kind=B8Ki) if (.not. allocated(DstInputData%InputMarkers)) then allocate(DstInputData%InputMarkers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6226,8 +6226,8 @@ subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%MulTabLoc)) then - LB(1:2) = lbound(SrcInputData%MulTabLoc) - UB(1:2) = ubound(SrcInputData%MulTabLoc) + LB(1:2) = lbound(SrcInputData%MulTabLoc, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%MulTabLoc, kind=B8Ki) if (.not. allocated(DstInputData%MulTabLoc)) then allocate(DstInputData%MulTabLoc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6238,8 +6238,8 @@ subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%MulTabLoc = SrcInputData%MulTabLoc end if if (allocated(SrcInputData%InflowVelocity)) then - LB(1:2) = lbound(SrcInputData%InflowVelocity) - UB(1:2) = ubound(SrcInputData%InflowVelocity) + LB(1:2) = lbound(SrcInputData%InflowVelocity, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%InflowVelocity, kind=B8Ki) if (.not. allocated(DstInputData%InflowVelocity)) then allocate(DstInputData%InflowVelocity(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6256,16 +6256,16 @@ subroutine AD14_DestroyInput(InputData, ErrStat, ErrMsg) type(AD14_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%InputMarkers)) then - LB(1:1) = lbound(InputData%InputMarkers) - UB(1:1) = ubound(InputData%InputMarkers) + LB(1:1) = lbound(InputData%InputMarkers, kind=B8Ki) + UB(1:1) = ubound(InputData%InputMarkers, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6288,14 +6288,14 @@ subroutine AD14_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%InputMarkers)) if (allocated(InData%InputMarkers)) then - call RegPackBounds(Buf, 1, lbound(InData%InputMarkers), ubound(InData%InputMarkers)) - LB(1:1) = lbound(InData%InputMarkers) - UB(1:1) = ubound(InData%InputMarkers) + call RegPackBounds(Buf, 1, lbound(InData%InputMarkers, kind=B8Ki), ubound(InData%InputMarkers, kind=B8Ki)) + LB(1:1) = lbound(InData%InputMarkers, kind=B8Ki) + UB(1:1) = ubound(InData%InputMarkers, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%InputMarkers(i1)) end do @@ -6304,12 +6304,12 @@ subroutine AD14_PackInput(Buf, Indata) call AD14_PackAeroConfig(Buf, InData%TurbineComponents) call RegPack(Buf, allocated(InData%MulTabLoc)) if (allocated(InData%MulTabLoc)) then - call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc), ubound(InData%MulTabLoc)) + call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc, kind=B8Ki), ubound(InData%MulTabLoc, kind=B8Ki)) call RegPack(Buf, InData%MulTabLoc) end if call RegPack(Buf, allocated(InData%InflowVelocity)) if (allocated(InData%InflowVelocity)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity), ubound(InData%InflowVelocity)) + call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity, kind=B8Ki), ubound(InData%InflowVelocity, kind=B8Ki)) call RegPack(Buf, InData%InflowVelocity) end if call RegPack(Buf, InData%AvgInfVel) @@ -6320,8 +6320,8 @@ subroutine AD14_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD14_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6380,16 +6380,16 @@ subroutine AD14_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%OutputLoads)) then - LB(1:1) = lbound(SrcOutputData%OutputLoads) - UB(1:1) = ubound(SrcOutputData%OutputLoads) + LB(1:1) = lbound(SrcOutputData%OutputLoads, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%OutputLoads, kind=B8Ki) if (.not. allocated(DstOutputData%OutputLoads)) then allocate(DstOutputData%OutputLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6412,16 +6412,16 @@ subroutine AD14_DestroyOutput(OutputData, ErrStat, ErrMsg) type(AD14_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD14_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%OutputLoads)) then - LB(1:1) = lbound(OutputData%OutputLoads) - UB(1:1) = ubound(OutputData%OutputLoads) + LB(1:1) = lbound(OutputData%OutputLoads, kind=B8Ki) + UB(1:1) = ubound(OutputData%OutputLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6436,14 +6436,14 @@ subroutine AD14_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%OutputLoads)) if (allocated(InData%OutputLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%OutputLoads), ubound(InData%OutputLoads)) - LB(1:1) = lbound(InData%OutputLoads) - UB(1:1) = ubound(InData%OutputLoads) + call RegPackBounds(Buf, 1, lbound(InData%OutputLoads, kind=B8Ki), ubound(InData%OutputLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%OutputLoads, kind=B8Ki) + UB(1:1) = ubound(InData%OutputLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%OutputLoads(i1)) end do @@ -6456,8 +6456,8 @@ subroutine AD14_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AD14_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6581,7 +6581,7 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + DO i1 = LBOUND(u_out%InputMarkers,1, kind=B8Ki),UBOUND(u_out%InputMarkers,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6589,16 +6589,16 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(u1%Twr_InputMarkers, u2%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%Position = a1*u1%TurbineComponents%Blade(i11)%Position + a2*u2%TurbineComponents%Blade(i11)%Position END DO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%Orientation = a1*u1%TurbineComponents%Blade(i11)%Orientation + a2*u2%TurbineComponents%Blade(i11)%Orientation END DO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%TranslationVel = a1*u1%TurbineComponents%Blade(i11)%TranslationVel + a2*u2%TurbineComponents%Blade(i11)%TranslationVel END DO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%RotationVel = a1*u1%TurbineComponents%Blade(i11)%RotationVel + a2*u2%TurbineComponents%Blade(i11)%RotationVel END DO END IF ! check if allocated @@ -6700,7 +6700,7 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + DO i1 = LBOUND(u_out%InputMarkers,1, kind=B8Ki),UBOUND(u_out%InputMarkers,1, kind=B8Ki) 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) END DO @@ -6708,16 +6708,16 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL MeshExtrapInterp2(u1%Twr_InputMarkers, u2%Twr_InputMarkers, u3%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%Position = a1*u1%TurbineComponents%Blade(i11)%Position + a2*u2%TurbineComponents%Blade(i11)%Position + a3*u3%TurbineComponents%Blade(i11)%Position END DO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%Orientation = a1*u1%TurbineComponents%Blade(i11)%Orientation + a2*u2%TurbineComponents%Blade(i11)%Orientation + a3*u3%TurbineComponents%Blade(i11)%Orientation END DO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%TranslationVel = a1*u1%TurbineComponents%Blade(i11)%TranslationVel + a2*u2%TurbineComponents%Blade(i11)%TranslationVel + a3*u3%TurbineComponents%Blade(i11)%TranslationVel END DO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki),UBOUND(u_out%TurbineComponents%Blade,1, kind=B8Ki) u_out%TurbineComponents%Blade(i11)%RotationVel = a1*u1%TurbineComponents%Blade(i11)%RotationVel + a2*u2%TurbineComponents%Blade(i11)%RotationVel + a3*u3%TurbineComponents%Blade(i11)%RotationVel END DO END IF ! check if allocated @@ -6857,7 +6857,7 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs a2 = t_out/t(2) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + DO i1 = LBOUND(y_out%OutputLoads,1, kind=B8Ki),UBOUND(y_out%OutputLoads,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6922,7 +6922,7 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + DO i1 = LBOUND(y_out%OutputLoads,1, kind=B8Ki),UBOUND(y_out%OutputLoads,1, kind=B8Ki) 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) END DO diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 1e9b95f7ed..c9756e1f5b 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -380,14 +380,14 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_Copyturbine_average_velocity_data' ErrStat = ErrID_None ErrMsg = '' if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array_temp)) then - LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array_temp) - UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array_temp) + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array_temp, kind=B8Ki) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array_temp, kind=B8Ki) if (.not. allocated(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) then allocate(Dstturbine_average_velocity_dataData%average_velocity_array_temp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -398,8 +398,8 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp end if if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array)) then - LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array) - UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array) + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array, kind=B8Ki) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array, kind=B8Ki) if (.not. allocated(Dstturbine_average_velocity_dataData%average_velocity_array)) then allocate(Dstturbine_average_velocity_dataData%average_velocity_array(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -410,8 +410,8 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array end if if (allocated(Srcturbine_average_velocity_dataData%swept_area)) then - LB(1:1) = lbound(Srcturbine_average_velocity_dataData%swept_area) - UB(1:1) = ubound(Srcturbine_average_velocity_dataData%swept_area) + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%swept_area, kind=B8Ki) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%swept_area, kind=B8Ki) if (.not. allocated(Dstturbine_average_velocity_dataData%swept_area)) then allocate(Dstturbine_average_velocity_dataData%swept_area(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -423,8 +423,8 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat end if Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity if (allocated(Srcturbine_average_velocity_dataData%time_step_velocity_array)) then - LB(1:1) = lbound(Srcturbine_average_velocity_dataData%time_step_velocity_array) - UB(1:1) = ubound(Srcturbine_average_velocity_dataData%time_step_velocity_array) + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%time_step_velocity_array, kind=B8Ki) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%time_step_velocity_array, kind=B8Ki) if (.not. allocated(Dstturbine_average_velocity_dataData%time_step_velocity_array)) then allocate(Dstturbine_average_velocity_dataData%time_step_velocity_array(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -466,23 +466,23 @@ subroutine DWM_Packturbine_average_velocity_data(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%average_velocity_array_temp)) if (allocated(InData%average_velocity_array_temp)) then - call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp), ubound(InData%average_velocity_array_temp)) + call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp, kind=B8Ki), ubound(InData%average_velocity_array_temp, kind=B8Ki)) call RegPack(Buf, InData%average_velocity_array_temp) end if call RegPack(Buf, allocated(InData%average_velocity_array)) if (allocated(InData%average_velocity_array)) then - call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array), ubound(InData%average_velocity_array)) + call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array, kind=B8Ki), ubound(InData%average_velocity_array, kind=B8Ki)) call RegPack(Buf, InData%average_velocity_array) end if call RegPack(Buf, allocated(InData%swept_area)) if (allocated(InData%swept_area)) then - call RegPackBounds(Buf, 1, lbound(InData%swept_area), ubound(InData%swept_area)) + call RegPackBounds(Buf, 1, lbound(InData%swept_area, kind=B8Ki), ubound(InData%swept_area, kind=B8Ki)) call RegPack(Buf, InData%swept_area) end if call RegPack(Buf, InData%time_step_velocity) call RegPack(Buf, allocated(InData%time_step_velocity_array)) if (allocated(InData%time_step_velocity_array)) then - call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array), ubound(InData%time_step_velocity_array)) + call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array, kind=B8Ki), ubound(InData%time_step_velocity_array, kind=B8Ki)) call RegPack(Buf, InData%time_step_velocity_array) end if call RegPack(Buf, InData%time_step_pass_velocity) @@ -494,7 +494,7 @@ subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(turbine_average_velocity_data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackturbine_average_velocity_data' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -568,7 +568,7 @@ subroutine DWM_CopyWake_Deficit_Data(SrcWake_Deficit_DataData, DstWake_Deficit_D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_CopyWake_Deficit_Data' ErrStat = ErrID_None @@ -576,8 +576,8 @@ subroutine DWM_CopyWake_Deficit_Data(SrcWake_Deficit_DataData, DstWake_Deficit_D DstWake_Deficit_DataData%np_x = SrcWake_Deficit_DataData%np_x DstWake_Deficit_DataData%X_length = SrcWake_Deficit_DataData%X_length if (allocated(SrcWake_Deficit_DataData%Turb_Stress_DWM)) then - LB(1:2) = lbound(SrcWake_Deficit_DataData%Turb_Stress_DWM) - UB(1:2) = ubound(SrcWake_Deficit_DataData%Turb_Stress_DWM) + LB(1:2) = lbound(SrcWake_Deficit_DataData%Turb_Stress_DWM, kind=B8Ki) + UB(1:2) = ubound(SrcWake_Deficit_DataData%Turb_Stress_DWM, kind=B8Ki) if (.not. allocated(DstWake_Deficit_DataData%Turb_Stress_DWM)) then allocate(DstWake_Deficit_DataData%Turb_Stress_DWM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -613,7 +613,7 @@ subroutine DWM_PackWake_Deficit_Data(Buf, Indata) call RegPack(Buf, InData%X_length) call RegPack(Buf, allocated(InData%Turb_Stress_DWM)) if (allocated(InData%Turb_Stress_DWM)) then - call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM), ubound(InData%Turb_Stress_DWM)) + call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM, kind=B8Ki), ubound(InData%Turb_Stress_DWM, kind=B8Ki)) call RegPack(Buf, InData%Turb_Stress_DWM) end if call RegPack(Buf, InData%n_x_vector) @@ -626,7 +626,7 @@ subroutine DWM_UnPackWake_Deficit_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DWM_Wake_Deficit_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackWake_Deficit_Data' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -705,15 +705,15 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_Copyread_turbine_position_data' ErrStat = ErrID_None ErrMsg = '' Dstread_turbine_position_dataData%SimulationOrder_index = Srcread_turbine_position_dataData%SimulationOrder_index if (allocated(Srcread_turbine_position_dataData%Turbine_sort_order)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%Turbine_sort_order) - UB(1:1) = ubound(Srcread_turbine_position_dataData%Turbine_sort_order) + LB(1:1) = lbound(Srcread_turbine_position_dataData%Turbine_sort_order, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%Turbine_sort_order, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%Turbine_sort_order)) then allocate(Dstread_turbine_position_dataData%Turbine_sort_order(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -725,8 +725,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index if (allocated(Srcread_turbine_position_dataData%TurbineInfluenceData)) then - LB(1:2) = lbound(Srcread_turbine_position_dataData%TurbineInfluenceData) - UB(1:2) = ubound(Srcread_turbine_position_dataData%TurbineInfluenceData) + LB(1:2) = lbound(Srcread_turbine_position_dataData%TurbineInfluenceData, kind=B8Ki) + UB(1:2) = ubound(Srcread_turbine_position_dataData%TurbineInfluenceData, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%TurbineInfluenceData)) then allocate(Dstread_turbine_position_dataData%TurbineInfluenceData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -737,8 +737,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_index)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_index) - UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_index) + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_index, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_index, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_index)) then allocate(Dstread_turbine_position_dataData%upwind_turbine_index(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -749,8 +749,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_index)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_index) - UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_index) + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_index, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_index, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_index)) then allocate(Dstread_turbine_position_dataData%downwind_turbine_index(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -763,8 +763,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number if (allocated(Srcread_turbine_position_dataData%turbine_windorigin_length)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%turbine_windorigin_length) - UB(1:1) = ubound(Srcread_turbine_position_dataData%turbine_windorigin_length) + LB(1:1) = lbound(Srcread_turbine_position_dataData%turbine_windorigin_length, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%turbine_windorigin_length, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%turbine_windorigin_length)) then allocate(Dstread_turbine_position_dataData%turbine_windorigin_length(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -775,8 +775,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) - UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) then allocate(Dstread_turbine_position_dataData%upwind_turbine_projected_distance(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -787,8 +787,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) - UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) then allocate(Dstread_turbine_position_dataData%downwind_turbine_projected_distance(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -799,8 +799,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance end if if (allocated(Srcread_turbine_position_dataData%turbine_angle)) then - LB(1:2) = lbound(Srcread_turbine_position_dataData%turbine_angle) - UB(1:2) = ubound(Srcread_turbine_position_dataData%turbine_angle) + LB(1:2) = lbound(Srcread_turbine_position_dataData%turbine_angle, kind=B8Ki) + UB(1:2) = ubound(Srcread_turbine_position_dataData%turbine_angle, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%turbine_angle)) then allocate(Dstread_turbine_position_dataData%turbine_angle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -811,8 +811,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle end if if (allocated(Srcread_turbine_position_dataData%upwind_align_angle)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_align_angle) - UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_align_angle) + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_align_angle, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_align_angle, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%upwind_align_angle)) then allocate(Dstread_turbine_position_dataData%upwind_align_angle(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -823,8 +823,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle end if if (allocated(Srcread_turbine_position_dataData%downwind_align_angle)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_align_angle) - UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_align_angle) + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_align_angle, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_align_angle, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%downwind_align_angle)) then allocate(Dstread_turbine_position_dataData%downwind_align_angle(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -835,8 +835,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) - UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) then allocate(Dstread_turbine_position_dataData%upwind_turbine_Xcoor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -847,8 +847,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) - UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) then allocate(Dstread_turbine_position_dataData%upwind_turbine_Ycoor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -859,8 +859,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor end if if (allocated(Srcread_turbine_position_dataData%wind_farm_Xcoor)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Xcoor) - UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Xcoor) + LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Xcoor, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Xcoor, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%wind_farm_Xcoor)) then allocate(Dstread_turbine_position_dataData%wind_farm_Xcoor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -871,8 +871,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor end if if (allocated(Srcread_turbine_position_dataData%wind_farm_Ycoor)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Ycoor) - UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Ycoor) + LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Ycoor, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Ycoor, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%wind_farm_Ycoor)) then allocate(Dstread_turbine_position_dataData%wind_farm_Ycoor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -883,8 +883,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) - UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) then allocate(Dstread_turbine_position_dataData%downwind_turbine_Xcoor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -895,8 +895,8 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) then - LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) - UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor, kind=B8Ki) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor, kind=B8Ki) if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) then allocate(Dstread_turbine_position_dataData%downwind_turbine_Ycoor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -973,85 +973,85 @@ subroutine DWM_Packread_turbine_position_data(Buf, Indata) call RegPack(Buf, InData%SimulationOrder_index) call RegPack(Buf, allocated(InData%Turbine_sort_order)) if (allocated(InData%Turbine_sort_order)) then - call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order), ubound(InData%Turbine_sort_order)) + call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order, kind=B8Ki), ubound(InData%Turbine_sort_order, kind=B8Ki)) call RegPack(Buf, InData%Turbine_sort_order) end if call RegPack(Buf, InData%WT_index) call RegPack(Buf, allocated(InData%TurbineInfluenceData)) if (allocated(InData%TurbineInfluenceData)) then - call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData), ubound(InData%TurbineInfluenceData)) + call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData, kind=B8Ki), ubound(InData%TurbineInfluenceData, kind=B8Ki)) call RegPack(Buf, InData%TurbineInfluenceData) end if call RegPack(Buf, allocated(InData%upwind_turbine_index)) if (allocated(InData%upwind_turbine_index)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index), ubound(InData%upwind_turbine_index)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index, kind=B8Ki), ubound(InData%upwind_turbine_index, kind=B8Ki)) call RegPack(Buf, InData%upwind_turbine_index) end if call RegPack(Buf, allocated(InData%downwind_turbine_index)) if (allocated(InData%downwind_turbine_index)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index), ubound(InData%downwind_turbine_index)) + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index, kind=B8Ki), ubound(InData%downwind_turbine_index, kind=B8Ki)) call RegPack(Buf, InData%downwind_turbine_index) end if call RegPack(Buf, InData%upwindturbine_number) call RegPack(Buf, InData%downwindturbine_number) call RegPack(Buf, allocated(InData%turbine_windorigin_length)) if (allocated(InData%turbine_windorigin_length)) then - call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length), ubound(InData%turbine_windorigin_length)) + call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length, kind=B8Ki), ubound(InData%turbine_windorigin_length, kind=B8Ki)) call RegPack(Buf, InData%turbine_windorigin_length) end if call RegPack(Buf, allocated(InData%upwind_turbine_projected_distance)) if (allocated(InData%upwind_turbine_projected_distance)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance), ubound(InData%upwind_turbine_projected_distance)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance, kind=B8Ki), ubound(InData%upwind_turbine_projected_distance, kind=B8Ki)) call RegPack(Buf, InData%upwind_turbine_projected_distance) end if call RegPack(Buf, allocated(InData%downwind_turbine_projected_distance)) if (allocated(InData%downwind_turbine_projected_distance)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance), ubound(InData%downwind_turbine_projected_distance)) + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance, kind=B8Ki), ubound(InData%downwind_turbine_projected_distance, kind=B8Ki)) call RegPack(Buf, InData%downwind_turbine_projected_distance) end if call RegPack(Buf, allocated(InData%turbine_angle)) if (allocated(InData%turbine_angle)) then - call RegPackBounds(Buf, 2, lbound(InData%turbine_angle), ubound(InData%turbine_angle)) + call RegPackBounds(Buf, 2, lbound(InData%turbine_angle, kind=B8Ki), ubound(InData%turbine_angle, kind=B8Ki)) call RegPack(Buf, InData%turbine_angle) end if call RegPack(Buf, allocated(InData%upwind_align_angle)) if (allocated(InData%upwind_align_angle)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle), ubound(InData%upwind_align_angle)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle, kind=B8Ki), ubound(InData%upwind_align_angle, kind=B8Ki)) call RegPack(Buf, InData%upwind_align_angle) end if call RegPack(Buf, allocated(InData%downwind_align_angle)) if (allocated(InData%downwind_align_angle)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle), ubound(InData%downwind_align_angle)) + call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle, kind=B8Ki), ubound(InData%downwind_align_angle, kind=B8Ki)) call RegPack(Buf, InData%downwind_align_angle) end if call RegPack(Buf, allocated(InData%upwind_turbine_Xcoor)) if (allocated(InData%upwind_turbine_Xcoor)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor), ubound(InData%upwind_turbine_Xcoor)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor, kind=B8Ki), ubound(InData%upwind_turbine_Xcoor, kind=B8Ki)) call RegPack(Buf, InData%upwind_turbine_Xcoor) end if call RegPack(Buf, allocated(InData%upwind_turbine_Ycoor)) if (allocated(InData%upwind_turbine_Ycoor)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor), ubound(InData%upwind_turbine_Ycoor)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor, kind=B8Ki), ubound(InData%upwind_turbine_Ycoor, kind=B8Ki)) call RegPack(Buf, InData%upwind_turbine_Ycoor) end if call RegPack(Buf, allocated(InData%wind_farm_Xcoor)) if (allocated(InData%wind_farm_Xcoor)) then - call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor), ubound(InData%wind_farm_Xcoor)) + call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor, kind=B8Ki), ubound(InData%wind_farm_Xcoor, kind=B8Ki)) call RegPack(Buf, InData%wind_farm_Xcoor) end if call RegPack(Buf, allocated(InData%wind_farm_Ycoor)) if (allocated(InData%wind_farm_Ycoor)) then - call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor), ubound(InData%wind_farm_Ycoor)) + call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor, kind=B8Ki), ubound(InData%wind_farm_Ycoor, kind=B8Ki)) call RegPack(Buf, InData%wind_farm_Ycoor) end if call RegPack(Buf, allocated(InData%downwind_turbine_Xcoor)) if (allocated(InData%downwind_turbine_Xcoor)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor), ubound(InData%downwind_turbine_Xcoor)) + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor, kind=B8Ki), ubound(InData%downwind_turbine_Xcoor, kind=B8Ki)) call RegPack(Buf, InData%downwind_turbine_Xcoor) end if call RegPack(Buf, allocated(InData%downwind_turbine_Ycoor)) if (allocated(InData%downwind_turbine_Ycoor)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor), ubound(InData%downwind_turbine_Ycoor)) + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor, kind=B8Ki), ubound(InData%downwind_turbine_Ycoor, kind=B8Ki)) call RegPack(Buf, InData%downwind_turbine_Ycoor) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1061,7 +1061,7 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(read_turbine_position_data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackread_turbine_position_data' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1305,14 +1305,14 @@ subroutine DWM_CopyWeiMethod(SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_CopyWeiMethod' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWeiMethodData%sweptarea)) then - LB(1:1) = lbound(SrcWeiMethodData%sweptarea) - UB(1:1) = ubound(SrcWeiMethodData%sweptarea) + LB(1:1) = lbound(SrcWeiMethodData%sweptarea, kind=B8Ki) + UB(1:1) = ubound(SrcWeiMethodData%sweptarea, kind=B8Ki) if (.not. allocated(DstWeiMethodData%sweptarea)) then allocate(DstWeiMethodData%sweptarea(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1344,7 +1344,7 @@ subroutine DWM_PackWeiMethod(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%sweptarea)) if (allocated(InData%sweptarea)) then - call RegPackBounds(Buf, 1, lbound(InData%sweptarea), ubound(InData%sweptarea)) + call RegPackBounds(Buf, 1, lbound(InData%sweptarea, kind=B8Ki), ubound(InData%sweptarea, kind=B8Ki)) call RegPack(Buf, InData%sweptarea) end if call RegPack(Buf, InData%weighting_denominator) @@ -1355,7 +1355,7 @@ subroutine DWM_UnPackWeiMethod(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WeiMethod), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackWeiMethod' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1383,14 +1383,14 @@ subroutine DWM_CopyTIDownstream(SrcTIDownstreamData, DstTIDownstreamData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_CopyTIDownstream' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcTIDownstreamData%TI_downstream_matrix)) then - LB(1:2) = lbound(SrcTIDownstreamData%TI_downstream_matrix) - UB(1:2) = ubound(SrcTIDownstreamData%TI_downstream_matrix) + LB(1:2) = lbound(SrcTIDownstreamData%TI_downstream_matrix, kind=B8Ki) + UB(1:2) = ubound(SrcTIDownstreamData%TI_downstream_matrix, kind=B8Ki) if (.not. allocated(DstTIDownstreamData%TI_downstream_matrix)) then allocate(DstTIDownstreamData%TI_downstream_matrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1450,7 +1450,7 @@ subroutine DWM_PackTIDownstream(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%TI_downstream_matrix)) if (allocated(InData%TI_downstream_matrix)) then - call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix), ubound(InData%TI_downstream_matrix)) + call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix, kind=B8Ki), ubound(InData%TI_downstream_matrix, kind=B8Ki)) call RegPack(Buf, InData%TI_downstream_matrix) end if call RegPack(Buf, InData%i) @@ -1489,7 +1489,7 @@ subroutine DWM_UnPackTIDownstream(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(TIDownstream), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackTIDownstream' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1636,14 +1636,14 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_CopyShinozuka' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcShinozukaData%f_syn)) then - LB(1:1) = lbound(SrcShinozukaData%f_syn) - UB(1:1) = ubound(SrcShinozukaData%f_syn) + LB(1:1) = lbound(SrcShinozukaData%f_syn, kind=B8Ki) + UB(1:1) = ubound(SrcShinozukaData%f_syn, kind=B8Ki) if (.not. allocated(DstShinozukaData%f_syn)) then allocate(DstShinozukaData%f_syn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1654,8 +1654,8 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt DstShinozukaData%f_syn = SrcShinozukaData%f_syn end if if (allocated(SrcShinozukaData%t_syn)) then - LB(1:1) = lbound(SrcShinozukaData%t_syn) - UB(1:1) = ubound(SrcShinozukaData%t_syn) + LB(1:1) = lbound(SrcShinozukaData%t_syn, kind=B8Ki) + UB(1:1) = ubound(SrcShinozukaData%t_syn, kind=B8Ki) if (.not. allocated(DstShinozukaData%t_syn)) then allocate(DstShinozukaData%t_syn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1666,8 +1666,8 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt DstShinozukaData%t_syn = SrcShinozukaData%t_syn end if if (allocated(SrcShinozukaData%phi)) then - LB(1:1) = lbound(SrcShinozukaData%phi) - UB(1:1) = ubound(SrcShinozukaData%phi) + LB(1:1) = lbound(SrcShinozukaData%phi, kind=B8Ki) + UB(1:1) = ubound(SrcShinozukaData%phi, kind=B8Ki) if (.not. allocated(DstShinozukaData%phi)) then allocate(DstShinozukaData%phi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1678,8 +1678,8 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt DstShinozukaData%phi = SrcShinozukaData%phi end if if (allocated(SrcShinozukaData%p_k)) then - LB(1:1) = lbound(SrcShinozukaData%p_k) - UB(1:1) = ubound(SrcShinozukaData%p_k) + LB(1:1) = lbound(SrcShinozukaData%p_k, kind=B8Ki) + UB(1:1) = ubound(SrcShinozukaData%p_k, kind=B8Ki) if (.not. allocated(DstShinozukaData%p_k)) then allocate(DstShinozukaData%p_k(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1690,8 +1690,8 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt DstShinozukaData%p_k = SrcShinozukaData%p_k end if if (allocated(SrcShinozukaData%a_k)) then - LB(1:1) = lbound(SrcShinozukaData%a_k) - UB(1:1) = ubound(SrcShinozukaData%a_k) + LB(1:1) = lbound(SrcShinozukaData%a_k, kind=B8Ki) + UB(1:1) = ubound(SrcShinozukaData%a_k, kind=B8Ki) if (.not. allocated(DstShinozukaData%a_k)) then allocate(DstShinozukaData%a_k(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1742,27 +1742,27 @@ subroutine DWM_PackShinozuka(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%f_syn)) if (allocated(InData%f_syn)) then - call RegPackBounds(Buf, 1, lbound(InData%f_syn), ubound(InData%f_syn)) + call RegPackBounds(Buf, 1, lbound(InData%f_syn, kind=B8Ki), ubound(InData%f_syn, kind=B8Ki)) call RegPack(Buf, InData%f_syn) end if call RegPack(Buf, allocated(InData%t_syn)) if (allocated(InData%t_syn)) then - call RegPackBounds(Buf, 1, lbound(InData%t_syn), ubound(InData%t_syn)) + call RegPackBounds(Buf, 1, lbound(InData%t_syn, kind=B8Ki), ubound(InData%t_syn, kind=B8Ki)) call RegPack(Buf, InData%t_syn) end if call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then - call RegPackBounds(Buf, 1, lbound(InData%phi), ubound(InData%phi)) + call RegPackBounds(Buf, 1, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) call RegPack(Buf, InData%phi) end if call RegPack(Buf, allocated(InData%p_k)) if (allocated(InData%p_k)) then - call RegPackBounds(Buf, 1, lbound(InData%p_k), ubound(InData%p_k)) + call RegPackBounds(Buf, 1, lbound(InData%p_k, kind=B8Ki), ubound(InData%p_k, kind=B8Ki)) call RegPack(Buf, InData%p_k) end if call RegPack(Buf, allocated(InData%a_k)) if (allocated(InData%a_k)) then - call RegPackBounds(Buf, 1, lbound(InData%a_k), ubound(InData%a_k)) + call RegPackBounds(Buf, 1, lbound(InData%a_k, kind=B8Ki), ubound(InData%a_k, kind=B8Ki)) call RegPack(Buf, InData%a_k) end if call RegPack(Buf, InData%num_points) @@ -1780,7 +1780,7 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Shinozuka), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackShinozuka' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1976,14 +1976,14 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_Copyread_upwind_result' ErrStat = ErrID_None ErrMsg = '' if (allocated(Srcread_upwind_resultData%upwind_U)) then - LB(1:2) = lbound(Srcread_upwind_resultData%upwind_U) - UB(1:2) = ubound(Srcread_upwind_resultData%upwind_U) + LB(1:2) = lbound(Srcread_upwind_resultData%upwind_U, kind=B8Ki) + UB(1:2) = ubound(Srcread_upwind_resultData%upwind_U, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%upwind_U)) then allocate(Dstread_upwind_resultData%upwind_U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1994,8 +1994,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U end if if (allocated(Srcread_upwind_resultData%upwind_wakecenter)) then - LB(1:4) = lbound(Srcread_upwind_resultData%upwind_wakecenter) - UB(1:4) = ubound(Srcread_upwind_resultData%upwind_wakecenter) + LB(1:4) = lbound(Srcread_upwind_resultData%upwind_wakecenter, kind=B8Ki) + UB(1:4) = ubound(Srcread_upwind_resultData%upwind_wakecenter, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%upwind_wakecenter)) then allocate(Dstread_upwind_resultData%upwind_wakecenter(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2006,8 +2006,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter end if if (allocated(Srcread_upwind_resultData%upwind_meanU)) then - LB(1:1) = lbound(Srcread_upwind_resultData%upwind_meanU) - UB(1:1) = ubound(Srcread_upwind_resultData%upwind_meanU) + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_meanU, kind=B8Ki) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_meanU, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%upwind_meanU)) then allocate(Dstread_upwind_resultData%upwind_meanU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2018,8 +2018,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU end if if (allocated(Srcread_upwind_resultData%upwind_TI)) then - LB(1:1) = lbound(Srcread_upwind_resultData%upwind_TI) - UB(1:1) = ubound(Srcread_upwind_resultData%upwind_TI) + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_TI, kind=B8Ki) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_TI, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%upwind_TI)) then allocate(Dstread_upwind_resultData%upwind_TI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2030,8 +2030,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI end if if (allocated(Srcread_upwind_resultData%upwind_small_TI)) then - LB(1:1) = lbound(Srcread_upwind_resultData%upwind_small_TI) - UB(1:1) = ubound(Srcread_upwind_resultData%upwind_small_TI) + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_small_TI, kind=B8Ki) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_small_TI, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%upwind_small_TI)) then allocate(Dstread_upwind_resultData%upwind_small_TI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2042,8 +2042,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI end if if (allocated(Srcread_upwind_resultData%upwind_smoothWake)) then - LB(1:2) = lbound(Srcread_upwind_resultData%upwind_smoothWake) - UB(1:2) = ubound(Srcread_upwind_resultData%upwind_smoothWake) + LB(1:2) = lbound(Srcread_upwind_resultData%upwind_smoothWake, kind=B8Ki) + UB(1:2) = ubound(Srcread_upwind_resultData%upwind_smoothWake, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%upwind_smoothWake)) then allocate(Dstread_upwind_resultData%upwind_smoothWake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2054,8 +2054,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake end if if (allocated(Srcread_upwind_resultData%velocity_aerodyn)) then - LB(1:1) = lbound(Srcread_upwind_resultData%velocity_aerodyn) - UB(1:1) = ubound(Srcread_upwind_resultData%velocity_aerodyn) + LB(1:1) = lbound(Srcread_upwind_resultData%velocity_aerodyn, kind=B8Ki) + UB(1:1) = ubound(Srcread_upwind_resultData%velocity_aerodyn, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%velocity_aerodyn)) then allocate(Dstread_upwind_resultData%velocity_aerodyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2066,8 +2066,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn end if if (allocated(Srcread_upwind_resultData%TI_downstream)) then - LB(1:1) = lbound(Srcread_upwind_resultData%TI_downstream) - UB(1:1) = ubound(Srcread_upwind_resultData%TI_downstream) + LB(1:1) = lbound(Srcread_upwind_resultData%TI_downstream, kind=B8Ki) + UB(1:1) = ubound(Srcread_upwind_resultData%TI_downstream, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%TI_downstream)) then allocate(Dstread_upwind_resultData%TI_downstream(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2078,8 +2078,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream end if if (allocated(Srcread_upwind_resultData%small_scale_TI_downstream)) then - LB(1:1) = lbound(Srcread_upwind_resultData%small_scale_TI_downstream) - UB(1:1) = ubound(Srcread_upwind_resultData%small_scale_TI_downstream) + LB(1:1) = lbound(Srcread_upwind_resultData%small_scale_TI_downstream, kind=B8Ki) + UB(1:1) = ubound(Srcread_upwind_resultData%small_scale_TI_downstream, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%small_scale_TI_downstream)) then allocate(Dstread_upwind_resultData%small_scale_TI_downstream(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2090,8 +2090,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream end if if (allocated(Srcread_upwind_resultData%smoothed_velocity_array)) then - LB(1:2) = lbound(Srcread_upwind_resultData%smoothed_velocity_array) - UB(1:2) = ubound(Srcread_upwind_resultData%smoothed_velocity_array) + LB(1:2) = lbound(Srcread_upwind_resultData%smoothed_velocity_array, kind=B8Ki) + UB(1:2) = ubound(Srcread_upwind_resultData%smoothed_velocity_array, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%smoothed_velocity_array)) then allocate(Dstread_upwind_resultData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2102,8 +2102,8 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array end if if (allocated(Srcread_upwind_resultData%vel_matrix)) then - LB(1:3) = lbound(Srcread_upwind_resultData%vel_matrix) - UB(1:3) = ubound(Srcread_upwind_resultData%vel_matrix) + LB(1:3) = lbound(Srcread_upwind_resultData%vel_matrix, kind=B8Ki) + UB(1:3) = ubound(Srcread_upwind_resultData%vel_matrix, kind=B8Ki) if (.not. allocated(Dstread_upwind_resultData%vel_matrix)) then allocate(Dstread_upwind_resultData%vel_matrix(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2164,57 +2164,57 @@ subroutine DWM_Packread_upwind_result(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%upwind_U)) if (allocated(InData%upwind_U)) then - call RegPackBounds(Buf, 2, lbound(InData%upwind_U), ubound(InData%upwind_U)) + call RegPackBounds(Buf, 2, lbound(InData%upwind_U, kind=B8Ki), ubound(InData%upwind_U, kind=B8Ki)) call RegPack(Buf, InData%upwind_U) end if call RegPack(Buf, allocated(InData%upwind_wakecenter)) if (allocated(InData%upwind_wakecenter)) then - call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter), ubound(InData%upwind_wakecenter)) + call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter, kind=B8Ki), ubound(InData%upwind_wakecenter, kind=B8Ki)) call RegPack(Buf, InData%upwind_wakecenter) end if call RegPack(Buf, allocated(InData%upwind_meanU)) if (allocated(InData%upwind_meanU)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU), ubound(InData%upwind_meanU)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU, kind=B8Ki), ubound(InData%upwind_meanU, kind=B8Ki)) call RegPack(Buf, InData%upwind_meanU) end if call RegPack(Buf, allocated(InData%upwind_TI)) if (allocated(InData%upwind_TI)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_TI), ubound(InData%upwind_TI)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_TI, kind=B8Ki), ubound(InData%upwind_TI, kind=B8Ki)) call RegPack(Buf, InData%upwind_TI) end if call RegPack(Buf, allocated(InData%upwind_small_TI)) if (allocated(InData%upwind_small_TI)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI), ubound(InData%upwind_small_TI)) + call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI, kind=B8Ki), ubound(InData%upwind_small_TI, kind=B8Ki)) call RegPack(Buf, InData%upwind_small_TI) end if call RegPack(Buf, allocated(InData%upwind_smoothWake)) if (allocated(InData%upwind_smoothWake)) then - call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake), ubound(InData%upwind_smoothWake)) + call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake, kind=B8Ki), ubound(InData%upwind_smoothWake, kind=B8Ki)) call RegPack(Buf, InData%upwind_smoothWake) end if call RegPack(Buf, allocated(InData%velocity_aerodyn)) if (allocated(InData%velocity_aerodyn)) then - call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn), ubound(InData%velocity_aerodyn)) + call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn, kind=B8Ki), ubound(InData%velocity_aerodyn, kind=B8Ki)) call RegPack(Buf, InData%velocity_aerodyn) end if call RegPack(Buf, allocated(InData%TI_downstream)) if (allocated(InData%TI_downstream)) then - call RegPackBounds(Buf, 1, lbound(InData%TI_downstream), ubound(InData%TI_downstream)) + call RegPackBounds(Buf, 1, lbound(InData%TI_downstream, kind=B8Ki), ubound(InData%TI_downstream, kind=B8Ki)) call RegPack(Buf, InData%TI_downstream) end if call RegPack(Buf, allocated(InData%small_scale_TI_downstream)) if (allocated(InData%small_scale_TI_downstream)) then - call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream), ubound(InData%small_scale_TI_downstream)) + call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream, kind=B8Ki), ubound(InData%small_scale_TI_downstream, kind=B8Ki)) call RegPack(Buf, InData%small_scale_TI_downstream) end if call RegPack(Buf, allocated(InData%smoothed_velocity_array)) if (allocated(InData%smoothed_velocity_array)) then - call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) + call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array, kind=B8Ki), ubound(InData%smoothed_velocity_array, kind=B8Ki)) call RegPack(Buf, InData%smoothed_velocity_array) end if call RegPack(Buf, allocated(InData%vel_matrix)) if (allocated(InData%vel_matrix)) then - call RegPackBounds(Buf, 3, lbound(InData%vel_matrix), ubound(InData%vel_matrix)) + call RegPackBounds(Buf, 3, lbound(InData%vel_matrix, kind=B8Ki), ubound(InData%vel_matrix, kind=B8Ki)) call RegPack(Buf, InData%vel_matrix) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2224,7 +2224,7 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(read_upwind_result), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackread_upwind_result' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2390,14 +2390,14 @@ subroutine DWM_Copywake_meandered_center(Srcwake_meandered_centerData, Dstwake_m integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DWM_Copywake_meandered_center' ErrStat = ErrID_None ErrMsg = '' if (allocated(Srcwake_meandered_centerData%wake_width)) then - LB(1:1) = lbound(Srcwake_meandered_centerData%wake_width) - UB(1:1) = ubound(Srcwake_meandered_centerData%wake_width) + LB(1:1) = lbound(Srcwake_meandered_centerData%wake_width, kind=B8Ki) + UB(1:1) = ubound(Srcwake_meandered_centerData%wake_width, kind=B8Ki) if (.not. allocated(Dstwake_meandered_centerData%wake_width)) then allocate(Dstwake_meandered_centerData%wake_width(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2428,7 +2428,7 @@ subroutine DWM_Packwake_meandered_center(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%wake_width)) if (allocated(InData%wake_width)) then - call RegPackBounds(Buf, 1, lbound(InData%wake_width), ubound(InData%wake_width)) + call RegPackBounds(Buf, 1, lbound(InData%wake_width, kind=B8Ki), ubound(InData%wake_width, kind=B8Ki)) call RegPack(Buf, InData%wake_width) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2438,7 +2438,7 @@ subroutine DWM_UnPackwake_meandered_center(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(wake_meandered_center), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackwake_meandered_center' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2511,15 +2511,15 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DWM_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%velocityU)) then - LB(1:1) = lbound(SrcParamData%velocityU) - UB(1:1) = ubound(SrcParamData%velocityU) + LB(1:1) = lbound(SrcParamData%velocityU, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%velocityU, kind=B8Ki) if (.not. allocated(DstParamData%velocityU)) then allocate(DstParamData%velocityU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2530,8 +2530,8 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%velocityU = SrcParamData%velocityU end if if (allocated(SrcParamData%smoothed_wake)) then - LB(1:1) = lbound(SrcParamData%smoothed_wake) - UB(1:1) = ubound(SrcParamData%smoothed_wake) + LB(1:1) = lbound(SrcParamData%smoothed_wake, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%smoothed_wake, kind=B8Ki) if (.not. allocated(DstParamData%smoothed_wake)) then allocate(DstParamData%smoothed_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2542,8 +2542,8 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%smoothed_wake = SrcParamData%smoothed_wake end if if (allocated(SrcParamData%WakePosition)) then - LB(1:3) = lbound(SrcParamData%WakePosition) - UB(1:3) = ubound(SrcParamData%WakePosition) + LB(1:3) = lbound(SrcParamData%WakePosition, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%WakePosition, kind=B8Ki) if (.not. allocated(DstParamData%WakePosition)) then allocate(DstParamData%WakePosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2573,8 +2573,8 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%air_density = SrcParamData%air_density DstParamData%RR = SrcParamData%RR if (allocated(SrcParamData%ElementRad)) then - LB(1:1) = lbound(SrcParamData%ElementRad) - UB(1:1) = ubound(SrcParamData%ElementRad) + LB(1:1) = lbound(SrcParamData%ElementRad, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ElementRad, kind=B8Ki) if (.not. allocated(DstParamData%ElementRad)) then allocate(DstParamData%ElementRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2628,17 +2628,17 @@ subroutine DWM_PackParam(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%velocityU)) if (allocated(InData%velocityU)) then - call RegPackBounds(Buf, 1, lbound(InData%velocityU), ubound(InData%velocityU)) + call RegPackBounds(Buf, 1, lbound(InData%velocityU, kind=B8Ki), ubound(InData%velocityU, kind=B8Ki)) call RegPack(Buf, InData%velocityU) end if call RegPack(Buf, allocated(InData%smoothed_wake)) if (allocated(InData%smoothed_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake), ubound(InData%smoothed_wake)) + call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake, kind=B8Ki), ubound(InData%smoothed_wake, kind=B8Ki)) call RegPack(Buf, InData%smoothed_wake) end if call RegPack(Buf, allocated(InData%WakePosition)) if (allocated(InData%WakePosition)) then - call RegPackBounds(Buf, 3, lbound(InData%WakePosition), ubound(InData%WakePosition)) + call RegPackBounds(Buf, 3, lbound(InData%WakePosition, kind=B8Ki), ubound(InData%WakePosition, kind=B8Ki)) call RegPack(Buf, InData%WakePosition) end if call RegPack(Buf, InData%WakePosition_1) @@ -2662,7 +2662,7 @@ subroutine DWM_PackParam(Buf, Indata) call RegPack(Buf, InData%RR) call RegPack(Buf, allocated(InData%ElementRad)) if (allocated(InData%ElementRad)) then - call RegPackBounds(Buf, 1, lbound(InData%ElementRad), ubound(InData%ElementRad)) + call RegPackBounds(Buf, 1, lbound(InData%ElementRad, kind=B8Ki), ubound(InData%ElementRad, kind=B8Ki)) call RegPack(Buf, InData%ElementRad) end if call RegPack(Buf, InData%Bnum) @@ -2676,7 +2676,7 @@ subroutine DWM_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DWM_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackParam' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2834,7 +2834,7 @@ subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DWM_CopyMisc' @@ -2850,8 +2850,8 @@ subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_velocity = SrcMiscData%U_velocity DstMiscData%V_velocity = SrcMiscData%V_velocity if (allocated(SrcMiscData%Nforce)) then - LB(1:2) = lbound(SrcMiscData%Nforce) - UB(1:2) = ubound(SrcMiscData%Nforce) + LB(1:2) = lbound(SrcMiscData%Nforce, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%Nforce, kind=B8Ki) if (.not. allocated(DstMiscData%Nforce)) then allocate(DstMiscData%Nforce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2862,8 +2862,8 @@ subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Nforce = SrcMiscData%Nforce end if if (allocated(SrcMiscData%blade_dr)) then - LB(1:1) = lbound(SrcMiscData%blade_dr) - UB(1:1) = ubound(SrcMiscData%blade_dr) + LB(1:1) = lbound(SrcMiscData%blade_dr, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%blade_dr, kind=B8Ki) if (.not. allocated(DstMiscData%blade_dr)) then allocate(DstMiscData%blade_dr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2973,12 +2973,12 @@ subroutine DWM_PackMisc(Buf, Indata) call RegPack(Buf, InData%V_velocity) call RegPack(Buf, allocated(InData%Nforce)) if (allocated(InData%Nforce)) then - call RegPackBounds(Buf, 2, lbound(InData%Nforce), ubound(InData%Nforce)) + call RegPackBounds(Buf, 2, lbound(InData%Nforce, kind=B8Ki), ubound(InData%Nforce, kind=B8Ki)) call RegPack(Buf, InData%Nforce) end if call RegPack(Buf, allocated(InData%blade_dr)) if (allocated(InData%blade_dr)) then - call RegPackBounds(Buf, 1, lbound(InData%blade_dr), ubound(InData%blade_dr)) + call RegPackBounds(Buf, 1, lbound(InData%blade_dr, kind=B8Ki), ubound(InData%blade_dr, kind=B8Ki)) call RegPack(Buf, InData%blade_dr) end if call RegPack(Buf, InData%NacYaw) @@ -3005,7 +3005,7 @@ subroutine DWM_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DWM_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackMisc' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3133,15 +3133,15 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DWM_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%turbine_thrust_force)) then - LB(1:1) = lbound(SrcOutputData%turbine_thrust_force) - UB(1:1) = ubound(SrcOutputData%turbine_thrust_force) + LB(1:1) = lbound(SrcOutputData%turbine_thrust_force, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%turbine_thrust_force, kind=B8Ki) if (.not. allocated(DstOutputData%turbine_thrust_force)) then allocate(DstOutputData%turbine_thrust_force(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3152,8 +3152,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force end if if (allocated(SrcOutputData%induction_factor)) then - LB(1:1) = lbound(SrcOutputData%induction_factor) - UB(1:1) = ubound(SrcOutputData%induction_factor) + LB(1:1) = lbound(SrcOutputData%induction_factor, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%induction_factor, kind=B8Ki) if (.not. allocated(DstOutputData%induction_factor)) then allocate(DstOutputData%induction_factor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3164,8 +3164,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%induction_factor = SrcOutputData%induction_factor end if if (allocated(SrcOutputData%r_initial)) then - LB(1:1) = lbound(SrcOutputData%r_initial) - UB(1:1) = ubound(SrcOutputData%r_initial) + LB(1:1) = lbound(SrcOutputData%r_initial, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%r_initial, kind=B8Ki) if (.not. allocated(DstOutputData%r_initial)) then allocate(DstOutputData%r_initial(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3176,8 +3176,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%r_initial = SrcOutputData%r_initial end if if (allocated(SrcOutputData%U_initial)) then - LB(1:1) = lbound(SrcOutputData%U_initial) - UB(1:1) = ubound(SrcOutputData%U_initial) + LB(1:1) = lbound(SrcOutputData%U_initial, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%U_initial, kind=B8Ki) if (.not. allocated(DstOutputData%U_initial)) then allocate(DstOutputData%U_initial(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3188,8 +3188,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%U_initial = SrcOutputData%U_initial end if if (allocated(SrcOutputData%Mean_FFWS_array)) then - LB(1:1) = lbound(SrcOutputData%Mean_FFWS_array) - UB(1:1) = ubound(SrcOutputData%Mean_FFWS_array) + LB(1:1) = lbound(SrcOutputData%Mean_FFWS_array, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Mean_FFWS_array, kind=B8Ki) if (.not. allocated(DstOutputData%Mean_FFWS_array)) then allocate(DstOutputData%Mean_FFWS_array(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3203,8 +3203,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%TI = SrcOutputData%TI DstOutputData%TI_downstream = SrcOutputData%TI_downstream if (allocated(SrcOutputData%wake_u)) then - LB(1:2) = lbound(SrcOutputData%wake_u) - UB(1:2) = ubound(SrcOutputData%wake_u) + LB(1:2) = lbound(SrcOutputData%wake_u, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%wake_u, kind=B8Ki) if (.not. allocated(DstOutputData%wake_u)) then allocate(DstOutputData%wake_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3215,8 +3215,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%wake_u = SrcOutputData%wake_u end if if (allocated(SrcOutputData%wake_position)) then - LB(1:3) = lbound(SrcOutputData%wake_position) - UB(1:3) = ubound(SrcOutputData%wake_position) + LB(1:3) = lbound(SrcOutputData%wake_position, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%wake_position, kind=B8Ki) if (.not. allocated(DstOutputData%wake_position)) then allocate(DstOutputData%wake_position(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3227,8 +3227,8 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%wake_position = SrcOutputData%wake_position end if if (allocated(SrcOutputData%smoothed_velocity_array)) then - LB(1:2) = lbound(SrcOutputData%smoothed_velocity_array) - UB(1:2) = ubound(SrcOutputData%smoothed_velocity_array) + LB(1:2) = lbound(SrcOutputData%smoothed_velocity_array, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%smoothed_velocity_array, kind=B8Ki) if (.not. allocated(DstOutputData%smoothed_velocity_array)) then allocate(DstOutputData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3292,27 +3292,27 @@ subroutine DWM_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%turbine_thrust_force)) if (allocated(InData%turbine_thrust_force)) then - call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force), ubound(InData%turbine_thrust_force)) + call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force, kind=B8Ki), ubound(InData%turbine_thrust_force, kind=B8Ki)) call RegPack(Buf, InData%turbine_thrust_force) end if call RegPack(Buf, allocated(InData%induction_factor)) if (allocated(InData%induction_factor)) then - call RegPackBounds(Buf, 1, lbound(InData%induction_factor), ubound(InData%induction_factor)) + call RegPackBounds(Buf, 1, lbound(InData%induction_factor, kind=B8Ki), ubound(InData%induction_factor, kind=B8Ki)) call RegPack(Buf, InData%induction_factor) end if call RegPack(Buf, allocated(InData%r_initial)) if (allocated(InData%r_initial)) then - call RegPackBounds(Buf, 1, lbound(InData%r_initial), ubound(InData%r_initial)) + call RegPackBounds(Buf, 1, lbound(InData%r_initial, kind=B8Ki), ubound(InData%r_initial, kind=B8Ki)) call RegPack(Buf, InData%r_initial) end if call RegPack(Buf, allocated(InData%U_initial)) if (allocated(InData%U_initial)) then - call RegPackBounds(Buf, 1, lbound(InData%U_initial), ubound(InData%U_initial)) + call RegPackBounds(Buf, 1, lbound(InData%U_initial, kind=B8Ki), ubound(InData%U_initial, kind=B8Ki)) call RegPack(Buf, InData%U_initial) end if call RegPack(Buf, allocated(InData%Mean_FFWS_array)) if (allocated(InData%Mean_FFWS_array)) then - call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array), ubound(InData%Mean_FFWS_array)) + call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array, kind=B8Ki), ubound(InData%Mean_FFWS_array, kind=B8Ki)) call RegPack(Buf, InData%Mean_FFWS_array) end if call RegPack(Buf, InData%Mean_FFWS) @@ -3320,17 +3320,17 @@ subroutine DWM_PackOutput(Buf, Indata) call RegPack(Buf, InData%TI_downstream) call RegPack(Buf, allocated(InData%wake_u)) if (allocated(InData%wake_u)) then - call RegPackBounds(Buf, 2, lbound(InData%wake_u), ubound(InData%wake_u)) + call RegPackBounds(Buf, 2, lbound(InData%wake_u, kind=B8Ki), ubound(InData%wake_u, kind=B8Ki)) call RegPack(Buf, InData%wake_u) end if call RegPack(Buf, allocated(InData%wake_position)) if (allocated(InData%wake_position)) then - call RegPackBounds(Buf, 3, lbound(InData%wake_position), ubound(InData%wake_position)) + call RegPackBounds(Buf, 3, lbound(InData%wake_position, kind=B8Ki), ubound(InData%wake_position, kind=B8Ki)) call RegPack(Buf, InData%wake_position) end if call RegPack(Buf, allocated(InData%smoothed_velocity_array)) if (allocated(InData%smoothed_velocity_array)) then - call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) + call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array, kind=B8Ki), ubound(InData%smoothed_velocity_array, kind=B8Ki)) call RegPack(Buf, InData%smoothed_velocity_array) end if call RegPack(Buf, InData%AtmUscale) @@ -3346,7 +3346,7 @@ subroutine DWM_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(DWM_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackOutput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index d01c244767..3845a5e793 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -253,14 +253,14 @@ subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGrid' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcHighWindGridData%data)) then - LB(1:5) = lbound(SrcHighWindGridData%data) - UB(1:5) = ubound(SrcHighWindGridData%data) + LB(1:5) = lbound(SrcHighWindGridData%data, kind=B8Ki) + UB(1:5) = ubound(SrcHighWindGridData%data, kind=B8Ki) if (.not. associated(DstHighWindGridData%data)) then allocate(DstHighWindGridData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -293,7 +293,7 @@ subroutine AWAE_PackHighWindGrid(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, associated(InData%data)) if (associated(InData%data)) then - call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) + call RegPackBounds(Buf, 5, lbound(InData%data, kind=B8Ki), ubound(InData%data, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%data) @@ -306,10 +306,10 @@ subroutine AWAE_UnPackHighWindGrid(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_HighWindGrid), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%data)) deallocate(OutData%data) @@ -344,7 +344,7 @@ subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGridPtr' ErrStat = ErrID_None @@ -370,7 +370,7 @@ subroutine AWAE_PackHighWindGridPtr(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, associated(InData%data)) if (associated(InData%data)) then - call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) + call RegPackBounds(Buf, 5, lbound(InData%data, kind=B8Ki), ubound(InData%data, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%data) @@ -383,10 +383,10 @@ subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_HighWindGridPtr), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%data)) deallocate(OutData%data) @@ -421,7 +421,7 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyInputFileType' ErrStat = ErrID_None @@ -435,8 +435,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY if (allocated(SrcInputFileTypeData%OutDisWindZ)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%OutDisWindZ)) then allocate(DstInputFileTypeData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -448,8 +448,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ if (allocated(SrcInputFileTypeData%OutDisWindX)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%OutDisWindX)) then allocate(DstInputFileTypeData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -461,8 +461,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ if (allocated(SrcInputFileTypeData%OutDisWindY)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%OutDisWindY)) then allocate(DstInputFileTypeData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -480,8 +480,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high if (allocated(SrcInputFileTypeData%X0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%X0_high) - UB(1:1) = ubound(SrcInputFileTypeData%X0_high) + LB(1:1) = lbound(SrcInputFileTypeData%X0_high, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%X0_high, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%X0_high)) then allocate(DstInputFileTypeData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -492,8 +492,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high end if if (allocated(SrcInputFileTypeData%Y0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) - UB(1:1) = ubound(SrcInputFileTypeData%Y0_high) + LB(1:1) = lbound(SrcInputFileTypeData%Y0_high, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%Y0_high, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%Y0_high)) then allocate(DstInputFileTypeData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -504,8 +504,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high end if if (allocated(SrcInputFileTypeData%Z0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) - UB(1:1) = ubound(SrcInputFileTypeData%Z0_high) + LB(1:1) = lbound(SrcInputFileTypeData%Z0_high, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%Z0_high, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%Z0_high)) then allocate(DstInputFileTypeData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -516,8 +516,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high end if if (allocated(SrcInputFileTypeData%dX_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dX_high) - UB(1:1) = ubound(SrcInputFileTypeData%dX_high) + LB(1:1) = lbound(SrcInputFileTypeData%dX_high, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%dX_high, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%dX_high)) then allocate(DstInputFileTypeData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -528,8 +528,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high end if if (allocated(SrcInputFileTypeData%dY_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dY_high) - UB(1:1) = ubound(SrcInputFileTypeData%dY_high) + LB(1:1) = lbound(SrcInputFileTypeData%dY_high, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%dY_high, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%dY_high)) then allocate(DstInputFileTypeData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -540,8 +540,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high end if if (allocated(SrcInputFileTypeData%dZ_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) - UB(1:1) = ubound(SrcInputFileTypeData%dZ_high) + LB(1:1) = lbound(SrcInputFileTypeData%dZ_high, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileTypeData%dZ_high, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%dZ_high)) then allocate(DstInputFileTypeData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -564,8 +564,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low if (allocated(SrcInputFileTypeData%WT_Position)) then - LB(1:2) = lbound(SrcInputFileTypeData%WT_Position) - UB(1:2) = ubound(SrcInputFileTypeData%WT_Position) + LB(1:2) = lbound(SrcInputFileTypeData%WT_Position, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileTypeData%WT_Position, kind=B8Ki) if (.not. allocated(DstInputFileTypeData%WT_Position)) then allocate(DstInputFileTypeData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -632,19 +632,19 @@ subroutine AWAE_PackInputFileType(Buf, Indata) call RegPack(Buf, InData%NOutDisWindXY) call RegPack(Buf, allocated(InData%OutDisWindZ)) if (allocated(InData%OutDisWindZ)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ, kind=B8Ki), ubound(InData%OutDisWindZ, kind=B8Ki)) call RegPack(Buf, InData%OutDisWindZ) end if call RegPack(Buf, InData%NOutDisWindYZ) call RegPack(Buf, allocated(InData%OutDisWindX)) if (allocated(InData%OutDisWindX)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX, kind=B8Ki), ubound(InData%OutDisWindX, kind=B8Ki)) call RegPack(Buf, InData%OutDisWindX) end if call RegPack(Buf, InData%NOutDisWindXZ) call RegPack(Buf, allocated(InData%OutDisWindY)) if (allocated(InData%OutDisWindY)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY, kind=B8Ki), ubound(InData%OutDisWindY, kind=B8Ki)) call RegPack(Buf, InData%OutDisWindY) end if call RegPack(Buf, InData%WrDisDT) @@ -656,32 +656,32 @@ subroutine AWAE_PackInputFileType(Buf, Indata) call RegPack(Buf, InData%dt_high) call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPackBounds(Buf, 1, lbound(InData%X0_high, kind=B8Ki), ubound(InData%X0_high, kind=B8Ki)) call RegPack(Buf, InData%X0_high) end if call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPackBounds(Buf, 1, lbound(InData%Y0_high, kind=B8Ki), ubound(InData%Y0_high, kind=B8Ki)) call RegPack(Buf, InData%Y0_high) end if call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPackBounds(Buf, 1, lbound(InData%Z0_high, kind=B8Ki), ubound(InData%Z0_high, kind=B8Ki)) call RegPack(Buf, InData%Z0_high) end if call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPackBounds(Buf, 1, lbound(InData%dX_high, kind=B8Ki), ubound(InData%dX_high, kind=B8Ki)) call RegPack(Buf, InData%dX_high) end if call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPackBounds(Buf, 1, lbound(InData%dY_high, kind=B8Ki), ubound(InData%dY_high, kind=B8Ki)) call RegPack(Buf, InData%dY_high) end if call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPackBounds(Buf, 1, lbound(InData%dZ_high, kind=B8Ki), ubound(InData%dZ_high, kind=B8Ki)) call RegPack(Buf, InData%dZ_high) end if call RegPack(Buf, InData%nX_high) @@ -698,7 +698,7 @@ subroutine AWAE_PackInputFileType(Buf, Indata) call RegPack(Buf, InData%Z0_low) call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then - call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPackBounds(Buf, 2, lbound(InData%WT_Position, kind=B8Ki), ubound(InData%WT_Position, kind=B8Ki)) call RegPack(Buf, InData%WT_Position) end if call RegPack(Buf, InData%Mod_Projection) @@ -709,7 +709,7 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -979,8 +979,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyInitOutput' @@ -990,8 +990,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%X0_high)) then - LB(1:1) = lbound(SrcInitOutputData%X0_high) - UB(1:1) = ubound(SrcInitOutputData%X0_high) + LB(1:1) = lbound(SrcInitOutputData%X0_high, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%X0_high, kind=B8Ki) if (.not. allocated(DstInitOutputData%X0_high)) then allocate(DstInitOutputData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1002,8 +1002,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%X0_high = SrcInitOutputData%X0_high end if if (allocated(SrcInitOutputData%Y0_high)) then - LB(1:1) = lbound(SrcInitOutputData%Y0_high) - UB(1:1) = ubound(SrcInitOutputData%Y0_high) + LB(1:1) = lbound(SrcInitOutputData%Y0_high, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%Y0_high, kind=B8Ki) if (.not. allocated(DstInitOutputData%Y0_high)) then allocate(DstInitOutputData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1014,8 +1014,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high end if if (allocated(SrcInitOutputData%Z0_high)) then - LB(1:1) = lbound(SrcInitOutputData%Z0_high) - UB(1:1) = ubound(SrcInitOutputData%Z0_high) + LB(1:1) = lbound(SrcInitOutputData%Z0_high, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%Z0_high, kind=B8Ki) if (.not. allocated(DstInitOutputData%Z0_high)) then allocate(DstInitOutputData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,8 +1026,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high end if if (allocated(SrcInitOutputData%dX_high)) then - LB(1:1) = lbound(SrcInitOutputData%dX_high) - UB(1:1) = ubound(SrcInitOutputData%dX_high) + LB(1:1) = lbound(SrcInitOutputData%dX_high, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%dX_high, kind=B8Ki) if (.not. allocated(DstInitOutputData%dX_high)) then allocate(DstInitOutputData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1038,8 +1038,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%dX_high = SrcInitOutputData%dX_high end if if (allocated(SrcInitOutputData%dY_high)) then - LB(1:1) = lbound(SrcInitOutputData%dY_high) - UB(1:1) = ubound(SrcInitOutputData%dY_high) + LB(1:1) = lbound(SrcInitOutputData%dY_high, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%dY_high, kind=B8Ki) if (.not. allocated(DstInitOutputData%dY_high)) then allocate(DstInitOutputData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1050,8 +1050,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%dY_high = SrcInitOutputData%dY_high end if if (allocated(SrcInitOutputData%dZ_high)) then - LB(1:1) = lbound(SrcInitOutputData%dZ_high) - UB(1:1) = ubound(SrcInitOutputData%dZ_high) + LB(1:1) = lbound(SrcInitOutputData%dZ_high, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%dZ_high, kind=B8Ki) if (.not. allocated(DstInitOutputData%dZ_high)) then allocate(DstInitOutputData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1074,8 +1074,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low if (allocated(SrcInitOutputData%Vdist_High)) then - LB(1:1) = lbound(SrcInitOutputData%Vdist_High) - UB(1:1) = ubound(SrcInitOutputData%Vdist_High) + LB(1:1) = lbound(SrcInitOutputData%Vdist_High, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%Vdist_High, kind=B8Ki) if (.not. allocated(DstInitOutputData%Vdist_High)) then allocate(DstInitOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1095,8 +1095,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AWAE_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' @@ -1123,8 +1123,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%dZ_high) end if if (allocated(InitOutputData%Vdist_High)) then - LB(1:1) = lbound(InitOutputData%Vdist_High) - UB(1:1) = ubound(InitOutputData%Vdist_High) + LB(1:1) = lbound(InitOutputData%Vdist_High, kind=B8Ki) + UB(1:1) = ubound(InitOutputData%Vdist_High, kind=B8Ki) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGridPtr(InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1137,38 +1137,38 @@ subroutine AWAE_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPackBounds(Buf, 1, lbound(InData%X0_high, kind=B8Ki), ubound(InData%X0_high, kind=B8Ki)) call RegPack(Buf, InData%X0_high) end if call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPackBounds(Buf, 1, lbound(InData%Y0_high, kind=B8Ki), ubound(InData%Y0_high, kind=B8Ki)) call RegPack(Buf, InData%Y0_high) end if call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPackBounds(Buf, 1, lbound(InData%Z0_high, kind=B8Ki), ubound(InData%Z0_high, kind=B8Ki)) call RegPack(Buf, InData%Z0_high) end if call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPackBounds(Buf, 1, lbound(InData%dX_high, kind=B8Ki), ubound(InData%dX_high, kind=B8Ki)) call RegPack(Buf, InData%dX_high) end if call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPackBounds(Buf, 1, lbound(InData%dY_high, kind=B8Ki), ubound(InData%dY_high, kind=B8Ki)) call RegPack(Buf, InData%dY_high) end if call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPackBounds(Buf, 1, lbound(InData%dZ_high, kind=B8Ki), ubound(InData%dZ_high, kind=B8Ki)) call RegPack(Buf, InData%dZ_high) end if call RegPack(Buf, InData%nX_high) @@ -1185,9 +1185,9 @@ subroutine AWAE_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%Z0_low) call RegPack(Buf, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) - LB(1:1) = lbound(InData%Vdist_High) - UB(1:1) = ubound(InData%Vdist_High) + call RegPackBounds(Buf, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) + LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) + UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) do i1 = LB(1), UB(1) call AWAE_PackHighWindGridPtr(Buf, InData%Vdist_High(i1)) end do @@ -1199,8 +1199,8 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1336,16 +1336,16 @@ subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%IfW)) then - LB(1:1) = lbound(SrcContStateData%IfW) - UB(1:1) = ubound(SrcContStateData%IfW) + LB(1:1) = lbound(SrcContStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%IfW, kind=B8Ki) if (.not. allocated(DstContStateData%IfW)) then allocate(DstContStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1365,16 +1365,16 @@ subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) type(AWAE_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%IfW)) then - LB(1:1) = lbound(ContStateData%IfW) - UB(1:1) = ubound(ContStateData%IfW) + LB(1:1) = lbound(ContStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(ContStateData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyContState(ContStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1387,14 +1387,14 @@ subroutine AWAE_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) - LB(1:1) = lbound(InData%IfW) - UB(1:1) = ubound(InData%IfW) + call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%IfW, kind=B8Ki) + UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackContState(Buf, InData%IfW(i1)) end do @@ -1406,8 +1406,8 @@ subroutine AWAE_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1434,16 +1434,16 @@ subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%IfW)) then - LB(1:1) = lbound(SrcDiscStateData%IfW) - UB(1:1) = ubound(SrcDiscStateData%IfW) + LB(1:1) = lbound(SrcDiscStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%IfW, kind=B8Ki) if (.not. allocated(DstDiscStateData%IfW)) then allocate(DstDiscStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1463,16 +1463,16 @@ subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(AWAE_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%IfW)) then - LB(1:1) = lbound(DiscStateData%IfW) - UB(1:1) = ubound(DiscStateData%IfW) + LB(1:1) = lbound(DiscStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyDiscState(DiscStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1485,14 +1485,14 @@ subroutine AWAE_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) - LB(1:1) = lbound(InData%IfW) - UB(1:1) = ubound(InData%IfW) + call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%IfW, kind=B8Ki) + UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(Buf, InData%IfW(i1)) end do @@ -1504,8 +1504,8 @@ subroutine AWAE_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1532,16 +1532,16 @@ subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%IfW)) then - LB(1:1) = lbound(SrcConstrStateData%IfW) - UB(1:1) = ubound(SrcConstrStateData%IfW) + LB(1:1) = lbound(SrcConstrStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%IfW, kind=B8Ki) if (.not. allocated(DstConstrStateData%IfW)) then allocate(DstConstrStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1561,16 +1561,16 @@ subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(AWAE_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%IfW)) then - LB(1:1) = lbound(ConstrStateData%IfW) - UB(1:1) = ubound(ConstrStateData%IfW) + LB(1:1) = lbound(ConstrStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyConstrState(ConstrStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1583,14 +1583,14 @@ subroutine AWAE_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) - LB(1:1) = lbound(InData%IfW) - UB(1:1) = ubound(InData%IfW) + call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%IfW, kind=B8Ki) + UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(Buf, InData%IfW(i1)) end do @@ -1602,8 +1602,8 @@ subroutine AWAE_UnPackConstrState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1630,16 +1630,16 @@ subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%IfW)) then - LB(1:1) = lbound(SrcOtherStateData%IfW) - UB(1:1) = ubound(SrcOtherStateData%IfW) + LB(1:1) = lbound(SrcOtherStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%IfW, kind=B8Ki) if (.not. allocated(DstOtherStateData%IfW)) then allocate(DstOtherStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1659,16 +1659,16 @@ subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(AWAE_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%IfW)) then - LB(1:1) = lbound(OtherStateData%IfW) - UB(1:1) = ubound(OtherStateData%IfW) + LB(1:1) = lbound(OtherStateData%IfW, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyOtherState(OtherStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1681,14 +1681,14 @@ subroutine AWAE_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) - LB(1:1) = lbound(InData%IfW) - UB(1:1) = ubound(InData%IfW) + call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%IfW, kind=B8Ki) + UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(Buf, InData%IfW(i1)) end do @@ -1700,8 +1700,8 @@ subroutine AWAE_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1728,16 +1728,16 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%Vamb_low)) then - LB(1:4) = lbound(SrcMiscData%Vamb_low) - UB(1:4) = ubound(SrcMiscData%Vamb_low) + LB(1:4) = lbound(SrcMiscData%Vamb_low, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%Vamb_low, kind=B8Ki) if (.not. allocated(DstMiscData%Vamb_low)) then allocate(DstMiscData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1748,8 +1748,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vamb_low = SrcMiscData%Vamb_low end if if (allocated(SrcMiscData%Vamb_lowpol)) then - LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) - UB(1:2) = ubound(SrcMiscData%Vamb_lowpol) + LB(1:2) = lbound(SrcMiscData%Vamb_lowpol, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%Vamb_lowpol, kind=B8Ki) if (.not. allocated(DstMiscData%Vamb_lowpol)) then allocate(DstMiscData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1760,8 +1760,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol end if if (allocated(SrcMiscData%Vdist_low)) then - LB(1:4) = lbound(SrcMiscData%Vdist_low) - UB(1:4) = ubound(SrcMiscData%Vdist_low) + LB(1:4) = lbound(SrcMiscData%Vdist_low, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%Vdist_low, kind=B8Ki) if (.not. allocated(DstMiscData%Vdist_low)) then allocate(DstMiscData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1772,8 +1772,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vdist_low = SrcMiscData%Vdist_low end if if (allocated(SrcMiscData%Vdist_low_full)) then - LB(1:4) = lbound(SrcMiscData%Vdist_low_full) - UB(1:4) = ubound(SrcMiscData%Vdist_low_full) + LB(1:4) = lbound(SrcMiscData%Vdist_low_full, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%Vdist_low_full, kind=B8Ki) if (.not. allocated(DstMiscData%Vdist_low_full)) then allocate(DstMiscData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1784,8 +1784,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full end if if (allocated(SrcMiscData%Vamb_High)) then - LB(1:1) = lbound(SrcMiscData%Vamb_High) - UB(1:1) = ubound(SrcMiscData%Vamb_High) + LB(1:1) = lbound(SrcMiscData%Vamb_High, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Vamb_High, kind=B8Ki) if (.not. allocated(DstMiscData%Vamb_High)) then allocate(DstMiscData%Vamb_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1800,8 +1800,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%parallelFlag)) then - LB(1:2) = lbound(SrcMiscData%parallelFlag) - UB(1:2) = ubound(SrcMiscData%parallelFlag) + LB(1:2) = lbound(SrcMiscData%parallelFlag, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%parallelFlag, kind=B8Ki) if (.not. allocated(DstMiscData%parallelFlag)) then allocate(DstMiscData%parallelFlag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1812,8 +1812,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%parallelFlag = SrcMiscData%parallelFlag end if if (allocated(SrcMiscData%r_s)) then - LB(1:2) = lbound(SrcMiscData%r_s) - UB(1:2) = ubound(SrcMiscData%r_s) + LB(1:2) = lbound(SrcMiscData%r_s, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%r_s, kind=B8Ki) if (.not. allocated(DstMiscData%r_s)) then allocate(DstMiscData%r_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1824,8 +1824,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_s = SrcMiscData%r_s end if if (allocated(SrcMiscData%r_e)) then - LB(1:2) = lbound(SrcMiscData%r_e) - UB(1:2) = ubound(SrcMiscData%r_e) + LB(1:2) = lbound(SrcMiscData%r_e, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%r_e, kind=B8Ki) if (.not. allocated(DstMiscData%r_e)) then allocate(DstMiscData%r_e(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1836,8 +1836,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_e = SrcMiscData%r_e end if if (allocated(SrcMiscData%rhat_s)) then - LB(1:3) = lbound(SrcMiscData%rhat_s) - UB(1:3) = ubound(SrcMiscData%rhat_s) + LB(1:3) = lbound(SrcMiscData%rhat_s, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%rhat_s, kind=B8Ki) if (.not. allocated(DstMiscData%rhat_s)) then allocate(DstMiscData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1848,8 +1848,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rhat_s = SrcMiscData%rhat_s end if if (allocated(SrcMiscData%rhat_e)) then - LB(1:3) = lbound(SrcMiscData%rhat_e) - UB(1:3) = ubound(SrcMiscData%rhat_e) + LB(1:3) = lbound(SrcMiscData%rhat_e, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%rhat_e, kind=B8Ki) if (.not. allocated(DstMiscData%rhat_e)) then allocate(DstMiscData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1860,8 +1860,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rhat_e = SrcMiscData%rhat_e end if if (allocated(SrcMiscData%pvec_cs)) then - LB(1:3) = lbound(SrcMiscData%pvec_cs) - UB(1:3) = ubound(SrcMiscData%pvec_cs) + LB(1:3) = lbound(SrcMiscData%pvec_cs, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%pvec_cs, kind=B8Ki) if (.not. allocated(DstMiscData%pvec_cs)) then allocate(DstMiscData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1872,8 +1872,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%pvec_cs = SrcMiscData%pvec_cs end if if (allocated(SrcMiscData%pvec_ce)) then - LB(1:3) = lbound(SrcMiscData%pvec_ce) - UB(1:3) = ubound(SrcMiscData%pvec_ce) + LB(1:3) = lbound(SrcMiscData%pvec_ce, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%pvec_ce, kind=B8Ki) if (.not. allocated(DstMiscData%pvec_ce)) then allocate(DstMiscData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1884,8 +1884,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%pvec_ce = SrcMiscData%pvec_ce end if if (allocated(SrcMiscData%outVizXYPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizXYPlane) - UB(1:4) = ubound(SrcMiscData%outVizXYPlane) + LB(1:4) = lbound(SrcMiscData%outVizXYPlane, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%outVizXYPlane, kind=B8Ki) if (.not. allocated(DstMiscData%outVizXYPlane)) then allocate(DstMiscData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1896,8 +1896,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane end if if (allocated(SrcMiscData%outVizYZPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizYZPlane) - UB(1:4) = ubound(SrcMiscData%outVizYZPlane) + LB(1:4) = lbound(SrcMiscData%outVizYZPlane, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%outVizYZPlane, kind=B8Ki) if (.not. allocated(DstMiscData%outVizYZPlane)) then allocate(DstMiscData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1908,8 +1908,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane end if if (allocated(SrcMiscData%outVizXZPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizXZPlane) - UB(1:4) = ubound(SrcMiscData%outVizXZPlane) + LB(1:4) = lbound(SrcMiscData%outVizXZPlane, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%outVizXZPlane, kind=B8Ki) if (.not. allocated(DstMiscData%outVizXZPlane)) then allocate(DstMiscData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1920,8 +1920,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane end if if (allocated(SrcMiscData%IfW)) then - LB(1:1) = lbound(SrcMiscData%IfW) - UB(1:1) = ubound(SrcMiscData%IfW) + LB(1:1) = lbound(SrcMiscData%IfW, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%IfW, kind=B8Ki) if (.not. allocated(DstMiscData%IfW)) then allocate(DstMiscData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1953,8 +1953,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) type(AWAE_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyMisc' @@ -1973,8 +1973,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Vdist_low_full) end if if (allocated(MiscData%Vamb_High)) then - LB(1:1) = lbound(MiscData%Vamb_High) - UB(1:1) = ubound(MiscData%Vamb_High) + LB(1:1) = lbound(MiscData%Vamb_High, kind=B8Ki) + UB(1:1) = ubound(MiscData%Vamb_High, kind=B8Ki) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGrid(MiscData%Vamb_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2012,8 +2012,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%outVizXZPlane) end if if (allocated(MiscData%IfW)) then - LB(1:1) = lbound(MiscData%IfW) - UB(1:1) = ubound(MiscData%IfW) + LB(1:1) = lbound(MiscData%IfW, kind=B8Ki) + UB(1:1) = ubound(MiscData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyMisc(MiscData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2034,93 +2034,93 @@ subroutine AWAE_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackMisc' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Vamb_low)) if (allocated(InData%Vamb_low)) then - call RegPackBounds(Buf, 4, lbound(InData%Vamb_low), ubound(InData%Vamb_low)) + call RegPackBounds(Buf, 4, lbound(InData%Vamb_low, kind=B8Ki), ubound(InData%Vamb_low, kind=B8Ki)) call RegPack(Buf, InData%Vamb_low) end if call RegPack(Buf, allocated(InData%Vamb_lowpol)) if (allocated(InData%Vamb_lowpol)) then - call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol), ubound(InData%Vamb_lowpol)) + call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol, kind=B8Ki), ubound(InData%Vamb_lowpol, kind=B8Ki)) call RegPack(Buf, InData%Vamb_lowpol) end if call RegPack(Buf, allocated(InData%Vdist_low)) if (allocated(InData%Vdist_low)) then - call RegPackBounds(Buf, 4, lbound(InData%Vdist_low), ubound(InData%Vdist_low)) + call RegPackBounds(Buf, 4, lbound(InData%Vdist_low, kind=B8Ki), ubound(InData%Vdist_low, kind=B8Ki)) call RegPack(Buf, InData%Vdist_low) end if call RegPack(Buf, allocated(InData%Vdist_low_full)) if (allocated(InData%Vdist_low_full)) then - call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full), ubound(InData%Vdist_low_full)) + call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full, kind=B8Ki), ubound(InData%Vdist_low_full, kind=B8Ki)) call RegPack(Buf, InData%Vdist_low_full) end if call RegPack(Buf, allocated(InData%Vamb_High)) if (allocated(InData%Vamb_High)) then - call RegPackBounds(Buf, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) - LB(1:1) = lbound(InData%Vamb_High) - UB(1:1) = ubound(InData%Vamb_High) + call RegPackBounds(Buf, 1, lbound(InData%Vamb_High, kind=B8Ki), ubound(InData%Vamb_High, kind=B8Ki)) + LB(1:1) = lbound(InData%Vamb_High, kind=B8Ki) + UB(1:1) = ubound(InData%Vamb_High, kind=B8Ki) do i1 = LB(1), UB(1) call AWAE_PackHighWindGrid(Buf, InData%Vamb_High(i1)) end do end if call RegPack(Buf, allocated(InData%parallelFlag)) if (allocated(InData%parallelFlag)) then - call RegPackBounds(Buf, 2, lbound(InData%parallelFlag), ubound(InData%parallelFlag)) + call RegPackBounds(Buf, 2, lbound(InData%parallelFlag, kind=B8Ki), ubound(InData%parallelFlag, kind=B8Ki)) call RegPack(Buf, InData%parallelFlag) end if call RegPack(Buf, allocated(InData%r_s)) if (allocated(InData%r_s)) then - call RegPackBounds(Buf, 2, lbound(InData%r_s), ubound(InData%r_s)) + call RegPackBounds(Buf, 2, lbound(InData%r_s, kind=B8Ki), ubound(InData%r_s, kind=B8Ki)) call RegPack(Buf, InData%r_s) end if call RegPack(Buf, allocated(InData%r_e)) if (allocated(InData%r_e)) then - call RegPackBounds(Buf, 2, lbound(InData%r_e), ubound(InData%r_e)) + call RegPackBounds(Buf, 2, lbound(InData%r_e, kind=B8Ki), ubound(InData%r_e, kind=B8Ki)) call RegPack(Buf, InData%r_e) end if call RegPack(Buf, allocated(InData%rhat_s)) if (allocated(InData%rhat_s)) then - call RegPackBounds(Buf, 3, lbound(InData%rhat_s), ubound(InData%rhat_s)) + call RegPackBounds(Buf, 3, lbound(InData%rhat_s, kind=B8Ki), ubound(InData%rhat_s, kind=B8Ki)) call RegPack(Buf, InData%rhat_s) end if call RegPack(Buf, allocated(InData%rhat_e)) if (allocated(InData%rhat_e)) then - call RegPackBounds(Buf, 3, lbound(InData%rhat_e), ubound(InData%rhat_e)) + call RegPackBounds(Buf, 3, lbound(InData%rhat_e, kind=B8Ki), ubound(InData%rhat_e, kind=B8Ki)) call RegPack(Buf, InData%rhat_e) end if call RegPack(Buf, allocated(InData%pvec_cs)) if (allocated(InData%pvec_cs)) then - call RegPackBounds(Buf, 3, lbound(InData%pvec_cs), ubound(InData%pvec_cs)) + call RegPackBounds(Buf, 3, lbound(InData%pvec_cs, kind=B8Ki), ubound(InData%pvec_cs, kind=B8Ki)) call RegPack(Buf, InData%pvec_cs) end if call RegPack(Buf, allocated(InData%pvec_ce)) if (allocated(InData%pvec_ce)) then - call RegPackBounds(Buf, 3, lbound(InData%pvec_ce), ubound(InData%pvec_ce)) + call RegPackBounds(Buf, 3, lbound(InData%pvec_ce, kind=B8Ki), ubound(InData%pvec_ce, kind=B8Ki)) call RegPack(Buf, InData%pvec_ce) end if call RegPack(Buf, allocated(InData%outVizXYPlane)) if (allocated(InData%outVizXYPlane)) then - call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane), ubound(InData%outVizXYPlane)) + call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane, kind=B8Ki), ubound(InData%outVizXYPlane, kind=B8Ki)) call RegPack(Buf, InData%outVizXYPlane) end if call RegPack(Buf, allocated(InData%outVizYZPlane)) if (allocated(InData%outVizYZPlane)) then - call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane), ubound(InData%outVizYZPlane)) + call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane, kind=B8Ki), ubound(InData%outVizYZPlane, kind=B8Ki)) call RegPack(Buf, InData%outVizYZPlane) end if call RegPack(Buf, allocated(InData%outVizXZPlane)) if (allocated(InData%outVizXZPlane)) then - call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane), ubound(InData%outVizXZPlane)) + call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane, kind=B8Ki), ubound(InData%outVizXZPlane, kind=B8Ki)) call RegPack(Buf, InData%outVizXZPlane) end if call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) - LB(1:1) = lbound(InData%IfW) - UB(1:1) = ubound(InData%IfW) + call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%IfW, kind=B8Ki) + UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackMisc(Buf, InData%IfW(i1)) end do @@ -2136,8 +2136,8 @@ subroutine AWAE_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2379,8 +2379,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyParam' @@ -2391,8 +2391,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumRadii = SrcParamData%NumRadii DstParamData%NumPlanes = SrcParamData%NumPlanes if (allocated(SrcParamData%y)) then - LB(1:1) = lbound(SrcParamData%y) - UB(1:1) = ubound(SrcParamData%y) + LB(1:1) = lbound(SrcParamData%y, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%y, kind=B8Ki) if (.not. allocated(DstParamData%y)) then allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2403,8 +2403,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%y = SrcParamData%y end if if (allocated(SrcParamData%z)) then - LB(1:1) = lbound(SrcParamData%z) - UB(1:1) = ubound(SrcParamData%z) + LB(1:1) = lbound(SrcParamData%z, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%z, kind=B8Ki) if (.not. allocated(DstParamData%z)) then allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2429,8 +2429,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0_low = SrcParamData%Y0_low DstParamData%Z0_low = SrcParamData%Z0_low if (allocated(SrcParamData%X0_high)) then - LB(1:1) = lbound(SrcParamData%X0_high) - UB(1:1) = ubound(SrcParamData%X0_high) + LB(1:1) = lbound(SrcParamData%X0_high, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%X0_high, kind=B8Ki) if (.not. allocated(DstParamData%X0_high)) then allocate(DstParamData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2441,8 +2441,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%X0_high = SrcParamData%X0_high end if if (allocated(SrcParamData%Y0_high)) then - LB(1:1) = lbound(SrcParamData%Y0_high) - UB(1:1) = ubound(SrcParamData%Y0_high) + LB(1:1) = lbound(SrcParamData%Y0_high, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Y0_high, kind=B8Ki) if (.not. allocated(DstParamData%Y0_high)) then allocate(DstParamData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2453,8 +2453,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0_high = SrcParamData%Y0_high end if if (allocated(SrcParamData%Z0_high)) then - LB(1:1) = lbound(SrcParamData%Z0_high) - UB(1:1) = ubound(SrcParamData%Z0_high) + LB(1:1) = lbound(SrcParamData%Z0_high, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Z0_high, kind=B8Ki) if (.not. allocated(DstParamData%Z0_high)) then allocate(DstParamData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2465,8 +2465,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Z0_high = SrcParamData%Z0_high end if if (allocated(SrcParamData%dX_high)) then - LB(1:1) = lbound(SrcParamData%dX_high) - UB(1:1) = ubound(SrcParamData%dX_high) + LB(1:1) = lbound(SrcParamData%dX_high, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dX_high, kind=B8Ki) if (.not. allocated(DstParamData%dX_high)) then allocate(DstParamData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2477,8 +2477,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dX_high = SrcParamData%dX_high end if if (allocated(SrcParamData%dY_high)) then - LB(1:1) = lbound(SrcParamData%dY_high) - UB(1:1) = ubound(SrcParamData%dY_high) + LB(1:1) = lbound(SrcParamData%dY_high, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dY_high, kind=B8Ki) if (.not. allocated(DstParamData%dY_high)) then allocate(DstParamData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2489,8 +2489,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dY_high = SrcParamData%dY_high end if if (allocated(SrcParamData%dZ_high)) then - LB(1:1) = lbound(SrcParamData%dZ_high) - UB(1:1) = ubound(SrcParamData%dZ_high) + LB(1:1) = lbound(SrcParamData%dZ_high, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dZ_high, kind=B8Ki) if (.not. allocated(DstParamData%dZ_high)) then allocate(DstParamData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2504,8 +2504,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nY_high = SrcParamData%nY_high DstParamData%nZ_high = SrcParamData%nZ_high if (allocated(SrcParamData%Grid_low)) then - LB(1:2) = lbound(SrcParamData%Grid_low) - UB(1:2) = ubound(SrcParamData%Grid_low) + LB(1:2) = lbound(SrcParamData%Grid_low, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Grid_low, kind=B8Ki) if (.not. allocated(DstParamData%Grid_low)) then allocate(DstParamData%Grid_low(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2516,8 +2516,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Grid_low = SrcParamData%Grid_low end if if (allocated(SrcParamData%Grid_high)) then - LB(1:3) = lbound(SrcParamData%Grid_high) - UB(1:3) = ubound(SrcParamData%Grid_high) + LB(1:3) = lbound(SrcParamData%Grid_high, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Grid_high, kind=B8Ki) if (.not. allocated(DstParamData%Grid_high)) then allocate(DstParamData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2528,8 +2528,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Grid_high = SrcParamData%Grid_high end if if (allocated(SrcParamData%WT_Position)) then - LB(1:2) = lbound(SrcParamData%WT_Position) - UB(1:2) = ubound(SrcParamData%WT_Position) + LB(1:2) = lbound(SrcParamData%WT_Position, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%WT_Position, kind=B8Ki) if (.not. allocated(DstParamData%WT_Position)) then allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2548,8 +2548,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam DstParamData%Mod_Projection = SrcParamData%Mod_Projection if (allocated(SrcParamData%IfW)) then - LB(1:1) = lbound(SrcParamData%IfW) - UB(1:1) = ubound(SrcParamData%IfW) + LB(1:1) = lbound(SrcParamData%IfW, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IfW, kind=B8Ki) if (.not. allocated(DstParamData%IfW)) then allocate(DstParamData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2567,8 +2567,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WrDisWind = SrcParamData%WrDisWind DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY if (allocated(SrcParamData%OutDisWindZ)) then - LB(1:1) = lbound(SrcParamData%OutDisWindZ) - UB(1:1) = ubound(SrcParamData%OutDisWindZ) + LB(1:1) = lbound(SrcParamData%OutDisWindZ, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutDisWindZ, kind=B8Ki) if (.not. allocated(DstParamData%OutDisWindZ)) then allocate(DstParamData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2580,8 +2580,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ if (allocated(SrcParamData%OutDisWindX)) then - LB(1:1) = lbound(SrcParamData%OutDisWindX) - UB(1:1) = ubound(SrcParamData%OutDisWindX) + LB(1:1) = lbound(SrcParamData%OutDisWindX, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutDisWindX, kind=B8Ki) if (.not. allocated(DstParamData%OutDisWindX)) then allocate(DstParamData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2593,8 +2593,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ if (allocated(SrcParamData%OutDisWindY)) then - LB(1:1) = lbound(SrcParamData%OutDisWindY) - UB(1:1) = ubound(SrcParamData%OutDisWindY) + LB(1:1) = lbound(SrcParamData%OutDisWindY, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutDisWindY, kind=B8Ki) if (.not. allocated(DstParamData%OutDisWindY)) then allocate(DstParamData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2613,8 +2613,8 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) type(AWAE_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyParam' @@ -2654,8 +2654,8 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WT_Position) end if if (allocated(ParamData%IfW)) then - LB(1:1) = lbound(ParamData%IfW) - UB(1:1) = ubound(ParamData%IfW) + LB(1:1) = lbound(ParamData%IfW, kind=B8Ki) + UB(1:1) = ubound(ParamData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyParam(ParamData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2677,8 +2677,8 @@ subroutine AWAE_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WindFilePath) call RegPack(Buf, InData%NumTurbines) @@ -2686,12 +2686,12 @@ subroutine AWAE_PackParam(Buf, Indata) call RegPack(Buf, InData%NumPlanes) call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPack(Buf, InData%y) end if call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) call RegPack(Buf, InData%z) end if call RegPack(Buf, InData%Mod_AmbWind) @@ -2710,32 +2710,32 @@ subroutine AWAE_PackParam(Buf, Indata) call RegPack(Buf, InData%Z0_low) call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPackBounds(Buf, 1, lbound(InData%X0_high, kind=B8Ki), ubound(InData%X0_high, kind=B8Ki)) call RegPack(Buf, InData%X0_high) end if call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPackBounds(Buf, 1, lbound(InData%Y0_high, kind=B8Ki), ubound(InData%Y0_high, kind=B8Ki)) call RegPack(Buf, InData%Y0_high) end if call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPackBounds(Buf, 1, lbound(InData%Z0_high, kind=B8Ki), ubound(InData%Z0_high, kind=B8Ki)) call RegPack(Buf, InData%Z0_high) end if call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPackBounds(Buf, 1, lbound(InData%dX_high, kind=B8Ki), ubound(InData%dX_high, kind=B8Ki)) call RegPack(Buf, InData%dX_high) end if call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPackBounds(Buf, 1, lbound(InData%dY_high, kind=B8Ki), ubound(InData%dY_high, kind=B8Ki)) call RegPack(Buf, InData%dY_high) end if call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPackBounds(Buf, 1, lbound(InData%dZ_high, kind=B8Ki), ubound(InData%dZ_high, kind=B8Ki)) call RegPack(Buf, InData%dZ_high) end if call RegPack(Buf, InData%nX_high) @@ -2743,17 +2743,17 @@ subroutine AWAE_PackParam(Buf, Indata) call RegPack(Buf, InData%nZ_high) call RegPack(Buf, allocated(InData%Grid_low)) if (allocated(InData%Grid_low)) then - call RegPackBounds(Buf, 2, lbound(InData%Grid_low), ubound(InData%Grid_low)) + call RegPackBounds(Buf, 2, lbound(InData%Grid_low, kind=B8Ki), ubound(InData%Grid_low, kind=B8Ki)) call RegPack(Buf, InData%Grid_low) end if call RegPack(Buf, allocated(InData%Grid_high)) if (allocated(InData%Grid_high)) then - call RegPackBounds(Buf, 3, lbound(InData%Grid_high), ubound(InData%Grid_high)) + call RegPackBounds(Buf, 3, lbound(InData%Grid_high, kind=B8Ki), ubound(InData%Grid_high, kind=B8Ki)) call RegPack(Buf, InData%Grid_high) end if call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then - call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPackBounds(Buf, 2, lbound(InData%WT_Position, kind=B8Ki), ubound(InData%WT_Position, kind=B8Ki)) call RegPack(Buf, InData%WT_Position) end if call RegPack(Buf, InData%n_high_low) @@ -2766,9 +2766,9 @@ subroutine AWAE_PackParam(Buf, Indata) call RegPack(Buf, InData%Mod_Projection) call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) - LB(1:1) = lbound(InData%IfW) - UB(1:1) = ubound(InData%IfW) + call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%IfW, kind=B8Ki) + UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackParam(Buf, InData%IfW(i1)) end do @@ -2778,19 +2778,19 @@ subroutine AWAE_PackParam(Buf, Indata) call RegPack(Buf, InData%NOutDisWindXY) call RegPack(Buf, allocated(InData%OutDisWindZ)) if (allocated(InData%OutDisWindZ)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ, kind=B8Ki), ubound(InData%OutDisWindZ, kind=B8Ki)) call RegPack(Buf, InData%OutDisWindZ) end if call RegPack(Buf, InData%NOutDisWindYZ) call RegPack(Buf, allocated(InData%OutDisWindX)) if (allocated(InData%OutDisWindX)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX, kind=B8Ki), ubound(InData%OutDisWindX, kind=B8Ki)) call RegPack(Buf, InData%OutDisWindX) end if call RegPack(Buf, InData%NOutDisWindXZ) call RegPack(Buf, allocated(InData%OutDisWindY)) if (allocated(InData%OutDisWindY)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY, kind=B8Ki), ubound(InData%OutDisWindY, kind=B8Ki)) call RegPack(Buf, InData%OutDisWindY) end if call RegPack(Buf, InData%OutFileRoot) @@ -2803,8 +2803,8 @@ subroutine AWAE_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3101,16 +3101,16 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Vdist_High)) then - LB(1:1) = lbound(SrcOutputData%Vdist_High) - UB(1:1) = ubound(SrcOutputData%Vdist_High) + LB(1:1) = lbound(SrcOutputData%Vdist_High, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Vdist_High, kind=B8Ki) if (.not. allocated(DstOutputData%Vdist_High)) then allocate(DstOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3125,8 +3125,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%V_plane)) then - LB(1:3) = lbound(SrcOutputData%V_plane) - UB(1:3) = ubound(SrcOutputData%V_plane) + LB(1:3) = lbound(SrcOutputData%V_plane, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%V_plane, kind=B8Ki) if (.not. allocated(DstOutputData%V_plane)) then allocate(DstOutputData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3137,8 +3137,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%V_plane = SrcOutputData%V_plane end if if (allocated(SrcOutputData%TI_amb)) then - LB(1:1) = lbound(SrcOutputData%TI_amb) - UB(1:1) = ubound(SrcOutputData%TI_amb) + LB(1:1) = lbound(SrcOutputData%TI_amb, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%TI_amb, kind=B8Ki) if (.not. allocated(DstOutputData%TI_amb)) then allocate(DstOutputData%TI_amb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3149,8 +3149,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%TI_amb = SrcOutputData%TI_amb end if if (allocated(SrcOutputData%Vx_wind_disk)) then - LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) - UB(1:1) = ubound(SrcOutputData%Vx_wind_disk) + LB(1:1) = lbound(SrcOutputData%Vx_wind_disk, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Vx_wind_disk, kind=B8Ki) if (.not. allocated(DstOutputData%Vx_wind_disk)) then allocate(DstOutputData%Vx_wind_disk(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3166,16 +3166,16 @@ subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) type(AWAE_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%Vdist_High)) then - LB(1:1) = lbound(OutputData%Vdist_High) - UB(1:1) = ubound(OutputData%Vdist_High) + LB(1:1) = lbound(OutputData%Vdist_High, kind=B8Ki) + UB(1:1) = ubound(OutputData%Vdist_High, kind=B8Ki) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGrid(OutputData%Vdist_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3197,31 +3197,31 @@ subroutine AWAE_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOutput' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) - LB(1:1) = lbound(InData%Vdist_High) - UB(1:1) = ubound(InData%Vdist_High) + call RegPackBounds(Buf, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) + LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) + UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) do i1 = LB(1), UB(1) call AWAE_PackHighWindGrid(Buf, InData%Vdist_High(i1)) end do end if call RegPack(Buf, allocated(InData%V_plane)) if (allocated(InData%V_plane)) then - call RegPackBounds(Buf, 3, lbound(InData%V_plane), ubound(InData%V_plane)) + call RegPackBounds(Buf, 3, lbound(InData%V_plane, kind=B8Ki), ubound(InData%V_plane, kind=B8Ki)) call RegPack(Buf, InData%V_plane) end if call RegPack(Buf, allocated(InData%TI_amb)) if (allocated(InData%TI_amb)) then - call RegPackBounds(Buf, 1, lbound(InData%TI_amb), ubound(InData%TI_amb)) + call RegPackBounds(Buf, 1, lbound(InData%TI_amb, kind=B8Ki), ubound(InData%TI_amb, kind=B8Ki)) call RegPack(Buf, InData%TI_amb) end if call RegPack(Buf, allocated(InData%Vx_wind_disk)) if (allocated(InData%Vx_wind_disk)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk), ubound(InData%Vx_wind_disk)) + call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk, kind=B8Ki), ubound(InData%Vx_wind_disk, kind=B8Ki)) call RegPack(Buf, InData%Vx_wind_disk) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3231,8 +3231,8 @@ subroutine AWAE_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3301,14 +3301,14 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%xhat_plane)) then - LB(1:3) = lbound(SrcInputData%xhat_plane) - UB(1:3) = ubound(SrcInputData%xhat_plane) + LB(1:3) = lbound(SrcInputData%xhat_plane, kind=B8Ki) + UB(1:3) = ubound(SrcInputData%xhat_plane, kind=B8Ki) if (.not. allocated(DstInputData%xhat_plane)) then allocate(DstInputData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3319,8 +3319,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xhat_plane = SrcInputData%xhat_plane end if if (allocated(SrcInputData%p_plane)) then - LB(1:3) = lbound(SrcInputData%p_plane) - UB(1:3) = ubound(SrcInputData%p_plane) + LB(1:3) = lbound(SrcInputData%p_plane, kind=B8Ki) + UB(1:3) = ubound(SrcInputData%p_plane, kind=B8Ki) if (.not. allocated(DstInputData%p_plane)) then allocate(DstInputData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3331,8 +3331,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%p_plane = SrcInputData%p_plane end if if (allocated(SrcInputData%Vx_wake)) then - LB(1:4) = lbound(SrcInputData%Vx_wake) - UB(1:4) = ubound(SrcInputData%Vx_wake) + LB(1:4) = lbound(SrcInputData%Vx_wake, kind=B8Ki) + UB(1:4) = ubound(SrcInputData%Vx_wake, kind=B8Ki) if (.not. allocated(DstInputData%Vx_wake)) then allocate(DstInputData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3343,8 +3343,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vx_wake = SrcInputData%Vx_wake end if if (allocated(SrcInputData%Vy_wake)) then - LB(1:4) = lbound(SrcInputData%Vy_wake) - UB(1:4) = ubound(SrcInputData%Vy_wake) + LB(1:4) = lbound(SrcInputData%Vy_wake, kind=B8Ki) + UB(1:4) = ubound(SrcInputData%Vy_wake, kind=B8Ki) if (.not. allocated(DstInputData%Vy_wake)) then allocate(DstInputData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3355,8 +3355,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vy_wake = SrcInputData%Vy_wake end if if (allocated(SrcInputData%Vz_wake)) then - LB(1:4) = lbound(SrcInputData%Vz_wake) - UB(1:4) = ubound(SrcInputData%Vz_wake) + LB(1:4) = lbound(SrcInputData%Vz_wake, kind=B8Ki) + UB(1:4) = ubound(SrcInputData%Vz_wake, kind=B8Ki) if (.not. allocated(DstInputData%Vz_wake)) then allocate(DstInputData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3367,8 +3367,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vz_wake = SrcInputData%Vz_wake end if if (allocated(SrcInputData%D_wake)) then - LB(1:2) = lbound(SrcInputData%D_wake) - UB(1:2) = ubound(SrcInputData%D_wake) + LB(1:2) = lbound(SrcInputData%D_wake, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%D_wake, kind=B8Ki) if (.not. allocated(DstInputData%D_wake)) then allocate(DstInputData%D_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3379,8 +3379,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%D_wake = SrcInputData%D_wake end if if (allocated(SrcInputData%WAT_k_mt)) then - LB(1:3) = lbound(SrcInputData%WAT_k_mt) - UB(1:3) = ubound(SrcInputData%WAT_k_mt) + LB(1:3) = lbound(SrcInputData%WAT_k_mt, kind=B8Ki) + UB(1:3) = ubound(SrcInputData%WAT_k_mt, kind=B8Ki) if (.not. allocated(DstInputData%WAT_k_mt)) then allocate(DstInputData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3429,37 +3429,37 @@ subroutine AWAE_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%xhat_plane)) if (allocated(InData%xhat_plane)) then - call RegPackBounds(Buf, 3, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPackBounds(Buf, 3, lbound(InData%xhat_plane, kind=B8Ki), ubound(InData%xhat_plane, kind=B8Ki)) call RegPack(Buf, InData%xhat_plane) end if call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then - call RegPackBounds(Buf, 3, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPackBounds(Buf, 3, lbound(InData%p_plane, kind=B8Ki), ubound(InData%p_plane, kind=B8Ki)) call RegPack(Buf, InData%p_plane) end if call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then - call RegPackBounds(Buf, 4, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPackBounds(Buf, 4, lbound(InData%Vx_wake, kind=B8Ki), ubound(InData%Vx_wake, kind=B8Ki)) call RegPack(Buf, InData%Vx_wake) end if call RegPack(Buf, allocated(InData%Vy_wake)) if (allocated(InData%Vy_wake)) then - call RegPackBounds(Buf, 4, lbound(InData%Vy_wake), ubound(InData%Vy_wake)) + call RegPackBounds(Buf, 4, lbound(InData%Vy_wake, kind=B8Ki), ubound(InData%Vy_wake, kind=B8Ki)) call RegPack(Buf, InData%Vy_wake) end if call RegPack(Buf, allocated(InData%Vz_wake)) if (allocated(InData%Vz_wake)) then - call RegPackBounds(Buf, 4, lbound(InData%Vz_wake), ubound(InData%Vz_wake)) + call RegPackBounds(Buf, 4, lbound(InData%Vz_wake, kind=B8Ki), ubound(InData%Vz_wake, kind=B8Ki)) call RegPack(Buf, InData%Vz_wake) end if call RegPack(Buf, allocated(InData%D_wake)) if (allocated(InData%D_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%D_wake), ubound(InData%D_wake)) + call RegPackBounds(Buf, 2, lbound(InData%D_wake, kind=B8Ki), ubound(InData%D_wake, kind=B8Ki)) call RegPack(Buf, InData%D_wake) end if call RegPack(Buf, allocated(InData%WAT_k_mt)) if (allocated(InData%WAT_k_mt)) then - call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) + call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt, kind=B8Ki), ubound(InData%WAT_k_mt, kind=B8Ki)) call RegPack(Buf, InData%WAT_k_mt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3469,7 +3469,7 @@ subroutine AWAE_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AWAE_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInput' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index c4fcd0772f..6e3e5b9acf 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -430,15 +430,15 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -449,8 +449,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -464,8 +464,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%kp_coordinate)) then - LB(1:2) = lbound(SrcInitOutputData%kp_coordinate) - UB(1:2) = ubound(SrcInitOutputData%kp_coordinate) + LB(1:2) = lbound(SrcInitOutputData%kp_coordinate, kind=B8Ki) + UB(1:2) = ubound(SrcInitOutputData%kp_coordinate, kind=B8Ki) if (.not. allocated(DstInitOutputData%kp_coordinate)) then allocate(DstInitOutputData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -477,8 +477,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if DstInitOutputData%kp_total = SrcInitOutputData%kp_total if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -489,8 +489,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -501,8 +501,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -513,8 +513,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -525,8 +525,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -537,8 +537,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -549,8 +549,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -561,8 +561,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -627,59 +627,59 @@ subroutine BD_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%kp_coordinate)) if (allocated(InData%kp_coordinate)) then - call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) + call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate, kind=B8Ki), ubound(InData%kp_coordinate, kind=B8Ki)) call RegPack(Buf, InData%kp_coordinate) end if call RegPack(Buf, InData%kp_total) call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -689,7 +689,7 @@ subroutine BD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -858,7 +858,7 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyBladeInputData' ErrStat = ErrID_None @@ -866,8 +866,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index if (allocated(SrcBladeInputDataData%station_eta)) then - LB(1:1) = lbound(SrcBladeInputDataData%station_eta) - UB(1:1) = ubound(SrcBladeInputDataData%station_eta) + LB(1:1) = lbound(SrcBladeInputDataData%station_eta, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%station_eta, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%station_eta)) then allocate(DstBladeInputDataData%station_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -878,8 +878,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta end if if (allocated(SrcBladeInputDataData%stiff0)) then - LB(1:3) = lbound(SrcBladeInputDataData%stiff0) - UB(1:3) = ubound(SrcBladeInputDataData%stiff0) + LB(1:3) = lbound(SrcBladeInputDataData%stiff0, kind=B8Ki) + UB(1:3) = ubound(SrcBladeInputDataData%stiff0, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%stiff0)) then allocate(DstBladeInputDataData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -890,8 +890,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 end if if (allocated(SrcBladeInputDataData%mass0)) then - LB(1:3) = lbound(SrcBladeInputDataData%mass0) - UB(1:3) = ubound(SrcBladeInputDataData%mass0) + LB(1:3) = lbound(SrcBladeInputDataData%mass0, kind=B8Ki) + UB(1:3) = ubound(SrcBladeInputDataData%mass0, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%mass0)) then allocate(DstBladeInputDataData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -932,17 +932,17 @@ subroutine BD_PackBladeInputData(Buf, Indata) call RegPack(Buf, InData%format_index) call RegPack(Buf, allocated(InData%station_eta)) if (allocated(InData%station_eta)) then - call RegPackBounds(Buf, 1, lbound(InData%station_eta), ubound(InData%station_eta)) + call RegPackBounds(Buf, 1, lbound(InData%station_eta, kind=B8Ki), ubound(InData%station_eta, kind=B8Ki)) call RegPack(Buf, InData%station_eta) end if call RegPack(Buf, allocated(InData%stiff0)) if (allocated(InData%stiff0)) then - call RegPackBounds(Buf, 3, lbound(InData%stiff0), ubound(InData%stiff0)) + call RegPackBounds(Buf, 3, lbound(InData%stiff0, kind=B8Ki), ubound(InData%stiff0, kind=B8Ki)) call RegPack(Buf, InData%stiff0) end if call RegPack(Buf, allocated(InData%mass0)) if (allocated(InData%mass0)) then - call RegPackBounds(Buf, 3, lbound(InData%mass0), ubound(InData%mass0)) + call RegPackBounds(Buf, 3, lbound(InData%mass0, kind=B8Ki), ubound(InData%mass0, kind=B8Ki)) call RegPack(Buf, InData%mass0) end if call RegPack(Buf, InData%beta) @@ -954,7 +954,7 @@ subroutine BD_UnPackBladeInputData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1016,7 +1016,7 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyInputFile' @@ -1025,8 +1025,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%member_total = SrcInputFileData%member_total DstInputFileData%kp_total = SrcInputFileData%kp_total if (allocated(SrcInputFileData%kp_member)) then - LB(1:1) = lbound(SrcInputFileData%kp_member) - UB(1:1) = ubound(SrcInputFileData%kp_member) + LB(1:1) = lbound(SrcInputFileData%kp_member, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%kp_member, kind=B8Ki) if (.not. allocated(DstInputFileData%kp_member)) then allocate(DstInputFileData%kp_member(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1054,8 +1054,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol if (allocated(SrcInputFileData%kp_coordinate)) then - LB(1:2) = lbound(SrcInputFileData%kp_coordinate) - UB(1:2) = ubound(SrcInputFileData%kp_coordinate) + LB(1:2) = lbound(SrcInputFileData%kp_coordinate, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileData%kp_coordinate, kind=B8Ki) if (.not. allocated(DstInputFileData%kp_coordinate)) then allocate(DstInputFileData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1077,8 +1077,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OutNd = SrcInputFileData%OutNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1092,8 +1092,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OutFmt = SrcInputFileData%OutFmt DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1104,8 +1104,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList end if if (allocated(SrcInputFileData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) - UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd) + LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd, kind=B8Ki) if (.not. allocated(DstInputFileData%BldNd_BlOutNd)) then allocate(DstInputFileData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1155,7 +1155,7 @@ subroutine BD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%kp_total) call RegPack(Buf, allocated(InData%kp_member)) if (allocated(InData%kp_member)) then - call RegPackBounds(Buf, 1, lbound(InData%kp_member), ubound(InData%kp_member)) + call RegPackBounds(Buf, 1, lbound(InData%kp_member, kind=B8Ki), ubound(InData%kp_member, kind=B8Ki)) call RegPack(Buf, InData%kp_member) end if call RegPack(Buf, InData%order_elem) @@ -1175,7 +1175,7 @@ subroutine BD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%tngt_stf_difftol) call RegPack(Buf, allocated(InData%kp_coordinate)) if (allocated(InData%kp_coordinate)) then - call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) + call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate, kind=B8Ki), ubound(InData%kp_coordinate, kind=B8Ki)) call RegPack(Buf, InData%kp_coordinate) end if call RegPack(Buf, InData%pitchJ) @@ -1191,7 +1191,7 @@ subroutine BD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%SumPrint) @@ -1199,12 +1199,12 @@ subroutine BD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%BldNd_NumOuts) call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList, kind=B8Ki), ubound(InData%BldNd_OutList, kind=B8Ki)) call RegPack(Buf, InData%BldNd_OutList) end if call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd, kind=B8Ki), ubound(InData%BldNd_BlOutNd, kind=B8Ki)) call RegPack(Buf, InData%BldNd_BlOutNd) end if call RegPack(Buf, InData%BldNd_BlOutNd_Str) @@ -1215,7 +1215,7 @@ subroutine BD_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInputFile' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1360,14 +1360,14 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%q)) then - LB(1:2) = lbound(SrcContStateData%q) - UB(1:2) = ubound(SrcContStateData%q) + LB(1:2) = lbound(SrcContStateData%q, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%q, kind=B8Ki) if (.not. allocated(DstContStateData%q)) then allocate(DstContStateData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1378,8 +1378,8 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%q = SrcContStateData%q end if if (allocated(SrcContStateData%dqdt)) then - LB(1:2) = lbound(SrcContStateData%dqdt) - UB(1:2) = ubound(SrcContStateData%dqdt) + LB(1:2) = lbound(SrcContStateData%dqdt, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%dqdt, kind=B8Ki) if (.not. allocated(DstContStateData%dqdt)) then allocate(DstContStateData%dqdt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1413,12 +1413,12 @@ subroutine BD_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%q)) if (allocated(InData%q)) then - call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPackBounds(Buf, 2, lbound(InData%q, kind=B8Ki), ubound(InData%q, kind=B8Ki)) call RegPack(Buf, InData%q) end if call RegPack(Buf, allocated(InData%dqdt)) if (allocated(InData%dqdt)) then - call RegPackBounds(Buf, 2, lbound(InData%dqdt), ubound(InData%dqdt)) + call RegPackBounds(Buf, 2, lbound(InData%dqdt, kind=B8Ki), ubound(InData%dqdt, kind=B8Ki)) call RegPack(Buf, InData%dqdt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1428,7 +1428,7 @@ subroutine BD_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackContState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1550,14 +1550,14 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%acc)) then - LB(1:2) = lbound(SrcOtherStateData%acc) - UB(1:2) = ubound(SrcOtherStateData%acc) + LB(1:2) = lbound(SrcOtherStateData%acc, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%acc, kind=B8Ki) if (.not. allocated(DstOtherStateData%acc)) then allocate(DstOtherStateData%acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1568,8 +1568,8 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%acc = SrcOtherStateData%acc end if if (allocated(SrcOtherStateData%xcc)) then - LB(1:2) = lbound(SrcOtherStateData%xcc) - UB(1:2) = ubound(SrcOtherStateData%xcc) + LB(1:2) = lbound(SrcOtherStateData%xcc, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%xcc, kind=B8Ki) if (.not. allocated(DstOtherStateData%xcc)) then allocate(DstOtherStateData%xcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1608,12 +1608,12 @@ subroutine BD_PackOtherState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%acc)) if (allocated(InData%acc)) then - call RegPackBounds(Buf, 2, lbound(InData%acc), ubound(InData%acc)) + call RegPackBounds(Buf, 2, lbound(InData%acc, kind=B8Ki), ubound(InData%acc, kind=B8Ki)) call RegPack(Buf, InData%acc) end if call RegPack(Buf, allocated(InData%xcc)) if (allocated(InData%xcc)) then - call RegPackBounds(Buf, 2, lbound(InData%xcc), ubound(InData%xcc)) + call RegPackBounds(Buf, 2, lbound(InData%xcc, kind=B8Ki), ubound(InData%xcc, kind=B8Ki)) call RegPack(Buf, InData%xcc) end if call RegPack(Buf, InData%InitAcc) @@ -1628,7 +1628,7 @@ subroutine BD_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOtherState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1678,14 +1678,14 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyqpParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcqpParamData%mmm)) then - LB(1:2) = lbound(SrcqpParamData%mmm) - UB(1:2) = ubound(SrcqpParamData%mmm) + LB(1:2) = lbound(SrcqpParamData%mmm, kind=B8Ki) + UB(1:2) = ubound(SrcqpParamData%mmm, kind=B8Ki) if (.not. allocated(DstqpParamData%mmm)) then allocate(DstqpParamData%mmm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1696,8 +1696,8 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err DstqpParamData%mmm = SrcqpParamData%mmm end if if (allocated(SrcqpParamData%mEta)) then - LB(1:3) = lbound(SrcqpParamData%mEta) - UB(1:3) = ubound(SrcqpParamData%mEta) + LB(1:3) = lbound(SrcqpParamData%mEta, kind=B8Ki) + UB(1:3) = ubound(SrcqpParamData%mEta, kind=B8Ki) if (.not. allocated(DstqpParamData%mEta)) then allocate(DstqpParamData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1731,12 +1731,12 @@ subroutine BD_PackqpParam(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%mmm)) if (allocated(InData%mmm)) then - call RegPackBounds(Buf, 2, lbound(InData%mmm), ubound(InData%mmm)) + call RegPackBounds(Buf, 2, lbound(InData%mmm, kind=B8Ki), ubound(InData%mmm, kind=B8Ki)) call RegPack(Buf, InData%mmm) end if call RegPack(Buf, allocated(InData%mEta)) if (allocated(InData%mEta)) then - call RegPackBounds(Buf, 3, lbound(InData%mEta), ubound(InData%mEta)) + call RegPackBounds(Buf, 3, lbound(InData%mEta, kind=B8Ki), ubound(InData%mEta, kind=B8Ki)) call RegPack(Buf, InData%mEta) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1746,7 +1746,7 @@ subroutine BD_UnPackqpParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(qpParam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackqpParam' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1786,8 +1786,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyParam' @@ -1797,8 +1797,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%coef = SrcParamData%coef DstParamData%rhoinf = SrcParamData%rhoinf if (allocated(SrcParamData%uuN0)) then - LB(1:3) = lbound(SrcParamData%uuN0) - UB(1:3) = ubound(SrcParamData%uuN0) + LB(1:3) = lbound(SrcParamData%uuN0, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%uuN0, kind=B8Ki) if (.not. allocated(DstParamData%uuN0)) then allocate(DstParamData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1809,8 +1809,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uuN0 = SrcParamData%uuN0 end if if (allocated(SrcParamData%twN0)) then - LB(1:2) = lbound(SrcParamData%twN0) - UB(1:2) = ubound(SrcParamData%twN0) + LB(1:2) = lbound(SrcParamData%twN0, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%twN0, kind=B8Ki) if (.not. allocated(DstParamData%twN0)) then allocate(DstParamData%twN0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1821,8 +1821,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%twN0 = SrcParamData%twN0 end if if (allocated(SrcParamData%Stif0_QP)) then - LB(1:3) = lbound(SrcParamData%Stif0_QP) - UB(1:3) = ubound(SrcParamData%Stif0_QP) + LB(1:3) = lbound(SrcParamData%Stif0_QP, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Stif0_QP, kind=B8Ki) if (.not. allocated(DstParamData%Stif0_QP)) then allocate(DstParamData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1833,8 +1833,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Stif0_QP = SrcParamData%Stif0_QP end if if (allocated(SrcParamData%Mass0_QP)) then - LB(1:3) = lbound(SrcParamData%Mass0_QP) - UB(1:3) = ubound(SrcParamData%Mass0_QP) + LB(1:3) = lbound(SrcParamData%Mass0_QP, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Mass0_QP, kind=B8Ki) if (.not. allocated(DstParamData%Mass0_QP)) then allocate(DstParamData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1846,8 +1846,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%gravity = SrcParamData%gravity if (allocated(SrcParamData%segment_eta)) then - LB(1:1) = lbound(SrcParamData%segment_eta) - UB(1:1) = ubound(SrcParamData%segment_eta) + LB(1:1) = lbound(SrcParamData%segment_eta, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%segment_eta, kind=B8Ki) if (.not. allocated(DstParamData%segment_eta)) then allocate(DstParamData%segment_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1858,8 +1858,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%segment_eta = SrcParamData%segment_eta end if if (allocated(SrcParamData%member_eta)) then - LB(1:1) = lbound(SrcParamData%member_eta) - UB(1:1) = ubound(SrcParamData%member_eta) + LB(1:1) = lbound(SrcParamData%member_eta, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%member_eta, kind=B8Ki) if (.not. allocated(DstParamData%member_eta)) then allocate(DstParamData%member_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1876,8 +1876,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%beta = SrcParamData%beta DstParamData%tol = SrcParamData%tol if (allocated(SrcParamData%QPtN)) then - LB(1:1) = lbound(SrcParamData%QPtN) - UB(1:1) = ubound(SrcParamData%QPtN) + LB(1:1) = lbound(SrcParamData%QPtN, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%QPtN, kind=B8Ki) if (.not. allocated(DstParamData%QPtN)) then allocate(DstParamData%QPtN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1888,8 +1888,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtN = SrcParamData%QPtN end if if (allocated(SrcParamData%QPtWeight)) then - LB(1:1) = lbound(SrcParamData%QPtWeight) - UB(1:1) = ubound(SrcParamData%QPtWeight) + LB(1:1) = lbound(SrcParamData%QPtWeight, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%QPtWeight, kind=B8Ki) if (.not. allocated(DstParamData%QPtWeight)) then allocate(DstParamData%QPtWeight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1900,8 +1900,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtWeight = SrcParamData%QPtWeight end if if (allocated(SrcParamData%Shp)) then - LB(1:2) = lbound(SrcParamData%Shp) - UB(1:2) = ubound(SrcParamData%Shp) + LB(1:2) = lbound(SrcParamData%Shp, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Shp, kind=B8Ki) if (.not. allocated(DstParamData%Shp)) then allocate(DstParamData%Shp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1912,8 +1912,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Shp = SrcParamData%Shp end if if (allocated(SrcParamData%ShpDer)) then - LB(1:2) = lbound(SrcParamData%ShpDer) - UB(1:2) = ubound(SrcParamData%ShpDer) + LB(1:2) = lbound(SrcParamData%ShpDer, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%ShpDer, kind=B8Ki) if (.not. allocated(DstParamData%ShpDer)) then allocate(DstParamData%ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1924,8 +1924,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ShpDer = SrcParamData%ShpDer end if if (allocated(SrcParamData%Jacobian)) then - LB(1:2) = lbound(SrcParamData%Jacobian) - UB(1:2) = ubound(SrcParamData%Jacobian) + LB(1:2) = lbound(SrcParamData%Jacobian, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jacobian, kind=B8Ki) if (.not. allocated(DstParamData%Jacobian)) then allocate(DstParamData%Jacobian(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1936,8 +1936,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jacobian = SrcParamData%Jacobian end if if (allocated(SrcParamData%uu0)) then - LB(1:3) = lbound(SrcParamData%uu0) - UB(1:3) = ubound(SrcParamData%uu0) + LB(1:3) = lbound(SrcParamData%uu0, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%uu0, kind=B8Ki) if (.not. allocated(DstParamData%uu0)) then allocate(DstParamData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1948,8 +1948,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uu0 = SrcParamData%uu0 end if if (allocated(SrcParamData%E10)) then - LB(1:3) = lbound(SrcParamData%E10) - UB(1:3) = ubound(SrcParamData%E10) + LB(1:3) = lbound(SrcParamData%E10, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%E10, kind=B8Ki) if (.not. allocated(DstParamData%E10)) then allocate(DstParamData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1961,8 +1961,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem if (allocated(SrcParamData%node_elem_idx)) then - LB(1:2) = lbound(SrcParamData%node_elem_idx) - UB(1:2) = ubound(SrcParamData%node_elem_idx) + LB(1:2) = lbound(SrcParamData%node_elem_idx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%node_elem_idx, kind=B8Ki) if (.not. allocated(DstParamData%node_elem_idx)) then allocate(DstParamData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1989,8 +1989,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutInputs = SrcParamData%OutInputs DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2007,8 +2007,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NNodeOuts = SrcParamData%NNodeOuts DstParamData%OutNd = SrcParamData%OutNd if (allocated(SrcParamData%NdIndx)) then - LB(1:1) = lbound(SrcParamData%NdIndx) - UB(1:1) = ubound(SrcParamData%NdIndx) + LB(1:1) = lbound(SrcParamData%NdIndx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NdIndx, kind=B8Ki) if (.not. allocated(DstParamData%NdIndx)) then allocate(DstParamData%NdIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2019,8 +2019,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NdIndx = SrcParamData%NdIndx end if if (allocated(SrcParamData%NdIndxInverse)) then - LB(1:1) = lbound(SrcParamData%NdIndxInverse) - UB(1:1) = ubound(SrcParamData%NdIndxInverse) + LB(1:1) = lbound(SrcParamData%NdIndxInverse, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NdIndxInverse, kind=B8Ki) if (.not. allocated(DstParamData%NdIndxInverse)) then allocate(DstParamData%NdIndxInverse(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2031,8 +2031,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse end if if (allocated(SrcParamData%OutNd2NdElem)) then - LB(1:2) = lbound(SrcParamData%OutNd2NdElem) - UB(1:2) = ubound(SrcParamData%OutNd2NdElem) + LB(1:2) = lbound(SrcParamData%OutNd2NdElem, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%OutNd2NdElem, kind=B8Ki) if (.not. allocated(DstParamData%OutNd2NdElem)) then allocate(DstParamData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2060,8 +2060,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts if (allocated(SrcParamData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcParamData%BldNd_OutParam) - UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + LB(1:1) = lbound(SrcParamData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam, kind=B8Ki) if (.not. allocated(DstParamData%BldNd_OutParam)) then allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2076,8 +2076,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) - UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd) + LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd, kind=B8Ki) if (.not. allocated(DstParamData%BldNd_BlOutNd)) then allocate(DstParamData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2088,8 +2088,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd end if if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then - LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) - UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac) + LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac, kind=B8Ki) if (.not. allocated(DstParamData%QPtw_Shp_Shp_Jac)) then allocate(DstParamData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2100,8 +2100,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac end if if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then - LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) - UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer) + LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer, kind=B8Ki) if (.not. allocated(DstParamData%QPtw_Shp_ShpDer)) then allocate(DstParamData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2112,8 +2112,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer end if if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then - LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) - UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki) if (.not. allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then allocate(DstParamData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2124,8 +2124,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac end if if (allocated(SrcParamData%QPtw_Shp_Jac)) then - LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) - UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac) + LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac, kind=B8Ki) if (.not. allocated(DstParamData%QPtw_Shp_Jac)) then allocate(DstParamData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2136,8 +2136,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac end if if (allocated(SrcParamData%QPtw_ShpDer)) then - LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) - UB(1:2) = ubound(SrcParamData%QPtw_ShpDer) + LB(1:2) = lbound(SrcParamData%QPtw_ShpDer, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%QPtw_ShpDer, kind=B8Ki) if (.not. allocated(DstParamData%QPtw_ShpDer)) then allocate(DstParamData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2148,8 +2148,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer end if if (allocated(SrcParamData%FEweight)) then - LB(1:2) = lbound(SrcParamData%FEweight) - UB(1:2) = ubound(SrcParamData%FEweight) + LB(1:2) = lbound(SrcParamData%FEweight, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%FEweight, kind=B8Ki) if (.not. allocated(DstParamData%FEweight)) then allocate(DstParamData%FEweight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2160,8 +2160,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FEweight = SrcParamData%FEweight end if if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2172,8 +2172,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2195,8 +2195,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) type(BD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_DestroyParam' @@ -2245,8 +2245,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%node_elem_idx) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2265,8 +2265,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) call BD_DestroyqpParam(ParamData%qp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam) - UB(1:1) = ubound(ParamData%BldNd_OutParam) + LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2306,41 +2306,41 @@ subroutine BD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackParam' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dt) call RegPack(Buf, InData%coef) call RegPack(Buf, InData%rhoinf) call RegPack(Buf, allocated(InData%uuN0)) if (allocated(InData%uuN0)) then - call RegPackBounds(Buf, 3, lbound(InData%uuN0), ubound(InData%uuN0)) + call RegPackBounds(Buf, 3, lbound(InData%uuN0, kind=B8Ki), ubound(InData%uuN0, kind=B8Ki)) call RegPack(Buf, InData%uuN0) end if call RegPack(Buf, allocated(InData%twN0)) if (allocated(InData%twN0)) then - call RegPackBounds(Buf, 2, lbound(InData%twN0), ubound(InData%twN0)) + call RegPackBounds(Buf, 2, lbound(InData%twN0, kind=B8Ki), ubound(InData%twN0, kind=B8Ki)) call RegPack(Buf, InData%twN0) end if call RegPack(Buf, allocated(InData%Stif0_QP)) if (allocated(InData%Stif0_QP)) then - call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP), ubound(InData%Stif0_QP)) + call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP, kind=B8Ki), ubound(InData%Stif0_QP, kind=B8Ki)) call RegPack(Buf, InData%Stif0_QP) end if call RegPack(Buf, allocated(InData%Mass0_QP)) if (allocated(InData%Mass0_QP)) then - call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP), ubound(InData%Mass0_QP)) + call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP, kind=B8Ki), ubound(InData%Mass0_QP, kind=B8Ki)) call RegPack(Buf, InData%Mass0_QP) end if call RegPack(Buf, InData%gravity) call RegPack(Buf, allocated(InData%segment_eta)) if (allocated(InData%segment_eta)) then - call RegPackBounds(Buf, 1, lbound(InData%segment_eta), ubound(InData%segment_eta)) + call RegPackBounds(Buf, 1, lbound(InData%segment_eta, kind=B8Ki), ubound(InData%segment_eta, kind=B8Ki)) call RegPack(Buf, InData%segment_eta) end if call RegPack(Buf, allocated(InData%member_eta)) if (allocated(InData%member_eta)) then - call RegPackBounds(Buf, 1, lbound(InData%member_eta), ubound(InData%member_eta)) + call RegPackBounds(Buf, 1, lbound(InData%member_eta, kind=B8Ki), ubound(InData%member_eta, kind=B8Ki)) call RegPack(Buf, InData%member_eta) end if call RegPack(Buf, InData%blade_length) @@ -2351,43 +2351,43 @@ subroutine BD_PackParam(Buf, Indata) call RegPack(Buf, InData%tol) call RegPack(Buf, allocated(InData%QPtN)) if (allocated(InData%QPtN)) then - call RegPackBounds(Buf, 1, lbound(InData%QPtN), ubound(InData%QPtN)) + call RegPackBounds(Buf, 1, lbound(InData%QPtN, kind=B8Ki), ubound(InData%QPtN, kind=B8Ki)) call RegPack(Buf, InData%QPtN) end if call RegPack(Buf, allocated(InData%QPtWeight)) if (allocated(InData%QPtWeight)) then - call RegPackBounds(Buf, 1, lbound(InData%QPtWeight), ubound(InData%QPtWeight)) + call RegPackBounds(Buf, 1, lbound(InData%QPtWeight, kind=B8Ki), ubound(InData%QPtWeight, kind=B8Ki)) call RegPack(Buf, InData%QPtWeight) end if call RegPack(Buf, allocated(InData%Shp)) if (allocated(InData%Shp)) then - call RegPackBounds(Buf, 2, lbound(InData%Shp), ubound(InData%Shp)) + call RegPackBounds(Buf, 2, lbound(InData%Shp, kind=B8Ki), ubound(InData%Shp, kind=B8Ki)) call RegPack(Buf, InData%Shp) end if call RegPack(Buf, allocated(InData%ShpDer)) if (allocated(InData%ShpDer)) then - call RegPackBounds(Buf, 2, lbound(InData%ShpDer), ubound(InData%ShpDer)) + call RegPackBounds(Buf, 2, lbound(InData%ShpDer, kind=B8Ki), ubound(InData%ShpDer, kind=B8Ki)) call RegPack(Buf, InData%ShpDer) end if call RegPack(Buf, allocated(InData%Jacobian)) if (allocated(InData%Jacobian)) then - call RegPackBounds(Buf, 2, lbound(InData%Jacobian), ubound(InData%Jacobian)) + call RegPackBounds(Buf, 2, lbound(InData%Jacobian, kind=B8Ki), ubound(InData%Jacobian, kind=B8Ki)) call RegPack(Buf, InData%Jacobian) end if call RegPack(Buf, allocated(InData%uu0)) if (allocated(InData%uu0)) then - call RegPackBounds(Buf, 3, lbound(InData%uu0), ubound(InData%uu0)) + call RegPackBounds(Buf, 3, lbound(InData%uu0, kind=B8Ki), ubound(InData%uu0, kind=B8Ki)) call RegPack(Buf, InData%uu0) end if call RegPack(Buf, allocated(InData%E10)) if (allocated(InData%E10)) then - call RegPackBounds(Buf, 3, lbound(InData%E10), ubound(InData%E10)) + call RegPackBounds(Buf, 3, lbound(InData%E10, kind=B8Ki), ubound(InData%E10, kind=B8Ki)) call RegPack(Buf, InData%E10) end if call RegPack(Buf, InData%nodes_per_elem) call RegPack(Buf, allocated(InData%node_elem_idx)) if (allocated(InData%node_elem_idx)) then - call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx), ubound(InData%node_elem_idx)) + call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx, kind=B8Ki), ubound(InData%node_elem_idx, kind=B8Ki)) call RegPack(Buf, InData%node_elem_idx) end if call RegPack(Buf, InData%refine) @@ -2408,9 +2408,9 @@ subroutine BD_PackParam(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -2419,17 +2419,17 @@ subroutine BD_PackParam(Buf, Indata) call RegPack(Buf, InData%OutNd) call RegPack(Buf, allocated(InData%NdIndx)) if (allocated(InData%NdIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%NdIndx), ubound(InData%NdIndx)) + call RegPackBounds(Buf, 1, lbound(InData%NdIndx, kind=B8Ki), ubound(InData%NdIndx, kind=B8Ki)) call RegPack(Buf, InData%NdIndx) end if call RegPack(Buf, allocated(InData%NdIndxInverse)) if (allocated(InData%NdIndxInverse)) then - call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse), ubound(InData%NdIndxInverse)) + call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse, kind=B8Ki), ubound(InData%NdIndxInverse, kind=B8Ki)) call RegPack(Buf, InData%NdIndxInverse) end if call RegPack(Buf, allocated(InData%OutNd2NdElem)) if (allocated(InData%OutNd2NdElem)) then - call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem), ubound(InData%OutNd2NdElem)) + call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem, kind=B8Ki), ubound(InData%OutNd2NdElem, kind=B8Ki)) call RegPack(Buf, InData%OutNd2NdElem) end if call RegPack(Buf, InData%OutFmt) @@ -2449,56 +2449,56 @@ subroutine BD_PackParam(Buf, Indata) call RegPack(Buf, InData%BldNd_TotNumOuts) call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) - LB(1:1) = lbound(InData%BldNd_OutParam) - UB(1:1) = ubound(InData%BldNd_OutParam) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) end do end if call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd, kind=B8Ki), ubound(InData%BldNd_BlOutNd, kind=B8Ki)) call RegPack(Buf, InData%BldNd_BlOutNd) end if call RegPack(Buf, allocated(InData%QPtw_Shp_Shp_Jac)) if (allocated(InData%QPtw_Shp_Shp_Jac)) then - call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac), ubound(InData%QPtw_Shp_Shp_Jac)) + call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac, kind=B8Ki), ubound(InData%QPtw_Shp_Shp_Jac, kind=B8Ki)) call RegPack(Buf, InData%QPtw_Shp_Shp_Jac) end if call RegPack(Buf, allocated(InData%QPtw_Shp_ShpDer)) if (allocated(InData%QPtw_Shp_ShpDer)) then - call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer), ubound(InData%QPtw_Shp_ShpDer)) + call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer, kind=B8Ki), ubound(InData%QPtw_Shp_ShpDer, kind=B8Ki)) call RegPack(Buf, InData%QPtw_Shp_ShpDer) end if call RegPack(Buf, allocated(InData%QPtw_ShpDer_ShpDer_Jac)) if (allocated(InData%QPtw_ShpDer_ShpDer_Jac)) then - call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac), ubound(InData%QPtw_ShpDer_ShpDer_Jac)) + call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki), ubound(InData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki)) call RegPack(Buf, InData%QPtw_ShpDer_ShpDer_Jac) end if call RegPack(Buf, allocated(InData%QPtw_Shp_Jac)) if (allocated(InData%QPtw_Shp_Jac)) then - call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac), ubound(InData%QPtw_Shp_Jac)) + call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac, kind=B8Ki), ubound(InData%QPtw_Shp_Jac, kind=B8Ki)) call RegPack(Buf, InData%QPtw_Shp_Jac) end if call RegPack(Buf, allocated(InData%QPtw_ShpDer)) if (allocated(InData%QPtw_ShpDer)) then - call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer), ubound(InData%QPtw_ShpDer)) + call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer, kind=B8Ki), ubound(InData%QPtw_ShpDer, kind=B8Ki)) call RegPack(Buf, InData%QPtw_ShpDer) end if call RegPack(Buf, allocated(InData%FEweight)) if (allocated(InData%FEweight)) then - call RegPackBounds(Buf, 2, lbound(InData%FEweight), ubound(InData%FEweight)) + call RegPackBounds(Buf, 2, lbound(InData%FEweight, kind=B8Ki), ubound(InData%FEweight, kind=B8Ki)) call RegPack(Buf, InData%FEweight) end if call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, InData%dx) @@ -2514,8 +2514,8 @@ subroutine BD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackParam' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3087,7 +3087,7 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyOutput' @@ -3102,8 +3102,8 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%RootMxr = SrcOutputData%RootMxr DstOutputData%RootMyr = SrcOutputData%RootMyr if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3144,7 +3144,7 @@ subroutine BD_PackOutput(Buf, Indata) call RegPack(Buf, InData%RootMyr) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3154,7 +3154,7 @@ subroutine BD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3186,14 +3186,14 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyEqMotionQP' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcEqMotionQPData%uuu)) then - LB(1:3) = lbound(SrcEqMotionQPData%uuu) - UB(1:3) = ubound(SrcEqMotionQPData%uuu) + LB(1:3) = lbound(SrcEqMotionQPData%uuu, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%uuu, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%uuu)) then allocate(DstEqMotionQPData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3204,8 +3204,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu end if if (allocated(SrcEqMotionQPData%uup)) then - LB(1:3) = lbound(SrcEqMotionQPData%uup) - UB(1:3) = ubound(SrcEqMotionQPData%uup) + LB(1:3) = lbound(SrcEqMotionQPData%uup, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%uup, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%uup)) then allocate(DstEqMotionQPData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3216,8 +3216,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%uup = SrcEqMotionQPData%uup end if if (allocated(SrcEqMotionQPData%vvv)) then - LB(1:3) = lbound(SrcEqMotionQPData%vvv) - UB(1:3) = ubound(SrcEqMotionQPData%vvv) + LB(1:3) = lbound(SrcEqMotionQPData%vvv, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%vvv, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%vvv)) then allocate(DstEqMotionQPData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3228,8 +3228,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv end if if (allocated(SrcEqMotionQPData%vvp)) then - LB(1:3) = lbound(SrcEqMotionQPData%vvp) - UB(1:3) = ubound(SrcEqMotionQPData%vvp) + LB(1:3) = lbound(SrcEqMotionQPData%vvp, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%vvp, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%vvp)) then allocate(DstEqMotionQPData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3240,8 +3240,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp end if if (allocated(SrcEqMotionQPData%aaa)) then - LB(1:3) = lbound(SrcEqMotionQPData%aaa) - UB(1:3) = ubound(SrcEqMotionQPData%aaa) + LB(1:3) = lbound(SrcEqMotionQPData%aaa, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%aaa, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%aaa)) then allocate(DstEqMotionQPData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3252,8 +3252,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa end if if (allocated(SrcEqMotionQPData%RR0)) then - LB(1:4) = lbound(SrcEqMotionQPData%RR0) - UB(1:4) = ubound(SrcEqMotionQPData%RR0) + LB(1:4) = lbound(SrcEqMotionQPData%RR0, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%RR0, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%RR0)) then allocate(DstEqMotionQPData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3264,8 +3264,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 end if if (allocated(SrcEqMotionQPData%kappa)) then - LB(1:3) = lbound(SrcEqMotionQPData%kappa) - UB(1:3) = ubound(SrcEqMotionQPData%kappa) + LB(1:3) = lbound(SrcEqMotionQPData%kappa, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%kappa, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%kappa)) then allocate(DstEqMotionQPData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3276,8 +3276,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa end if if (allocated(SrcEqMotionQPData%E1)) then - LB(1:3) = lbound(SrcEqMotionQPData%E1) - UB(1:3) = ubound(SrcEqMotionQPData%E1) + LB(1:3) = lbound(SrcEqMotionQPData%E1, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%E1, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%E1)) then allocate(DstEqMotionQPData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3288,8 +3288,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 end if if (allocated(SrcEqMotionQPData%Stif)) then - LB(1:4) = lbound(SrcEqMotionQPData%Stif) - UB(1:4) = ubound(SrcEqMotionQPData%Stif) + LB(1:4) = lbound(SrcEqMotionQPData%Stif, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Stif, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Stif)) then allocate(DstEqMotionQPData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3300,8 +3300,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif end if if (allocated(SrcEqMotionQPData%Fb)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fb) - UB(1:3) = ubound(SrcEqMotionQPData%Fb) + LB(1:3) = lbound(SrcEqMotionQPData%Fb, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%Fb, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Fb)) then allocate(DstEqMotionQPData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3312,8 +3312,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb end if if (allocated(SrcEqMotionQPData%Fc)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fc) - UB(1:3) = ubound(SrcEqMotionQPData%Fc) + LB(1:3) = lbound(SrcEqMotionQPData%Fc, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%Fc, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Fc)) then allocate(DstEqMotionQPData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3324,8 +3324,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc end if if (allocated(SrcEqMotionQPData%Fd)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fd) - UB(1:3) = ubound(SrcEqMotionQPData%Fd) + LB(1:3) = lbound(SrcEqMotionQPData%Fd, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%Fd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Fd)) then allocate(DstEqMotionQPData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3336,8 +3336,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd end if if (allocated(SrcEqMotionQPData%Fg)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fg) - UB(1:3) = ubound(SrcEqMotionQPData%Fg) + LB(1:3) = lbound(SrcEqMotionQPData%Fg, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%Fg, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Fg)) then allocate(DstEqMotionQPData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3348,8 +3348,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg end if if (allocated(SrcEqMotionQPData%Fi)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fi) - UB(1:3) = ubound(SrcEqMotionQPData%Fi) + LB(1:3) = lbound(SrcEqMotionQPData%Fi, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%Fi, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Fi)) then allocate(DstEqMotionQPData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3360,8 +3360,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi end if if (allocated(SrcEqMotionQPData%Ftemp)) then - LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) - UB(1:3) = ubound(SrcEqMotionQPData%Ftemp) + LB(1:3) = lbound(SrcEqMotionQPData%Ftemp, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%Ftemp, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Ftemp)) then allocate(DstEqMotionQPData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3372,8 +3372,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp end if if (allocated(SrcEqMotionQPData%RR0mEta)) then - LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) - UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta) + LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta, kind=B8Ki) + UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%RR0mEta)) then allocate(DstEqMotionQPData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3384,8 +3384,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta end if if (allocated(SrcEqMotionQPData%rho)) then - LB(1:4) = lbound(SrcEqMotionQPData%rho) - UB(1:4) = ubound(SrcEqMotionQPData%rho) + LB(1:4) = lbound(SrcEqMotionQPData%rho, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%rho, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%rho)) then allocate(DstEqMotionQPData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3396,8 +3396,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%rho = SrcEqMotionQPData%rho end if if (allocated(SrcEqMotionQPData%betaC)) then - LB(1:4) = lbound(SrcEqMotionQPData%betaC) - UB(1:4) = ubound(SrcEqMotionQPData%betaC) + LB(1:4) = lbound(SrcEqMotionQPData%betaC, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%betaC, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%betaC)) then allocate(DstEqMotionQPData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3408,8 +3408,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC end if if (allocated(SrcEqMotionQPData%Gi)) then - LB(1:4) = lbound(SrcEqMotionQPData%Gi) - UB(1:4) = ubound(SrcEqMotionQPData%Gi) + LB(1:4) = lbound(SrcEqMotionQPData%Gi, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Gi, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Gi)) then allocate(DstEqMotionQPData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3420,8 +3420,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi end if if (allocated(SrcEqMotionQPData%Ki)) then - LB(1:4) = lbound(SrcEqMotionQPData%Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Ki, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Ki, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Ki)) then allocate(DstEqMotionQPData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3432,8 +3432,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki end if if (allocated(SrcEqMotionQPData%Mi)) then - LB(1:4) = lbound(SrcEqMotionQPData%Mi) - UB(1:4) = ubound(SrcEqMotionQPData%Mi) + LB(1:4) = lbound(SrcEqMotionQPData%Mi, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Mi, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Mi)) then allocate(DstEqMotionQPData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3444,8 +3444,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi end if if (allocated(SrcEqMotionQPData%Oe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Oe) - UB(1:4) = ubound(SrcEqMotionQPData%Oe) + LB(1:4) = lbound(SrcEqMotionQPData%Oe, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Oe, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Oe)) then allocate(DstEqMotionQPData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3456,8 +3456,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe end if if (allocated(SrcEqMotionQPData%Pe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Pe) - UB(1:4) = ubound(SrcEqMotionQPData%Pe) + LB(1:4) = lbound(SrcEqMotionQPData%Pe, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Pe, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Pe)) then allocate(DstEqMotionQPData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3468,8 +3468,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe end if if (allocated(SrcEqMotionQPData%Qe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Qe) - UB(1:4) = ubound(SrcEqMotionQPData%Qe) + LB(1:4) = lbound(SrcEqMotionQPData%Qe, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Qe, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Qe)) then allocate(DstEqMotionQPData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3480,8 +3480,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe end if if (allocated(SrcEqMotionQPData%Gd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Gd) - UB(1:4) = ubound(SrcEqMotionQPData%Gd) + LB(1:4) = lbound(SrcEqMotionQPData%Gd, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Gd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Gd)) then allocate(DstEqMotionQPData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3492,8 +3492,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd end if if (allocated(SrcEqMotionQPData%Od)) then - LB(1:4) = lbound(SrcEqMotionQPData%Od) - UB(1:4) = ubound(SrcEqMotionQPData%Od) + LB(1:4) = lbound(SrcEqMotionQPData%Od, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Od, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Od)) then allocate(DstEqMotionQPData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3504,8 +3504,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Od = SrcEqMotionQPData%Od end if if (allocated(SrcEqMotionQPData%Pd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Pd) - UB(1:4) = ubound(SrcEqMotionQPData%Pd) + LB(1:4) = lbound(SrcEqMotionQPData%Pd, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Pd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Pd)) then allocate(DstEqMotionQPData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3516,8 +3516,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd end if if (allocated(SrcEqMotionQPData%Qd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Qd) - UB(1:4) = ubound(SrcEqMotionQPData%Qd) + LB(1:4) = lbound(SrcEqMotionQPData%Qd, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Qd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Qd)) then allocate(DstEqMotionQPData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3528,8 +3528,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd end if if (allocated(SrcEqMotionQPData%Sd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Sd) - UB(1:4) = ubound(SrcEqMotionQPData%Sd) + LB(1:4) = lbound(SrcEqMotionQPData%Sd, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Sd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Sd)) then allocate(DstEqMotionQPData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3540,8 +3540,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd end if if (allocated(SrcEqMotionQPData%Xd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Xd) - UB(1:4) = ubound(SrcEqMotionQPData%Xd) + LB(1:4) = lbound(SrcEqMotionQPData%Xd, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Xd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Xd)) then allocate(DstEqMotionQPData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3552,8 +3552,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd end if if (allocated(SrcEqMotionQPData%Yd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Yd) - UB(1:4) = ubound(SrcEqMotionQPData%Yd) + LB(1:4) = lbound(SrcEqMotionQPData%Yd, kind=B8Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Yd, kind=B8Ki) if (.not. allocated(DstEqMotionQPData%Yd)) then allocate(DstEqMotionQPData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3674,157 +3674,157 @@ subroutine BD_PackEqMotionQP(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%uuu)) if (allocated(InData%uuu)) then - call RegPackBounds(Buf, 3, lbound(InData%uuu), ubound(InData%uuu)) + call RegPackBounds(Buf, 3, lbound(InData%uuu, kind=B8Ki), ubound(InData%uuu, kind=B8Ki)) call RegPack(Buf, InData%uuu) end if call RegPack(Buf, allocated(InData%uup)) if (allocated(InData%uup)) then - call RegPackBounds(Buf, 3, lbound(InData%uup), ubound(InData%uup)) + call RegPackBounds(Buf, 3, lbound(InData%uup, kind=B8Ki), ubound(InData%uup, kind=B8Ki)) call RegPack(Buf, InData%uup) end if call RegPack(Buf, allocated(InData%vvv)) if (allocated(InData%vvv)) then - call RegPackBounds(Buf, 3, lbound(InData%vvv), ubound(InData%vvv)) + call RegPackBounds(Buf, 3, lbound(InData%vvv, kind=B8Ki), ubound(InData%vvv, kind=B8Ki)) call RegPack(Buf, InData%vvv) end if call RegPack(Buf, allocated(InData%vvp)) if (allocated(InData%vvp)) then - call RegPackBounds(Buf, 3, lbound(InData%vvp), ubound(InData%vvp)) + call RegPackBounds(Buf, 3, lbound(InData%vvp, kind=B8Ki), ubound(InData%vvp, kind=B8Ki)) call RegPack(Buf, InData%vvp) end if call RegPack(Buf, allocated(InData%aaa)) if (allocated(InData%aaa)) then - call RegPackBounds(Buf, 3, lbound(InData%aaa), ubound(InData%aaa)) + call RegPackBounds(Buf, 3, lbound(InData%aaa, kind=B8Ki), ubound(InData%aaa, kind=B8Ki)) call RegPack(Buf, InData%aaa) end if call RegPack(Buf, allocated(InData%RR0)) if (allocated(InData%RR0)) then - call RegPackBounds(Buf, 4, lbound(InData%RR0), ubound(InData%RR0)) + call RegPackBounds(Buf, 4, lbound(InData%RR0, kind=B8Ki), ubound(InData%RR0, kind=B8Ki)) call RegPack(Buf, InData%RR0) end if call RegPack(Buf, allocated(InData%kappa)) if (allocated(InData%kappa)) then - call RegPackBounds(Buf, 3, lbound(InData%kappa), ubound(InData%kappa)) + call RegPackBounds(Buf, 3, lbound(InData%kappa, kind=B8Ki), ubound(InData%kappa, kind=B8Ki)) call RegPack(Buf, InData%kappa) end if call RegPack(Buf, allocated(InData%E1)) if (allocated(InData%E1)) then - call RegPackBounds(Buf, 3, lbound(InData%E1), ubound(InData%E1)) + call RegPackBounds(Buf, 3, lbound(InData%E1, kind=B8Ki), ubound(InData%E1, kind=B8Ki)) call RegPack(Buf, InData%E1) end if call RegPack(Buf, allocated(InData%Stif)) if (allocated(InData%Stif)) then - call RegPackBounds(Buf, 4, lbound(InData%Stif), ubound(InData%Stif)) + call RegPackBounds(Buf, 4, lbound(InData%Stif, kind=B8Ki), ubound(InData%Stif, kind=B8Ki)) call RegPack(Buf, InData%Stif) end if call RegPack(Buf, allocated(InData%Fb)) if (allocated(InData%Fb)) then - call RegPackBounds(Buf, 3, lbound(InData%Fb), ubound(InData%Fb)) + call RegPackBounds(Buf, 3, lbound(InData%Fb, kind=B8Ki), ubound(InData%Fb, kind=B8Ki)) call RegPack(Buf, InData%Fb) end if call RegPack(Buf, allocated(InData%Fc)) if (allocated(InData%Fc)) then - call RegPackBounds(Buf, 3, lbound(InData%Fc), ubound(InData%Fc)) + call RegPackBounds(Buf, 3, lbound(InData%Fc, kind=B8Ki), ubound(InData%Fc, kind=B8Ki)) call RegPack(Buf, InData%Fc) end if call RegPack(Buf, allocated(InData%Fd)) if (allocated(InData%Fd)) then - call RegPackBounds(Buf, 3, lbound(InData%Fd), ubound(InData%Fd)) + call RegPackBounds(Buf, 3, lbound(InData%Fd, kind=B8Ki), ubound(InData%Fd, kind=B8Ki)) call RegPack(Buf, InData%Fd) end if call RegPack(Buf, allocated(InData%Fg)) if (allocated(InData%Fg)) then - call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) + call RegPackBounds(Buf, 3, lbound(InData%Fg, kind=B8Ki), ubound(InData%Fg, kind=B8Ki)) call RegPack(Buf, InData%Fg) end if call RegPack(Buf, allocated(InData%Fi)) if (allocated(InData%Fi)) then - call RegPackBounds(Buf, 3, lbound(InData%Fi), ubound(InData%Fi)) + call RegPackBounds(Buf, 3, lbound(InData%Fi, kind=B8Ki), ubound(InData%Fi, kind=B8Ki)) call RegPack(Buf, InData%Fi) end if call RegPack(Buf, allocated(InData%Ftemp)) if (allocated(InData%Ftemp)) then - call RegPackBounds(Buf, 3, lbound(InData%Ftemp), ubound(InData%Ftemp)) + call RegPackBounds(Buf, 3, lbound(InData%Ftemp, kind=B8Ki), ubound(InData%Ftemp, kind=B8Ki)) call RegPack(Buf, InData%Ftemp) end if call RegPack(Buf, allocated(InData%RR0mEta)) if (allocated(InData%RR0mEta)) then - call RegPackBounds(Buf, 3, lbound(InData%RR0mEta), ubound(InData%RR0mEta)) + call RegPackBounds(Buf, 3, lbound(InData%RR0mEta, kind=B8Ki), ubound(InData%RR0mEta, kind=B8Ki)) call RegPack(Buf, InData%RR0mEta) end if call RegPack(Buf, allocated(InData%rho)) if (allocated(InData%rho)) then - call RegPackBounds(Buf, 4, lbound(InData%rho), ubound(InData%rho)) + call RegPackBounds(Buf, 4, lbound(InData%rho, kind=B8Ki), ubound(InData%rho, kind=B8Ki)) call RegPack(Buf, InData%rho) end if call RegPack(Buf, allocated(InData%betaC)) if (allocated(InData%betaC)) then - call RegPackBounds(Buf, 4, lbound(InData%betaC), ubound(InData%betaC)) + call RegPackBounds(Buf, 4, lbound(InData%betaC, kind=B8Ki), ubound(InData%betaC, kind=B8Ki)) call RegPack(Buf, InData%betaC) end if call RegPack(Buf, allocated(InData%Gi)) if (allocated(InData%Gi)) then - call RegPackBounds(Buf, 4, lbound(InData%Gi), ubound(InData%Gi)) + call RegPackBounds(Buf, 4, lbound(InData%Gi, kind=B8Ki), ubound(InData%Gi, kind=B8Ki)) call RegPack(Buf, InData%Gi) end if call RegPack(Buf, allocated(InData%Ki)) if (allocated(InData%Ki)) then - call RegPackBounds(Buf, 4, lbound(InData%Ki), ubound(InData%Ki)) + call RegPackBounds(Buf, 4, lbound(InData%Ki, kind=B8Ki), ubound(InData%Ki, kind=B8Ki)) call RegPack(Buf, InData%Ki) end if call RegPack(Buf, allocated(InData%Mi)) if (allocated(InData%Mi)) then - call RegPackBounds(Buf, 4, lbound(InData%Mi), ubound(InData%Mi)) + call RegPackBounds(Buf, 4, lbound(InData%Mi, kind=B8Ki), ubound(InData%Mi, kind=B8Ki)) call RegPack(Buf, InData%Mi) end if call RegPack(Buf, allocated(InData%Oe)) if (allocated(InData%Oe)) then - call RegPackBounds(Buf, 4, lbound(InData%Oe), ubound(InData%Oe)) + call RegPackBounds(Buf, 4, lbound(InData%Oe, kind=B8Ki), ubound(InData%Oe, kind=B8Ki)) call RegPack(Buf, InData%Oe) end if call RegPack(Buf, allocated(InData%Pe)) if (allocated(InData%Pe)) then - call RegPackBounds(Buf, 4, lbound(InData%Pe), ubound(InData%Pe)) + call RegPackBounds(Buf, 4, lbound(InData%Pe, kind=B8Ki), ubound(InData%Pe, kind=B8Ki)) call RegPack(Buf, InData%Pe) end if call RegPack(Buf, allocated(InData%Qe)) if (allocated(InData%Qe)) then - call RegPackBounds(Buf, 4, lbound(InData%Qe), ubound(InData%Qe)) + call RegPackBounds(Buf, 4, lbound(InData%Qe, kind=B8Ki), ubound(InData%Qe, kind=B8Ki)) call RegPack(Buf, InData%Qe) end if call RegPack(Buf, allocated(InData%Gd)) if (allocated(InData%Gd)) then - call RegPackBounds(Buf, 4, lbound(InData%Gd), ubound(InData%Gd)) + call RegPackBounds(Buf, 4, lbound(InData%Gd, kind=B8Ki), ubound(InData%Gd, kind=B8Ki)) call RegPack(Buf, InData%Gd) end if call RegPack(Buf, allocated(InData%Od)) if (allocated(InData%Od)) then - call RegPackBounds(Buf, 4, lbound(InData%Od), ubound(InData%Od)) + call RegPackBounds(Buf, 4, lbound(InData%Od, kind=B8Ki), ubound(InData%Od, kind=B8Ki)) call RegPack(Buf, InData%Od) end if call RegPack(Buf, allocated(InData%Pd)) if (allocated(InData%Pd)) then - call RegPackBounds(Buf, 4, lbound(InData%Pd), ubound(InData%Pd)) + call RegPackBounds(Buf, 4, lbound(InData%Pd, kind=B8Ki), ubound(InData%Pd, kind=B8Ki)) call RegPack(Buf, InData%Pd) end if call RegPack(Buf, allocated(InData%Qd)) if (allocated(InData%Qd)) then - call RegPackBounds(Buf, 4, lbound(InData%Qd), ubound(InData%Qd)) + call RegPackBounds(Buf, 4, lbound(InData%Qd, kind=B8Ki), ubound(InData%Qd, kind=B8Ki)) call RegPack(Buf, InData%Qd) end if call RegPack(Buf, allocated(InData%Sd)) if (allocated(InData%Sd)) then - call RegPackBounds(Buf, 4, lbound(InData%Sd), ubound(InData%Sd)) + call RegPackBounds(Buf, 4, lbound(InData%Sd, kind=B8Ki), ubound(InData%Sd, kind=B8Ki)) call RegPack(Buf, InData%Sd) end if call RegPack(Buf, allocated(InData%Xd)) if (allocated(InData%Xd)) then - call RegPackBounds(Buf, 4, lbound(InData%Xd), ubound(InData%Xd)) + call RegPackBounds(Buf, 4, lbound(InData%Xd, kind=B8Ki), ubound(InData%Xd, kind=B8Ki)) call RegPack(Buf, InData%Xd) end if call RegPack(Buf, allocated(InData%Yd)) if (allocated(InData%Yd)) then - call RegPackBounds(Buf, 4, lbound(InData%Yd), ubound(InData%Yd)) + call RegPackBounds(Buf, 4, lbound(InData%Yd, kind=B8Ki), ubound(InData%Yd, kind=B8Ki)) call RegPack(Buf, InData%Yd) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3834,7 +3834,7 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(EqMotionQP), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4280,7 +4280,7 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyMisc' @@ -4303,8 +4303,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%lin_A)) then - LB(1:2) = lbound(SrcMiscData%lin_A) - UB(1:2) = ubound(SrcMiscData%lin_A) + LB(1:2) = lbound(SrcMiscData%lin_A, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%lin_A, kind=B8Ki) if (.not. allocated(DstMiscData%lin_A)) then allocate(DstMiscData%lin_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4315,8 +4315,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%lin_A = SrcMiscData%lin_A end if if (allocated(SrcMiscData%lin_C)) then - LB(1:2) = lbound(SrcMiscData%lin_C) - UB(1:2) = ubound(SrcMiscData%lin_C) + LB(1:2) = lbound(SrcMiscData%lin_C, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%lin_C, kind=B8Ki) if (.not. allocated(DstMiscData%lin_C)) then allocate(DstMiscData%lin_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4327,8 +4327,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%lin_C = SrcMiscData%lin_C end if if (allocated(SrcMiscData%Nrrr)) then - LB(1:3) = lbound(SrcMiscData%Nrrr) - UB(1:3) = ubound(SrcMiscData%Nrrr) + LB(1:3) = lbound(SrcMiscData%Nrrr, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%Nrrr, kind=B8Ki) if (.not. allocated(DstMiscData%Nrrr)) then allocate(DstMiscData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4339,8 +4339,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Nrrr = SrcMiscData%Nrrr end if if (allocated(SrcMiscData%elf)) then - LB(1:2) = lbound(SrcMiscData%elf) - UB(1:2) = ubound(SrcMiscData%elf) + LB(1:2) = lbound(SrcMiscData%elf, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%elf, kind=B8Ki) if (.not. allocated(DstMiscData%elf)) then allocate(DstMiscData%elf(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4351,8 +4351,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elf = SrcMiscData%elf end if if (allocated(SrcMiscData%EFint)) then - LB(1:3) = lbound(SrcMiscData%EFint) - UB(1:3) = ubound(SrcMiscData%EFint) + LB(1:3) = lbound(SrcMiscData%EFint, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%EFint, kind=B8Ki) if (.not. allocated(DstMiscData%EFint)) then allocate(DstMiscData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4363,8 +4363,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%EFint = SrcMiscData%EFint end if if (allocated(SrcMiscData%elk)) then - LB(1:4) = lbound(SrcMiscData%elk) - UB(1:4) = ubound(SrcMiscData%elk) + LB(1:4) = lbound(SrcMiscData%elk, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%elk, kind=B8Ki) if (.not. allocated(DstMiscData%elk)) then allocate(DstMiscData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4375,8 +4375,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elk = SrcMiscData%elk end if if (allocated(SrcMiscData%elg)) then - LB(1:4) = lbound(SrcMiscData%elg) - UB(1:4) = ubound(SrcMiscData%elg) + LB(1:4) = lbound(SrcMiscData%elg, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%elg, kind=B8Ki) if (.not. allocated(DstMiscData%elg)) then allocate(DstMiscData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4387,8 +4387,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elg = SrcMiscData%elg end if if (allocated(SrcMiscData%elm)) then - LB(1:4) = lbound(SrcMiscData%elm) - UB(1:4) = ubound(SrcMiscData%elm) + LB(1:4) = lbound(SrcMiscData%elm, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%elm, kind=B8Ki) if (.not. allocated(DstMiscData%elm)) then allocate(DstMiscData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4399,8 +4399,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elm = SrcMiscData%elm end if if (allocated(SrcMiscData%DistrLoad_QP)) then - LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) - UB(1:3) = ubound(SrcMiscData%DistrLoad_QP) + LB(1:3) = lbound(SrcMiscData%DistrLoad_QP, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%DistrLoad_QP, kind=B8Ki) if (.not. allocated(DstMiscData%DistrLoad_QP)) then allocate(DstMiscData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4411,8 +4411,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP end if if (allocated(SrcMiscData%PointLoadLcl)) then - LB(1:2) = lbound(SrcMiscData%PointLoadLcl) - UB(1:2) = ubound(SrcMiscData%PointLoadLcl) + LB(1:2) = lbound(SrcMiscData%PointLoadLcl, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%PointLoadLcl, kind=B8Ki) if (.not. allocated(DstMiscData%PointLoadLcl)) then allocate(DstMiscData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4423,8 +4423,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl end if if (allocated(SrcMiscData%StifK)) then - LB(1:4) = lbound(SrcMiscData%StifK) - UB(1:4) = ubound(SrcMiscData%StifK) + LB(1:4) = lbound(SrcMiscData%StifK, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%StifK, kind=B8Ki) if (.not. allocated(DstMiscData%StifK)) then allocate(DstMiscData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4435,8 +4435,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StifK = SrcMiscData%StifK end if if (allocated(SrcMiscData%MassM)) then - LB(1:4) = lbound(SrcMiscData%MassM) - UB(1:4) = ubound(SrcMiscData%MassM) + LB(1:4) = lbound(SrcMiscData%MassM, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%MassM, kind=B8Ki) if (.not. allocated(DstMiscData%MassM)) then allocate(DstMiscData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4447,8 +4447,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%MassM = SrcMiscData%MassM end if if (allocated(SrcMiscData%DampG)) then - LB(1:4) = lbound(SrcMiscData%DampG) - UB(1:4) = ubound(SrcMiscData%DampG) + LB(1:4) = lbound(SrcMiscData%DampG, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%DampG, kind=B8Ki) if (.not. allocated(DstMiscData%DampG)) then allocate(DstMiscData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4459,8 +4459,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DampG = SrcMiscData%DampG end if if (allocated(SrcMiscData%StifK_fd)) then - LB(1:4) = lbound(SrcMiscData%StifK_fd) - UB(1:4) = ubound(SrcMiscData%StifK_fd) + LB(1:4) = lbound(SrcMiscData%StifK_fd, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%StifK_fd, kind=B8Ki) if (.not. allocated(DstMiscData%StifK_fd)) then allocate(DstMiscData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4471,8 +4471,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StifK_fd = SrcMiscData%StifK_fd end if if (allocated(SrcMiscData%MassM_fd)) then - LB(1:4) = lbound(SrcMiscData%MassM_fd) - UB(1:4) = ubound(SrcMiscData%MassM_fd) + LB(1:4) = lbound(SrcMiscData%MassM_fd, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%MassM_fd, kind=B8Ki) if (.not. allocated(DstMiscData%MassM_fd)) then allocate(DstMiscData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4483,8 +4483,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%MassM_fd = SrcMiscData%MassM_fd end if if (allocated(SrcMiscData%DampG_fd)) then - LB(1:4) = lbound(SrcMiscData%DampG_fd) - UB(1:4) = ubound(SrcMiscData%DampG_fd) + LB(1:4) = lbound(SrcMiscData%DampG_fd, kind=B8Ki) + UB(1:4) = ubound(SrcMiscData%DampG_fd, kind=B8Ki) if (.not. allocated(DstMiscData%DampG_fd)) then allocate(DstMiscData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4495,8 +4495,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DampG_fd = SrcMiscData%DampG_fd end if if (allocated(SrcMiscData%RHS)) then - LB(1:2) = lbound(SrcMiscData%RHS) - UB(1:2) = ubound(SrcMiscData%RHS) + LB(1:2) = lbound(SrcMiscData%RHS, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%RHS, kind=B8Ki) if (.not. allocated(DstMiscData%RHS)) then allocate(DstMiscData%RHS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4507,8 +4507,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS = SrcMiscData%RHS end if if (allocated(SrcMiscData%RHS_p)) then - LB(1:2) = lbound(SrcMiscData%RHS_p) - UB(1:2) = ubound(SrcMiscData%RHS_p) + LB(1:2) = lbound(SrcMiscData%RHS_p, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%RHS_p, kind=B8Ki) if (.not. allocated(DstMiscData%RHS_p)) then allocate(DstMiscData%RHS_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4519,8 +4519,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS_p = SrcMiscData%RHS_p end if if (allocated(SrcMiscData%RHS_m)) then - LB(1:2) = lbound(SrcMiscData%RHS_m) - UB(1:2) = ubound(SrcMiscData%RHS_m) + LB(1:2) = lbound(SrcMiscData%RHS_m, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%RHS_m, kind=B8Ki) if (.not. allocated(DstMiscData%RHS_m)) then allocate(DstMiscData%RHS_m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4531,8 +4531,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS_m = SrcMiscData%RHS_m end if if (allocated(SrcMiscData%BldInternalForceFE)) then - LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) - UB(1:2) = ubound(SrcMiscData%BldInternalForceFE) + LB(1:2) = lbound(SrcMiscData%BldInternalForceFE, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%BldInternalForceFE, kind=B8Ki) if (.not. allocated(DstMiscData%BldInternalForceFE)) then allocate(DstMiscData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4543,8 +4543,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE end if if (allocated(SrcMiscData%BldInternalForceQP)) then - LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) - UB(1:2) = ubound(SrcMiscData%BldInternalForceQP) + LB(1:2) = lbound(SrcMiscData%BldInternalForceQP, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%BldInternalForceQP, kind=B8Ki) if (.not. allocated(DstMiscData%BldInternalForceQP)) then allocate(DstMiscData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4555,8 +4555,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP end if if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then - LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) - UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment) + LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment, kind=B8Ki) if (.not. allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then allocate(DstMiscData%FirstNodeReactionLclForceMoment(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4567,8 +4567,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment end if if (allocated(SrcMiscData%Solution)) then - LB(1:2) = lbound(SrcMiscData%Solution) - UB(1:2) = ubound(SrcMiscData%Solution) + LB(1:2) = lbound(SrcMiscData%Solution, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%Solution, kind=B8Ki) if (.not. allocated(DstMiscData%Solution)) then allocate(DstMiscData%Solution(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4579,8 +4579,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Solution = SrcMiscData%Solution end if if (allocated(SrcMiscData%LP_StifK)) then - LB(1:2) = lbound(SrcMiscData%LP_StifK) - UB(1:2) = ubound(SrcMiscData%LP_StifK) + LB(1:2) = lbound(SrcMiscData%LP_StifK, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%LP_StifK, kind=B8Ki) if (.not. allocated(DstMiscData%LP_StifK)) then allocate(DstMiscData%LP_StifK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4591,8 +4591,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_StifK = SrcMiscData%LP_StifK end if if (allocated(SrcMiscData%LP_MassM)) then - LB(1:2) = lbound(SrcMiscData%LP_MassM) - UB(1:2) = ubound(SrcMiscData%LP_MassM) + LB(1:2) = lbound(SrcMiscData%LP_MassM, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%LP_MassM, kind=B8Ki) if (.not. allocated(DstMiscData%LP_MassM)) then allocate(DstMiscData%LP_MassM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4603,8 +4603,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_MassM = SrcMiscData%LP_MassM end if if (allocated(SrcMiscData%LP_MassM_LU)) then - LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) - UB(1:2) = ubound(SrcMiscData%LP_MassM_LU) + LB(1:2) = lbound(SrcMiscData%LP_MassM_LU, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%LP_MassM_LU, kind=B8Ki) if (.not. allocated(DstMiscData%LP_MassM_LU)) then allocate(DstMiscData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4615,8 +4615,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU end if if (allocated(SrcMiscData%LP_RHS)) then - LB(1:1) = lbound(SrcMiscData%LP_RHS) - UB(1:1) = ubound(SrcMiscData%LP_RHS) + LB(1:1) = lbound(SrcMiscData%LP_RHS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LP_RHS, kind=B8Ki) if (.not. allocated(DstMiscData%LP_RHS)) then allocate(DstMiscData%LP_RHS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4627,8 +4627,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_RHS = SrcMiscData%LP_RHS end if if (allocated(SrcMiscData%LP_StifK_LU)) then - LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) - UB(1:2) = ubound(SrcMiscData%LP_StifK_LU) + LB(1:2) = lbound(SrcMiscData%LP_StifK_LU, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%LP_StifK_LU, kind=B8Ki) if (.not. allocated(DstMiscData%LP_StifK_LU)) then allocate(DstMiscData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4639,8 +4639,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU end if if (allocated(SrcMiscData%LP_RHS_LU)) then - LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) - UB(1:1) = ubound(SrcMiscData%LP_RHS_LU) + LB(1:1) = lbound(SrcMiscData%LP_RHS_LU, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LP_RHS_LU, kind=B8Ki) if (.not. allocated(DstMiscData%LP_RHS_LU)) then allocate(DstMiscData%LP_RHS_LU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4651,8 +4651,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU end if if (allocated(SrcMiscData%LP_indx)) then - LB(1:1) = lbound(SrcMiscData%LP_indx) - UB(1:1) = ubound(SrcMiscData%LP_indx) + LB(1:1) = lbound(SrcMiscData%LP_indx, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LP_indx, kind=B8Ki) if (.not. allocated(DstMiscData%LP_indx)) then allocate(DstMiscData%LP_indx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4798,152 +4798,152 @@ subroutine BD_PackMisc(Buf, Indata) call BD_PackEqMotionQP(Buf, InData%qp) call RegPack(Buf, allocated(InData%lin_A)) if (allocated(InData%lin_A)) then - call RegPackBounds(Buf, 2, lbound(InData%lin_A), ubound(InData%lin_A)) + call RegPackBounds(Buf, 2, lbound(InData%lin_A, kind=B8Ki), ubound(InData%lin_A, kind=B8Ki)) call RegPack(Buf, InData%lin_A) end if call RegPack(Buf, allocated(InData%lin_C)) if (allocated(InData%lin_C)) then - call RegPackBounds(Buf, 2, lbound(InData%lin_C), ubound(InData%lin_C)) + call RegPackBounds(Buf, 2, lbound(InData%lin_C, kind=B8Ki), ubound(InData%lin_C, kind=B8Ki)) call RegPack(Buf, InData%lin_C) end if call RegPack(Buf, allocated(InData%Nrrr)) if (allocated(InData%Nrrr)) then - call RegPackBounds(Buf, 3, lbound(InData%Nrrr), ubound(InData%Nrrr)) + call RegPackBounds(Buf, 3, lbound(InData%Nrrr, kind=B8Ki), ubound(InData%Nrrr, kind=B8Ki)) call RegPack(Buf, InData%Nrrr) end if call RegPack(Buf, allocated(InData%elf)) if (allocated(InData%elf)) then - call RegPackBounds(Buf, 2, lbound(InData%elf), ubound(InData%elf)) + call RegPackBounds(Buf, 2, lbound(InData%elf, kind=B8Ki), ubound(InData%elf, kind=B8Ki)) call RegPack(Buf, InData%elf) end if call RegPack(Buf, allocated(InData%EFint)) if (allocated(InData%EFint)) then - call RegPackBounds(Buf, 3, lbound(InData%EFint), ubound(InData%EFint)) + call RegPackBounds(Buf, 3, lbound(InData%EFint, kind=B8Ki), ubound(InData%EFint, kind=B8Ki)) call RegPack(Buf, InData%EFint) end if call RegPack(Buf, allocated(InData%elk)) if (allocated(InData%elk)) then - call RegPackBounds(Buf, 4, lbound(InData%elk), ubound(InData%elk)) + call RegPackBounds(Buf, 4, lbound(InData%elk, kind=B8Ki), ubound(InData%elk, kind=B8Ki)) call RegPack(Buf, InData%elk) end if call RegPack(Buf, allocated(InData%elg)) if (allocated(InData%elg)) then - call RegPackBounds(Buf, 4, lbound(InData%elg), ubound(InData%elg)) + call RegPackBounds(Buf, 4, lbound(InData%elg, kind=B8Ki), ubound(InData%elg, kind=B8Ki)) call RegPack(Buf, InData%elg) end if call RegPack(Buf, allocated(InData%elm)) if (allocated(InData%elm)) then - call RegPackBounds(Buf, 4, lbound(InData%elm), ubound(InData%elm)) + call RegPackBounds(Buf, 4, lbound(InData%elm, kind=B8Ki), ubound(InData%elm, kind=B8Ki)) call RegPack(Buf, InData%elm) end if call RegPack(Buf, allocated(InData%DistrLoad_QP)) if (allocated(InData%DistrLoad_QP)) then - call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP), ubound(InData%DistrLoad_QP)) + call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP, kind=B8Ki), ubound(InData%DistrLoad_QP, kind=B8Ki)) call RegPack(Buf, InData%DistrLoad_QP) end if call RegPack(Buf, allocated(InData%PointLoadLcl)) if (allocated(InData%PointLoadLcl)) then - call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl), ubound(InData%PointLoadLcl)) + call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl, kind=B8Ki), ubound(InData%PointLoadLcl, kind=B8Ki)) call RegPack(Buf, InData%PointLoadLcl) end if call RegPack(Buf, allocated(InData%StifK)) if (allocated(InData%StifK)) then - call RegPackBounds(Buf, 4, lbound(InData%StifK), ubound(InData%StifK)) + call RegPackBounds(Buf, 4, lbound(InData%StifK, kind=B8Ki), ubound(InData%StifK, kind=B8Ki)) call RegPack(Buf, InData%StifK) end if call RegPack(Buf, allocated(InData%MassM)) if (allocated(InData%MassM)) then - call RegPackBounds(Buf, 4, lbound(InData%MassM), ubound(InData%MassM)) + call RegPackBounds(Buf, 4, lbound(InData%MassM, kind=B8Ki), ubound(InData%MassM, kind=B8Ki)) call RegPack(Buf, InData%MassM) end if call RegPack(Buf, allocated(InData%DampG)) if (allocated(InData%DampG)) then - call RegPackBounds(Buf, 4, lbound(InData%DampG), ubound(InData%DampG)) + call RegPackBounds(Buf, 4, lbound(InData%DampG, kind=B8Ki), ubound(InData%DampG, kind=B8Ki)) call RegPack(Buf, InData%DampG) end if call RegPack(Buf, allocated(InData%StifK_fd)) if (allocated(InData%StifK_fd)) then - call RegPackBounds(Buf, 4, lbound(InData%StifK_fd), ubound(InData%StifK_fd)) + call RegPackBounds(Buf, 4, lbound(InData%StifK_fd, kind=B8Ki), ubound(InData%StifK_fd, kind=B8Ki)) call RegPack(Buf, InData%StifK_fd) end if call RegPack(Buf, allocated(InData%MassM_fd)) if (allocated(InData%MassM_fd)) then - call RegPackBounds(Buf, 4, lbound(InData%MassM_fd), ubound(InData%MassM_fd)) + call RegPackBounds(Buf, 4, lbound(InData%MassM_fd, kind=B8Ki), ubound(InData%MassM_fd, kind=B8Ki)) call RegPack(Buf, InData%MassM_fd) end if call RegPack(Buf, allocated(InData%DampG_fd)) if (allocated(InData%DampG_fd)) then - call RegPackBounds(Buf, 4, lbound(InData%DampG_fd), ubound(InData%DampG_fd)) + call RegPackBounds(Buf, 4, lbound(InData%DampG_fd, kind=B8Ki), ubound(InData%DampG_fd, kind=B8Ki)) call RegPack(Buf, InData%DampG_fd) end if call RegPack(Buf, allocated(InData%RHS)) if (allocated(InData%RHS)) then - call RegPackBounds(Buf, 2, lbound(InData%RHS), ubound(InData%RHS)) + call RegPackBounds(Buf, 2, lbound(InData%RHS, kind=B8Ki), ubound(InData%RHS, kind=B8Ki)) call RegPack(Buf, InData%RHS) end if call RegPack(Buf, allocated(InData%RHS_p)) if (allocated(InData%RHS_p)) then - call RegPackBounds(Buf, 2, lbound(InData%RHS_p), ubound(InData%RHS_p)) + call RegPackBounds(Buf, 2, lbound(InData%RHS_p, kind=B8Ki), ubound(InData%RHS_p, kind=B8Ki)) call RegPack(Buf, InData%RHS_p) end if call RegPack(Buf, allocated(InData%RHS_m)) if (allocated(InData%RHS_m)) then - call RegPackBounds(Buf, 2, lbound(InData%RHS_m), ubound(InData%RHS_m)) + call RegPackBounds(Buf, 2, lbound(InData%RHS_m, kind=B8Ki), ubound(InData%RHS_m, kind=B8Ki)) call RegPack(Buf, InData%RHS_m) end if call RegPack(Buf, allocated(InData%BldInternalForceFE)) if (allocated(InData%BldInternalForceFE)) then - call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE), ubound(InData%BldInternalForceFE)) + call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE, kind=B8Ki), ubound(InData%BldInternalForceFE, kind=B8Ki)) call RegPack(Buf, InData%BldInternalForceFE) end if call RegPack(Buf, allocated(InData%BldInternalForceQP)) if (allocated(InData%BldInternalForceQP)) then - call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP), ubound(InData%BldInternalForceQP)) + call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP, kind=B8Ki), ubound(InData%BldInternalForceQP, kind=B8Ki)) call RegPack(Buf, InData%BldInternalForceQP) end if call RegPack(Buf, allocated(InData%FirstNodeReactionLclForceMoment)) if (allocated(InData%FirstNodeReactionLclForceMoment)) then - call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment), ubound(InData%FirstNodeReactionLclForceMoment)) + call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment, kind=B8Ki), ubound(InData%FirstNodeReactionLclForceMoment, kind=B8Ki)) call RegPack(Buf, InData%FirstNodeReactionLclForceMoment) end if call RegPack(Buf, allocated(InData%Solution)) if (allocated(InData%Solution)) then - call RegPackBounds(Buf, 2, lbound(InData%Solution), ubound(InData%Solution)) + call RegPackBounds(Buf, 2, lbound(InData%Solution, kind=B8Ki), ubound(InData%Solution, kind=B8Ki)) call RegPack(Buf, InData%Solution) end if call RegPack(Buf, allocated(InData%LP_StifK)) if (allocated(InData%LP_StifK)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_StifK), ubound(InData%LP_StifK)) + call RegPackBounds(Buf, 2, lbound(InData%LP_StifK, kind=B8Ki), ubound(InData%LP_StifK, kind=B8Ki)) call RegPack(Buf, InData%LP_StifK) end if call RegPack(Buf, allocated(InData%LP_MassM)) if (allocated(InData%LP_MassM)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_MassM), ubound(InData%LP_MassM)) + call RegPackBounds(Buf, 2, lbound(InData%LP_MassM, kind=B8Ki), ubound(InData%LP_MassM, kind=B8Ki)) call RegPack(Buf, InData%LP_MassM) end if call RegPack(Buf, allocated(InData%LP_MassM_LU)) if (allocated(InData%LP_MassM_LU)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU), ubound(InData%LP_MassM_LU)) + call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU, kind=B8Ki), ubound(InData%LP_MassM_LU, kind=B8Ki)) call RegPack(Buf, InData%LP_MassM_LU) end if call RegPack(Buf, allocated(InData%LP_RHS)) if (allocated(InData%LP_RHS)) then - call RegPackBounds(Buf, 1, lbound(InData%LP_RHS), ubound(InData%LP_RHS)) + call RegPackBounds(Buf, 1, lbound(InData%LP_RHS, kind=B8Ki), ubound(InData%LP_RHS, kind=B8Ki)) call RegPack(Buf, InData%LP_RHS) end if call RegPack(Buf, allocated(InData%LP_StifK_LU)) if (allocated(InData%LP_StifK_LU)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU), ubound(InData%LP_StifK_LU)) + call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU, kind=B8Ki), ubound(InData%LP_StifK_LU, kind=B8Ki)) call RegPack(Buf, InData%LP_StifK_LU) end if call RegPack(Buf, allocated(InData%LP_RHS_LU)) if (allocated(InData%LP_RHS_LU)) then - call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU), ubound(InData%LP_RHS_LU)) + call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU, kind=B8Ki), ubound(InData%LP_RHS_LU, kind=B8Ki)) call RegPack(Buf, InData%LP_RHS_LU) end if call RegPack(Buf, allocated(InData%LP_indx)) if (allocated(InData%LP_indx)) then - call RegPackBounds(Buf, 1, lbound(InData%LP_indx), ubound(InData%LP_indx)) + call RegPackBounds(Buf, 1, lbound(InData%LP_indx, kind=B8Ki), ubound(InData%LP_indx, kind=B8Ki)) call RegPack(Buf, InData%LP_indx) end if call BD_PackInput(Buf, InData%u) @@ -4955,7 +4955,7 @@ subroutine BD_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackMisc' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 4e52b6773b..563fd371c6 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -905,15 +905,15 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -924,8 +924,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -940,8 +940,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err if (ErrStat >= AbortErrLev) return DstInitOutputData%NumBl = SrcInitOutputData%NumBl if (allocated(SrcInitOutputData%BlPitch)) then - LB(1:1) = lbound(SrcInitOutputData%BlPitch) - UB(1:1) = ubound(SrcInitOutputData%BlPitch) + LB(1:1) = lbound(SrcInitOutputData%BlPitch, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%BlPitch, kind=B8Ki) if (.not. allocated(DstInitOutputData%BlPitch)) then allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -956,8 +956,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight DstInitOutputData%HubHt = SrcInitOutputData%HubHt if (allocated(SrcInitOutputData%BldRNodes)) then - LB(1:1) = lbound(SrcInitOutputData%BldRNodes) - UB(1:1) = ubound(SrcInitOutputData%BldRNodes) + LB(1:1) = lbound(SrcInitOutputData%BldRNodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%BldRNodes, kind=B8Ki) if (.not. allocated(DstInitOutputData%BldRNodes)) then allocate(DstInitOutputData%BldRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -968,8 +968,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes end if if (allocated(SrcInitOutputData%TwrHNodes)) then - LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) - UB(1:1) = ubound(SrcInitOutputData%TwrHNodes) + LB(1:1) = lbound(SrcInitOutputData%TwrHNodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%TwrHNodes, kind=B8Ki) if (.not. allocated(DstInitOutputData%TwrHNodes)) then allocate(DstInitOutputData%TwrHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -988,8 +988,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1000,8 +1000,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1012,8 +1012,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1024,8 +1024,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1036,8 +1036,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1048,8 +1048,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1060,8 +1060,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1072,8 +1072,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1145,19 +1145,19 @@ subroutine ED_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%NumBl) call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) call RegPack(Buf, InData%BlPitch) end if call RegPack(Buf, InData%BladeLength) @@ -1166,12 +1166,12 @@ subroutine ED_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%HubHt) call RegPack(Buf, allocated(InData%BldRNodes)) if (allocated(InData%BldRNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%BldRNodes), ubound(InData%BldRNodes)) + call RegPackBounds(Buf, 1, lbound(InData%BldRNodes, kind=B8Ki), ubound(InData%BldRNodes, kind=B8Ki)) call RegPack(Buf, InData%BldRNodes) end if call RegPack(Buf, allocated(InData%TwrHNodes)) if (allocated(InData%TwrHNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes), ubound(InData%TwrHNodes)) + call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes, kind=B8Ki), ubound(InData%TwrHNodes, kind=B8Ki)) call RegPack(Buf, InData%TwrHNodes) end if call RegPack(Buf, InData%PlatformPos) @@ -1184,42 +1184,42 @@ subroutine ED_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%isFixed_GenDOF) call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, InData%GearBox_index) @@ -1230,7 +1230,7 @@ subroutine ED_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1453,15 +1453,15 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyBladeInputData' ErrStat = ErrID_None ErrMsg = '' DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt if (allocated(SrcBladeInputDataData%BlFract)) then - LB(1:1) = lbound(SrcBladeInputDataData%BlFract) - UB(1:1) = ubound(SrcBladeInputDataData%BlFract) + LB(1:1) = lbound(SrcBladeInputDataData%BlFract, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%BlFract, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%BlFract)) then allocate(DstBladeInputDataData%BlFract(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1472,8 +1472,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract end if if (allocated(SrcBladeInputDataData%PitchAx)) then - LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) - UB(1:1) = ubound(SrcBladeInputDataData%PitchAx) + LB(1:1) = lbound(SrcBladeInputDataData%PitchAx, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%PitchAx, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%PitchAx)) then allocate(DstBladeInputDataData%PitchAx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1484,8 +1484,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx end if if (allocated(SrcBladeInputDataData%StrcTwst)) then - LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) - UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst) + LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%StrcTwst)) then allocate(DstBladeInputDataData%StrcTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1496,8 +1496,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst end if if (allocated(SrcBladeInputDataData%BMassDen)) then - LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) - UB(1:1) = ubound(SrcBladeInputDataData%BMassDen) + LB(1:1) = lbound(SrcBladeInputDataData%BMassDen, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%BMassDen, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%BMassDen)) then allocate(DstBladeInputDataData%BMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1508,8 +1508,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen end if if (allocated(SrcBladeInputDataData%FlpStff)) then - LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) - UB(1:1) = ubound(SrcBladeInputDataData%FlpStff) + LB(1:1) = lbound(SrcBladeInputDataData%FlpStff, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%FlpStff, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%FlpStff)) then allocate(DstBladeInputDataData%FlpStff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1520,8 +1520,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff end if if (allocated(SrcBladeInputDataData%EdgStff)) then - LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) - UB(1:1) = ubound(SrcBladeInputDataData%EdgStff) + LB(1:1) = lbound(SrcBladeInputDataData%EdgStff, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%EdgStff, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%EdgStff)) then allocate(DstBladeInputDataData%EdgStff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1535,8 +1535,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr if (allocated(SrcBladeInputDataData%BldFl1Sh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh) - UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh) + LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%BldFl1Sh)) then allocate(DstBladeInputDataData%BldFl1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1547,8 +1547,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh end if if (allocated(SrcBladeInputDataData%BldFl2Sh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) - UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh) + LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%BldFl2Sh)) then allocate(DstBladeInputDataData%BldFl2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1559,8 +1559,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh end if if (allocated(SrcBladeInputDataData%BldEdgSh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) - UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh) + LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh, kind=B8Ki) + UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh, kind=B8Ki) if (.not. allocated(DstBladeInputDataData%BldEdgSh)) then allocate(DstBladeInputDataData%BldEdgSh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1616,32 +1616,32 @@ subroutine ED_PackBladeInputData(Buf, Indata) call RegPack(Buf, InData%NBlInpSt) call RegPack(Buf, allocated(InData%BlFract)) if (allocated(InData%BlFract)) then - call RegPackBounds(Buf, 1, lbound(InData%BlFract), ubound(InData%BlFract)) + call RegPackBounds(Buf, 1, lbound(InData%BlFract, kind=B8Ki), ubound(InData%BlFract, kind=B8Ki)) call RegPack(Buf, InData%BlFract) end if call RegPack(Buf, allocated(InData%PitchAx)) if (allocated(InData%PitchAx)) then - call RegPackBounds(Buf, 1, lbound(InData%PitchAx), ubound(InData%PitchAx)) + call RegPackBounds(Buf, 1, lbound(InData%PitchAx, kind=B8Ki), ubound(InData%PitchAx, kind=B8Ki)) call RegPack(Buf, InData%PitchAx) end if call RegPack(Buf, allocated(InData%StrcTwst)) if (allocated(InData%StrcTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%StrcTwst), ubound(InData%StrcTwst)) + call RegPackBounds(Buf, 1, lbound(InData%StrcTwst, kind=B8Ki), ubound(InData%StrcTwst, kind=B8Ki)) call RegPack(Buf, InData%StrcTwst) end if call RegPack(Buf, allocated(InData%BMassDen)) if (allocated(InData%BMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%BMassDen), ubound(InData%BMassDen)) + call RegPackBounds(Buf, 1, lbound(InData%BMassDen, kind=B8Ki), ubound(InData%BMassDen, kind=B8Ki)) call RegPack(Buf, InData%BMassDen) end if call RegPack(Buf, allocated(InData%FlpStff)) if (allocated(InData%FlpStff)) then - call RegPackBounds(Buf, 1, lbound(InData%FlpStff), ubound(InData%FlpStff)) + call RegPackBounds(Buf, 1, lbound(InData%FlpStff, kind=B8Ki), ubound(InData%FlpStff, kind=B8Ki)) call RegPack(Buf, InData%FlpStff) end if call RegPack(Buf, allocated(InData%EdgStff)) if (allocated(InData%EdgStff)) then - call RegPackBounds(Buf, 1, lbound(InData%EdgStff), ubound(InData%EdgStff)) + call RegPackBounds(Buf, 1, lbound(InData%EdgStff, kind=B8Ki), ubound(InData%EdgStff, kind=B8Ki)) call RegPack(Buf, InData%EdgStff) end if call RegPack(Buf, InData%BldFlDmp) @@ -1649,17 +1649,17 @@ subroutine ED_PackBladeInputData(Buf, Indata) call RegPack(Buf, InData%FlStTunr) call RegPack(Buf, allocated(InData%BldFl1Sh)) if (allocated(InData%BldFl1Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) + call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh, kind=B8Ki), ubound(InData%BldFl1Sh, kind=B8Ki)) call RegPack(Buf, InData%BldFl1Sh) end if call RegPack(Buf, allocated(InData%BldFl2Sh)) if (allocated(InData%BldFl2Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) + call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh, kind=B8Ki), ubound(InData%BldFl2Sh, kind=B8Ki)) call RegPack(Buf, InData%BldFl2Sh) end if call RegPack(Buf, allocated(InData%BldEdgSh)) if (allocated(InData%BldEdgSh)) then - call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) + call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh, kind=B8Ki), ubound(InData%BldEdgSh, kind=B8Ki)) call RegPack(Buf, InData%BldEdgSh) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1669,7 +1669,7 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1815,15 +1815,15 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyBladeMeshInputData' ErrStat = ErrID_None ErrMsg = '' DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes if (allocated(SrcBladeMeshInputDataData%RNodes)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes) - UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes) + LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes, kind=B8Ki) + UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes, kind=B8Ki) if (.not. allocated(DstBladeMeshInputDataData%RNodes)) then allocate(DstBladeMeshInputDataData%RNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1834,8 +1834,8 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes end if if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) - UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst) + LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst, kind=B8Ki) + UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst, kind=B8Ki) if (.not. allocated(DstBladeMeshInputDataData%AeroTwst)) then allocate(DstBladeMeshInputDataData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1846,8 +1846,8 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst end if if (allocated(SrcBladeMeshInputDataData%Chord)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) - UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord) + LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord, kind=B8Ki) + UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord, kind=B8Ki) if (.not. allocated(DstBladeMeshInputDataData%Chord)) then allocate(DstBladeMeshInputDataData%Chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1885,17 +1885,17 @@ subroutine ED_PackBladeMeshInputData(Buf, Indata) call RegPack(Buf, InData%BldNodes) call RegPack(Buf, allocated(InData%RNodes)) if (allocated(InData%RNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) + call RegPackBounds(Buf, 1, lbound(InData%RNodes, kind=B8Ki), ubound(InData%RNodes, kind=B8Ki)) call RegPack(Buf, InData%RNodes) end if call RegPack(Buf, allocated(InData%AeroTwst)) if (allocated(InData%AeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) + call RegPackBounds(Buf, 1, lbound(InData%AeroTwst, kind=B8Ki), ubound(InData%AeroTwst, kind=B8Ki)) call RegPack(Buf, InData%AeroTwst) end if call RegPack(Buf, allocated(InData%Chord)) if (allocated(InData%Chord)) then - call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) + call RegPackBounds(Buf, 1, lbound(InData%Chord, kind=B8Ki), ubound(InData%Chord, kind=B8Ki)) call RegPack(Buf, InData%Chord) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1905,7 +1905,7 @@ subroutine ED_UnPackBladeMeshInputData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_BladeMeshInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1961,8 +1961,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInputFile' @@ -1989,8 +1989,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl DstInputFileData%IPDefl = SrcInputFileData%IPDefl if (allocated(SrcInputFileData%BlPitch)) then - LB(1:1) = lbound(SrcInputFileData%BlPitch) - UB(1:1) = ubound(SrcInputFileData%BlPitch) + LB(1:1) = lbound(SrcInputFileData%BlPitch, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BlPitch, kind=B8Ki) if (.not. allocated(DstInputFileData%BlPitch)) then allocate(DstInputFileData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2016,8 +2016,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TipRad = SrcInputFileData%TipRad DstInputFileData%HubRad = SrcInputFileData%HubRad if (allocated(SrcInputFileData%PreCone)) then - LB(1:1) = lbound(SrcInputFileData%PreCone) - UB(1:1) = ubound(SrcInputFileData%PreCone) + LB(1:1) = lbound(SrcInputFileData%PreCone, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PreCone, kind=B8Ki) if (.not. allocated(DstInputFileData%PreCone)) then allocate(DstInputFileData%PreCone(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2048,8 +2048,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt if (allocated(SrcInputFileData%TipMass)) then - LB(1:1) = lbound(SrcInputFileData%TipMass) - UB(1:1) = ubound(SrcInputFileData%TipMass) + LB(1:1) = lbound(SrcInputFileData%TipMass, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TipMass, kind=B8Ki) if (.not. allocated(DstInputFileData%TipMass)) then allocate(DstInputFileData%TipMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2071,8 +2071,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner DstInputFileData%BldNodes = SrcInputFileData%BldNodes if (allocated(SrcInputFileData%InpBlMesh)) then - LB(1:1) = lbound(SrcInputFileData%InpBlMesh) - UB(1:1) = ubound(SrcInputFileData%InpBlMesh) + LB(1:1) = lbound(SrcInputFileData%InpBlMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%InpBlMesh, kind=B8Ki) if (.not. allocated(DstInputFileData%InpBlMesh)) then allocate(DstInputFileData%InpBlMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2087,8 +2087,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end do end if if (allocated(SrcInputFileData%InpBl)) then - LB(1:1) = lbound(SrcInputFileData%InpBl) - UB(1:1) = ubound(SrcInputFileData%InpBl) + LB(1:1) = lbound(SrcInputFileData%InpBl, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%InpBl, kind=B8Ki) if (.not. allocated(DstInputFileData%InpBl)) then allocate(DstInputFileData%InpBl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2128,8 +2128,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2145,8 +2145,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr if (allocated(SrcInputFileData%HtFract)) then - LB(1:1) = lbound(SrcInputFileData%HtFract) - UB(1:1) = ubound(SrcInputFileData%HtFract) + LB(1:1) = lbound(SrcInputFileData%HtFract, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%HtFract, kind=B8Ki) if (.not. allocated(DstInputFileData%HtFract)) then allocate(DstInputFileData%HtFract(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2157,8 +2157,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%HtFract = SrcInputFileData%HtFract end if if (allocated(SrcInputFileData%TMassDen)) then - LB(1:1) = lbound(SrcInputFileData%TMassDen) - UB(1:1) = ubound(SrcInputFileData%TMassDen) + LB(1:1) = lbound(SrcInputFileData%TMassDen, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TMassDen, kind=B8Ki) if (.not. allocated(DstInputFileData%TMassDen)) then allocate(DstInputFileData%TMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2169,8 +2169,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TMassDen = SrcInputFileData%TMassDen end if if (allocated(SrcInputFileData%TwFAStif)) then - LB(1:1) = lbound(SrcInputFileData%TwFAStif) - UB(1:1) = ubound(SrcInputFileData%TwFAStif) + LB(1:1) = lbound(SrcInputFileData%TwFAStif, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TwFAStif, kind=B8Ki) if (.not. allocated(DstInputFileData%TwFAStif)) then allocate(DstInputFileData%TwFAStif(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2181,8 +2181,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif end if if (allocated(SrcInputFileData%TwSSStif)) then - LB(1:1) = lbound(SrcInputFileData%TwSSStif) - UB(1:1) = ubound(SrcInputFileData%TwSSStif) + LB(1:1) = lbound(SrcInputFileData%TwSSStif, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TwSSStif, kind=B8Ki) if (.not. allocated(DstInputFileData%TwSSStif)) then allocate(DstInputFileData%TwSSStif(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2193,8 +2193,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif end if if (allocated(SrcInputFileData%TwFAM1Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) - UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh) + LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh, kind=B8Ki) if (.not. allocated(DstInputFileData%TwFAM1Sh)) then allocate(DstInputFileData%TwFAM1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2205,8 +2205,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh end if if (allocated(SrcInputFileData%TwFAM2Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) - UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh) + LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh, kind=B8Ki) if (.not. allocated(DstInputFileData%TwFAM2Sh)) then allocate(DstInputFileData%TwFAM2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2217,8 +2217,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh end if if (allocated(SrcInputFileData%TwSSM1Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) - UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh) + LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh, kind=B8Ki) if (.not. allocated(DstInputFileData%TwSSM1Sh)) then allocate(DstInputFileData%TwSSM1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2229,8 +2229,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh end if if (allocated(SrcInputFileData%TwSSM2Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) - UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh) + LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh, kind=B8Ki) if (.not. allocated(DstInputFileData%TwSSM2Sh)) then allocate(DstInputFileData%TwSSM2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2285,8 +2285,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%method = SrcInputFileData%method DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2304,8 +2304,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(ED_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyInputFile' @@ -2321,8 +2321,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%TipMass) end if if (allocated(InputFileData%InpBlMesh)) then - LB(1:1) = lbound(InputFileData%InpBlMesh) - UB(1:1) = ubound(InputFileData%InpBlMesh) + LB(1:1) = lbound(InputFileData%InpBlMesh, kind=B8Ki) + UB(1:1) = ubound(InputFileData%InpBlMesh, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyBladeMeshInputData(InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2330,8 +2330,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%InpBlMesh) end if if (allocated(InputFileData%InpBl)) then - LB(1:1) = lbound(InputFileData%InpBl) - UB(1:1) = ubound(InputFileData%InpBl) + LB(1:1) = lbound(InputFileData%InpBl, kind=B8Ki) + UB(1:1) = ubound(InputFileData%InpBl, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyBladeInputData(InputFileData%InpBl(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2374,8 +2374,8 @@ subroutine ED_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInputFile' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%FlapDOF1) @@ -2399,7 +2399,7 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%IPDefl) call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) call RegPack(Buf, InData%BlPitch) end if call RegPack(Buf, InData%TeetDefl) @@ -2419,7 +2419,7 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%HubRad) call RegPack(Buf, allocated(InData%PreCone)) if (allocated(InData%PreCone)) then - call RegPackBounds(Buf, 1, lbound(InData%PreCone), ubound(InData%PreCone)) + call RegPackBounds(Buf, 1, lbound(InData%PreCone, kind=B8Ki), ubound(InData%PreCone, kind=B8Ki)) call RegPack(Buf, InData%PreCone) end if call RegPack(Buf, InData%HubCM) @@ -2444,7 +2444,7 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%PtfmRefzt) call RegPack(Buf, allocated(InData%TipMass)) if (allocated(InData%TipMass)) then - call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) + call RegPackBounds(Buf, 1, lbound(InData%TipMass, kind=B8Ki), ubound(InData%TipMass, kind=B8Ki)) call RegPack(Buf, InData%TipMass) end if call RegPack(Buf, InData%HubMass) @@ -2460,18 +2460,18 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%BldNodes) call RegPack(Buf, allocated(InData%InpBlMesh)) if (allocated(InData%InpBlMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) - LB(1:1) = lbound(InData%InpBlMesh) - UB(1:1) = ubound(InData%InpBlMesh) + call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh, kind=B8Ki), ubound(InData%InpBlMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%InpBlMesh, kind=B8Ki) + UB(1:1) = ubound(InData%InpBlMesh, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackBladeMeshInputData(Buf, InData%InpBlMesh(i1)) end do end if call RegPack(Buf, allocated(InData%InpBl)) if (allocated(InData%InpBl)) then - call RegPackBounds(Buf, 1, lbound(InData%InpBl), ubound(InData%InpBl)) - LB(1:1) = lbound(InData%InpBl) - UB(1:1) = ubound(InData%InpBl) + call RegPackBounds(Buf, 1, lbound(InData%InpBl, kind=B8Ki), ubound(InData%InpBl, kind=B8Ki)) + LB(1:1) = lbound(InData%InpBl, kind=B8Ki) + UB(1:1) = ubound(InData%InpBl, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackBladeInputData(Buf, InData%InpBl(i1)) end do @@ -2503,7 +2503,7 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%NTwInpSt) @@ -2513,42 +2513,42 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%SSStTunr) call RegPack(Buf, allocated(InData%HtFract)) if (allocated(InData%HtFract)) then - call RegPackBounds(Buf, 1, lbound(InData%HtFract), ubound(InData%HtFract)) + call RegPackBounds(Buf, 1, lbound(InData%HtFract, kind=B8Ki), ubound(InData%HtFract, kind=B8Ki)) call RegPack(Buf, InData%HtFract) end if call RegPack(Buf, allocated(InData%TMassDen)) if (allocated(InData%TMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%TMassDen), ubound(InData%TMassDen)) + call RegPackBounds(Buf, 1, lbound(InData%TMassDen, kind=B8Ki), ubound(InData%TMassDen, kind=B8Ki)) call RegPack(Buf, InData%TMassDen) end if call RegPack(Buf, allocated(InData%TwFAStif)) if (allocated(InData%TwFAStif)) then - call RegPackBounds(Buf, 1, lbound(InData%TwFAStif), ubound(InData%TwFAStif)) + call RegPackBounds(Buf, 1, lbound(InData%TwFAStif, kind=B8Ki), ubound(InData%TwFAStif, kind=B8Ki)) call RegPack(Buf, InData%TwFAStif) end if call RegPack(Buf, allocated(InData%TwSSStif)) if (allocated(InData%TwSSStif)) then - call RegPackBounds(Buf, 1, lbound(InData%TwSSStif), ubound(InData%TwSSStif)) + call RegPackBounds(Buf, 1, lbound(InData%TwSSStif, kind=B8Ki), ubound(InData%TwSSStif, kind=B8Ki)) call RegPack(Buf, InData%TwSSStif) end if call RegPack(Buf, allocated(InData%TwFAM1Sh)) if (allocated(InData%TwFAM1Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh), ubound(InData%TwFAM1Sh)) + call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh, kind=B8Ki), ubound(InData%TwFAM1Sh, kind=B8Ki)) call RegPack(Buf, InData%TwFAM1Sh) end if call RegPack(Buf, allocated(InData%TwFAM2Sh)) if (allocated(InData%TwFAM2Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh), ubound(InData%TwFAM2Sh)) + call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh, kind=B8Ki), ubound(InData%TwFAM2Sh, kind=B8Ki)) call RegPack(Buf, InData%TwFAM2Sh) end if call RegPack(Buf, allocated(InData%TwSSM1Sh)) if (allocated(InData%TwSSM1Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh), ubound(InData%TwSSM1Sh)) + call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh, kind=B8Ki), ubound(InData%TwSSM1Sh, kind=B8Ki)) call RegPack(Buf, InData%TwSSM1Sh) end if call RegPack(Buf, allocated(InData%TwSSM2Sh)) if (allocated(InData%TwSSM2Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh), ubound(InData%TwSSM2Sh)) + call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh, kind=B8Ki), ubound(InData%TwSSM2Sh, kind=B8Ki)) call RegPack(Buf, InData%TwSSM2Sh) end if call RegPack(Buf, InData%RFrlDOF) @@ -2597,7 +2597,7 @@ subroutine ED_PackInputFile(Buf, Indata) call RegPack(Buf, InData%BldNd_NumOuts) call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList, kind=B8Ki), ubound(InData%BldNd_OutList, kind=B8Ki)) call RegPack(Buf, InData%BldNd_OutList) end if call RegPack(Buf, InData%BldNd_BlOutNd_Str) @@ -2609,8 +2609,8 @@ subroutine ED_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInputFile' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3118,7 +3118,7 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyCoordSys' ErrStat = ErrID_None @@ -3145,8 +3145,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%g2 = SrcCoordSysData%g2 DstCoordSysData%g3 = SrcCoordSysData%g3 if (allocated(SrcCoordSysData%i1)) then - LB(1:2) = lbound(SrcCoordSysData%i1) - UB(1:2) = ubound(SrcCoordSysData%i1) + LB(1:2) = lbound(SrcCoordSysData%i1, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%i1, kind=B8Ki) if (.not. allocated(DstCoordSysData%i1)) then allocate(DstCoordSysData%i1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3157,8 +3157,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i1 = SrcCoordSysData%i1 end if if (allocated(SrcCoordSysData%i2)) then - LB(1:2) = lbound(SrcCoordSysData%i2) - UB(1:2) = ubound(SrcCoordSysData%i2) + LB(1:2) = lbound(SrcCoordSysData%i2, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%i2, kind=B8Ki) if (.not. allocated(DstCoordSysData%i2)) then allocate(DstCoordSysData%i2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3169,8 +3169,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i2 = SrcCoordSysData%i2 end if if (allocated(SrcCoordSysData%i3)) then - LB(1:2) = lbound(SrcCoordSysData%i3) - UB(1:2) = ubound(SrcCoordSysData%i3) + LB(1:2) = lbound(SrcCoordSysData%i3, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%i3, kind=B8Ki) if (.not. allocated(DstCoordSysData%i3)) then allocate(DstCoordSysData%i3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3181,8 +3181,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i3 = SrcCoordSysData%i3 end if if (allocated(SrcCoordSysData%j1)) then - LB(1:2) = lbound(SrcCoordSysData%j1) - UB(1:2) = ubound(SrcCoordSysData%j1) + LB(1:2) = lbound(SrcCoordSysData%j1, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%j1, kind=B8Ki) if (.not. allocated(DstCoordSysData%j1)) then allocate(DstCoordSysData%j1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3193,8 +3193,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j1 = SrcCoordSysData%j1 end if if (allocated(SrcCoordSysData%j2)) then - LB(1:2) = lbound(SrcCoordSysData%j2) - UB(1:2) = ubound(SrcCoordSysData%j2) + LB(1:2) = lbound(SrcCoordSysData%j2, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%j2, kind=B8Ki) if (.not. allocated(DstCoordSysData%j2)) then allocate(DstCoordSysData%j2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3205,8 +3205,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j2 = SrcCoordSysData%j2 end if if (allocated(SrcCoordSysData%j3)) then - LB(1:2) = lbound(SrcCoordSysData%j3) - UB(1:2) = ubound(SrcCoordSysData%j3) + LB(1:2) = lbound(SrcCoordSysData%j3, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%j3, kind=B8Ki) if (.not. allocated(DstCoordSysData%j3)) then allocate(DstCoordSysData%j3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3217,8 +3217,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j3 = SrcCoordSysData%j3 end if if (allocated(SrcCoordSysData%m1)) then - LB(1:3) = lbound(SrcCoordSysData%m1) - UB(1:3) = ubound(SrcCoordSysData%m1) + LB(1:3) = lbound(SrcCoordSysData%m1, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%m1, kind=B8Ki) if (.not. allocated(DstCoordSysData%m1)) then allocate(DstCoordSysData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3229,8 +3229,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m1 = SrcCoordSysData%m1 end if if (allocated(SrcCoordSysData%m2)) then - LB(1:3) = lbound(SrcCoordSysData%m2) - UB(1:3) = ubound(SrcCoordSysData%m2) + LB(1:3) = lbound(SrcCoordSysData%m2, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%m2, kind=B8Ki) if (.not. allocated(DstCoordSysData%m2)) then allocate(DstCoordSysData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3241,8 +3241,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m2 = SrcCoordSysData%m2 end if if (allocated(SrcCoordSysData%m3)) then - LB(1:3) = lbound(SrcCoordSysData%m3) - UB(1:3) = ubound(SrcCoordSysData%m3) + LB(1:3) = lbound(SrcCoordSysData%m3, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%m3, kind=B8Ki) if (.not. allocated(DstCoordSysData%m3)) then allocate(DstCoordSysData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3253,8 +3253,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m3 = SrcCoordSysData%m3 end if if (allocated(SrcCoordSysData%n1)) then - LB(1:3) = lbound(SrcCoordSysData%n1) - UB(1:3) = ubound(SrcCoordSysData%n1) + LB(1:3) = lbound(SrcCoordSysData%n1, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%n1, kind=B8Ki) if (.not. allocated(DstCoordSysData%n1)) then allocate(DstCoordSysData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3265,8 +3265,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%n1 = SrcCoordSysData%n1 end if if (allocated(SrcCoordSysData%n2)) then - LB(1:3) = lbound(SrcCoordSysData%n2) - UB(1:3) = ubound(SrcCoordSysData%n2) + LB(1:3) = lbound(SrcCoordSysData%n2, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%n2, kind=B8Ki) if (.not. allocated(DstCoordSysData%n2)) then allocate(DstCoordSysData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3277,8 +3277,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%n2 = SrcCoordSysData%n2 end if if (allocated(SrcCoordSysData%n3)) then - LB(1:3) = lbound(SrcCoordSysData%n3) - UB(1:3) = ubound(SrcCoordSysData%n3) + LB(1:3) = lbound(SrcCoordSysData%n3, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%n3, kind=B8Ki) if (.not. allocated(DstCoordSysData%n3)) then allocate(DstCoordSysData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3293,8 +3293,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%rf3 = SrcCoordSysData%rf3 DstCoordSysData%rfa = SrcCoordSysData%rfa if (allocated(SrcCoordSysData%t1)) then - LB(1:2) = lbound(SrcCoordSysData%t1) - UB(1:2) = ubound(SrcCoordSysData%t1) + LB(1:2) = lbound(SrcCoordSysData%t1, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%t1, kind=B8Ki) if (.not. allocated(DstCoordSysData%t1)) then allocate(DstCoordSysData%t1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3305,8 +3305,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t1 = SrcCoordSysData%t1 end if if (allocated(SrcCoordSysData%t2)) then - LB(1:2) = lbound(SrcCoordSysData%t2) - UB(1:2) = ubound(SrcCoordSysData%t2) + LB(1:2) = lbound(SrcCoordSysData%t2, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%t2, kind=B8Ki) if (.not. allocated(DstCoordSysData%t2)) then allocate(DstCoordSysData%t2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3317,8 +3317,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t2 = SrcCoordSysData%t2 end if if (allocated(SrcCoordSysData%t3)) then - LB(1:2) = lbound(SrcCoordSysData%t3) - UB(1:2) = ubound(SrcCoordSysData%t3) + LB(1:2) = lbound(SrcCoordSysData%t3, kind=B8Ki) + UB(1:2) = ubound(SrcCoordSysData%t3, kind=B8Ki) if (.not. allocated(DstCoordSysData%t3)) then allocate(DstCoordSysData%t3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3329,8 +3329,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t3 = SrcCoordSysData%t3 end if if (allocated(SrcCoordSysData%te1)) then - LB(1:3) = lbound(SrcCoordSysData%te1) - UB(1:3) = ubound(SrcCoordSysData%te1) + LB(1:3) = lbound(SrcCoordSysData%te1, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%te1, kind=B8Ki) if (.not. allocated(DstCoordSysData%te1)) then allocate(DstCoordSysData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3341,8 +3341,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%te1 = SrcCoordSysData%te1 end if if (allocated(SrcCoordSysData%te2)) then - LB(1:3) = lbound(SrcCoordSysData%te2) - UB(1:3) = ubound(SrcCoordSysData%te2) + LB(1:3) = lbound(SrcCoordSysData%te2, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%te2, kind=B8Ki) if (.not. allocated(DstCoordSysData%te2)) then allocate(DstCoordSysData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3353,8 +3353,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%te2 = SrcCoordSysData%te2 end if if (allocated(SrcCoordSysData%te3)) then - LB(1:3) = lbound(SrcCoordSysData%te3) - UB(1:3) = ubound(SrcCoordSysData%te3) + LB(1:3) = lbound(SrcCoordSysData%te3, kind=B8Ki) + UB(1:3) = ubound(SrcCoordSysData%te3, kind=B8Ki) if (.not. allocated(DstCoordSysData%te3)) then allocate(DstCoordSysData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3464,62 +3464,62 @@ subroutine ED_PackCoordSys(Buf, Indata) call RegPack(Buf, InData%g3) call RegPack(Buf, allocated(InData%i1)) if (allocated(InData%i1)) then - call RegPackBounds(Buf, 2, lbound(InData%i1), ubound(InData%i1)) + call RegPackBounds(Buf, 2, lbound(InData%i1, kind=B8Ki), ubound(InData%i1, kind=B8Ki)) call RegPack(Buf, InData%i1) end if call RegPack(Buf, allocated(InData%i2)) if (allocated(InData%i2)) then - call RegPackBounds(Buf, 2, lbound(InData%i2), ubound(InData%i2)) + call RegPackBounds(Buf, 2, lbound(InData%i2, kind=B8Ki), ubound(InData%i2, kind=B8Ki)) call RegPack(Buf, InData%i2) end if call RegPack(Buf, allocated(InData%i3)) if (allocated(InData%i3)) then - call RegPackBounds(Buf, 2, lbound(InData%i3), ubound(InData%i3)) + call RegPackBounds(Buf, 2, lbound(InData%i3, kind=B8Ki), ubound(InData%i3, kind=B8Ki)) call RegPack(Buf, InData%i3) end if call RegPack(Buf, allocated(InData%j1)) if (allocated(InData%j1)) then - call RegPackBounds(Buf, 2, lbound(InData%j1), ubound(InData%j1)) + call RegPackBounds(Buf, 2, lbound(InData%j1, kind=B8Ki), ubound(InData%j1, kind=B8Ki)) call RegPack(Buf, InData%j1) end if call RegPack(Buf, allocated(InData%j2)) if (allocated(InData%j2)) then - call RegPackBounds(Buf, 2, lbound(InData%j2), ubound(InData%j2)) + call RegPackBounds(Buf, 2, lbound(InData%j2, kind=B8Ki), ubound(InData%j2, kind=B8Ki)) call RegPack(Buf, InData%j2) end if call RegPack(Buf, allocated(InData%j3)) if (allocated(InData%j3)) then - call RegPackBounds(Buf, 2, lbound(InData%j3), ubound(InData%j3)) + call RegPackBounds(Buf, 2, lbound(InData%j3, kind=B8Ki), ubound(InData%j3, kind=B8Ki)) call RegPack(Buf, InData%j3) end if call RegPack(Buf, allocated(InData%m1)) if (allocated(InData%m1)) then - call RegPackBounds(Buf, 3, lbound(InData%m1), ubound(InData%m1)) + call RegPackBounds(Buf, 3, lbound(InData%m1, kind=B8Ki), ubound(InData%m1, kind=B8Ki)) call RegPack(Buf, InData%m1) end if call RegPack(Buf, allocated(InData%m2)) if (allocated(InData%m2)) then - call RegPackBounds(Buf, 3, lbound(InData%m2), ubound(InData%m2)) + call RegPackBounds(Buf, 3, lbound(InData%m2, kind=B8Ki), ubound(InData%m2, kind=B8Ki)) call RegPack(Buf, InData%m2) end if call RegPack(Buf, allocated(InData%m3)) if (allocated(InData%m3)) then - call RegPackBounds(Buf, 3, lbound(InData%m3), ubound(InData%m3)) + call RegPackBounds(Buf, 3, lbound(InData%m3, kind=B8Ki), ubound(InData%m3, kind=B8Ki)) call RegPack(Buf, InData%m3) end if call RegPack(Buf, allocated(InData%n1)) if (allocated(InData%n1)) then - call RegPackBounds(Buf, 3, lbound(InData%n1), ubound(InData%n1)) + call RegPackBounds(Buf, 3, lbound(InData%n1, kind=B8Ki), ubound(InData%n1, kind=B8Ki)) call RegPack(Buf, InData%n1) end if call RegPack(Buf, allocated(InData%n2)) if (allocated(InData%n2)) then - call RegPackBounds(Buf, 3, lbound(InData%n2), ubound(InData%n2)) + call RegPackBounds(Buf, 3, lbound(InData%n2, kind=B8Ki), ubound(InData%n2, kind=B8Ki)) call RegPack(Buf, InData%n2) end if call RegPack(Buf, allocated(InData%n3)) if (allocated(InData%n3)) then - call RegPackBounds(Buf, 3, lbound(InData%n3), ubound(InData%n3)) + call RegPackBounds(Buf, 3, lbound(InData%n3, kind=B8Ki), ubound(InData%n3, kind=B8Ki)) call RegPack(Buf, InData%n3) end if call RegPack(Buf, InData%rf1) @@ -3528,32 +3528,32 @@ subroutine ED_PackCoordSys(Buf, Indata) call RegPack(Buf, InData%rfa) call RegPack(Buf, allocated(InData%t1)) if (allocated(InData%t1)) then - call RegPackBounds(Buf, 2, lbound(InData%t1), ubound(InData%t1)) + call RegPackBounds(Buf, 2, lbound(InData%t1, kind=B8Ki), ubound(InData%t1, kind=B8Ki)) call RegPack(Buf, InData%t1) end if call RegPack(Buf, allocated(InData%t2)) if (allocated(InData%t2)) then - call RegPackBounds(Buf, 2, lbound(InData%t2), ubound(InData%t2)) + call RegPackBounds(Buf, 2, lbound(InData%t2, kind=B8Ki), ubound(InData%t2, kind=B8Ki)) call RegPack(Buf, InData%t2) end if call RegPack(Buf, allocated(InData%t3)) if (allocated(InData%t3)) then - call RegPackBounds(Buf, 2, lbound(InData%t3), ubound(InData%t3)) + call RegPackBounds(Buf, 2, lbound(InData%t3, kind=B8Ki), ubound(InData%t3, kind=B8Ki)) call RegPack(Buf, InData%t3) end if call RegPack(Buf, allocated(InData%te1)) if (allocated(InData%te1)) then - call RegPackBounds(Buf, 3, lbound(InData%te1), ubound(InData%te1)) + call RegPackBounds(Buf, 3, lbound(InData%te1, kind=B8Ki), ubound(InData%te1, kind=B8Ki)) call RegPack(Buf, InData%te1) end if call RegPack(Buf, allocated(InData%te2)) if (allocated(InData%te2)) then - call RegPackBounds(Buf, 3, lbound(InData%te2), ubound(InData%te2)) + call RegPackBounds(Buf, 3, lbound(InData%te2, kind=B8Ki), ubound(InData%te2, kind=B8Ki)) call RegPack(Buf, InData%te2) end if call RegPack(Buf, allocated(InData%te3)) if (allocated(InData%te3)) then - call RegPackBounds(Buf, 3, lbound(InData%te3), ubound(InData%te3)) + call RegPackBounds(Buf, 3, lbound(InData%te3, kind=B8Ki), ubound(InData%te3, kind=B8Ki)) call RegPack(Buf, InData%te3) end if call RegPack(Buf, InData%tf1) @@ -3570,7 +3570,7 @@ subroutine ED_UnPackCoordSys(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_CoordSys), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3898,7 +3898,7 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' ErrStat = ErrID_None @@ -3910,8 +3910,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE if (allocated(SrcActiveDOFsData%NPSBE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSBE) - UB(1:1) = ubound(SrcActiveDOFsData%NPSBE) + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%NPSBE)) then allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3922,8 +3922,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE end if if (allocated(SrcActiveDOFsData%NPSE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSE) - UB(1:1) = ubound(SrcActiveDOFsData%NPSE) + LB(1:1) = lbound(SrcActiveDOFsData%NPSE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%NPSE)) then allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3936,8 +3936,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE if (allocated(SrcActiveDOFsData%PCE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PCE) - UB(1:1) = ubound(SrcActiveDOFsData%PCE) + LB(1:1) = lbound(SrcActiveDOFsData%PCE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PCE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PCE)) then allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3948,8 +3948,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE end if if (allocated(SrcActiveDOFsData%PDE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PDE) - UB(1:1) = ubound(SrcActiveDOFsData%PDE) + LB(1:1) = lbound(SrcActiveDOFsData%PDE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PDE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PDE)) then allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3960,8 +3960,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE end if if (allocated(SrcActiveDOFsData%PIE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PIE) - UB(1:1) = ubound(SrcActiveDOFsData%PIE) + LB(1:1) = lbound(SrcActiveDOFsData%PIE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PIE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PIE)) then allocate(DstActiveDOFsData%PIE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3972,8 +3972,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE end if if (allocated(SrcActiveDOFsData%PTE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PTE) - UB(1:1) = ubound(SrcActiveDOFsData%PTE) + LB(1:1) = lbound(SrcActiveDOFsData%PTE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PTE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PTE)) then allocate(DstActiveDOFsData%PTE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3984,8 +3984,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE end if if (allocated(SrcActiveDOFsData%PTTE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PTTE) - UB(1:1) = ubound(SrcActiveDOFsData%PTTE) + LB(1:1) = lbound(SrcActiveDOFsData%PTTE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PTTE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PTTE)) then allocate(DstActiveDOFsData%PTTE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3996,8 +3996,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE end if if (allocated(SrcActiveDOFsData%PS)) then - LB(1:1) = lbound(SrcActiveDOFsData%PS) - UB(1:1) = ubound(SrcActiveDOFsData%PS) + LB(1:1) = lbound(SrcActiveDOFsData%PS, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PS, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PS)) then allocate(DstActiveDOFsData%PS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4008,8 +4008,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PS = SrcActiveDOFsData%PS end if if (allocated(SrcActiveDOFsData%PSBE)) then - LB(1:2) = lbound(SrcActiveDOFsData%PSBE) - UB(1:2) = ubound(SrcActiveDOFsData%PSBE) + LB(1:2) = lbound(SrcActiveDOFsData%PSBE, kind=B8Ki) + UB(1:2) = ubound(SrcActiveDOFsData%PSBE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PSBE)) then allocate(DstActiveDOFsData%PSBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4020,8 +4020,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE end if if (allocated(SrcActiveDOFsData%PSE)) then - LB(1:2) = lbound(SrcActiveDOFsData%PSE) - UB(1:2) = ubound(SrcActiveDOFsData%PSE) + LB(1:2) = lbound(SrcActiveDOFsData%PSE, kind=B8Ki) + UB(1:2) = ubound(SrcActiveDOFsData%PSE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PSE)) then allocate(DstActiveDOFsData%PSE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4032,8 +4032,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE end if if (allocated(SrcActiveDOFsData%PUE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PUE) - UB(1:1) = ubound(SrcActiveDOFsData%PUE) + LB(1:1) = lbound(SrcActiveDOFsData%PUE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PUE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PUE)) then allocate(DstActiveDOFsData%PUE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4044,8 +4044,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE end if if (allocated(SrcActiveDOFsData%PYE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PYE) - UB(1:1) = ubound(SrcActiveDOFsData%PYE) + LB(1:1) = lbound(SrcActiveDOFsData%PYE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PYE, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%PYE)) then allocate(DstActiveDOFsData%PYE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4056,8 +4056,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE end if if (allocated(SrcActiveDOFsData%SrtPS)) then - LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) - UB(1:1) = ubound(SrcActiveDOFsData%SrtPS) + LB(1:1) = lbound(SrcActiveDOFsData%SrtPS, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPS, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%SrtPS)) then allocate(DstActiveDOFsData%SrtPS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4068,8 +4068,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS end if if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then - LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) - UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG) + LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%SrtPSNAUG)) then allocate(DstActiveDOFsData%SrtPSNAUG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4080,8 +4080,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG end if if (allocated(SrcActiveDOFsData%Diag)) then - LB(1:1) = lbound(SrcActiveDOFsData%Diag) - UB(1:1) = ubound(SrcActiveDOFsData%Diag) + LB(1:1) = lbound(SrcActiveDOFsData%Diag, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%Diag, kind=B8Ki) if (.not. allocated(DstActiveDOFsData%Diag)) then allocate(DstActiveDOFsData%Diag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4160,79 +4160,79 @@ subroutine ED_PackActiveDOFs(Buf, Indata) call RegPack(Buf, InData%NPTTE) call RegPack(Buf, allocated(InData%NPSBE)) if (allocated(InData%NPSBE)) then - call RegPackBounds(Buf, 1, lbound(InData%NPSBE), ubound(InData%NPSBE)) + call RegPackBounds(Buf, 1, lbound(InData%NPSBE, kind=B8Ki), ubound(InData%NPSBE, kind=B8Ki)) call RegPack(Buf, InData%NPSBE) end if call RegPack(Buf, allocated(InData%NPSE)) if (allocated(InData%NPSE)) then - call RegPackBounds(Buf, 1, lbound(InData%NPSE), ubound(InData%NPSE)) + call RegPackBounds(Buf, 1, lbound(InData%NPSE, kind=B8Ki), ubound(InData%NPSE, kind=B8Ki)) call RegPack(Buf, InData%NPSE) end if call RegPack(Buf, InData%NPUE) call RegPack(Buf, InData%NPYE) call RegPack(Buf, allocated(InData%PCE)) if (allocated(InData%PCE)) then - call RegPackBounds(Buf, 1, lbound(InData%PCE), ubound(InData%PCE)) + call RegPackBounds(Buf, 1, lbound(InData%PCE, kind=B8Ki), ubound(InData%PCE, kind=B8Ki)) call RegPack(Buf, InData%PCE) end if call RegPack(Buf, allocated(InData%PDE)) if (allocated(InData%PDE)) then - call RegPackBounds(Buf, 1, lbound(InData%PDE), ubound(InData%PDE)) + call RegPackBounds(Buf, 1, lbound(InData%PDE, kind=B8Ki), ubound(InData%PDE, kind=B8Ki)) call RegPack(Buf, InData%PDE) end if call RegPack(Buf, allocated(InData%PIE)) if (allocated(InData%PIE)) then - call RegPackBounds(Buf, 1, lbound(InData%PIE), ubound(InData%PIE)) + call RegPackBounds(Buf, 1, lbound(InData%PIE, kind=B8Ki), ubound(InData%PIE, kind=B8Ki)) call RegPack(Buf, InData%PIE) end if call RegPack(Buf, allocated(InData%PTE)) if (allocated(InData%PTE)) then - call RegPackBounds(Buf, 1, lbound(InData%PTE), ubound(InData%PTE)) + call RegPackBounds(Buf, 1, lbound(InData%PTE, kind=B8Ki), ubound(InData%PTE, kind=B8Ki)) call RegPack(Buf, InData%PTE) end if call RegPack(Buf, allocated(InData%PTTE)) if (allocated(InData%PTTE)) then - call RegPackBounds(Buf, 1, lbound(InData%PTTE), ubound(InData%PTTE)) + call RegPackBounds(Buf, 1, lbound(InData%PTTE, kind=B8Ki), ubound(InData%PTTE, kind=B8Ki)) call RegPack(Buf, InData%PTTE) end if call RegPack(Buf, allocated(InData%PS)) if (allocated(InData%PS)) then - call RegPackBounds(Buf, 1, lbound(InData%PS), ubound(InData%PS)) + call RegPackBounds(Buf, 1, lbound(InData%PS, kind=B8Ki), ubound(InData%PS, kind=B8Ki)) call RegPack(Buf, InData%PS) end if call RegPack(Buf, allocated(InData%PSBE)) if (allocated(InData%PSBE)) then - call RegPackBounds(Buf, 2, lbound(InData%PSBE), ubound(InData%PSBE)) + call RegPackBounds(Buf, 2, lbound(InData%PSBE, kind=B8Ki), ubound(InData%PSBE, kind=B8Ki)) call RegPack(Buf, InData%PSBE) end if call RegPack(Buf, allocated(InData%PSE)) if (allocated(InData%PSE)) then - call RegPackBounds(Buf, 2, lbound(InData%PSE), ubound(InData%PSE)) + call RegPackBounds(Buf, 2, lbound(InData%PSE, kind=B8Ki), ubound(InData%PSE, kind=B8Ki)) call RegPack(Buf, InData%PSE) end if call RegPack(Buf, allocated(InData%PUE)) if (allocated(InData%PUE)) then - call RegPackBounds(Buf, 1, lbound(InData%PUE), ubound(InData%PUE)) + call RegPackBounds(Buf, 1, lbound(InData%PUE, kind=B8Ki), ubound(InData%PUE, kind=B8Ki)) call RegPack(Buf, InData%PUE) end if call RegPack(Buf, allocated(InData%PYE)) if (allocated(InData%PYE)) then - call RegPackBounds(Buf, 1, lbound(InData%PYE), ubound(InData%PYE)) + call RegPackBounds(Buf, 1, lbound(InData%PYE, kind=B8Ki), ubound(InData%PYE, kind=B8Ki)) call RegPack(Buf, InData%PYE) end if call RegPack(Buf, allocated(InData%SrtPS)) if (allocated(InData%SrtPS)) then - call RegPackBounds(Buf, 1, lbound(InData%SrtPS), ubound(InData%SrtPS)) + call RegPackBounds(Buf, 1, lbound(InData%SrtPS, kind=B8Ki), ubound(InData%SrtPS, kind=B8Ki)) call RegPack(Buf, InData%SrtPS) end if call RegPack(Buf, allocated(InData%SrtPSNAUG)) if (allocated(InData%SrtPSNAUG)) then - call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG), ubound(InData%SrtPSNAUG)) + call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG, kind=B8Ki), ubound(InData%SrtPSNAUG, kind=B8Ki)) call RegPack(Buf, InData%SrtPSNAUG) end if call RegPack(Buf, allocated(InData%Diag)) if (allocated(InData%Diag)) then - call RegPackBounds(Buf, 1, lbound(InData%Diag), ubound(InData%Diag)) + call RegPackBounds(Buf, 1, lbound(InData%Diag, kind=B8Ki), ubound(InData%Diag, kind=B8Ki)) call RegPack(Buf, InData%Diag) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4242,7 +4242,7 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_ActiveDOFs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4480,15 +4480,15 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyRtHndSide' ErrStat = ErrID_None ErrMsg = '' DstRtHndSideData%rO = SrcRtHndSideData%rO if (allocated(SrcRtHndSideData%rQS)) then - LB(1:3) = lbound(SrcRtHndSideData%rQS) - UB(1:3) = ubound(SrcRtHndSideData%rQS) + LB(1:3) = lbound(SrcRtHndSideData%rQS, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%rQS, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rQS)) then allocate(DstRtHndSideData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4499,8 +4499,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rQS = SrcRtHndSideData%rQS end if if (allocated(SrcRtHndSideData%rS)) then - LB(1:3) = lbound(SrcRtHndSideData%rS) - UB(1:3) = ubound(SrcRtHndSideData%rS) + LB(1:3) = lbound(SrcRtHndSideData%rS, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%rS, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rS)) then allocate(DstRtHndSideData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4511,8 +4511,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rS = SrcRtHndSideData%rS end if if (allocated(SrcRtHndSideData%rS0S)) then - LB(1:3) = lbound(SrcRtHndSideData%rS0S) - UB(1:3) = ubound(SrcRtHndSideData%rS0S) + LB(1:3) = lbound(SrcRtHndSideData%rS0S, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%rS0S, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rS0S)) then allocate(DstRtHndSideData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4523,8 +4523,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S end if if (allocated(SrcRtHndSideData%rT)) then - LB(1:2) = lbound(SrcRtHndSideData%rT) - UB(1:2) = ubound(SrcRtHndSideData%rT) + LB(1:2) = lbound(SrcRtHndSideData%rT, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%rT, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rT)) then allocate(DstRtHndSideData%rT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4536,8 +4536,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O if (allocated(SrcRtHndSideData%rT0T)) then - LB(1:2) = lbound(SrcRtHndSideData%rT0T) - UB(1:2) = ubound(SrcRtHndSideData%rT0T) + LB(1:2) = lbound(SrcRtHndSideData%rT0T, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%rT0T, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rT0T)) then allocate(DstRtHndSideData%rT0T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4550,8 +4550,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rZ = SrcRtHndSideData%rZ DstRtHndSideData%rZO = SrcRtHndSideData%rZO if (allocated(SrcRtHndSideData%rZT)) then - LB(1:2) = lbound(SrcRtHndSideData%rZT) - UB(1:2) = ubound(SrcRtHndSideData%rZT) + LB(1:2) = lbound(SrcRtHndSideData%rZT, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%rZT, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rZT)) then allocate(DstRtHndSideData%rZT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4572,8 +4572,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rOW = SrcRtHndSideData%rOW DstRtHndSideData%rPC = SrcRtHndSideData%rPC if (allocated(SrcRtHndSideData%rPS0)) then - LB(1:2) = lbound(SrcRtHndSideData%rPS0) - UB(1:2) = ubound(SrcRtHndSideData%rPS0) + LB(1:2) = lbound(SrcRtHndSideData%rPS0, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%rPS0, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rPS0)) then allocate(DstRtHndSideData%rPS0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4591,8 +4591,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 if (allocated(SrcRtHndSideData%AngPosEF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngPosEF) - UB(1:2) = ubound(SrcRtHndSideData%AngPosEF) + LB(1:2) = lbound(SrcRtHndSideData%AngPosEF, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%AngPosEF, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngPosEF)) then allocate(DstRtHndSideData%AngPosEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4603,8 +4603,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF end if if (allocated(SrcRtHndSideData%AngPosXF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) - UB(1:2) = ubound(SrcRtHndSideData%AngPosXF) + LB(1:2) = lbound(SrcRtHndSideData%AngPosXF, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%AngPosXF, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngPosXF)) then allocate(DstRtHndSideData%AngPosXF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4615,8 +4615,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF end if if (allocated(SrcRtHndSideData%AngPosHM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) - UB(1:3) = ubound(SrcRtHndSideData%AngPosHM) + LB(1:3) = lbound(SrcRtHndSideData%AngPosHM, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%AngPosHM, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngPosHM)) then allocate(DstRtHndSideData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4629,8 +4629,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX if (allocated(SrcRtHndSideData%PAngVelEA)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEA)) then allocate(DstRtHndSideData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4641,8 +4641,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA end if if (allocated(SrcRtHndSideData%PAngVelEF)) then - LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) - UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF) + LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF, kind=B8Ki) + UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEF)) then allocate(DstRtHndSideData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4653,8 +4653,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF end if if (allocated(SrcRtHndSideData%PAngVelEG)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEG)) then allocate(DstRtHndSideData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4665,8 +4665,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG end if if (allocated(SrcRtHndSideData%PAngVelEH)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEH)) then allocate(DstRtHndSideData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4677,8 +4677,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH end if if (allocated(SrcRtHndSideData%PAngVelEL)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEL)) then allocate(DstRtHndSideData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4689,8 +4689,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL end if if (allocated(SrcRtHndSideData%PAngVelEM)) then - LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) - UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM) + LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM, kind=B8Ki) + UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEM)) then allocate(DstRtHndSideData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4701,8 +4701,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM end if if (allocated(SrcRtHndSideData%AngVelEM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) - UB(1:3) = ubound(SrcRtHndSideData%AngVelEM) + LB(1:3) = lbound(SrcRtHndSideData%AngVelEM, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%AngVelEM, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngVelEM)) then allocate(DstRtHndSideData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4713,8 +4713,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM end if if (allocated(SrcRtHndSideData%PAngVelEN)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEN)) then allocate(DstRtHndSideData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4726,8 +4726,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA if (allocated(SrcRtHndSideData%PAngVelEB)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEB)) then allocate(DstRtHndSideData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4738,8 +4738,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB end if if (allocated(SrcRtHndSideData%PAngVelER)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelER) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelER, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelER, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelER)) then allocate(DstRtHndSideData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4750,8 +4750,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER end if if (allocated(SrcRtHndSideData%PAngVelEX)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PAngVelEX)) then allocate(DstRtHndSideData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4773,8 +4773,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt if (allocated(SrcRtHndSideData%AngAccEFt)) then - LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt) - UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt) + LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngAccEFt)) then allocate(DstRtHndSideData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4785,8 +4785,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt end if if (allocated(SrcRtHndSideData%AngVelEF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) - UB(1:2) = ubound(SrcRtHndSideData%AngVelEF) + LB(1:2) = lbound(SrcRtHndSideData%AngVelEF, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%AngVelEF, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngVelEF)) then allocate(DstRtHndSideData%AngVelEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4797,8 +4797,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF end if if (allocated(SrcRtHndSideData%AngVelHM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) - UB(1:3) = ubound(SrcRtHndSideData%AngVelHM) + LB(1:3) = lbound(SrcRtHndSideData%AngVelHM, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%AngVelHM, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngVelHM)) then allocate(DstRtHndSideData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4812,8 +4812,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt if (allocated(SrcRtHndSideData%AngAccEKt)) then - LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt) - UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt) + LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%AngAccEKt)) then allocate(DstRtHndSideData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4831,8 +4831,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt if (allocated(SrcRtHndSideData%LinVelES)) then - LB(1:3) = lbound(SrcRtHndSideData%LinVelES) - UB(1:3) = ubound(SrcRtHndSideData%LinVelES) + LB(1:3) = lbound(SrcRtHndSideData%LinVelES, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%LinVelES, kind=B8Ki) if (.not. allocated(DstRtHndSideData%LinVelES)) then allocate(DstRtHndSideData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4844,8 +4844,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ if (allocated(SrcRtHndSideData%LinVelET)) then - LB(1:2) = lbound(SrcRtHndSideData%LinVelET) - UB(1:2) = ubound(SrcRtHndSideData%LinVelET) + LB(1:2) = lbound(SrcRtHndSideData%LinVelET, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%LinVelET, kind=B8Ki) if (.not. allocated(DstRtHndSideData%LinVelET)) then allocate(DstRtHndSideData%LinVelET(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4856,8 +4856,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET end if if (allocated(SrcRtHndSideData%LinVelESm2)) then - LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) - UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2) + LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2, kind=B8Ki) + UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2, kind=B8Ki) if (.not. allocated(DstRtHndSideData%LinVelESm2)) then allocate(DstRtHndSideData%LinVelESm2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4868,8 +4868,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 end if if (allocated(SrcRtHndSideData%PLinVelEIMU)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEIMU)) then allocate(DstRtHndSideData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4880,8 +4880,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU end if if (allocated(SrcRtHndSideData%PLinVelEO)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEO)) then allocate(DstRtHndSideData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4892,8 +4892,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO end if if (allocated(SrcRtHndSideData%PLinVelES)) then - LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) - UB(1:5) = ubound(SrcRtHndSideData%PLinVelES) + LB(1:5) = lbound(SrcRtHndSideData%PLinVelES, kind=B8Ki) + UB(1:5) = ubound(SrcRtHndSideData%PLinVelES, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelES)) then allocate(DstRtHndSideData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4904,8 +4904,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES end if if (allocated(SrcRtHndSideData%PLinVelET)) then - LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) - UB(1:4) = ubound(SrcRtHndSideData%PLinVelET) + LB(1:4) = lbound(SrcRtHndSideData%PLinVelET, kind=B8Ki) + UB(1:4) = ubound(SrcRtHndSideData%PLinVelET, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelET)) then allocate(DstRtHndSideData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4916,8 +4916,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET end if if (allocated(SrcRtHndSideData%PLinVelEZ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEZ)) then allocate(DstRtHndSideData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4928,8 +4928,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ end if if (allocated(SrcRtHndSideData%PLinVelEC)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEC)) then allocate(DstRtHndSideData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4940,8 +4940,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC end if if (allocated(SrcRtHndSideData%PLinVelED)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelED) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelED, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelED, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelED)) then allocate(DstRtHndSideData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4952,8 +4952,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED end if if (allocated(SrcRtHndSideData%PLinVelEI)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEI)) then allocate(DstRtHndSideData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4964,8 +4964,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI end if if (allocated(SrcRtHndSideData%PLinVelEJ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEJ)) then allocate(DstRtHndSideData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4976,8 +4976,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ end if if (allocated(SrcRtHndSideData%PLinVelEP)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEP)) then allocate(DstRtHndSideData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4988,8 +4988,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP end if if (allocated(SrcRtHndSideData%PLinVelEQ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEQ)) then allocate(DstRtHndSideData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5000,8 +5000,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ end if if (allocated(SrcRtHndSideData%PLinVelEU)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEU)) then allocate(DstRtHndSideData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5012,8 +5012,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU end if if (allocated(SrcRtHndSideData%PLinVelEV)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEV)) then allocate(DstRtHndSideData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5024,8 +5024,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV end if if (allocated(SrcRtHndSideData%PLinVelEW)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEW)) then allocate(DstRtHndSideData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5036,8 +5036,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW end if if (allocated(SrcRtHndSideData%PLinVelEY)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PLinVelEY)) then allocate(DstRtHndSideData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5050,8 +5050,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt if (allocated(SrcRtHndSideData%LinAccESt)) then - LB(1:3) = lbound(SrcRtHndSideData%LinAccESt) - UB(1:3) = ubound(SrcRtHndSideData%LinAccESt) + LB(1:3) = lbound(SrcRtHndSideData%LinAccESt, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%LinAccESt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%LinAccESt)) then allocate(DstRtHndSideData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5062,8 +5062,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt end if if (allocated(SrcRtHndSideData%LinAccETt)) then - LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) - UB(1:2) = ubound(SrcRtHndSideData%LinAccETt) + LB(1:2) = lbound(SrcRtHndSideData%LinAccETt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%LinAccETt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%LinAccETt)) then allocate(DstRtHndSideData%LinAccETt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5081,8 +5081,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott if (allocated(SrcRtHndSideData%FrcS0Bt)) then - LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt) - UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt) + LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%FrcS0Bt)) then allocate(DstRtHndSideData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5094,8 +5094,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt if (allocated(SrcRtHndSideData%FSAero)) then - LB(1:3) = lbound(SrcRtHndSideData%FSAero) - UB(1:3) = ubound(SrcRtHndSideData%FSAero) + LB(1:3) = lbound(SrcRtHndSideData%FSAero, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%FSAero, kind=B8Ki) if (.not. allocated(DstRtHndSideData%FSAero)) then allocate(DstRtHndSideData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5106,8 +5106,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero end if if (allocated(SrcRtHndSideData%FSTipDrag)) then - LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) - UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag) + LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag, kind=B8Ki) if (.not. allocated(DstRtHndSideData%FSTipDrag)) then allocate(DstRtHndSideData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5118,8 +5118,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag end if if (allocated(SrcRtHndSideData%FTHydrot)) then - LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) - UB(1:2) = ubound(SrcRtHndSideData%FTHydrot) + LB(1:2) = lbound(SrcRtHndSideData%FTHydrot, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%FTHydrot, kind=B8Ki) if (.not. allocated(DstRtHndSideData%FTHydrot)) then allocate(DstRtHndSideData%FTHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5131,8 +5131,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot if (allocated(SrcRtHndSideData%MFHydrot)) then - LB(1:2) = lbound(SrcRtHndSideData%MFHydrot) - UB(1:2) = ubound(SrcRtHndSideData%MFHydrot) + LB(1:2) = lbound(SrcRtHndSideData%MFHydrot, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%MFHydrot, kind=B8Ki) if (.not. allocated(DstRtHndSideData%MFHydrot)) then allocate(DstRtHndSideData%MFHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5144,8 +5144,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt if (allocated(SrcRtHndSideData%MomH0Bt)) then - LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt) - UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt) + LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%MomH0Bt)) then allocate(DstRtHndSideData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5160,8 +5160,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt if (allocated(SrcRtHndSideData%MMAero)) then - LB(1:3) = lbound(SrcRtHndSideData%MMAero) - UB(1:3) = ubound(SrcRtHndSideData%MMAero) + LB(1:3) = lbound(SrcRtHndSideData%MMAero, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%MMAero, kind=B8Ki) if (.not. allocated(DstRtHndSideData%MMAero)) then allocate(DstRtHndSideData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5173,8 +5173,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot if (allocated(SrcRtHndSideData%PFrcONcRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt) - UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt) + LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcONcRt)) then allocate(DstRtHndSideData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5185,8 +5185,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt end if if (allocated(SrcRtHndSideData%PFrcPRot)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) - UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot) + LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcPRot)) then allocate(DstRtHndSideData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5197,8 +5197,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot end if if (allocated(SrcRtHndSideData%PFrcS0B)) then - LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) - UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B) + LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcS0B)) then allocate(DstRtHndSideData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5209,8 +5209,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B end if if (allocated(SrcRtHndSideData%PFrcT0Trb)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) - UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb) + LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcT0Trb)) then allocate(DstRtHndSideData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5221,8 +5221,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb end if if (allocated(SrcRtHndSideData%PFTHydro)) then - LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) - UB(1:3) = ubound(SrcRtHndSideData%PFTHydro) + LB(1:3) = lbound(SrcRtHndSideData%PFTHydro, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PFTHydro, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFTHydro)) then allocate(DstRtHndSideData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5234,8 +5234,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro if (allocated(SrcRtHndSideData%PMFHydro)) then - LB(1:3) = lbound(SrcRtHndSideData%PMFHydro) - UB(1:3) = ubound(SrcRtHndSideData%PMFHydro) + LB(1:3) = lbound(SrcRtHndSideData%PMFHydro, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PMFHydro, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMFHydro)) then allocate(DstRtHndSideData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5246,8 +5246,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro end if if (allocated(SrcRtHndSideData%PMomBNcRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) - UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt) + LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomBNcRt)) then allocate(DstRtHndSideData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5258,8 +5258,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt end if if (allocated(SrcRtHndSideData%PMomH0B)) then - LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) - UB(1:3) = ubound(SrcRtHndSideData%PMomH0B) + LB(1:3) = lbound(SrcRtHndSideData%PMomH0B, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%PMomH0B, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomH0B)) then allocate(DstRtHndSideData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5270,8 +5270,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B end if if (allocated(SrcRtHndSideData%PMomLPRot)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) - UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot) + LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomLPRot)) then allocate(DstRtHndSideData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5282,8 +5282,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot end if if (allocated(SrcRtHndSideData%PMomNGnRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) - UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt) + LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomNGnRt)) then allocate(DstRtHndSideData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5294,8 +5294,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt end if if (allocated(SrcRtHndSideData%PMomNTail)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) - UB(1:2) = ubound(SrcRtHndSideData%PMomNTail) + LB(1:2) = lbound(SrcRtHndSideData%PMomNTail, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PMomNTail, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomNTail)) then allocate(DstRtHndSideData%PMomNTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5306,8 +5306,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail end if if (allocated(SrcRtHndSideData%PMomX0Trb)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) - UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb) + LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomX0Trb)) then allocate(DstRtHndSideData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5324,8 +5324,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt if (allocated(SrcRtHndSideData%PFrcVGnRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt) - UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt) + LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcVGnRt)) then allocate(DstRtHndSideData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5336,8 +5336,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt end if if (allocated(SrcRtHndSideData%PFrcWTail)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) - UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail) + LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcWTail)) then allocate(DstRtHndSideData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5348,8 +5348,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail end if if (allocated(SrcRtHndSideData%PFrcZAll)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) - UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll) + LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PFrcZAll)) then allocate(DstRtHndSideData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5360,8 +5360,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll end if if (allocated(SrcRtHndSideData%PMomXAll)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) - UB(1:2) = ubound(SrcRtHndSideData%PMomXAll) + LB(1:2) = lbound(SrcRtHndSideData%PMomXAll, kind=B8Ki) + UB(1:2) = ubound(SrcRtHndSideData%PMomXAll, kind=B8Ki) if (.not. allocated(DstRtHndSideData%PMomXAll)) then allocate(DstRtHndSideData%PMomXAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5376,8 +5376,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac if (allocated(SrcRtHndSideData%rSAerCen)) then - LB(1:3) = lbound(SrcRtHndSideData%rSAerCen) - UB(1:3) = ubound(SrcRtHndSideData%rSAerCen) + LB(1:3) = lbound(SrcRtHndSideData%rSAerCen, kind=B8Ki) + UB(1:3) = ubound(SrcRtHndSideData%rSAerCen, kind=B8Ki) if (.not. allocated(DstRtHndSideData%rSAerCen)) then allocate(DstRtHndSideData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5613,35 +5613,35 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%rO) call RegPack(Buf, allocated(InData%rQS)) if (allocated(InData%rQS)) then - call RegPackBounds(Buf, 3, lbound(InData%rQS), ubound(InData%rQS)) + call RegPackBounds(Buf, 3, lbound(InData%rQS, kind=B8Ki), ubound(InData%rQS, kind=B8Ki)) call RegPack(Buf, InData%rQS) end if call RegPack(Buf, allocated(InData%rS)) if (allocated(InData%rS)) then - call RegPackBounds(Buf, 3, lbound(InData%rS), ubound(InData%rS)) + call RegPackBounds(Buf, 3, lbound(InData%rS, kind=B8Ki), ubound(InData%rS, kind=B8Ki)) call RegPack(Buf, InData%rS) end if call RegPack(Buf, allocated(InData%rS0S)) if (allocated(InData%rS0S)) then - call RegPackBounds(Buf, 3, lbound(InData%rS0S), ubound(InData%rS0S)) + call RegPackBounds(Buf, 3, lbound(InData%rS0S, kind=B8Ki), ubound(InData%rS0S, kind=B8Ki)) call RegPack(Buf, InData%rS0S) end if call RegPack(Buf, allocated(InData%rT)) if (allocated(InData%rT)) then - call RegPackBounds(Buf, 2, lbound(InData%rT), ubound(InData%rT)) + call RegPackBounds(Buf, 2, lbound(InData%rT, kind=B8Ki), ubound(InData%rT, kind=B8Ki)) call RegPack(Buf, InData%rT) end if call RegPack(Buf, InData%rT0O) call RegPack(Buf, allocated(InData%rT0T)) if (allocated(InData%rT0T)) then - call RegPackBounds(Buf, 2, lbound(InData%rT0T), ubound(InData%rT0T)) + call RegPackBounds(Buf, 2, lbound(InData%rT0T, kind=B8Ki), ubound(InData%rT0T, kind=B8Ki)) call RegPack(Buf, InData%rT0T) end if call RegPack(Buf, InData%rZ) call RegPack(Buf, InData%rZO) call RegPack(Buf, allocated(InData%rZT)) if (allocated(InData%rZT)) then - call RegPackBounds(Buf, 2, lbound(InData%rZT), ubound(InData%rZT)) + call RegPackBounds(Buf, 2, lbound(InData%rZT, kind=B8Ki), ubound(InData%rZT, kind=B8Ki)) call RegPack(Buf, InData%rZT) end if call RegPack(Buf, InData%rPQ) @@ -5656,7 +5656,7 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%rPC) call RegPack(Buf, allocated(InData%rPS0)) if (allocated(InData%rPS0)) then - call RegPackBounds(Buf, 2, lbound(InData%rPS0), ubound(InData%rPS0)) + call RegPackBounds(Buf, 2, lbound(InData%rPS0, kind=B8Ki), ubound(InData%rPS0, kind=B8Ki)) call RegPack(Buf, InData%rPS0) end if call RegPack(Buf, InData%rQ) @@ -5668,75 +5668,75 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%rZT0) call RegPack(Buf, allocated(InData%AngPosEF)) if (allocated(InData%AngPosEF)) then - call RegPackBounds(Buf, 2, lbound(InData%AngPosEF), ubound(InData%AngPosEF)) + call RegPackBounds(Buf, 2, lbound(InData%AngPosEF, kind=B8Ki), ubound(InData%AngPosEF, kind=B8Ki)) call RegPack(Buf, InData%AngPosEF) end if call RegPack(Buf, allocated(InData%AngPosXF)) if (allocated(InData%AngPosXF)) then - call RegPackBounds(Buf, 2, lbound(InData%AngPosXF), ubound(InData%AngPosXF)) + call RegPackBounds(Buf, 2, lbound(InData%AngPosXF, kind=B8Ki), ubound(InData%AngPosXF, kind=B8Ki)) call RegPack(Buf, InData%AngPosXF) end if call RegPack(Buf, allocated(InData%AngPosHM)) if (allocated(InData%AngPosHM)) then - call RegPackBounds(Buf, 3, lbound(InData%AngPosHM), ubound(InData%AngPosHM)) + call RegPackBounds(Buf, 3, lbound(InData%AngPosHM, kind=B8Ki), ubound(InData%AngPosHM, kind=B8Ki)) call RegPack(Buf, InData%AngPosHM) end if call RegPack(Buf, InData%AngPosXB) call RegPack(Buf, InData%AngPosEX) call RegPack(Buf, allocated(InData%PAngVelEA)) if (allocated(InData%PAngVelEA)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA), ubound(InData%PAngVelEA)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA, kind=B8Ki), ubound(InData%PAngVelEA, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEA) end if call RegPack(Buf, allocated(InData%PAngVelEF)) if (allocated(InData%PAngVelEF)) then - call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF), ubound(InData%PAngVelEF)) + call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF, kind=B8Ki), ubound(InData%PAngVelEF, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEF) end if call RegPack(Buf, allocated(InData%PAngVelEG)) if (allocated(InData%PAngVelEG)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG), ubound(InData%PAngVelEG)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG, kind=B8Ki), ubound(InData%PAngVelEG, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEG) end if call RegPack(Buf, allocated(InData%PAngVelEH)) if (allocated(InData%PAngVelEH)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH), ubound(InData%PAngVelEH)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH, kind=B8Ki), ubound(InData%PAngVelEH, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEH) end if call RegPack(Buf, allocated(InData%PAngVelEL)) if (allocated(InData%PAngVelEL)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL), ubound(InData%PAngVelEL)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL, kind=B8Ki), ubound(InData%PAngVelEL, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEL) end if call RegPack(Buf, allocated(InData%PAngVelEM)) if (allocated(InData%PAngVelEM)) then - call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM), ubound(InData%PAngVelEM)) + call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM, kind=B8Ki), ubound(InData%PAngVelEM, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEM) end if call RegPack(Buf, allocated(InData%AngVelEM)) if (allocated(InData%AngVelEM)) then - call RegPackBounds(Buf, 3, lbound(InData%AngVelEM), ubound(InData%AngVelEM)) + call RegPackBounds(Buf, 3, lbound(InData%AngVelEM, kind=B8Ki), ubound(InData%AngVelEM, kind=B8Ki)) call RegPack(Buf, InData%AngVelEM) end if call RegPack(Buf, allocated(InData%PAngVelEN)) if (allocated(InData%PAngVelEN)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN), ubound(InData%PAngVelEN)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN, kind=B8Ki), ubound(InData%PAngVelEN, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEN) end if call RegPack(Buf, InData%AngVelEA) call RegPack(Buf, allocated(InData%PAngVelEB)) if (allocated(InData%PAngVelEB)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB), ubound(InData%PAngVelEB)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB, kind=B8Ki), ubound(InData%PAngVelEB, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEB) end if call RegPack(Buf, allocated(InData%PAngVelER)) if (allocated(InData%PAngVelER)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelER), ubound(InData%PAngVelER)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelER, kind=B8Ki), ubound(InData%PAngVelER, kind=B8Ki)) call RegPack(Buf, InData%PAngVelER) end if call RegPack(Buf, allocated(InData%PAngVelEX)) if (allocated(InData%PAngVelEX)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX), ubound(InData%PAngVelEX)) + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX, kind=B8Ki), ubound(InData%PAngVelEX, kind=B8Ki)) call RegPack(Buf, InData%PAngVelEX) end if call RegPack(Buf, InData%AngVelEG) @@ -5752,17 +5752,17 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%AngAccEXt) call RegPack(Buf, allocated(InData%AngAccEFt)) if (allocated(InData%AngAccEFt)) then - call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt), ubound(InData%AngAccEFt)) + call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt, kind=B8Ki), ubound(InData%AngAccEFt, kind=B8Ki)) call RegPack(Buf, InData%AngAccEFt) end if call RegPack(Buf, allocated(InData%AngVelEF)) if (allocated(InData%AngVelEF)) then - call RegPackBounds(Buf, 2, lbound(InData%AngVelEF), ubound(InData%AngVelEF)) + call RegPackBounds(Buf, 2, lbound(InData%AngVelEF, kind=B8Ki), ubound(InData%AngVelEF, kind=B8Ki)) call RegPack(Buf, InData%AngVelEF) end if call RegPack(Buf, allocated(InData%AngVelHM)) if (allocated(InData%AngVelHM)) then - call RegPackBounds(Buf, 3, lbound(InData%AngVelHM), ubound(InData%AngVelHM)) + call RegPackBounds(Buf, 3, lbound(InData%AngVelHM, kind=B8Ki), ubound(InData%AngVelHM, kind=B8Ki)) call RegPack(Buf, InData%AngVelHM) end if call RegPack(Buf, InData%AngAccEAt) @@ -5770,7 +5770,7 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%AngAccEHt) call RegPack(Buf, allocated(InData%AngAccEKt)) if (allocated(InData%AngAccEKt)) then - call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt), ubound(InData%AngAccEKt)) + call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt, kind=B8Ki), ubound(InData%AngAccEKt, kind=B8Ki)) call RegPack(Buf, InData%AngAccEKt) end if call RegPack(Buf, InData%AngAccENt) @@ -5782,105 +5782,105 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%LinAccEYt) call RegPack(Buf, allocated(InData%LinVelES)) if (allocated(InData%LinVelES)) then - call RegPackBounds(Buf, 3, lbound(InData%LinVelES), ubound(InData%LinVelES)) + call RegPackBounds(Buf, 3, lbound(InData%LinVelES, kind=B8Ki), ubound(InData%LinVelES, kind=B8Ki)) call RegPack(Buf, InData%LinVelES) end if call RegPack(Buf, InData%LinVelEQ) call RegPack(Buf, allocated(InData%LinVelET)) if (allocated(InData%LinVelET)) then - call RegPackBounds(Buf, 2, lbound(InData%LinVelET), ubound(InData%LinVelET)) + call RegPackBounds(Buf, 2, lbound(InData%LinVelET, kind=B8Ki), ubound(InData%LinVelET, kind=B8Ki)) call RegPack(Buf, InData%LinVelET) end if call RegPack(Buf, allocated(InData%LinVelESm2)) if (allocated(InData%LinVelESm2)) then - call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2), ubound(InData%LinVelESm2)) + call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2, kind=B8Ki), ubound(InData%LinVelESm2, kind=B8Ki)) call RegPack(Buf, InData%LinVelESm2) end if call RegPack(Buf, allocated(InData%PLinVelEIMU)) if (allocated(InData%PLinVelEIMU)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU), ubound(InData%PLinVelEIMU)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU, kind=B8Ki), ubound(InData%PLinVelEIMU, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEIMU) end if call RegPack(Buf, allocated(InData%PLinVelEO)) if (allocated(InData%PLinVelEO)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO), ubound(InData%PLinVelEO)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO, kind=B8Ki), ubound(InData%PLinVelEO, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEO) end if call RegPack(Buf, allocated(InData%PLinVelES)) if (allocated(InData%PLinVelES)) then - call RegPackBounds(Buf, 5, lbound(InData%PLinVelES), ubound(InData%PLinVelES)) + call RegPackBounds(Buf, 5, lbound(InData%PLinVelES, kind=B8Ki), ubound(InData%PLinVelES, kind=B8Ki)) call RegPack(Buf, InData%PLinVelES) end if call RegPack(Buf, allocated(InData%PLinVelET)) if (allocated(InData%PLinVelET)) then - call RegPackBounds(Buf, 4, lbound(InData%PLinVelET), ubound(InData%PLinVelET)) + call RegPackBounds(Buf, 4, lbound(InData%PLinVelET, kind=B8Ki), ubound(InData%PLinVelET, kind=B8Ki)) call RegPack(Buf, InData%PLinVelET) end if call RegPack(Buf, allocated(InData%PLinVelEZ)) if (allocated(InData%PLinVelEZ)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ), ubound(InData%PLinVelEZ)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ, kind=B8Ki), ubound(InData%PLinVelEZ, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEZ) end if call RegPack(Buf, allocated(InData%PLinVelEC)) if (allocated(InData%PLinVelEC)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC), ubound(InData%PLinVelEC)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC, kind=B8Ki), ubound(InData%PLinVelEC, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEC) end if call RegPack(Buf, allocated(InData%PLinVelED)) if (allocated(InData%PLinVelED)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelED), ubound(InData%PLinVelED)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelED, kind=B8Ki), ubound(InData%PLinVelED, kind=B8Ki)) call RegPack(Buf, InData%PLinVelED) end if call RegPack(Buf, allocated(InData%PLinVelEI)) if (allocated(InData%PLinVelEI)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI), ubound(InData%PLinVelEI)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI, kind=B8Ki), ubound(InData%PLinVelEI, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEI) end if call RegPack(Buf, allocated(InData%PLinVelEJ)) if (allocated(InData%PLinVelEJ)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ), ubound(InData%PLinVelEJ)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ, kind=B8Ki), ubound(InData%PLinVelEJ, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEJ) end if call RegPack(Buf, allocated(InData%PLinVelEP)) if (allocated(InData%PLinVelEP)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP), ubound(InData%PLinVelEP)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP, kind=B8Ki), ubound(InData%PLinVelEP, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEP) end if call RegPack(Buf, allocated(InData%PLinVelEQ)) if (allocated(InData%PLinVelEQ)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ), ubound(InData%PLinVelEQ)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ, kind=B8Ki), ubound(InData%PLinVelEQ, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEQ) end if call RegPack(Buf, allocated(InData%PLinVelEU)) if (allocated(InData%PLinVelEU)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU), ubound(InData%PLinVelEU)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU, kind=B8Ki), ubound(InData%PLinVelEU, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEU) end if call RegPack(Buf, allocated(InData%PLinVelEV)) if (allocated(InData%PLinVelEV)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV), ubound(InData%PLinVelEV)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV, kind=B8Ki), ubound(InData%PLinVelEV, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEV) end if call RegPack(Buf, allocated(InData%PLinVelEW)) if (allocated(InData%PLinVelEW)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW), ubound(InData%PLinVelEW)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW, kind=B8Ki), ubound(InData%PLinVelEW, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEW) end if call RegPack(Buf, allocated(InData%PLinVelEY)) if (allocated(InData%PLinVelEY)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY), ubound(InData%PLinVelEY)) + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY, kind=B8Ki), ubound(InData%PLinVelEY, kind=B8Ki)) call RegPack(Buf, InData%PLinVelEY) end if call RegPack(Buf, InData%LinAccEIMUt) call RegPack(Buf, InData%LinAccEOt) call RegPack(Buf, allocated(InData%LinAccESt)) if (allocated(InData%LinAccESt)) then - call RegPackBounds(Buf, 3, lbound(InData%LinAccESt), ubound(InData%LinAccESt)) + call RegPackBounds(Buf, 3, lbound(InData%LinAccESt, kind=B8Ki), ubound(InData%LinAccESt, kind=B8Ki)) call RegPack(Buf, InData%LinAccESt) end if call RegPack(Buf, allocated(InData%LinAccETt)) if (allocated(InData%LinAccETt)) then - call RegPackBounds(Buf, 2, lbound(InData%LinAccETt), ubound(InData%LinAccETt)) + call RegPackBounds(Buf, 2, lbound(InData%LinAccETt, kind=B8Ki), ubound(InData%LinAccETt, kind=B8Ki)) call RegPack(Buf, InData%LinAccETt) end if call RegPack(Buf, InData%LinAccEZt) @@ -5892,35 +5892,35 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%FrcPRott) call RegPack(Buf, allocated(InData%FrcS0Bt)) if (allocated(InData%FrcS0Bt)) then - call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt), ubound(InData%FrcS0Bt)) + call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt, kind=B8Ki), ubound(InData%FrcS0Bt, kind=B8Ki)) call RegPack(Buf, InData%FrcS0Bt) end if call RegPack(Buf, InData%FrcT0Trbt) call RegPack(Buf, allocated(InData%FSAero)) if (allocated(InData%FSAero)) then - call RegPackBounds(Buf, 3, lbound(InData%FSAero), ubound(InData%FSAero)) + call RegPackBounds(Buf, 3, lbound(InData%FSAero, kind=B8Ki), ubound(InData%FSAero, kind=B8Ki)) call RegPack(Buf, InData%FSAero) end if call RegPack(Buf, allocated(InData%FSTipDrag)) if (allocated(InData%FSTipDrag)) then - call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag), ubound(InData%FSTipDrag)) + call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag, kind=B8Ki), ubound(InData%FSTipDrag, kind=B8Ki)) call RegPack(Buf, InData%FSTipDrag) end if call RegPack(Buf, allocated(InData%FTHydrot)) if (allocated(InData%FTHydrot)) then - call RegPackBounds(Buf, 2, lbound(InData%FTHydrot), ubound(InData%FTHydrot)) + call RegPackBounds(Buf, 2, lbound(InData%FTHydrot, kind=B8Ki), ubound(InData%FTHydrot, kind=B8Ki)) call RegPack(Buf, InData%FTHydrot) end if call RegPack(Buf, InData%FZHydrot) call RegPack(Buf, allocated(InData%MFHydrot)) if (allocated(InData%MFHydrot)) then - call RegPackBounds(Buf, 2, lbound(InData%MFHydrot), ubound(InData%MFHydrot)) + call RegPackBounds(Buf, 2, lbound(InData%MFHydrot, kind=B8Ki), ubound(InData%MFHydrot, kind=B8Ki)) call RegPack(Buf, InData%MFHydrot) end if call RegPack(Buf, InData%MomBNcRtt) call RegPack(Buf, allocated(InData%MomH0Bt)) if (allocated(InData%MomH0Bt)) then - call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt), ubound(InData%MomH0Bt)) + call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt, kind=B8Ki), ubound(InData%MomH0Bt, kind=B8Ki)) call RegPack(Buf, InData%MomH0Bt) end if call RegPack(Buf, InData%MomLPRott) @@ -5929,69 +5929,69 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%MomX0Trbt) call RegPack(Buf, allocated(InData%MMAero)) if (allocated(InData%MMAero)) then - call RegPackBounds(Buf, 3, lbound(InData%MMAero), ubound(InData%MMAero)) + call RegPackBounds(Buf, 3, lbound(InData%MMAero, kind=B8Ki), ubound(InData%MMAero, kind=B8Ki)) call RegPack(Buf, InData%MMAero) end if call RegPack(Buf, InData%MXHydrot) call RegPack(Buf, allocated(InData%PFrcONcRt)) if (allocated(InData%PFrcONcRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt), ubound(InData%PFrcONcRt)) + call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt, kind=B8Ki), ubound(InData%PFrcONcRt, kind=B8Ki)) call RegPack(Buf, InData%PFrcONcRt) end if call RegPack(Buf, allocated(InData%PFrcPRot)) if (allocated(InData%PFrcPRot)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot), ubound(InData%PFrcPRot)) + call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot, kind=B8Ki), ubound(InData%PFrcPRot, kind=B8Ki)) call RegPack(Buf, InData%PFrcPRot) end if call RegPack(Buf, allocated(InData%PFrcS0B)) if (allocated(InData%PFrcS0B)) then - call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B), ubound(InData%PFrcS0B)) + call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B, kind=B8Ki), ubound(InData%PFrcS0B, kind=B8Ki)) call RegPack(Buf, InData%PFrcS0B) end if call RegPack(Buf, allocated(InData%PFrcT0Trb)) if (allocated(InData%PFrcT0Trb)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb), ubound(InData%PFrcT0Trb)) + call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb, kind=B8Ki), ubound(InData%PFrcT0Trb, kind=B8Ki)) call RegPack(Buf, InData%PFrcT0Trb) end if call RegPack(Buf, allocated(InData%PFTHydro)) if (allocated(InData%PFTHydro)) then - call RegPackBounds(Buf, 3, lbound(InData%PFTHydro), ubound(InData%PFTHydro)) + call RegPackBounds(Buf, 3, lbound(InData%PFTHydro, kind=B8Ki), ubound(InData%PFTHydro, kind=B8Ki)) call RegPack(Buf, InData%PFTHydro) end if call RegPack(Buf, InData%PFZHydro) call RegPack(Buf, allocated(InData%PMFHydro)) if (allocated(InData%PMFHydro)) then - call RegPackBounds(Buf, 3, lbound(InData%PMFHydro), ubound(InData%PMFHydro)) + call RegPackBounds(Buf, 3, lbound(InData%PMFHydro, kind=B8Ki), ubound(InData%PMFHydro, kind=B8Ki)) call RegPack(Buf, InData%PMFHydro) end if call RegPack(Buf, allocated(InData%PMomBNcRt)) if (allocated(InData%PMomBNcRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt), ubound(InData%PMomBNcRt)) + call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt, kind=B8Ki), ubound(InData%PMomBNcRt, kind=B8Ki)) call RegPack(Buf, InData%PMomBNcRt) end if call RegPack(Buf, allocated(InData%PMomH0B)) if (allocated(InData%PMomH0B)) then - call RegPackBounds(Buf, 3, lbound(InData%PMomH0B), ubound(InData%PMomH0B)) + call RegPackBounds(Buf, 3, lbound(InData%PMomH0B, kind=B8Ki), ubound(InData%PMomH0B, kind=B8Ki)) call RegPack(Buf, InData%PMomH0B) end if call RegPack(Buf, allocated(InData%PMomLPRot)) if (allocated(InData%PMomLPRot)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot), ubound(InData%PMomLPRot)) + call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot, kind=B8Ki), ubound(InData%PMomLPRot, kind=B8Ki)) call RegPack(Buf, InData%PMomLPRot) end if call RegPack(Buf, allocated(InData%PMomNGnRt)) if (allocated(InData%PMomNGnRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt), ubound(InData%PMomNGnRt)) + call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt, kind=B8Ki), ubound(InData%PMomNGnRt, kind=B8Ki)) call RegPack(Buf, InData%PMomNGnRt) end if call RegPack(Buf, allocated(InData%PMomNTail)) if (allocated(InData%PMomNTail)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomNTail), ubound(InData%PMomNTail)) + call RegPackBounds(Buf, 2, lbound(InData%PMomNTail, kind=B8Ki), ubound(InData%PMomNTail, kind=B8Ki)) call RegPack(Buf, InData%PMomNTail) end if call RegPack(Buf, allocated(InData%PMomX0Trb)) if (allocated(InData%PMomX0Trb)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb), ubound(InData%PMomX0Trb)) + call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb, kind=B8Ki), ubound(InData%PMomX0Trb, kind=B8Ki)) call RegPack(Buf, InData%PMomX0Trb) end if call RegPack(Buf, InData%PMXHydro) @@ -6002,22 +6002,22 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%MomXAllt) call RegPack(Buf, allocated(InData%PFrcVGnRt)) if (allocated(InData%PFrcVGnRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt), ubound(InData%PFrcVGnRt)) + call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt, kind=B8Ki), ubound(InData%PFrcVGnRt, kind=B8Ki)) call RegPack(Buf, InData%PFrcVGnRt) end if call RegPack(Buf, allocated(InData%PFrcWTail)) if (allocated(InData%PFrcWTail)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail), ubound(InData%PFrcWTail)) + call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail, kind=B8Ki), ubound(InData%PFrcWTail, kind=B8Ki)) call RegPack(Buf, InData%PFrcWTail) end if call RegPack(Buf, allocated(InData%PFrcZAll)) if (allocated(InData%PFrcZAll)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll), ubound(InData%PFrcZAll)) + call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll, kind=B8Ki), ubound(InData%PFrcZAll, kind=B8Ki)) call RegPack(Buf, InData%PFrcZAll) end if call RegPack(Buf, allocated(InData%PMomXAll)) if (allocated(InData%PMomXAll)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomXAll), ubound(InData%PMomXAll)) + call RegPackBounds(Buf, 2, lbound(InData%PMomXAll, kind=B8Ki), ubound(InData%PMomXAll, kind=B8Ki)) call RegPack(Buf, InData%PMomXAll) end if call RegPack(Buf, InData%TeetMom) @@ -6026,7 +6026,7 @@ subroutine ED_PackRtHndSide(Buf, Indata) call RegPack(Buf, InData%GBoxEffFac) call RegPack(Buf, allocated(InData%rSAerCen)) if (allocated(InData%rSAerCen)) then - call RegPackBounds(Buf, 3, lbound(InData%rSAerCen), ubound(InData%rSAerCen)) + call RegPackBounds(Buf, 3, lbound(InData%rSAerCen, kind=B8Ki), ubound(InData%rSAerCen, kind=B8Ki)) call RegPack(Buf, InData%rSAerCen) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6036,7 +6036,7 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_RtHndSide), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7162,14 +7162,14 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%QT)) then - LB(1:1) = lbound(SrcContStateData%QT) - UB(1:1) = ubound(SrcContStateData%QT) + LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) if (.not. allocated(DstContStateData%QT)) then allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7180,8 +7180,8 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%QT = SrcContStateData%QT end if if (allocated(SrcContStateData%QDT)) then - LB(1:1) = lbound(SrcContStateData%QDT) - UB(1:1) = ubound(SrcContStateData%QDT) + LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) if (.not. allocated(DstContStateData%QDT)) then allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7215,12 +7215,12 @@ subroutine ED_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%QT)) if (allocated(InData%QT)) then - call RegPackBounds(Buf, 1, lbound(InData%QT), ubound(InData%QT)) + call RegPackBounds(Buf, 1, lbound(InData%QT, kind=B8Ki), ubound(InData%QT, kind=B8Ki)) call RegPack(Buf, InData%QT) end if call RegPack(Buf, allocated(InData%QDT)) if (allocated(InData%QDT)) then - call RegPackBounds(Buf, 1, lbound(InData%QDT), ubound(InData%QDT)) + call RegPackBounds(Buf, 1, lbound(InData%QDT, kind=B8Ki), ubound(InData%QDT, kind=B8Ki)) call RegPack(Buf, InData%QDT) end if if (RegCheckErr(Buf, RoutineName)) return @@ -7230,7 +7230,7 @@ subroutine ED_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackContState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7348,24 +7348,24 @@ subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcOtherStateData%IC)) then - LB(1:1) = lbound(SrcOtherStateData%IC) - UB(1:1) = ubound(SrcOtherStateData%IC) + LB(1:1) = lbound(SrcOtherStateData%IC, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%IC, kind=B8Ki) if (.not. allocated(DstOtherStateData%IC)) then allocate(DstOtherStateData%IC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7385,15 +7385,15 @@ subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(ED_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7407,18 +7407,18 @@ subroutine ED_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%xdot(i1)) end do call RegPack(Buf, allocated(InData%IC)) if (allocated(InData%IC)) then - call RegPackBounds(Buf, 1, lbound(InData%IC), ubound(InData%IC)) + call RegPackBounds(Buf, 1, lbound(InData%IC, kind=B8Ki), ubound(InData%IC, kind=B8Ki)) call RegPack(Buf, InData%IC) end if call RegPack(Buf, InData%HSSBrTrq) @@ -7432,15 +7432,15 @@ subroutine ED_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - LB(1:1) = lbound(OutData%xdot) - UB(1:1) = ubound(OutData%xdot) + LB(1:1) = lbound(OutData%xdot, kind=B8Ki) + UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call ED_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do @@ -7474,7 +7474,7 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyMisc' @@ -7487,8 +7487,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7499,8 +7499,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%AugMat)) then - LB(1:2) = lbound(SrcMiscData%AugMat) - UB(1:2) = ubound(SrcMiscData%AugMat) + LB(1:2) = lbound(SrcMiscData%AugMat, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AugMat, kind=B8Ki) if (.not. allocated(DstMiscData%AugMat)) then allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7511,8 +7511,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AugMat = SrcMiscData%AugMat end if if (allocated(SrcMiscData%AugMat_factor)) then - LB(1:2) = lbound(SrcMiscData%AugMat_factor) - UB(1:2) = ubound(SrcMiscData%AugMat_factor) + LB(1:2) = lbound(SrcMiscData%AugMat_factor, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%AugMat_factor, kind=B8Ki) if (.not. allocated(DstMiscData%AugMat_factor)) then allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7523,8 +7523,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor end if if (allocated(SrcMiscData%SolnVec)) then - LB(1:1) = lbound(SrcMiscData%SolnVec) - UB(1:1) = ubound(SrcMiscData%SolnVec) + LB(1:1) = lbound(SrcMiscData%SolnVec, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SolnVec, kind=B8Ki) if (.not. allocated(DstMiscData%SolnVec)) then allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7535,8 +7535,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SolnVec = SrcMiscData%SolnVec end if if (allocated(SrcMiscData%AugMat_pivot)) then - LB(1:1) = lbound(SrcMiscData%AugMat_pivot) - UB(1:1) = ubound(SrcMiscData%AugMat_pivot) + LB(1:1) = lbound(SrcMiscData%AugMat_pivot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot, kind=B8Ki) if (.not. allocated(DstMiscData%AugMat_pivot)) then allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7547,8 +7547,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot end if if (allocated(SrcMiscData%OgnlGeAzRo)) then - LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) - UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) if (.not. allocated(DstMiscData%OgnlGeAzRo)) then allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7559,8 +7559,8 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo end if if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T) - UB(1:1) = ubound(SrcMiscData%QD2T) + LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) if (.not. allocated(DstMiscData%QD2T)) then allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7618,37 +7618,37 @@ subroutine ED_PackMisc(Buf, Indata) call ED_PackRtHndSide(Buf, InData%RtHS) call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, allocated(InData%AugMat)) if (allocated(InData%AugMat)) then - call RegPackBounds(Buf, 2, lbound(InData%AugMat), ubound(InData%AugMat)) + call RegPackBounds(Buf, 2, lbound(InData%AugMat, kind=B8Ki), ubound(InData%AugMat, kind=B8Ki)) call RegPack(Buf, InData%AugMat) end if call RegPack(Buf, allocated(InData%AugMat_factor)) if (allocated(InData%AugMat_factor)) then - call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor), ubound(InData%AugMat_factor)) + call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor, kind=B8Ki), ubound(InData%AugMat_factor, kind=B8Ki)) call RegPack(Buf, InData%AugMat_factor) end if call RegPack(Buf, allocated(InData%SolnVec)) if (allocated(InData%SolnVec)) then - call RegPackBounds(Buf, 1, lbound(InData%SolnVec), ubound(InData%SolnVec)) + call RegPackBounds(Buf, 1, lbound(InData%SolnVec, kind=B8Ki), ubound(InData%SolnVec, kind=B8Ki)) call RegPack(Buf, InData%SolnVec) end if call RegPack(Buf, allocated(InData%AugMat_pivot)) if (allocated(InData%AugMat_pivot)) then - call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot), ubound(InData%AugMat_pivot)) + call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot, kind=B8Ki), ubound(InData%AugMat_pivot, kind=B8Ki)) call RegPack(Buf, InData%AugMat_pivot) end if call RegPack(Buf, allocated(InData%OgnlGeAzRo)) if (allocated(InData%OgnlGeAzRo)) then - call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo), ubound(InData%OgnlGeAzRo)) + call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo, kind=B8Ki), ubound(InData%OgnlGeAzRo, kind=B8Ki)) call RegPack(Buf, InData%OgnlGeAzRo) end if call RegPack(Buf, allocated(InData%QD2T)) if (allocated(InData%QD2T)) then - call RegPackBounds(Buf, 1, lbound(InData%QD2T), ubound(InData%QD2T)) + call RegPackBounds(Buf, 1, lbound(InData%QD2T, kind=B8Ki), ubound(InData%QD2T, kind=B8Ki)) call RegPack(Buf, InData%QD2T) end if call RegPack(Buf, InData%IgnoreMod) @@ -7659,7 +7659,7 @@ subroutine ED_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackMisc' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7773,8 +7773,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyParam' @@ -7789,8 +7789,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NAug = SrcParamData%NAug DstParamData%NPH = SrcParamData%NPH if (allocated(SrcParamData%PH)) then - LB(1:1) = lbound(SrcParamData%PH) - UB(1:1) = ubound(SrcParamData%PH) + LB(1:1) = lbound(SrcParamData%PH, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%PH, kind=B8Ki) if (.not. allocated(DstParamData%PH)) then allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7802,8 +7802,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NPM = SrcParamData%NPM if (allocated(SrcParamData%PM)) then - LB(1:2) = lbound(SrcParamData%PM) - UB(1:2) = ubound(SrcParamData%PM) + LB(1:2) = lbound(SrcParamData%PM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PM, kind=B8Ki) if (.not. allocated(DstParamData%PM)) then allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7814,8 +7814,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PM = SrcParamData%PM end if if (allocated(SrcParamData%DOF_Flag)) then - LB(1:1) = lbound(SrcParamData%DOF_Flag) - UB(1:1) = ubound(SrcParamData%DOF_Flag) + LB(1:1) = lbound(SrcParamData%DOF_Flag, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DOF_Flag, kind=B8Ki) if (.not. allocated(DstParamData%DOF_Flag)) then allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7826,8 +7826,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DOF_Flag = SrcParamData%DOF_Flag end if if (allocated(SrcParamData%DOF_Desc)) then - LB(1:1) = lbound(SrcParamData%DOF_Desc) - UB(1:1) = ubound(SrcParamData%DOF_Desc) + LB(1:1) = lbound(SrcParamData%DOF_Desc, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DOF_Desc, kind=B8Ki) if (.not. allocated(DstParamData%DOF_Desc)) then allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7845,8 +7845,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NBlGages = SrcParamData%NBlGages DstParamData%NTwGages = SrcParamData%NTwGages if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7865,8 +7865,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AzimB1Up = SrcParamData%AzimB1Up DstParamData%CosDel3 = SrcParamData%CosDel3 if (allocated(SrcParamData%CosPreC)) then - LB(1:1) = lbound(SrcParamData%CosPreC) - UB(1:1) = ubound(SrcParamData%CosPreC) + LB(1:1) = lbound(SrcParamData%CosPreC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%CosPreC, kind=B8Ki) if (.not. allocated(DstParamData%CosPreC)) then allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7920,8 +7920,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rZYzt = SrcParamData%rZYzt DstParamData%SinDel3 = SrcParamData%SinDel3 if (allocated(SrcParamData%SinPreC)) then - LB(1:1) = lbound(SrcParamData%SinPreC) - UB(1:1) = ubound(SrcParamData%SinPreC) + LB(1:1) = lbound(SrcParamData%SinPreC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%SinPreC, kind=B8Ki) if (.not. allocated(DstParamData%SinPreC)) then allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7948,8 +7948,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%UndSling = SrcParamData%UndSling DstParamData%NumBl = SrcParamData%NumBl if (allocated(SrcParamData%AxRedTFA)) then - LB(1:3) = lbound(SrcParamData%AxRedTFA) - UB(1:3) = ubound(SrcParamData%AxRedTFA) + LB(1:3) = lbound(SrcParamData%AxRedTFA, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AxRedTFA, kind=B8Ki) if (.not. allocated(DstParamData%AxRedTFA)) then allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7960,8 +7960,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AxRedTFA = SrcParamData%AxRedTFA end if if (allocated(SrcParamData%AxRedTSS)) then - LB(1:3) = lbound(SrcParamData%AxRedTSS) - UB(1:3) = ubound(SrcParamData%AxRedTSS) + LB(1:3) = lbound(SrcParamData%AxRedTSS, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AxRedTSS, kind=B8Ki) if (.not. allocated(DstParamData%AxRedTSS)) then allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7974,8 +7974,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CTFA = SrcParamData%CTFA DstParamData%CTSS = SrcParamData%CTSS if (allocated(SrcParamData%DHNodes)) then - LB(1:1) = lbound(SrcParamData%DHNodes) - UB(1:1) = ubound(SrcParamData%DHNodes) + LB(1:1) = lbound(SrcParamData%DHNodes, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DHNodes, kind=B8Ki) if (.not. allocated(DstParamData%DHNodes)) then allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7986,8 +7986,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DHNodes = SrcParamData%DHNodes end if if (allocated(SrcParamData%HNodes)) then - LB(1:1) = lbound(SrcParamData%HNodes) - UB(1:1) = ubound(SrcParamData%HNodes) + LB(1:1) = lbound(SrcParamData%HNodes, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%HNodes, kind=B8Ki) if (.not. allocated(DstParamData%HNodes)) then allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7998,8 +7998,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%HNodes = SrcParamData%HNodes end if if (allocated(SrcParamData%HNodesNorm)) then - LB(1:1) = lbound(SrcParamData%HNodesNorm) - UB(1:1) = ubound(SrcParamData%HNodesNorm) + LB(1:1) = lbound(SrcParamData%HNodesNorm, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%HNodesNorm, kind=B8Ki) if (.not. allocated(DstParamData%HNodesNorm)) then allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8012,8 +8012,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KTFA = SrcParamData%KTFA DstParamData%KTSS = SrcParamData%KTSS if (allocated(SrcParamData%MassT)) then - LB(1:1) = lbound(SrcParamData%MassT) - UB(1:1) = ubound(SrcParamData%MassT) + LB(1:1) = lbound(SrcParamData%MassT, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MassT, kind=B8Ki) if (.not. allocated(DstParamData%MassT)) then allocate(DstParamData%MassT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8024,8 +8024,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MassT = SrcParamData%MassT end if if (allocated(SrcParamData%StiffTSS)) then - LB(1:1) = lbound(SrcParamData%StiffTSS) - UB(1:1) = ubound(SrcParamData%StiffTSS) + LB(1:1) = lbound(SrcParamData%StiffTSS, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%StiffTSS, kind=B8Ki) if (.not. allocated(DstParamData%StiffTSS)) then allocate(DstParamData%StiffTSS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8036,8 +8036,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffTSS = SrcParamData%StiffTSS end if if (allocated(SrcParamData%TwrFASF)) then - LB(1:3) = lbound(SrcParamData%TwrFASF) - UB(1:3) = ubound(SrcParamData%TwrFASF) + LB(1:3) = lbound(SrcParamData%TwrFASF, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%TwrFASF, kind=B8Ki) if (.not. allocated(DstParamData%TwrFASF)) then allocate(DstParamData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8049,8 +8049,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%TwrFlexL = SrcParamData%TwrFlexL if (allocated(SrcParamData%TwrSSSF)) then - LB(1:3) = lbound(SrcParamData%TwrSSSF) - UB(1:3) = ubound(SrcParamData%TwrSSSF) + LB(1:3) = lbound(SrcParamData%TwrSSSF, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%TwrSSSF, kind=B8Ki) if (.not. allocated(DstParamData%TwrSSSF)) then allocate(DstParamData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8064,8 +8064,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TwrNodes = SrcParamData%TwrNodes DstParamData%MHK = SrcParamData%MHK if (allocated(SrcParamData%StiffTFA)) then - LB(1:1) = lbound(SrcParamData%StiffTFA) - UB(1:1) = ubound(SrcParamData%StiffTFA) + LB(1:1) = lbound(SrcParamData%StiffTFA, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%StiffTFA, kind=B8Ki) if (.not. allocated(DstParamData%StiffTFA)) then allocate(DstParamData%StiffTFA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8077,8 +8077,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%AtfaIner = SrcParamData%AtfaIner if (allocated(SrcParamData%BldCG)) then - LB(1:1) = lbound(SrcParamData%BldCG) - UB(1:1) = ubound(SrcParamData%BldCG) + LB(1:1) = lbound(SrcParamData%BldCG, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BldCG, kind=B8Ki) if (.not. allocated(DstParamData%BldCG)) then allocate(DstParamData%BldCG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8089,8 +8089,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldCG = SrcParamData%BldCG end if if (allocated(SrcParamData%BldMass)) then - LB(1:1) = lbound(SrcParamData%BldMass) - UB(1:1) = ubound(SrcParamData%BldMass) + LB(1:1) = lbound(SrcParamData%BldMass, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BldMass, kind=B8Ki) if (.not. allocated(DstParamData%BldMass)) then allocate(DstParamData%BldMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8102,8 +8102,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BoomMass = SrcParamData%BoomMass if (allocated(SrcParamData%FirstMom)) then - LB(1:1) = lbound(SrcParamData%FirstMom) - UB(1:1) = ubound(SrcParamData%FirstMom) + LB(1:1) = lbound(SrcParamData%FirstMom, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FirstMom, kind=B8Ki) if (.not. allocated(DstParamData%FirstMom)) then allocate(DstParamData%FirstMom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8128,8 +8128,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotMass = SrcParamData%RotMass DstParamData%RrfaIner = SrcParamData%RrfaIner if (allocated(SrcParamData%SecondMom)) then - LB(1:1) = lbound(SrcParamData%SecondMom) - UB(1:1) = ubound(SrcParamData%SecondMom) + LB(1:1) = lbound(SrcParamData%SecondMom, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%SecondMom, kind=B8Ki) if (.not. allocated(DstParamData%SecondMom)) then allocate(DstParamData%SecondMom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8142,8 +8142,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TFinMass = SrcParamData%TFinMass DstParamData%TFrlIner = SrcParamData%TFrlIner if (allocated(SrcParamData%TipMass)) then - LB(1:1) = lbound(SrcParamData%TipMass) - UB(1:1) = ubound(SrcParamData%TipMass) + LB(1:1) = lbound(SrcParamData%TipMass, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TipMass, kind=B8Ki) if (.not. allocated(DstParamData%TipMass)) then allocate(DstParamData%TipMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8159,8 +8159,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%YawBrMass = SrcParamData%YawBrMass DstParamData%Gravity = SrcParamData%Gravity if (allocated(SrcParamData%PitchAxis)) then - LB(1:2) = lbound(SrcParamData%PitchAxis) - UB(1:2) = ubound(SrcParamData%PitchAxis) + LB(1:2) = lbound(SrcParamData%PitchAxis, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PitchAxis, kind=B8Ki) if (.not. allocated(DstParamData%PitchAxis)) then allocate(DstParamData%PitchAxis(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8171,8 +8171,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PitchAxis = SrcParamData%PitchAxis end if if (allocated(SrcParamData%AeroTwst)) then - LB(1:1) = lbound(SrcParamData%AeroTwst) - UB(1:1) = ubound(SrcParamData%AeroTwst) + LB(1:1) = lbound(SrcParamData%AeroTwst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AeroTwst, kind=B8Ki) if (.not. allocated(DstParamData%AeroTwst)) then allocate(DstParamData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8183,8 +8183,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AeroTwst = SrcParamData%AeroTwst end if if (allocated(SrcParamData%AxRedBld)) then - LB(1:4) = lbound(SrcParamData%AxRedBld) - UB(1:4) = ubound(SrcParamData%AxRedBld) + LB(1:4) = lbound(SrcParamData%AxRedBld, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%AxRedBld, kind=B8Ki) if (.not. allocated(DstParamData%AxRedBld)) then allocate(DstParamData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8195,8 +8195,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AxRedBld = SrcParamData%AxRedBld end if if (allocated(SrcParamData%BldEDamp)) then - LB(1:2) = lbound(SrcParamData%BldEDamp) - UB(1:2) = ubound(SrcParamData%BldEDamp) + LB(1:2) = lbound(SrcParamData%BldEDamp, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BldEDamp, kind=B8Ki) if (.not. allocated(DstParamData%BldEDamp)) then allocate(DstParamData%BldEDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8207,8 +8207,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldEDamp = SrcParamData%BldEDamp end if if (allocated(SrcParamData%BldFDamp)) then - LB(1:2) = lbound(SrcParamData%BldFDamp) - UB(1:2) = ubound(SrcParamData%BldFDamp) + LB(1:2) = lbound(SrcParamData%BldFDamp, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BldFDamp, kind=B8Ki) if (.not. allocated(DstParamData%BldFDamp)) then allocate(DstParamData%BldFDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8220,8 +8220,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BldFlexL = SrcParamData%BldFlexL if (allocated(SrcParamData%CAeroTwst)) then - LB(1:1) = lbound(SrcParamData%CAeroTwst) - UB(1:1) = ubound(SrcParamData%CAeroTwst) + LB(1:1) = lbound(SrcParamData%CAeroTwst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%CAeroTwst, kind=B8Ki) if (.not. allocated(DstParamData%CAeroTwst)) then allocate(DstParamData%CAeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8232,8 +8232,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CAeroTwst = SrcParamData%CAeroTwst end if if (allocated(SrcParamData%CBE)) then - LB(1:3) = lbound(SrcParamData%CBE) - UB(1:3) = ubound(SrcParamData%CBE) + LB(1:3) = lbound(SrcParamData%CBE, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%CBE, kind=B8Ki) if (.not. allocated(DstParamData%CBE)) then allocate(DstParamData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8244,8 +8244,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBE = SrcParamData%CBE end if if (allocated(SrcParamData%CBF)) then - LB(1:3) = lbound(SrcParamData%CBF) - UB(1:3) = ubound(SrcParamData%CBF) + LB(1:3) = lbound(SrcParamData%CBF, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%CBF, kind=B8Ki) if (.not. allocated(DstParamData%CBF)) then allocate(DstParamData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8256,8 +8256,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBF = SrcParamData%CBF end if if (allocated(SrcParamData%Chord)) then - LB(1:1) = lbound(SrcParamData%Chord) - UB(1:1) = ubound(SrcParamData%Chord) + LB(1:1) = lbound(SrcParamData%Chord, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Chord, kind=B8Ki) if (.not. allocated(DstParamData%Chord)) then allocate(DstParamData%Chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8268,8 +8268,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Chord = SrcParamData%Chord end if if (allocated(SrcParamData%CThetaS)) then - LB(1:2) = lbound(SrcParamData%CThetaS) - UB(1:2) = ubound(SrcParamData%CThetaS) + LB(1:2) = lbound(SrcParamData%CThetaS, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CThetaS, kind=B8Ki) if (.not. allocated(DstParamData%CThetaS)) then allocate(DstParamData%CThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8280,8 +8280,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CThetaS = SrcParamData%CThetaS end if if (allocated(SrcParamData%DRNodes)) then - LB(1:1) = lbound(SrcParamData%DRNodes) - UB(1:1) = ubound(SrcParamData%DRNodes) + LB(1:1) = lbound(SrcParamData%DRNodes, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DRNodes, kind=B8Ki) if (.not. allocated(DstParamData%DRNodes)) then allocate(DstParamData%DRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8292,8 +8292,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DRNodes = SrcParamData%DRNodes end if if (allocated(SrcParamData%FStTunr)) then - LB(1:2) = lbound(SrcParamData%FStTunr) - UB(1:2) = ubound(SrcParamData%FStTunr) + LB(1:2) = lbound(SrcParamData%FStTunr, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%FStTunr, kind=B8Ki) if (.not. allocated(DstParamData%FStTunr)) then allocate(DstParamData%FStTunr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8304,8 +8304,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FStTunr = SrcParamData%FStTunr end if if (allocated(SrcParamData%KBE)) then - LB(1:3) = lbound(SrcParamData%KBE) - UB(1:3) = ubound(SrcParamData%KBE) + LB(1:3) = lbound(SrcParamData%KBE, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%KBE, kind=B8Ki) if (.not. allocated(DstParamData%KBE)) then allocate(DstParamData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8316,8 +8316,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBE = SrcParamData%KBE end if if (allocated(SrcParamData%KBF)) then - LB(1:3) = lbound(SrcParamData%KBF) - UB(1:3) = ubound(SrcParamData%KBF) + LB(1:3) = lbound(SrcParamData%KBF, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%KBF, kind=B8Ki) if (.not. allocated(DstParamData%KBF)) then allocate(DstParamData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8328,8 +8328,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBF = SrcParamData%KBF end if if (allocated(SrcParamData%MassB)) then - LB(1:2) = lbound(SrcParamData%MassB) - UB(1:2) = ubound(SrcParamData%MassB) + LB(1:2) = lbound(SrcParamData%MassB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MassB, kind=B8Ki) if (.not. allocated(DstParamData%MassB)) then allocate(DstParamData%MassB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8340,8 +8340,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MassB = SrcParamData%MassB end if if (allocated(SrcParamData%RNodes)) then - LB(1:1) = lbound(SrcParamData%RNodes) - UB(1:1) = ubound(SrcParamData%RNodes) + LB(1:1) = lbound(SrcParamData%RNodes, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%RNodes, kind=B8Ki) if (.not. allocated(DstParamData%RNodes)) then allocate(DstParamData%RNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8352,8 +8352,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RNodes = SrcParamData%RNodes end if if (allocated(SrcParamData%RNodesNorm)) then - LB(1:1) = lbound(SrcParamData%RNodesNorm) - UB(1:1) = ubound(SrcParamData%RNodesNorm) + LB(1:1) = lbound(SrcParamData%RNodesNorm, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%RNodesNorm, kind=B8Ki) if (.not. allocated(DstParamData%RNodesNorm)) then allocate(DstParamData%RNodesNorm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8364,8 +8364,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RNodesNorm = SrcParamData%RNodesNorm end if if (allocated(SrcParamData%rSAerCenn1)) then - LB(1:2) = lbound(SrcParamData%rSAerCenn1) - UB(1:2) = ubound(SrcParamData%rSAerCenn1) + LB(1:2) = lbound(SrcParamData%rSAerCenn1, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%rSAerCenn1, kind=B8Ki) if (.not. allocated(DstParamData%rSAerCenn1)) then allocate(DstParamData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8376,8 +8376,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 end if if (allocated(SrcParamData%rSAerCenn2)) then - LB(1:2) = lbound(SrcParamData%rSAerCenn2) - UB(1:2) = ubound(SrcParamData%rSAerCenn2) + LB(1:2) = lbound(SrcParamData%rSAerCenn2, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%rSAerCenn2, kind=B8Ki) if (.not. allocated(DstParamData%rSAerCenn2)) then allocate(DstParamData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8388,8 +8388,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 end if if (allocated(SrcParamData%SAeroTwst)) then - LB(1:1) = lbound(SrcParamData%SAeroTwst) - UB(1:1) = ubound(SrcParamData%SAeroTwst) + LB(1:1) = lbound(SrcParamData%SAeroTwst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%SAeroTwst, kind=B8Ki) if (.not. allocated(DstParamData%SAeroTwst)) then allocate(DstParamData%SAeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8400,8 +8400,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SAeroTwst = SrcParamData%SAeroTwst end if if (allocated(SrcParamData%StiffBE)) then - LB(1:2) = lbound(SrcParamData%StiffBE) - UB(1:2) = ubound(SrcParamData%StiffBE) + LB(1:2) = lbound(SrcParamData%StiffBE, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%StiffBE, kind=B8Ki) if (.not. allocated(DstParamData%StiffBE)) then allocate(DstParamData%StiffBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8412,8 +8412,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffBE = SrcParamData%StiffBE end if if (allocated(SrcParamData%StiffBF)) then - LB(1:2) = lbound(SrcParamData%StiffBF) - UB(1:2) = ubound(SrcParamData%StiffBF) + LB(1:2) = lbound(SrcParamData%StiffBF, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%StiffBF, kind=B8Ki) if (.not. allocated(DstParamData%StiffBF)) then allocate(DstParamData%StiffBF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8424,8 +8424,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffBF = SrcParamData%StiffBF end if if (allocated(SrcParamData%SThetaS)) then - LB(1:2) = lbound(SrcParamData%SThetaS) - UB(1:2) = ubound(SrcParamData%SThetaS) + LB(1:2) = lbound(SrcParamData%SThetaS, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%SThetaS, kind=B8Ki) if (.not. allocated(DstParamData%SThetaS)) then allocate(DstParamData%SThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8436,8 +8436,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SThetaS = SrcParamData%SThetaS end if if (allocated(SrcParamData%ThetaS)) then - LB(1:2) = lbound(SrcParamData%ThetaS) - UB(1:2) = ubound(SrcParamData%ThetaS) + LB(1:2) = lbound(SrcParamData%ThetaS, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%ThetaS, kind=B8Ki) if (.not. allocated(DstParamData%ThetaS)) then allocate(DstParamData%ThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8448,8 +8448,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ThetaS = SrcParamData%ThetaS end if if (allocated(SrcParamData%TwistedSF)) then - LB(1:5) = lbound(SrcParamData%TwistedSF) - UB(1:5) = ubound(SrcParamData%TwistedSF) + LB(1:5) = lbound(SrcParamData%TwistedSF, kind=B8Ki) + UB(1:5) = ubound(SrcParamData%TwistedSF, kind=B8Ki) if (.not. allocated(DstParamData%TwistedSF)) then allocate(DstParamData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8460,8 +8460,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TwistedSF = SrcParamData%TwistedSF end if if (allocated(SrcParamData%BldFl1Sh)) then - LB(1:2) = lbound(SrcParamData%BldFl1Sh) - UB(1:2) = ubound(SrcParamData%BldFl1Sh) + LB(1:2) = lbound(SrcParamData%BldFl1Sh, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BldFl1Sh, kind=B8Ki) if (.not. allocated(DstParamData%BldFl1Sh)) then allocate(DstParamData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8472,8 +8472,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh end if if (allocated(SrcParamData%BldFl2Sh)) then - LB(1:2) = lbound(SrcParamData%BldFl2Sh) - UB(1:2) = ubound(SrcParamData%BldFl2Sh) + LB(1:2) = lbound(SrcParamData%BldFl2Sh, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BldFl2Sh, kind=B8Ki) if (.not. allocated(DstParamData%BldFl2Sh)) then allocate(DstParamData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8484,8 +8484,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh end if if (allocated(SrcParamData%BldEdgSh)) then - LB(1:2) = lbound(SrcParamData%BldEdgSh) - UB(1:2) = ubound(SrcParamData%BldEdgSh) + LB(1:2) = lbound(SrcParamData%BldEdgSh, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BldEdgSh, kind=B8Ki) if (.not. allocated(DstParamData%BldEdgSh)) then allocate(DstParamData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8496,8 +8496,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldEdgSh = SrcParamData%BldEdgSh end if if (allocated(SrcParamData%FreqBE)) then - LB(1:3) = lbound(SrcParamData%FreqBE) - UB(1:3) = ubound(SrcParamData%FreqBE) + LB(1:3) = lbound(SrcParamData%FreqBE, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%FreqBE, kind=B8Ki) if (.not. allocated(DstParamData%FreqBE)) then allocate(DstParamData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8508,8 +8508,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FreqBE = SrcParamData%FreqBE end if if (allocated(SrcParamData%FreqBF)) then - LB(1:3) = lbound(SrcParamData%FreqBF) - UB(1:3) = ubound(SrcParamData%FreqBF) + LB(1:3) = lbound(SrcParamData%FreqBF, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%FreqBF, kind=B8Ki) if (.not. allocated(DstParamData%FreqBF)) then allocate(DstParamData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8562,8 +8562,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotSpeed = SrcParamData%RotSpeed DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%BElmntMass)) then - LB(1:2) = lbound(SrcParamData%BElmntMass) - UB(1:2) = ubound(SrcParamData%BElmntMass) + LB(1:2) = lbound(SrcParamData%BElmntMass, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BElmntMass, kind=B8Ki) if (.not. allocated(DstParamData%BElmntMass)) then allocate(DstParamData%BElmntMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8574,8 +8574,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BElmntMass = SrcParamData%BElmntMass end if if (allocated(SrcParamData%TElmntMass)) then - LB(1:1) = lbound(SrcParamData%TElmntMass) - UB(1:1) = ubound(SrcParamData%TElmntMass) + LB(1:1) = lbound(SrcParamData%TElmntMass, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TElmntMass, kind=B8Ki) if (.not. allocated(DstParamData%TElmntMass)) then allocate(DstParamData%TElmntMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8593,8 +8593,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts if (allocated(SrcParamData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcParamData%BldNd_OutParam) - UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + LB(1:1) = lbound(SrcParamData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam, kind=B8Ki) if (.not. allocated(DstParamData%BldNd_OutParam)) then allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8610,8 +8610,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8622,8 +8622,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8634,8 +8634,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8658,8 +8658,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) type(ED_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyParam' @@ -8680,8 +8680,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) call ED_DestroyActiveDOFs(ParamData%DOFs, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8836,8 +8836,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TElmntMass) end if if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam) - UB(1:1) = ubound(ParamData%BldNd_OutParam) + LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8859,8 +8859,8 @@ subroutine ED_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackParam' - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%DT24) @@ -8872,23 +8872,23 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%NPH) call RegPack(Buf, allocated(InData%PH)) if (allocated(InData%PH)) then - call RegPackBounds(Buf, 1, lbound(InData%PH), ubound(InData%PH)) + call RegPackBounds(Buf, 1, lbound(InData%PH, kind=B8Ki), ubound(InData%PH, kind=B8Ki)) call RegPack(Buf, InData%PH) end if call RegPack(Buf, InData%NPM) call RegPack(Buf, allocated(InData%PM)) if (allocated(InData%PM)) then - call RegPackBounds(Buf, 2, lbound(InData%PM), ubound(InData%PM)) + call RegPackBounds(Buf, 2, lbound(InData%PM, kind=B8Ki), ubound(InData%PM, kind=B8Ki)) call RegPack(Buf, InData%PM) end if call RegPack(Buf, allocated(InData%DOF_Flag)) if (allocated(InData%DOF_Flag)) then - call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag), ubound(InData%DOF_Flag)) + call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag, kind=B8Ki), ubound(InData%DOF_Flag, kind=B8Ki)) call RegPack(Buf, InData%DOF_Flag) end if call RegPack(Buf, allocated(InData%DOF_Desc)) if (allocated(InData%DOF_Desc)) then - call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc), ubound(InData%DOF_Desc)) + call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc, kind=B8Ki), ubound(InData%DOF_Desc, kind=B8Ki)) call RegPack(Buf, InData%DOF_Desc) end if call ED_PackActiveDOFs(Buf, InData%DOFs) @@ -8898,9 +8898,9 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%NTwGages) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -8911,7 +8911,7 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%CosDel3) call RegPack(Buf, allocated(InData%CosPreC)) if (allocated(InData%CosPreC)) then - call RegPackBounds(Buf, 1, lbound(InData%CosPreC), ubound(InData%CosPreC)) + call RegPackBounds(Buf, 1, lbound(InData%CosPreC, kind=B8Ki), ubound(InData%CosPreC, kind=B8Ki)) call RegPack(Buf, InData%CosPreC) end if call RegPack(Buf, InData%CRFrlSkew) @@ -8959,7 +8959,7 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%SinDel3) call RegPack(Buf, allocated(InData%SinPreC)) if (allocated(InData%SinPreC)) then - call RegPackBounds(Buf, 1, lbound(InData%SinPreC), ubound(InData%SinPreC)) + call RegPackBounds(Buf, 1, lbound(InData%SinPreC, kind=B8Ki), ubound(InData%SinPreC, kind=B8Ki)) call RegPack(Buf, InData%SinPreC) end if call RegPack(Buf, InData%SRFrlSkew) @@ -8980,52 +8980,52 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%NumBl) call RegPack(Buf, allocated(InData%AxRedTFA)) if (allocated(InData%AxRedTFA)) then - call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA), ubound(InData%AxRedTFA)) + call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA, kind=B8Ki), ubound(InData%AxRedTFA, kind=B8Ki)) call RegPack(Buf, InData%AxRedTFA) end if call RegPack(Buf, allocated(InData%AxRedTSS)) if (allocated(InData%AxRedTSS)) then - call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS), ubound(InData%AxRedTSS)) + call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS, kind=B8Ki), ubound(InData%AxRedTSS, kind=B8Ki)) call RegPack(Buf, InData%AxRedTSS) end if call RegPack(Buf, InData%CTFA) call RegPack(Buf, InData%CTSS) call RegPack(Buf, allocated(InData%DHNodes)) if (allocated(InData%DHNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%DHNodes), ubound(InData%DHNodes)) + call RegPackBounds(Buf, 1, lbound(InData%DHNodes, kind=B8Ki), ubound(InData%DHNodes, kind=B8Ki)) call RegPack(Buf, InData%DHNodes) end if call RegPack(Buf, allocated(InData%HNodes)) if (allocated(InData%HNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%HNodes), ubound(InData%HNodes)) + call RegPackBounds(Buf, 1, lbound(InData%HNodes, kind=B8Ki), ubound(InData%HNodes, kind=B8Ki)) call RegPack(Buf, InData%HNodes) end if call RegPack(Buf, allocated(InData%HNodesNorm)) if (allocated(InData%HNodesNorm)) then - call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm), ubound(InData%HNodesNorm)) + call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm, kind=B8Ki), ubound(InData%HNodesNorm, kind=B8Ki)) call RegPack(Buf, InData%HNodesNorm) end if call RegPack(Buf, InData%KTFA) call RegPack(Buf, InData%KTSS) call RegPack(Buf, allocated(InData%MassT)) if (allocated(InData%MassT)) then - call RegPackBounds(Buf, 1, lbound(InData%MassT), ubound(InData%MassT)) + call RegPackBounds(Buf, 1, lbound(InData%MassT, kind=B8Ki), ubound(InData%MassT, kind=B8Ki)) call RegPack(Buf, InData%MassT) end if call RegPack(Buf, allocated(InData%StiffTSS)) if (allocated(InData%StiffTSS)) then - call RegPackBounds(Buf, 1, lbound(InData%StiffTSS), ubound(InData%StiffTSS)) + call RegPackBounds(Buf, 1, lbound(InData%StiffTSS, kind=B8Ki), ubound(InData%StiffTSS, kind=B8Ki)) call RegPack(Buf, InData%StiffTSS) end if call RegPack(Buf, allocated(InData%TwrFASF)) if (allocated(InData%TwrFASF)) then - call RegPackBounds(Buf, 3, lbound(InData%TwrFASF), ubound(InData%TwrFASF)) + call RegPackBounds(Buf, 3, lbound(InData%TwrFASF, kind=B8Ki), ubound(InData%TwrFASF, kind=B8Ki)) call RegPack(Buf, InData%TwrFASF) end if call RegPack(Buf, InData%TwrFlexL) call RegPack(Buf, allocated(InData%TwrSSSF)) if (allocated(InData%TwrSSSF)) then - call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF), ubound(InData%TwrSSSF)) + call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF, kind=B8Ki), ubound(InData%TwrSSSF, kind=B8Ki)) call RegPack(Buf, InData%TwrSSSF) end if call RegPack(Buf, InData%TTopNode) @@ -9033,24 +9033,24 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%MHK) call RegPack(Buf, allocated(InData%StiffTFA)) if (allocated(InData%StiffTFA)) then - call RegPackBounds(Buf, 1, lbound(InData%StiffTFA), ubound(InData%StiffTFA)) + call RegPackBounds(Buf, 1, lbound(InData%StiffTFA, kind=B8Ki), ubound(InData%StiffTFA, kind=B8Ki)) call RegPack(Buf, InData%StiffTFA) end if call RegPack(Buf, InData%AtfaIner) call RegPack(Buf, allocated(InData%BldCG)) if (allocated(InData%BldCG)) then - call RegPackBounds(Buf, 1, lbound(InData%BldCG), ubound(InData%BldCG)) + call RegPackBounds(Buf, 1, lbound(InData%BldCG, kind=B8Ki), ubound(InData%BldCG, kind=B8Ki)) call RegPack(Buf, InData%BldCG) end if call RegPack(Buf, allocated(InData%BldMass)) if (allocated(InData%BldMass)) then - call RegPackBounds(Buf, 1, lbound(InData%BldMass), ubound(InData%BldMass)) + call RegPackBounds(Buf, 1, lbound(InData%BldMass, kind=B8Ki), ubound(InData%BldMass, kind=B8Ki)) call RegPack(Buf, InData%BldMass) end if call RegPack(Buf, InData%BoomMass) call RegPack(Buf, allocated(InData%FirstMom)) if (allocated(InData%FirstMom)) then - call RegPackBounds(Buf, 1, lbound(InData%FirstMom), ubound(InData%FirstMom)) + call RegPackBounds(Buf, 1, lbound(InData%FirstMom, kind=B8Ki), ubound(InData%FirstMom, kind=B8Ki)) call RegPack(Buf, InData%FirstMom) end if call RegPack(Buf, InData%GenIner) @@ -9069,14 +9069,14 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%RrfaIner) call RegPack(Buf, allocated(InData%SecondMom)) if (allocated(InData%SecondMom)) then - call RegPackBounds(Buf, 1, lbound(InData%SecondMom), ubound(InData%SecondMom)) + call RegPackBounds(Buf, 1, lbound(InData%SecondMom, kind=B8Ki), ubound(InData%SecondMom, kind=B8Ki)) call RegPack(Buf, InData%SecondMom) end if call RegPack(Buf, InData%TFinMass) call RegPack(Buf, InData%TFrlIner) call RegPack(Buf, allocated(InData%TipMass)) if (allocated(InData%TipMass)) then - call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) + call RegPackBounds(Buf, 1, lbound(InData%TipMass, kind=B8Ki), ubound(InData%TipMass, kind=B8Ki)) call RegPack(Buf, InData%TipMass) end if call RegPack(Buf, InData%TurbMass) @@ -9086,153 +9086,153 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, allocated(InData%PitchAxis)) if (allocated(InData%PitchAxis)) then - call RegPackBounds(Buf, 2, lbound(InData%PitchAxis), ubound(InData%PitchAxis)) + call RegPackBounds(Buf, 2, lbound(InData%PitchAxis, kind=B8Ki), ubound(InData%PitchAxis, kind=B8Ki)) call RegPack(Buf, InData%PitchAxis) end if call RegPack(Buf, allocated(InData%AeroTwst)) if (allocated(InData%AeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) + call RegPackBounds(Buf, 1, lbound(InData%AeroTwst, kind=B8Ki), ubound(InData%AeroTwst, kind=B8Ki)) call RegPack(Buf, InData%AeroTwst) end if call RegPack(Buf, allocated(InData%AxRedBld)) if (allocated(InData%AxRedBld)) then - call RegPackBounds(Buf, 4, lbound(InData%AxRedBld), ubound(InData%AxRedBld)) + call RegPackBounds(Buf, 4, lbound(InData%AxRedBld, kind=B8Ki), ubound(InData%AxRedBld, kind=B8Ki)) call RegPack(Buf, InData%AxRedBld) end if call RegPack(Buf, allocated(InData%BldEDamp)) if (allocated(InData%BldEDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%BldEDamp), ubound(InData%BldEDamp)) + call RegPackBounds(Buf, 2, lbound(InData%BldEDamp, kind=B8Ki), ubound(InData%BldEDamp, kind=B8Ki)) call RegPack(Buf, InData%BldEDamp) end if call RegPack(Buf, allocated(InData%BldFDamp)) if (allocated(InData%BldFDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%BldFDamp), ubound(InData%BldFDamp)) + call RegPackBounds(Buf, 2, lbound(InData%BldFDamp, kind=B8Ki), ubound(InData%BldFDamp, kind=B8Ki)) call RegPack(Buf, InData%BldFDamp) end if call RegPack(Buf, InData%BldFlexL) call RegPack(Buf, allocated(InData%CAeroTwst)) if (allocated(InData%CAeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst), ubound(InData%CAeroTwst)) + call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst, kind=B8Ki), ubound(InData%CAeroTwst, kind=B8Ki)) call RegPack(Buf, InData%CAeroTwst) end if call RegPack(Buf, allocated(InData%CBE)) if (allocated(InData%CBE)) then - call RegPackBounds(Buf, 3, lbound(InData%CBE), ubound(InData%CBE)) + call RegPackBounds(Buf, 3, lbound(InData%CBE, kind=B8Ki), ubound(InData%CBE, kind=B8Ki)) call RegPack(Buf, InData%CBE) end if call RegPack(Buf, allocated(InData%CBF)) if (allocated(InData%CBF)) then - call RegPackBounds(Buf, 3, lbound(InData%CBF), ubound(InData%CBF)) + call RegPackBounds(Buf, 3, lbound(InData%CBF, kind=B8Ki), ubound(InData%CBF, kind=B8Ki)) call RegPack(Buf, InData%CBF) end if call RegPack(Buf, allocated(InData%Chord)) if (allocated(InData%Chord)) then - call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) + call RegPackBounds(Buf, 1, lbound(InData%Chord, kind=B8Ki), ubound(InData%Chord, kind=B8Ki)) call RegPack(Buf, InData%Chord) end if call RegPack(Buf, allocated(InData%CThetaS)) if (allocated(InData%CThetaS)) then - call RegPackBounds(Buf, 2, lbound(InData%CThetaS), ubound(InData%CThetaS)) + call RegPackBounds(Buf, 2, lbound(InData%CThetaS, kind=B8Ki), ubound(InData%CThetaS, kind=B8Ki)) call RegPack(Buf, InData%CThetaS) end if call RegPack(Buf, allocated(InData%DRNodes)) if (allocated(InData%DRNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%DRNodes), ubound(InData%DRNodes)) + call RegPackBounds(Buf, 1, lbound(InData%DRNodes, kind=B8Ki), ubound(InData%DRNodes, kind=B8Ki)) call RegPack(Buf, InData%DRNodes) end if call RegPack(Buf, allocated(InData%FStTunr)) if (allocated(InData%FStTunr)) then - call RegPackBounds(Buf, 2, lbound(InData%FStTunr), ubound(InData%FStTunr)) + call RegPackBounds(Buf, 2, lbound(InData%FStTunr, kind=B8Ki), ubound(InData%FStTunr, kind=B8Ki)) call RegPack(Buf, InData%FStTunr) end if call RegPack(Buf, allocated(InData%KBE)) if (allocated(InData%KBE)) then - call RegPackBounds(Buf, 3, lbound(InData%KBE), ubound(InData%KBE)) + call RegPackBounds(Buf, 3, lbound(InData%KBE, kind=B8Ki), ubound(InData%KBE, kind=B8Ki)) call RegPack(Buf, InData%KBE) end if call RegPack(Buf, allocated(InData%KBF)) if (allocated(InData%KBF)) then - call RegPackBounds(Buf, 3, lbound(InData%KBF), ubound(InData%KBF)) + call RegPackBounds(Buf, 3, lbound(InData%KBF, kind=B8Ki), ubound(InData%KBF, kind=B8Ki)) call RegPack(Buf, InData%KBF) end if call RegPack(Buf, allocated(InData%MassB)) if (allocated(InData%MassB)) then - call RegPackBounds(Buf, 2, lbound(InData%MassB), ubound(InData%MassB)) + call RegPackBounds(Buf, 2, lbound(InData%MassB, kind=B8Ki), ubound(InData%MassB, kind=B8Ki)) call RegPack(Buf, InData%MassB) end if call RegPack(Buf, allocated(InData%RNodes)) if (allocated(InData%RNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) + call RegPackBounds(Buf, 1, lbound(InData%RNodes, kind=B8Ki), ubound(InData%RNodes, kind=B8Ki)) call RegPack(Buf, InData%RNodes) end if call RegPack(Buf, allocated(InData%RNodesNorm)) if (allocated(InData%RNodesNorm)) then - call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm), ubound(InData%RNodesNorm)) + call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm, kind=B8Ki), ubound(InData%RNodesNorm, kind=B8Ki)) call RegPack(Buf, InData%RNodesNorm) end if call RegPack(Buf, allocated(InData%rSAerCenn1)) if (allocated(InData%rSAerCenn1)) then - call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1), ubound(InData%rSAerCenn1)) + call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1, kind=B8Ki), ubound(InData%rSAerCenn1, kind=B8Ki)) call RegPack(Buf, InData%rSAerCenn1) end if call RegPack(Buf, allocated(InData%rSAerCenn2)) if (allocated(InData%rSAerCenn2)) then - call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2), ubound(InData%rSAerCenn2)) + call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2, kind=B8Ki), ubound(InData%rSAerCenn2, kind=B8Ki)) call RegPack(Buf, InData%rSAerCenn2) end if call RegPack(Buf, allocated(InData%SAeroTwst)) if (allocated(InData%SAeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst), ubound(InData%SAeroTwst)) + call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst, kind=B8Ki), ubound(InData%SAeroTwst, kind=B8Ki)) call RegPack(Buf, InData%SAeroTwst) end if call RegPack(Buf, allocated(InData%StiffBE)) if (allocated(InData%StiffBE)) then - call RegPackBounds(Buf, 2, lbound(InData%StiffBE), ubound(InData%StiffBE)) + call RegPackBounds(Buf, 2, lbound(InData%StiffBE, kind=B8Ki), ubound(InData%StiffBE, kind=B8Ki)) call RegPack(Buf, InData%StiffBE) end if call RegPack(Buf, allocated(InData%StiffBF)) if (allocated(InData%StiffBF)) then - call RegPackBounds(Buf, 2, lbound(InData%StiffBF), ubound(InData%StiffBF)) + call RegPackBounds(Buf, 2, lbound(InData%StiffBF, kind=B8Ki), ubound(InData%StiffBF, kind=B8Ki)) call RegPack(Buf, InData%StiffBF) end if call RegPack(Buf, allocated(InData%SThetaS)) if (allocated(InData%SThetaS)) then - call RegPackBounds(Buf, 2, lbound(InData%SThetaS), ubound(InData%SThetaS)) + call RegPackBounds(Buf, 2, lbound(InData%SThetaS, kind=B8Ki), ubound(InData%SThetaS, kind=B8Ki)) call RegPack(Buf, InData%SThetaS) end if call RegPack(Buf, allocated(InData%ThetaS)) if (allocated(InData%ThetaS)) then - call RegPackBounds(Buf, 2, lbound(InData%ThetaS), ubound(InData%ThetaS)) + call RegPackBounds(Buf, 2, lbound(InData%ThetaS, kind=B8Ki), ubound(InData%ThetaS, kind=B8Ki)) call RegPack(Buf, InData%ThetaS) end if call RegPack(Buf, allocated(InData%TwistedSF)) if (allocated(InData%TwistedSF)) then - call RegPackBounds(Buf, 5, lbound(InData%TwistedSF), ubound(InData%TwistedSF)) + call RegPackBounds(Buf, 5, lbound(InData%TwistedSF, kind=B8Ki), ubound(InData%TwistedSF, kind=B8Ki)) call RegPack(Buf, InData%TwistedSF) end if call RegPack(Buf, allocated(InData%BldFl1Sh)) if (allocated(InData%BldFl1Sh)) then - call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) + call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh, kind=B8Ki), ubound(InData%BldFl1Sh, kind=B8Ki)) call RegPack(Buf, InData%BldFl1Sh) end if call RegPack(Buf, allocated(InData%BldFl2Sh)) if (allocated(InData%BldFl2Sh)) then - call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) + call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh, kind=B8Ki), ubound(InData%BldFl2Sh, kind=B8Ki)) call RegPack(Buf, InData%BldFl2Sh) end if call RegPack(Buf, allocated(InData%BldEdgSh)) if (allocated(InData%BldEdgSh)) then - call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) + call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh, kind=B8Ki), ubound(InData%BldEdgSh, kind=B8Ki)) call RegPack(Buf, InData%BldEdgSh) end if call RegPack(Buf, allocated(InData%FreqBE)) if (allocated(InData%FreqBE)) then - call RegPackBounds(Buf, 3, lbound(InData%FreqBE), ubound(InData%FreqBE)) + call RegPackBounds(Buf, 3, lbound(InData%FreqBE, kind=B8Ki), ubound(InData%FreqBE, kind=B8Ki)) call RegPack(Buf, InData%FreqBE) end if call RegPack(Buf, allocated(InData%FreqBF)) if (allocated(InData%FreqBF)) then - call RegPackBounds(Buf, 3, lbound(InData%FreqBF), ubound(InData%FreqBF)) + call RegPackBounds(Buf, 3, lbound(InData%FreqBF, kind=B8Ki), ubound(InData%FreqBF, kind=B8Ki)) call RegPack(Buf, InData%FreqBF) end if call RegPack(Buf, InData%FreqTFA) @@ -9279,12 +9279,12 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%BElmntMass)) if (allocated(InData%BElmntMass)) then - call RegPackBounds(Buf, 2, lbound(InData%BElmntMass), ubound(InData%BElmntMass)) + call RegPackBounds(Buf, 2, lbound(InData%BElmntMass, kind=B8Ki), ubound(InData%BElmntMass, kind=B8Ki)) call RegPack(Buf, InData%BElmntMass) end if call RegPack(Buf, allocated(InData%TElmntMass)) if (allocated(InData%TElmntMass)) then - call RegPackBounds(Buf, 1, lbound(InData%TElmntMass), ubound(InData%TElmntMass)) + call RegPackBounds(Buf, 1, lbound(InData%TElmntMass, kind=B8Ki), ubound(InData%TElmntMass, kind=B8Ki)) call RegPack(Buf, InData%TElmntMass) end if call RegPack(Buf, InData%method) @@ -9296,9 +9296,9 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%BldNd_TotNumOuts) call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) - LB(1:1) = lbound(InData%BldNd_OutParam) - UB(1:1) = ubound(InData%BldNd_OutParam) + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) end do @@ -9306,17 +9306,17 @@ subroutine ED_PackParam(Buf, Indata) call RegPack(Buf, InData%BldNd_BladesOut) call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) call RegPack(Buf, InData%dx) end if call RegPack(Buf, InData%Jac_ny) @@ -9333,8 +9333,8 @@ subroutine ED_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackParam' - integer(IntKi) :: i1, i2, i3, i4, i5 - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -10491,16 +10491,16 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%BladePtLoads)) then - LB(1:1) = lbound(SrcInputData%BladePtLoads) - UB(1:1) = ubound(SrcInputData%BladePtLoads) + LB(1:1) = lbound(SrcInputData%BladePtLoads, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%BladePtLoads, kind=B8Ki) if (.not. allocated(DstInputData%BladePtLoads)) then allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10530,8 +10530,8 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%TwrAddedMass)) then - LB(1:3) = lbound(SrcInputData%TwrAddedMass) - UB(1:3) = ubound(SrcInputData%TwrAddedMass) + LB(1:3) = lbound(SrcInputData%TwrAddedMass, kind=B8Ki) + UB(1:3) = ubound(SrcInputData%TwrAddedMass, kind=B8Ki) if (.not. allocated(DstInputData%TwrAddedMass)) then allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10543,8 +10543,8 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass if (allocated(SrcInputData%BlPitchCom)) then - LB(1:1) = lbound(SrcInputData%BlPitchCom) - UB(1:1) = ubound(SrcInputData%BlPitchCom) + LB(1:1) = lbound(SrcInputData%BlPitchCom, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%BlPitchCom, kind=B8Ki) if (.not. allocated(DstInputData%BlPitchCom)) then allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10563,16 +10563,16 @@ subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) type(ED_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%BladePtLoads)) then - LB(1:1) = lbound(InputData%BladePtLoads) - UB(1:1) = ubound(InputData%BladePtLoads) + LB(1:1) = lbound(InputData%BladePtLoads, kind=B8Ki) + UB(1:1) = ubound(InputData%BladePtLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10601,14 +10601,14 @@ subroutine ED_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInput' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%BladePtLoads)) if (allocated(InData%BladePtLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) - LB(1:1) = lbound(InData%BladePtLoads) - UB(1:1) = ubound(InData%BladePtLoads) + call RegPackBounds(Buf, 1, lbound(InData%BladePtLoads, kind=B8Ki), ubound(InData%BladePtLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%BladePtLoads, kind=B8Ki) + UB(1:1) = ubound(InData%BladePtLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladePtLoads(i1)) end do @@ -10620,13 +10620,13 @@ subroutine ED_PackInput(Buf, Indata) call MeshPack(Buf, InData%TFinCMLoads) call RegPack(Buf, allocated(InData%TwrAddedMass)) if (allocated(InData%TwrAddedMass)) then - call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass), ubound(InData%TwrAddedMass)) + call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass, kind=B8Ki), ubound(InData%TwrAddedMass, kind=B8Ki)) call RegPack(Buf, InData%TwrAddedMass) end if call RegPack(Buf, InData%PtfmAddedMass) call RegPack(Buf, allocated(InData%BlPitchCom)) if (allocated(InData%BlPitchCom)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom, kind=B8Ki), ubound(InData%BlPitchCom, kind=B8Ki)) call RegPack(Buf, InData%BlPitchCom) end if call RegPack(Buf, InData%YawMom) @@ -10639,8 +10639,8 @@ subroutine ED_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInput' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -10708,16 +10708,16 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%BladeLn2Mesh)) then - LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) - UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh, kind=B8Ki) if (.not. allocated(DstOutputData%BladeLn2Mesh)) then allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10747,8 +10747,8 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcOutputData%BladeRootMotion) - UB(1:1) = ubound(SrcOutputData%BladeRootMotion) + LB(1:1) = lbound(SrcOutputData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion, kind=B8Ki) if (.not. allocated(DstOutputData%BladeRootMotion)) then allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10775,8 +10775,8 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10787,8 +10787,8 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%BlPitch)) then - LB(1:1) = lbound(SrcOutputData%BlPitch) - UB(1:1) = ubound(SrcOutputData%BlPitch) + LB(1:1) = lbound(SrcOutputData%BlPitch, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BlPitch, kind=B8Ki) if (.not. allocated(DstOutputData%BlPitch)) then allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10830,16 +10830,16 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) type(ED_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%BladeLn2Mesh)) then - LB(1:1) = lbound(OutputData%BladeLn2Mesh) - UB(1:1) = ubound(OutputData%BladeLn2Mesh) + LB(1:1) = lbound(OutputData%BladeLn2Mesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%BladeLn2Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10857,8 +10857,8 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) call MeshDestroy( OutputData%BladeRootMotion14, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%BladeRootMotion)) then - LB(1:1) = lbound(OutputData%BladeRootMotion) - UB(1:1) = ubound(OutputData%BladeRootMotion) + LB(1:1) = lbound(OutputData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(OutputData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10885,14 +10885,14 @@ subroutine ED_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) - LB(1:1) = lbound(InData%BladeLn2Mesh) - UB(1:1) = ubound(InData%BladeLn2Mesh) + call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) + UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeLn2Mesh(i1)) end do @@ -10904,9 +10904,9 @@ subroutine ED_PackOutput(Buf, Indata) call MeshPack(Buf, InData%BladeRootMotion14) call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) - LB(1:1) = lbound(InData%BladeRootMotion) - UB(1:1) = ubound(InData%BladeRootMotion) + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) + UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BladeRootMotion(i1)) end do @@ -10917,12 +10917,12 @@ subroutine ED_PackOutput(Buf, Indata) call MeshPack(Buf, InData%TFinCMMotion) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) call RegPack(Buf, InData%BlPitch) end if call RegPack(Buf, InData%Yaw) @@ -10958,8 +10958,8 @@ subroutine ED_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ED_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -11186,7 +11186,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + DO i1 = LBOUND(u_out%BladePtLoads,1, kind=B8Ki),UBOUND(u_out%BladePtLoads,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -11206,7 +11206,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END IF ! check if allocated u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -11275,7 +11275,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + DO i1 = LBOUND(u_out%BladePtLoads,1, kind=B8Ki),UBOUND(u_out%BladePtLoads,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -11295,7 +11295,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END IF ! check if allocated u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + a3*u3%PtfmAddedMass IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) 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 @@ -11402,7 +11402,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + DO i1 = LBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki),UBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -11418,7 +11418,7 @@ 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 i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -11435,7 +11435,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -11523,7 +11523,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + DO i1 = LBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki),UBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -11539,7 +11539,7 @@ 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 i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -11556,7 +11556,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) 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 diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index f7714f8fa7..64783b1eb5 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -212,7 +212,7 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInitInput' ErrStat = ErrID_None @@ -222,8 +222,8 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower if (associated(SrcInitInputData%StructBldRNodes)) then - LB(1:1) = lbound(SrcInitInputData%StructBldRNodes) - UB(1:1) = ubound(SrcInitInputData%StructBldRNodes) + LB(1:1) = lbound(SrcInitInputData%StructBldRNodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%StructBldRNodes, kind=B8Ki) if (.not. associated(DstInitInputData%StructBldRNodes)) then allocate(DstInitInputData%StructBldRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -237,8 +237,8 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes end if if (associated(SrcInitInputData%StructTwrHNodes)) then - LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) - UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes) + LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes, kind=B8Ki) if (.not. associated(DstInitInputData%StructTwrHNodes)) then allocate(DstInitInputData%StructTwrHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -296,7 +296,7 @@ subroutine ExtInfw_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NumActForcePtsTower) call RegPack(Buf, associated(InData%StructBldRNodes)) if (associated(InData%StructBldRNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes), ubound(InData%StructBldRNodes)) + call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes, kind=B8Ki), ubound(InData%StructBldRNodes, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%StructBldRNodes), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%StructBldRNodes) @@ -304,7 +304,7 @@ subroutine ExtInfw_PackInitInput(Buf, Indata) end if call RegPack(Buf, associated(InData%StructTwrHNodes)) if (associated(InData%StructTwrHNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes), ubound(InData%StructTwrHNodes)) + call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes, kind=B8Ki), ubound(InData%StructTwrHNodes, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%StructTwrHNodes), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%StructTwrHNodes) @@ -321,10 +321,10 @@ subroutine ExtInfw_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%NumActForcePtsBlade) @@ -466,7 +466,7 @@ SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointe ELSE InitInputData%C_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) IF (InitInputData%C_obj%StructBldRNodes_Len > 0) & - InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(LBOUND(InitInputData%StructBldRNodes,1))) + InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(LBOUND(InitInputData%StructBldRNodes,1, kind=B8Ki))) END IF END IF @@ -478,7 +478,7 @@ SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointe ELSE InitInputData%C_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) IF (InitInputData%C_obj%StructTwrHNodes_Len > 0) & - InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(LBOUND(InitInputData%StructTwrHNodes,1))) + InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(LBOUND(InitInputData%StructTwrHNodes,1, kind=B8Ki))) END IF END IF InitInputData%C_obj%BladeLength = InitInputData%BladeLength @@ -493,15 +493,15 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -512,8 +512,8 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -561,12 +561,12 @@ subroutine ExtInfw_PackInitOutput(Buf, Indata) end if call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) @@ -584,10 +584,10 @@ subroutine ExtInfw_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) @@ -681,16 +681,16 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%ActForceMotionsPoints)) then - LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) - UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) + LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) if (.not. allocated(DstMiscData%ActForceMotionsPoints)) then allocate(DstMiscData%ActForceMotionsPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -705,8 +705,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%ActForceLoadsPoints)) then - LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) - UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints) + LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints, kind=B8Ki) if (.not. allocated(DstMiscData%ActForceLoadsPoints)) then allocate(DstMiscData%ActForceLoadsPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -721,8 +721,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Line2_to_Point_Loads)) then - LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) - UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads) + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads, kind=B8Ki) if (.not. allocated(DstMiscData%Line2_to_Point_Loads)) then allocate(DstMiscData%Line2_to_Point_Loads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -737,8 +737,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Line2_to_Point_Motions)) then - LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) - UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions) + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions, kind=B8Ki) if (.not. allocated(DstMiscData%Line2_to_Point_Motions)) then allocate(DstMiscData%Line2_to_Point_Motions(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -770,16 +770,16 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ExtInfw_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%ActForceMotionsPoints)) then - LB(1:1) = lbound(MiscData%ActForceMotionsPoints) - UB(1:1) = ubound(MiscData%ActForceMotionsPoints) + LB(1:1) = lbound(MiscData%ActForceMotionsPoints, kind=B8Ki) + UB(1:1) = ubound(MiscData%ActForceMotionsPoints, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -787,8 +787,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ActForceMotionsPoints) end if if (allocated(MiscData%ActForceLoadsPoints)) then - LB(1:1) = lbound(MiscData%ActForceLoadsPoints) - UB(1:1) = ubound(MiscData%ActForceLoadsPoints) + LB(1:1) = lbound(MiscData%ActForceLoadsPoints, kind=B8Ki) + UB(1:1) = ubound(MiscData%ActForceLoadsPoints, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -796,8 +796,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ActForceLoadsPoints) end if if (allocated(MiscData%Line2_to_Point_Loads)) then - LB(1:1) = lbound(MiscData%Line2_to_Point_Loads) - UB(1:1) = ubound(MiscData%Line2_to_Point_Loads) + LB(1:1) = lbound(MiscData%Line2_to_Point_Loads, kind=B8Ki) + UB(1:1) = ubound(MiscData%Line2_to_Point_Loads, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -805,8 +805,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Line2_to_Point_Loads) end if if (allocated(MiscData%Line2_to_Point_Motions)) then - LB(1:1) = lbound(MiscData%Line2_to_Point_Motions) - UB(1:1) = ubound(MiscData%Line2_to_Point_Motions) + LB(1:1) = lbound(MiscData%Line2_to_Point_Motions, kind=B8Ki) + UB(1:1) = ubound(MiscData%Line2_to_Point_Motions, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -825,8 +825,8 @@ subroutine ExtInfw_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then @@ -835,36 +835,36 @@ subroutine ExtInfw_PackMisc(Buf, Indata) end if call RegPack(Buf, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then - call RegPackBounds(Buf, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) - LB(1:1) = lbound(InData%ActForceMotionsPoints) - UB(1:1) = ubound(InData%ActForceMotionsPoints) + call RegPackBounds(Buf, 1, lbound(InData%ActForceMotionsPoints, kind=B8Ki), ubound(InData%ActForceMotionsPoints, kind=B8Ki)) + LB(1:1) = lbound(InData%ActForceMotionsPoints, kind=B8Ki) + UB(1:1) = ubound(InData%ActForceMotionsPoints, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%ActForceMotionsPoints(i1)) end do end if call RegPack(Buf, allocated(InData%ActForceLoadsPoints)) if (allocated(InData%ActForceLoadsPoints)) then - call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) - LB(1:1) = lbound(InData%ActForceLoadsPoints) - UB(1:1) = ubound(InData%ActForceLoadsPoints) + call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints, kind=B8Ki), ubound(InData%ActForceLoadsPoints, kind=B8Ki)) + LB(1:1) = lbound(InData%ActForceLoadsPoints, kind=B8Ki) + UB(1:1) = ubound(InData%ActForceLoadsPoints, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%ActForceLoadsPoints(i1)) end do end if call RegPack(Buf, allocated(InData%Line2_to_Point_Loads)) if (allocated(InData%Line2_to_Point_Loads)) then - call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) - LB(1:1) = lbound(InData%Line2_to_Point_Loads) - UB(1:1) = ubound(InData%Line2_to_Point_Loads) + call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads, kind=B8Ki), ubound(InData%Line2_to_Point_Loads, kind=B8Ki)) + LB(1:1) = lbound(InData%Line2_to_Point_Loads, kind=B8Ki) + UB(1:1) = ubound(InData%Line2_to_Point_Loads, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Loads(i1)) end do end if call RegPack(Buf, allocated(InData%Line2_to_Point_Motions)) if (allocated(InData%Line2_to_Point_Motions)) then - call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) - LB(1:1) = lbound(InData%Line2_to_Point_Motions) - UB(1:1) = ubound(InData%Line2_to_Point_Motions) + call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions, kind=B8Ki), ubound(InData%Line2_to_Point_Motions, kind=B8Ki)) + LB(1:1) = lbound(InData%Line2_to_Point_Motions, kind=B8Ki) + UB(1:1) = ubound(InData%Line2_to_Point_Motions, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Motions(i1)) end do @@ -883,11 +883,11 @@ subroutine ExtInfw_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) @@ -1012,7 +1012,7 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyParam' ErrStat = ErrID_None @@ -1032,8 +1032,8 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower if (associated(SrcParamData%forceBldRnodes)) then - LB(1:1) = lbound(SrcParamData%forceBldRnodes) - UB(1:1) = ubound(SrcParamData%forceBldRnodes) + LB(1:1) = lbound(SrcParamData%forceBldRnodes, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%forceBldRnodes, kind=B8Ki) if (.not. associated(DstParamData%forceBldRnodes)) then allocate(DstParamData%forceBldRnodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1047,8 +1047,8 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes end if if (associated(SrcParamData%forceTwrHnodes)) then - LB(1:1) = lbound(SrcParamData%forceTwrHnodes) - UB(1:1) = ubound(SrcParamData%forceTwrHnodes) + LB(1:1) = lbound(SrcParamData%forceTwrHnodes, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%forceTwrHnodes, kind=B8Ki) if (.not. associated(DstParamData%forceTwrHnodes)) then allocate(DstParamData%forceTwrHnodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1111,7 +1111,7 @@ subroutine ExtInfw_PackParam(Buf, Indata) call RegPack(Buf, InData%NnodesForceTower) call RegPack(Buf, associated(InData%forceBldRnodes)) if (associated(InData%forceBldRnodes)) then - call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes), ubound(InData%forceBldRnodes)) + call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes, kind=B8Ki), ubound(InData%forceBldRnodes, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%forceBldRnodes), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%forceBldRnodes) @@ -1119,7 +1119,7 @@ subroutine ExtInfw_PackParam(Buf, Indata) end if call RegPack(Buf, associated(InData%forceTwrHnodes)) if (associated(InData%forceTwrHnodes)) then - call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes), ubound(InData%forceTwrHnodes)) + call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes, kind=B8Ki), ubound(InData%forceTwrHnodes, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%forceTwrHnodes), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%forceTwrHnodes) @@ -1136,10 +1136,10 @@ subroutine ExtInfw_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackParam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%AirDens) @@ -1306,7 +1306,7 @@ SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) IF (ParamData%C_obj%forceBldRnodes_Len > 0) & - ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(LBOUND(ParamData%forceBldRnodes,1))) + ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(LBOUND(ParamData%forceBldRnodes,1, kind=B8Ki))) END IF END IF @@ -1318,7 +1318,7 @@ SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) IF (ParamData%C_obj%forceTwrHnodes_Len > 0) & - ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(LBOUND(ParamData%forceTwrHnodes,1))) + ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(LBOUND(ParamData%forceTwrHnodes,1, kind=B8Ki))) END IF END IF ParamData%C_obj%BladeLength = ParamData%BladeLength @@ -1333,14 +1333,14 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%pxVel)) then - LB(1:1) = lbound(SrcInputData%pxVel) - UB(1:1) = ubound(SrcInputData%pxVel) + LB(1:1) = lbound(SrcInputData%pxVel, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pxVel, kind=B8Ki) if (.not. associated(DstInputData%pxVel)) then allocate(DstInputData%pxVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1354,8 +1354,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pxVel = SrcInputData%pxVel end if if (associated(SrcInputData%pyVel)) then - LB(1:1) = lbound(SrcInputData%pyVel) - UB(1:1) = ubound(SrcInputData%pyVel) + LB(1:1) = lbound(SrcInputData%pyVel, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pyVel, kind=B8Ki) if (.not. associated(DstInputData%pyVel)) then allocate(DstInputData%pyVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1369,8 +1369,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pyVel = SrcInputData%pyVel end if if (associated(SrcInputData%pzVel)) then - LB(1:1) = lbound(SrcInputData%pzVel) - UB(1:1) = ubound(SrcInputData%pzVel) + LB(1:1) = lbound(SrcInputData%pzVel, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pzVel, kind=B8Ki) if (.not. associated(DstInputData%pzVel)) then allocate(DstInputData%pzVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1384,8 +1384,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pzVel = SrcInputData%pzVel end if if (associated(SrcInputData%pxForce)) then - LB(1:1) = lbound(SrcInputData%pxForce) - UB(1:1) = ubound(SrcInputData%pxForce) + LB(1:1) = lbound(SrcInputData%pxForce, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pxForce, kind=B8Ki) if (.not. associated(DstInputData%pxForce)) then allocate(DstInputData%pxForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1399,8 +1399,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pxForce = SrcInputData%pxForce end if if (associated(SrcInputData%pyForce)) then - LB(1:1) = lbound(SrcInputData%pyForce) - UB(1:1) = ubound(SrcInputData%pyForce) + LB(1:1) = lbound(SrcInputData%pyForce, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pyForce, kind=B8Ki) if (.not. associated(DstInputData%pyForce)) then allocate(DstInputData%pyForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1414,8 +1414,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pyForce = SrcInputData%pyForce end if if (associated(SrcInputData%pzForce)) then - LB(1:1) = lbound(SrcInputData%pzForce) - UB(1:1) = ubound(SrcInputData%pzForce) + LB(1:1) = lbound(SrcInputData%pzForce, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pzForce, kind=B8Ki) if (.not. associated(DstInputData%pzForce)) then allocate(DstInputData%pzForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1429,8 +1429,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pzForce = SrcInputData%pzForce end if if (associated(SrcInputData%xdotForce)) then - LB(1:1) = lbound(SrcInputData%xdotForce) - UB(1:1) = ubound(SrcInputData%xdotForce) + LB(1:1) = lbound(SrcInputData%xdotForce, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%xdotForce, kind=B8Ki) if (.not. associated(DstInputData%xdotForce)) then allocate(DstInputData%xdotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1444,8 +1444,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%xdotForce = SrcInputData%xdotForce end if if (associated(SrcInputData%ydotForce)) then - LB(1:1) = lbound(SrcInputData%ydotForce) - UB(1:1) = ubound(SrcInputData%ydotForce) + LB(1:1) = lbound(SrcInputData%ydotForce, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ydotForce, kind=B8Ki) if (.not. associated(DstInputData%ydotForce)) then allocate(DstInputData%ydotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1459,8 +1459,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%ydotForce = SrcInputData%ydotForce end if if (associated(SrcInputData%zdotForce)) then - LB(1:1) = lbound(SrcInputData%zdotForce) - UB(1:1) = ubound(SrcInputData%zdotForce) + LB(1:1) = lbound(SrcInputData%zdotForce, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%zdotForce, kind=B8Ki) if (.not. associated(DstInputData%zdotForce)) then allocate(DstInputData%zdotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1474,8 +1474,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%zdotForce = SrcInputData%zdotForce end if if (associated(SrcInputData%pOrientation)) then - LB(1:1) = lbound(SrcInputData%pOrientation) - UB(1:1) = ubound(SrcInputData%pOrientation) + LB(1:1) = lbound(SrcInputData%pOrientation, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%pOrientation, kind=B8Ki) if (.not. associated(DstInputData%pOrientation)) then allocate(DstInputData%pOrientation(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1489,8 +1489,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pOrientation = SrcInputData%pOrientation end if if (associated(SrcInputData%fx)) then - LB(1:1) = lbound(SrcInputData%fx) - UB(1:1) = ubound(SrcInputData%fx) + LB(1:1) = lbound(SrcInputData%fx, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fx, kind=B8Ki) if (.not. associated(DstInputData%fx)) then allocate(DstInputData%fx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1504,8 +1504,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fx = SrcInputData%fx end if if (associated(SrcInputData%fy)) then - LB(1:1) = lbound(SrcInputData%fy) - UB(1:1) = ubound(SrcInputData%fy) + LB(1:1) = lbound(SrcInputData%fy, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fy, kind=B8Ki) if (.not. associated(DstInputData%fy)) then allocate(DstInputData%fy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1519,8 +1519,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fy = SrcInputData%fy end if if (associated(SrcInputData%fz)) then - LB(1:1) = lbound(SrcInputData%fz) - UB(1:1) = ubound(SrcInputData%fz) + LB(1:1) = lbound(SrcInputData%fz, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fz, kind=B8Ki) if (.not. associated(DstInputData%fz)) then allocate(DstInputData%fz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1534,8 +1534,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fz = SrcInputData%fz end if if (associated(SrcInputData%momentx)) then - LB(1:1) = lbound(SrcInputData%momentx) - UB(1:1) = ubound(SrcInputData%momentx) + LB(1:1) = lbound(SrcInputData%momentx, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%momentx, kind=B8Ki) if (.not. associated(DstInputData%momentx)) then allocate(DstInputData%momentx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1549,8 +1549,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momentx = SrcInputData%momentx end if if (associated(SrcInputData%momenty)) then - LB(1:1) = lbound(SrcInputData%momenty) - UB(1:1) = ubound(SrcInputData%momenty) + LB(1:1) = lbound(SrcInputData%momenty, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%momenty, kind=B8Ki) if (.not. associated(DstInputData%momenty)) then allocate(DstInputData%momenty(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1564,8 +1564,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momenty = SrcInputData%momenty end if if (associated(SrcInputData%momentz)) then - LB(1:1) = lbound(SrcInputData%momentz) - UB(1:1) = ubound(SrcInputData%momentz) + LB(1:1) = lbound(SrcInputData%momentz, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%momentz, kind=B8Ki) if (.not. associated(DstInputData%momentz)) then allocate(DstInputData%momentz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1579,8 +1579,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momentz = SrcInputData%momentz end if if (associated(SrcInputData%forceNodesChord)) then - LB(1:1) = lbound(SrcInputData%forceNodesChord) - UB(1:1) = ubound(SrcInputData%forceNodesChord) + LB(1:1) = lbound(SrcInputData%forceNodesChord, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%forceNodesChord, kind=B8Ki) if (.not. associated(DstInputData%forceNodesChord)) then allocate(DstInputData%forceNodesChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1718,7 +1718,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pxVel)) if (associated(InData%pxVel)) then - call RegPackBounds(Buf, 1, lbound(InData%pxVel), ubound(InData%pxVel)) + call RegPackBounds(Buf, 1, lbound(InData%pxVel, kind=B8Ki), ubound(InData%pxVel, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pxVel), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pxVel) @@ -1726,7 +1726,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pyVel)) if (associated(InData%pyVel)) then - call RegPackBounds(Buf, 1, lbound(InData%pyVel), ubound(InData%pyVel)) + call RegPackBounds(Buf, 1, lbound(InData%pyVel, kind=B8Ki), ubound(InData%pyVel, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pyVel), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pyVel) @@ -1734,7 +1734,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pzVel)) if (associated(InData%pzVel)) then - call RegPackBounds(Buf, 1, lbound(InData%pzVel), ubound(InData%pzVel)) + call RegPackBounds(Buf, 1, lbound(InData%pzVel, kind=B8Ki), ubound(InData%pzVel, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pzVel), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pzVel) @@ -1742,7 +1742,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pxForce)) if (associated(InData%pxForce)) then - call RegPackBounds(Buf, 1, lbound(InData%pxForce), ubound(InData%pxForce)) + call RegPackBounds(Buf, 1, lbound(InData%pxForce, kind=B8Ki), ubound(InData%pxForce, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pxForce), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pxForce) @@ -1750,7 +1750,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pyForce)) if (associated(InData%pyForce)) then - call RegPackBounds(Buf, 1, lbound(InData%pyForce), ubound(InData%pyForce)) + call RegPackBounds(Buf, 1, lbound(InData%pyForce, kind=B8Ki), ubound(InData%pyForce, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pyForce), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pyForce) @@ -1758,7 +1758,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pzForce)) if (associated(InData%pzForce)) then - call RegPackBounds(Buf, 1, lbound(InData%pzForce), ubound(InData%pzForce)) + call RegPackBounds(Buf, 1, lbound(InData%pzForce, kind=B8Ki), ubound(InData%pzForce, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pzForce), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pzForce) @@ -1766,7 +1766,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%xdotForce)) if (associated(InData%xdotForce)) then - call RegPackBounds(Buf, 1, lbound(InData%xdotForce), ubound(InData%xdotForce)) + call RegPackBounds(Buf, 1, lbound(InData%xdotForce, kind=B8Ki), ubound(InData%xdotForce, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%xdotForce), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%xdotForce) @@ -1774,7 +1774,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%ydotForce)) if (associated(InData%ydotForce)) then - call RegPackBounds(Buf, 1, lbound(InData%ydotForce), ubound(InData%ydotForce)) + call RegPackBounds(Buf, 1, lbound(InData%ydotForce, kind=B8Ki), ubound(InData%ydotForce, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%ydotForce), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%ydotForce) @@ -1782,7 +1782,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%zdotForce)) if (associated(InData%zdotForce)) then - call RegPackBounds(Buf, 1, lbound(InData%zdotForce), ubound(InData%zdotForce)) + call RegPackBounds(Buf, 1, lbound(InData%zdotForce, kind=B8Ki), ubound(InData%zdotForce, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%zdotForce), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%zdotForce) @@ -1790,7 +1790,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%pOrientation)) if (associated(InData%pOrientation)) then - call RegPackBounds(Buf, 1, lbound(InData%pOrientation), ubound(InData%pOrientation)) + call RegPackBounds(Buf, 1, lbound(InData%pOrientation, kind=B8Ki), ubound(InData%pOrientation, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%pOrientation), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%pOrientation) @@ -1798,7 +1798,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%fx)) if (associated(InData%fx)) then - call RegPackBounds(Buf, 1, lbound(InData%fx), ubound(InData%fx)) + call RegPackBounds(Buf, 1, lbound(InData%fx, kind=B8Ki), ubound(InData%fx, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fx), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fx) @@ -1806,7 +1806,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%fy)) if (associated(InData%fy)) then - call RegPackBounds(Buf, 1, lbound(InData%fy), ubound(InData%fy)) + call RegPackBounds(Buf, 1, lbound(InData%fy, kind=B8Ki), ubound(InData%fy, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fy), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fy) @@ -1814,7 +1814,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%fz)) if (associated(InData%fz)) then - call RegPackBounds(Buf, 1, lbound(InData%fz), ubound(InData%fz)) + call RegPackBounds(Buf, 1, lbound(InData%fz, kind=B8Ki), ubound(InData%fz, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fz), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fz) @@ -1822,7 +1822,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%momentx)) if (associated(InData%momentx)) then - call RegPackBounds(Buf, 1, lbound(InData%momentx), ubound(InData%momentx)) + call RegPackBounds(Buf, 1, lbound(InData%momentx, kind=B8Ki), ubound(InData%momentx, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%momentx), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%momentx) @@ -1830,7 +1830,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%momenty)) if (associated(InData%momenty)) then - call RegPackBounds(Buf, 1, lbound(InData%momenty), ubound(InData%momenty)) + call RegPackBounds(Buf, 1, lbound(InData%momenty, kind=B8Ki), ubound(InData%momenty, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%momenty), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%momenty) @@ -1838,7 +1838,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%momentz)) if (associated(InData%momentz)) then - call RegPackBounds(Buf, 1, lbound(InData%momentz), ubound(InData%momentz)) + call RegPackBounds(Buf, 1, lbound(InData%momentz, kind=B8Ki), ubound(InData%momentz, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%momentz), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%momentz) @@ -1846,7 +1846,7 @@ subroutine ExtInfw_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%forceNodesChord)) if (associated(InData%forceNodesChord)) then - call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord), ubound(InData%forceNodesChord)) + call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord, kind=B8Ki), ubound(InData%forceNodesChord, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%forceNodesChord), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%forceNodesChord) @@ -1859,10 +1859,10 @@ subroutine ExtInfw_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%pxVel)) deallocate(OutData%pxVel) @@ -2503,7 +2503,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pxVel_Len = SIZE(InputData%pxVel) IF (InputData%C_obj%pxVel_Len > 0) & - InputData%C_obj%pxVel = C_LOC(InputData%pxVel(LBOUND(InputData%pxVel,1))) + InputData%C_obj%pxVel = C_LOC(InputData%pxVel(LBOUND(InputData%pxVel,1, kind=B8Ki))) END IF END IF @@ -2515,7 +2515,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pyVel_Len = SIZE(InputData%pyVel) IF (InputData%C_obj%pyVel_Len > 0) & - InputData%C_obj%pyVel = C_LOC(InputData%pyVel(LBOUND(InputData%pyVel,1))) + InputData%C_obj%pyVel = C_LOC(InputData%pyVel(LBOUND(InputData%pyVel,1, kind=B8Ki))) END IF END IF @@ -2527,7 +2527,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pzVel_Len = SIZE(InputData%pzVel) IF (InputData%C_obj%pzVel_Len > 0) & - InputData%C_obj%pzVel = C_LOC(InputData%pzVel(LBOUND(InputData%pzVel,1))) + InputData%C_obj%pzVel = C_LOC(InputData%pzVel(LBOUND(InputData%pzVel,1, kind=B8Ki))) END IF END IF @@ -2539,7 +2539,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pxForce_Len = SIZE(InputData%pxForce) IF (InputData%C_obj%pxForce_Len > 0) & - InputData%C_obj%pxForce = C_LOC(InputData%pxForce(LBOUND(InputData%pxForce,1))) + InputData%C_obj%pxForce = C_LOC(InputData%pxForce(LBOUND(InputData%pxForce,1, kind=B8Ki))) END IF END IF @@ -2551,7 +2551,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pyForce_Len = SIZE(InputData%pyForce) IF (InputData%C_obj%pyForce_Len > 0) & - InputData%C_obj%pyForce = C_LOC(InputData%pyForce(LBOUND(InputData%pyForce,1))) + InputData%C_obj%pyForce = C_LOC(InputData%pyForce(LBOUND(InputData%pyForce,1, kind=B8Ki))) END IF END IF @@ -2563,7 +2563,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pzForce_Len = SIZE(InputData%pzForce) IF (InputData%C_obj%pzForce_Len > 0) & - InputData%C_obj%pzForce = C_LOC(InputData%pzForce(LBOUND(InputData%pzForce,1))) + InputData%C_obj%pzForce = C_LOC(InputData%pzForce(LBOUND(InputData%pzForce,1, kind=B8Ki))) END IF END IF @@ -2575,7 +2575,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%xdotForce_Len = SIZE(InputData%xdotForce) IF (InputData%C_obj%xdotForce_Len > 0) & - InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(LBOUND(InputData%xdotForce,1))) + InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(LBOUND(InputData%xdotForce,1, kind=B8Ki))) END IF END IF @@ -2587,7 +2587,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%ydotForce_Len = SIZE(InputData%ydotForce) IF (InputData%C_obj%ydotForce_Len > 0) & - InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(LBOUND(InputData%ydotForce,1))) + InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(LBOUND(InputData%ydotForce,1, kind=B8Ki))) END IF END IF @@ -2599,7 +2599,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%zdotForce_Len = SIZE(InputData%zdotForce) IF (InputData%C_obj%zdotForce_Len > 0) & - InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(LBOUND(InputData%zdotForce,1))) + InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(LBOUND(InputData%zdotForce,1, kind=B8Ki))) END IF END IF @@ -2611,7 +2611,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pOrientation_Len = SIZE(InputData%pOrientation) IF (InputData%C_obj%pOrientation_Len > 0) & - InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(LBOUND(InputData%pOrientation,1))) + InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(LBOUND(InputData%pOrientation,1, kind=B8Ki))) END IF END IF @@ -2623,7 +2623,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fx_Len = SIZE(InputData%fx) IF (InputData%C_obj%fx_Len > 0) & - InputData%C_obj%fx = C_LOC(InputData%fx(LBOUND(InputData%fx,1))) + InputData%C_obj%fx = C_LOC(InputData%fx(LBOUND(InputData%fx,1, kind=B8Ki))) END IF END IF @@ -2635,7 +2635,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fy_Len = SIZE(InputData%fy) IF (InputData%C_obj%fy_Len > 0) & - InputData%C_obj%fy = C_LOC(InputData%fy(LBOUND(InputData%fy,1))) + InputData%C_obj%fy = C_LOC(InputData%fy(LBOUND(InputData%fy,1, kind=B8Ki))) END IF END IF @@ -2647,7 +2647,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fz_Len = SIZE(InputData%fz) IF (InputData%C_obj%fz_Len > 0) & - InputData%C_obj%fz = C_LOC(InputData%fz(LBOUND(InputData%fz,1))) + InputData%C_obj%fz = C_LOC(InputData%fz(LBOUND(InputData%fz,1, kind=B8Ki))) END IF END IF @@ -2659,7 +2659,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momentx_Len = SIZE(InputData%momentx) IF (InputData%C_obj%momentx_Len > 0) & - InputData%C_obj%momentx = C_LOC(InputData%momentx(LBOUND(InputData%momentx,1))) + InputData%C_obj%momentx = C_LOC(InputData%momentx(LBOUND(InputData%momentx,1, kind=B8Ki))) END IF END IF @@ -2671,7 +2671,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momenty_Len = SIZE(InputData%momenty) IF (InputData%C_obj%momenty_Len > 0) & - InputData%C_obj%momenty = C_LOC(InputData%momenty(LBOUND(InputData%momenty,1))) + InputData%C_obj%momenty = C_LOC(InputData%momenty(LBOUND(InputData%momenty,1, kind=B8Ki))) END IF END IF @@ -2683,7 +2683,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momentz_Len = SIZE(InputData%momentz) IF (InputData%C_obj%momentz_Len > 0) & - InputData%C_obj%momentz = C_LOC(InputData%momentz(LBOUND(InputData%momentz,1))) + InputData%C_obj%momentz = C_LOC(InputData%momentz(LBOUND(InputData%momentz,1, kind=B8Ki))) END IF END IF @@ -2695,7 +2695,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) IF (InputData%C_obj%forceNodesChord_Len > 0) & - InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(LBOUND(InputData%forceNodesChord,1))) + InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(LBOUND(InputData%forceNodesChord,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -2706,14 +2706,14 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%u)) then - LB(1:1) = lbound(SrcOutputData%u) - UB(1:1) = ubound(SrcOutputData%u) + LB(1:1) = lbound(SrcOutputData%u, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%u, kind=B8Ki) if (.not. associated(DstOutputData%u)) then allocate(DstOutputData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2727,8 +2727,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%u = SrcOutputData%u end if if (associated(SrcOutputData%v)) then - LB(1:1) = lbound(SrcOutputData%v) - UB(1:1) = ubound(SrcOutputData%v) + LB(1:1) = lbound(SrcOutputData%v, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%v, kind=B8Ki) if (.not. associated(DstOutputData%v)) then allocate(DstOutputData%v(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2742,8 +2742,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%v = SrcOutputData%v end if if (associated(SrcOutputData%w)) then - LB(1:1) = lbound(SrcOutputData%w) - UB(1:1) = ubound(SrcOutputData%w) + LB(1:1) = lbound(SrcOutputData%w, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%w, kind=B8Ki) if (.not. associated(DstOutputData%w)) then allocate(DstOutputData%w(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2757,8 +2757,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%w = SrcOutputData%w end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2812,7 +2812,7 @@ subroutine ExtInfw_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%u)) if (associated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%u), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%u) @@ -2820,7 +2820,7 @@ subroutine ExtInfw_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%v)) if (associated(InData%v)) then - call RegPackBounds(Buf, 1, lbound(InData%v), ubound(InData%v)) + call RegPackBounds(Buf, 1, lbound(InData%v, kind=B8Ki), ubound(InData%v, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%v), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%v) @@ -2828,7 +2828,7 @@ subroutine ExtInfw_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%w)) if (associated(InData%w)) then - call RegPackBounds(Buf, 1, lbound(InData%w), ubound(InData%w)) + call RegPackBounds(Buf, 1, lbound(InData%w, kind=B8Ki), ubound(InData%w, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%w), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%w) @@ -2836,7 +2836,7 @@ subroutine ExtInfw_PackOutput(Buf, Indata) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2846,10 +2846,10 @@ subroutine ExtInfw_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtInfw_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%u)) deallocate(OutData%u) @@ -3014,7 +3014,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%u_Len = SIZE(OutputData%u) IF (OutputData%C_obj%u_Len > 0) & - OutputData%C_obj%u = C_LOC(OutputData%u(LBOUND(OutputData%u,1))) + OutputData%C_obj%u = C_LOC(OutputData%u(LBOUND(OutputData%u,1, kind=B8Ki))) END IF END IF @@ -3026,7 +3026,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%v_Len = SIZE(OutputData%v) IF (OutputData%C_obj%v_Len > 0) & - OutputData%C_obj%v = C_LOC(OutputData%v(LBOUND(OutputData%v,1))) + OutputData%C_obj%v = C_LOC(OutputData%v(LBOUND(OutputData%v,1, kind=B8Ki))) END IF END IF @@ -3038,7 +3038,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%w_Len = SIZE(OutputData%w) IF (OutputData%C_obj%w_Len > 0) & - OutputData%C_obj%w = C_LOC(OutputData%w(LBOUND(OutputData%w,1))) + OutputData%C_obj%w = C_LOC(OutputData%w(LBOUND(OutputData%w,1, kind=B8Ki))) END IF END IF END SUBROUTINE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index ce08cab5c0..9ca5ac7425 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -213,7 +213,7 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyInputFile' ErrStat = ErrID_None @@ -225,8 +225,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst DstInputFileData%EquilStart = SrcInputFileData%EquilStart if (allocated(SrcInputFileData%ActiveCBDOF)) then - LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF) - UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF) + LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF, kind=B8Ki) if (.not. allocated(DstInputFileData%ActiveCBDOF)) then allocate(DstInputFileData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -237,8 +237,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF end if if (allocated(SrcInputFileData%InitPosList)) then - LB(1:1) = lbound(SrcInputFileData%InitPosList) - UB(1:1) = ubound(SrcInputFileData%InitPosList) + LB(1:1) = lbound(SrcInputFileData%InitPosList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%InitPosList, kind=B8Ki) if (.not. allocated(DstInputFileData%InitPosList)) then allocate(DstInputFileData%InitPosList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -249,8 +249,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%InitPosList = SrcInputFileData%InitPosList end if if (allocated(SrcInputFileData%InitVelList)) then - LB(1:1) = lbound(SrcInputFileData%InitVelList) - UB(1:1) = ubound(SrcInputFileData%InitVelList) + LB(1:1) = lbound(SrcInputFileData%InitVelList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%InitVelList, kind=B8Ki) if (.not. allocated(DstInputFileData%InitVelList)) then allocate(DstInputFileData%InitVelList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -267,8 +267,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -314,17 +314,17 @@ subroutine ExtPtfm_PackInputFile(Buf, Indata) call RegPack(Buf, InData%EquilStart) call RegPack(Buf, allocated(InData%ActiveCBDOF)) if (allocated(InData%ActiveCBDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) + call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF, kind=B8Ki), ubound(InData%ActiveCBDOF, kind=B8Ki)) call RegPack(Buf, InData%ActiveCBDOF) end if call RegPack(Buf, allocated(InData%InitPosList)) if (allocated(InData%InitPosList)) then - call RegPackBounds(Buf, 1, lbound(InData%InitPosList), ubound(InData%InitPosList)) + call RegPackBounds(Buf, 1, lbound(InData%InitPosList, kind=B8Ki), ubound(InData%InitPosList, kind=B8Ki)) call RegPack(Buf, InData%InitPosList) end if call RegPack(Buf, allocated(InData%InitVelList)) if (allocated(InData%InitVelList)) then - call RegPackBounds(Buf, 1, lbound(InData%InitVelList), ubound(InData%InitVelList)) + call RegPackBounds(Buf, 1, lbound(InData%InitVelList, kind=B8Ki), ubound(InData%InitVelList, kind=B8Ki)) call RegPack(Buf, InData%InitVelList) end if call RegPack(Buf, InData%SumPrint) @@ -335,7 +335,7 @@ subroutine ExtPtfm_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return @@ -345,7 +345,7 @@ subroutine ExtPtfm_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -437,7 +437,7 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitOutput' @@ -447,8 +447,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -459,8 +459,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -471,8 +471,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -483,8 +483,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -495,8 +495,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -507,8 +507,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -519,8 +519,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -531,8 +531,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -543,8 +543,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -555,8 +555,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -619,52 +619,52 @@ subroutine ExtPtfm_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -674,7 +674,7 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -827,14 +827,14 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm) - UB(1:1) = ubound(SrcContStateData%qm) + LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) if (.not. allocated(DstContStateData%qm)) then allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -845,8 +845,8 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E DstContStateData%qm = SrcContStateData%qm end if if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot) - UB(1:1) = ubound(SrcContStateData%qmdot) + LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) if (.not. allocated(DstContStateData%qmdot)) then allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -880,12 +880,12 @@ subroutine ExtPtfm_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%qm)) if (allocated(InData%qm)) then - call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) + call RegPackBounds(Buf, 1, lbound(InData%qm, kind=B8Ki), ubound(InData%qm, kind=B8Ki)) call RegPack(Buf, InData%qm) end if call RegPack(Buf, allocated(InData%qmdot)) if (allocated(InData%qmdot)) then - call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) + call RegPackBounds(Buf, 1, lbound(InData%qmdot, kind=B8Ki), ubound(InData%qmdot, kind=B8Ki)) call RegPack(Buf, InData%qmdot) end if if (RegCheckErr(Buf, RoutineName)) return @@ -895,7 +895,7 @@ subroutine ExtPtfm_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1013,16 +1013,16 @@ subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1043,16 +1043,16 @@ subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(ExtPtfm_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1065,14 +1065,14 @@ subroutine ExtPtfm_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + call RegPackBounds(Buf, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(Buf, InData%xdot(i1)) end do @@ -1085,8 +1085,8 @@ subroutine ExtPtfm_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1115,14 +1115,14 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%xFlat)) then - LB(1:1) = lbound(SrcMiscData%xFlat) - UB(1:1) = ubound(SrcMiscData%xFlat) + LB(1:1) = lbound(SrcMiscData%xFlat, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%xFlat, kind=B8Ki) if (.not. allocated(DstMiscData%xFlat)) then allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1134,8 +1134,8 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%uFlat = SrcMiscData%uFlat if (allocated(SrcMiscData%F_at_t)) then - LB(1:1) = lbound(SrcMiscData%F_at_t) - UB(1:1) = ubound(SrcMiscData%F_at_t) + LB(1:1) = lbound(SrcMiscData%F_at_t, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_at_t, kind=B8Ki) if (.not. allocated(DstMiscData%F_at_t)) then allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1148,8 +1148,8 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Indx = SrcMiscData%Indx DstMiscData%EquilStart = SrcMiscData%EquilStart if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1186,20 +1186,20 @@ subroutine ExtPtfm_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%xFlat)) if (allocated(InData%xFlat)) then - call RegPackBounds(Buf, 1, lbound(InData%xFlat), ubound(InData%xFlat)) + call RegPackBounds(Buf, 1, lbound(InData%xFlat, kind=B8Ki), ubound(InData%xFlat, kind=B8Ki)) call RegPack(Buf, InData%xFlat) end if call RegPack(Buf, InData%uFlat) call RegPack(Buf, allocated(InData%F_at_t)) if (allocated(InData%F_at_t)) then - call RegPackBounds(Buf, 1, lbound(InData%F_at_t), ubound(InData%F_at_t)) + call RegPackBounds(Buf, 1, lbound(InData%F_at_t, kind=B8Ki), ubound(InData%F_at_t, kind=B8Ki)) call RegPack(Buf, InData%F_at_t) end if call RegPack(Buf, InData%Indx) call RegPack(Buf, InData%EquilStart) call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1209,7 +1209,7 @@ subroutine ExtPtfm_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1269,16 +1269,16 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%Mass)) then - LB(1:2) = lbound(SrcParamData%Mass) - UB(1:2) = ubound(SrcParamData%Mass) + LB(1:2) = lbound(SrcParamData%Mass, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Mass, kind=B8Ki) if (.not. allocated(DstParamData%Mass)) then allocate(DstParamData%Mass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1289,8 +1289,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Mass = SrcParamData%Mass end if if (allocated(SrcParamData%Damp)) then - LB(1:2) = lbound(SrcParamData%Damp) - UB(1:2) = ubound(SrcParamData%Damp) + LB(1:2) = lbound(SrcParamData%Damp, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Damp, kind=B8Ki) if (.not. allocated(DstParamData%Damp)) then allocate(DstParamData%Damp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1301,8 +1301,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Damp = SrcParamData%Damp end if if (allocated(SrcParamData%Stff)) then - LB(1:2) = lbound(SrcParamData%Stff) - UB(1:2) = ubound(SrcParamData%Stff) + LB(1:2) = lbound(SrcParamData%Stff, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Stff, kind=B8Ki) if (.not. allocated(DstParamData%Stff)) then allocate(DstParamData%Stff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1313,8 +1313,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Stff = SrcParamData%Stff end if if (allocated(SrcParamData%Forces)) then - LB(1:2) = lbound(SrcParamData%Forces) - UB(1:2) = ubound(SrcParamData%Forces) + LB(1:2) = lbound(SrcParamData%Forces, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Forces, kind=B8Ki) if (.not. allocated(DstParamData%Forces)) then allocate(DstParamData%Forces(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1325,8 +1325,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Forces = SrcParamData%Forces end if if (allocated(SrcParamData%times)) then - LB(1:1) = lbound(SrcParamData%times) - UB(1:1) = ubound(SrcParamData%times) + LB(1:1) = lbound(SrcParamData%times, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%times, kind=B8Ki) if (.not. allocated(DstParamData%times)) then allocate(DstParamData%times(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1337,8 +1337,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%times = SrcParamData%times end if if (allocated(SrcParamData%AMat)) then - LB(1:2) = lbound(SrcParamData%AMat) - UB(1:2) = ubound(SrcParamData%AMat) + LB(1:2) = lbound(SrcParamData%AMat, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AMat, kind=B8Ki) if (.not. allocated(DstParamData%AMat)) then allocate(DstParamData%AMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1349,8 +1349,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%AMat = SrcParamData%AMat end if if (allocated(SrcParamData%BMat)) then - LB(1:2) = lbound(SrcParamData%BMat) - UB(1:2) = ubound(SrcParamData%BMat) + LB(1:2) = lbound(SrcParamData%BMat, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%BMat, kind=B8Ki) if (.not. allocated(DstParamData%BMat)) then allocate(DstParamData%BMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1361,8 +1361,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%BMat = SrcParamData%BMat end if if (allocated(SrcParamData%CMat)) then - LB(1:2) = lbound(SrcParamData%CMat) - UB(1:2) = ubound(SrcParamData%CMat) + LB(1:2) = lbound(SrcParamData%CMat, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CMat, kind=B8Ki) if (.not. allocated(DstParamData%CMat)) then allocate(DstParamData%CMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1373,8 +1373,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%CMat = SrcParamData%CMat end if if (allocated(SrcParamData%DMat)) then - LB(1:2) = lbound(SrcParamData%DMat) - UB(1:2) = ubound(SrcParamData%DMat) + LB(1:2) = lbound(SrcParamData%DMat, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%DMat, kind=B8Ki) if (.not. allocated(DstParamData%DMat)) then allocate(DstParamData%DMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1385,8 +1385,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DMat = SrcParamData%DMat end if if (allocated(SrcParamData%FX)) then - LB(1:1) = lbound(SrcParamData%FX) - UB(1:1) = ubound(SrcParamData%FX) + LB(1:1) = lbound(SrcParamData%FX, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FX, kind=B8Ki) if (.not. allocated(DstParamData%FX)) then allocate(DstParamData%FX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1397,8 +1397,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%FX = SrcParamData%FX end if if (allocated(SrcParamData%FY)) then - LB(1:1) = lbound(SrcParamData%FY) - UB(1:1) = ubound(SrcParamData%FY) + LB(1:1) = lbound(SrcParamData%FY, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FY, kind=B8Ki) if (.not. allocated(DstParamData%FY)) then allocate(DstParamData%FY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1409,8 +1409,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%FY = SrcParamData%FY end if if (allocated(SrcParamData%M11)) then - LB(1:2) = lbound(SrcParamData%M11) - UB(1:2) = ubound(SrcParamData%M11) + LB(1:2) = lbound(SrcParamData%M11, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%M11, kind=B8Ki) if (.not. allocated(DstParamData%M11)) then allocate(DstParamData%M11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1421,8 +1421,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M11 = SrcParamData%M11 end if if (allocated(SrcParamData%M12)) then - LB(1:2) = lbound(SrcParamData%M12) - UB(1:2) = ubound(SrcParamData%M12) + LB(1:2) = lbound(SrcParamData%M12, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%M12, kind=B8Ki) if (.not. allocated(DstParamData%M12)) then allocate(DstParamData%M12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1433,8 +1433,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M12 = SrcParamData%M12 end if if (allocated(SrcParamData%M22)) then - LB(1:2) = lbound(SrcParamData%M22) - UB(1:2) = ubound(SrcParamData%M22) + LB(1:2) = lbound(SrcParamData%M22, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%M22, kind=B8Ki) if (.not. allocated(DstParamData%M22)) then allocate(DstParamData%M22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1445,8 +1445,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M22 = SrcParamData%M22 end if if (allocated(SrcParamData%M21)) then - LB(1:2) = lbound(SrcParamData%M21) - UB(1:2) = ubound(SrcParamData%M21) + LB(1:2) = lbound(SrcParamData%M21, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%M21, kind=B8Ki) if (.not. allocated(DstParamData%M21)) then allocate(DstParamData%M21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1457,8 +1457,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M21 = SrcParamData%M21 end if if (allocated(SrcParamData%K11)) then - LB(1:2) = lbound(SrcParamData%K11) - UB(1:2) = ubound(SrcParamData%K11) + LB(1:2) = lbound(SrcParamData%K11, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%K11, kind=B8Ki) if (.not. allocated(DstParamData%K11)) then allocate(DstParamData%K11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1469,8 +1469,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%K11 = SrcParamData%K11 end if if (allocated(SrcParamData%K22)) then - LB(1:2) = lbound(SrcParamData%K22) - UB(1:2) = ubound(SrcParamData%K22) + LB(1:2) = lbound(SrcParamData%K22, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%K22, kind=B8Ki) if (.not. allocated(DstParamData%K22)) then allocate(DstParamData%K22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1481,8 +1481,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%K22 = SrcParamData%K22 end if if (allocated(SrcParamData%C11)) then - LB(1:2) = lbound(SrcParamData%C11) - UB(1:2) = ubound(SrcParamData%C11) + LB(1:2) = lbound(SrcParamData%C11, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C11, kind=B8Ki) if (.not. allocated(DstParamData%C11)) then allocate(DstParamData%C11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1493,8 +1493,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C11 = SrcParamData%C11 end if if (allocated(SrcParamData%C12)) then - LB(1:2) = lbound(SrcParamData%C12) - UB(1:2) = ubound(SrcParamData%C12) + LB(1:2) = lbound(SrcParamData%C12, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C12, kind=B8Ki) if (.not. allocated(DstParamData%C12)) then allocate(DstParamData%C12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1505,8 +1505,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C12 = SrcParamData%C12 end if if (allocated(SrcParamData%C22)) then - LB(1:2) = lbound(SrcParamData%C22) - UB(1:2) = ubound(SrcParamData%C22) + LB(1:2) = lbound(SrcParamData%C22, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C22, kind=B8Ki) if (.not. allocated(DstParamData%C22)) then allocate(DstParamData%C22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1517,8 +1517,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C22 = SrcParamData%C22 end if if (allocated(SrcParamData%C21)) then - LB(1:2) = lbound(SrcParamData%C21) - UB(1:2) = ubound(SrcParamData%C21) + LB(1:2) = lbound(SrcParamData%C21, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C21, kind=B8Ki) if (.not. allocated(DstParamData%C21)) then allocate(DstParamData%C21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1536,8 +1536,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%IntMethod = SrcParamData%IntMethod if (allocated(SrcParamData%ActiveCBDOF)) then - LB(1:1) = lbound(SrcParamData%ActiveCBDOF) - UB(1:1) = ubound(SrcParamData%ActiveCBDOF) + LB(1:1) = lbound(SrcParamData%ActiveCBDOF, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ActiveCBDOF, kind=B8Ki) if (.not. allocated(DstParamData%ActiveCBDOF)) then allocate(DstParamData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1548,8 +1548,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1564,8 +1564,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1581,8 +1581,8 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) type(ExtPtfm_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyParam' @@ -1655,8 +1655,8 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%ActiveCBDOF) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1672,112 +1672,112 @@ subroutine ExtPtfm_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Mass)) if (allocated(InData%Mass)) then - call RegPackBounds(Buf, 2, lbound(InData%Mass), ubound(InData%Mass)) + call RegPackBounds(Buf, 2, lbound(InData%Mass, kind=B8Ki), ubound(InData%Mass, kind=B8Ki)) call RegPack(Buf, InData%Mass) end if call RegPack(Buf, allocated(InData%Damp)) if (allocated(InData%Damp)) then - call RegPackBounds(Buf, 2, lbound(InData%Damp), ubound(InData%Damp)) + call RegPackBounds(Buf, 2, lbound(InData%Damp, kind=B8Ki), ubound(InData%Damp, kind=B8Ki)) call RegPack(Buf, InData%Damp) end if call RegPack(Buf, allocated(InData%Stff)) if (allocated(InData%Stff)) then - call RegPackBounds(Buf, 2, lbound(InData%Stff), ubound(InData%Stff)) + call RegPackBounds(Buf, 2, lbound(InData%Stff, kind=B8Ki), ubound(InData%Stff, kind=B8Ki)) call RegPack(Buf, InData%Stff) end if call RegPack(Buf, allocated(InData%Forces)) if (allocated(InData%Forces)) then - call RegPackBounds(Buf, 2, lbound(InData%Forces), ubound(InData%Forces)) + call RegPackBounds(Buf, 2, lbound(InData%Forces, kind=B8Ki), ubound(InData%Forces, kind=B8Ki)) call RegPack(Buf, InData%Forces) end if call RegPack(Buf, allocated(InData%times)) if (allocated(InData%times)) then - call RegPackBounds(Buf, 1, lbound(InData%times), ubound(InData%times)) + call RegPackBounds(Buf, 1, lbound(InData%times, kind=B8Ki), ubound(InData%times, kind=B8Ki)) call RegPack(Buf, InData%times) end if call RegPack(Buf, allocated(InData%AMat)) if (allocated(InData%AMat)) then - call RegPackBounds(Buf, 2, lbound(InData%AMat), ubound(InData%AMat)) + call RegPackBounds(Buf, 2, lbound(InData%AMat, kind=B8Ki), ubound(InData%AMat, kind=B8Ki)) call RegPack(Buf, InData%AMat) end if call RegPack(Buf, allocated(InData%BMat)) if (allocated(InData%BMat)) then - call RegPackBounds(Buf, 2, lbound(InData%BMat), ubound(InData%BMat)) + call RegPackBounds(Buf, 2, lbound(InData%BMat, kind=B8Ki), ubound(InData%BMat, kind=B8Ki)) call RegPack(Buf, InData%BMat) end if call RegPack(Buf, allocated(InData%CMat)) if (allocated(InData%CMat)) then - call RegPackBounds(Buf, 2, lbound(InData%CMat), ubound(InData%CMat)) + call RegPackBounds(Buf, 2, lbound(InData%CMat, kind=B8Ki), ubound(InData%CMat, kind=B8Ki)) call RegPack(Buf, InData%CMat) end if call RegPack(Buf, allocated(InData%DMat)) if (allocated(InData%DMat)) then - call RegPackBounds(Buf, 2, lbound(InData%DMat), ubound(InData%DMat)) + call RegPackBounds(Buf, 2, lbound(InData%DMat, kind=B8Ki), ubound(InData%DMat, kind=B8Ki)) call RegPack(Buf, InData%DMat) end if call RegPack(Buf, allocated(InData%FX)) if (allocated(InData%FX)) then - call RegPackBounds(Buf, 1, lbound(InData%FX), ubound(InData%FX)) + call RegPackBounds(Buf, 1, lbound(InData%FX, kind=B8Ki), ubound(InData%FX, kind=B8Ki)) call RegPack(Buf, InData%FX) end if call RegPack(Buf, allocated(InData%FY)) if (allocated(InData%FY)) then - call RegPackBounds(Buf, 1, lbound(InData%FY), ubound(InData%FY)) + call RegPackBounds(Buf, 1, lbound(InData%FY, kind=B8Ki), ubound(InData%FY, kind=B8Ki)) call RegPack(Buf, InData%FY) end if call RegPack(Buf, allocated(InData%M11)) if (allocated(InData%M11)) then - call RegPackBounds(Buf, 2, lbound(InData%M11), ubound(InData%M11)) + call RegPackBounds(Buf, 2, lbound(InData%M11, kind=B8Ki), ubound(InData%M11, kind=B8Ki)) call RegPack(Buf, InData%M11) end if call RegPack(Buf, allocated(InData%M12)) if (allocated(InData%M12)) then - call RegPackBounds(Buf, 2, lbound(InData%M12), ubound(InData%M12)) + call RegPackBounds(Buf, 2, lbound(InData%M12, kind=B8Ki), ubound(InData%M12, kind=B8Ki)) call RegPack(Buf, InData%M12) end if call RegPack(Buf, allocated(InData%M22)) if (allocated(InData%M22)) then - call RegPackBounds(Buf, 2, lbound(InData%M22), ubound(InData%M22)) + call RegPackBounds(Buf, 2, lbound(InData%M22, kind=B8Ki), ubound(InData%M22, kind=B8Ki)) call RegPack(Buf, InData%M22) end if call RegPack(Buf, allocated(InData%M21)) if (allocated(InData%M21)) then - call RegPackBounds(Buf, 2, lbound(InData%M21), ubound(InData%M21)) + call RegPackBounds(Buf, 2, lbound(InData%M21, kind=B8Ki), ubound(InData%M21, kind=B8Ki)) call RegPack(Buf, InData%M21) end if call RegPack(Buf, allocated(InData%K11)) if (allocated(InData%K11)) then - call RegPackBounds(Buf, 2, lbound(InData%K11), ubound(InData%K11)) + call RegPackBounds(Buf, 2, lbound(InData%K11, kind=B8Ki), ubound(InData%K11, kind=B8Ki)) call RegPack(Buf, InData%K11) end if call RegPack(Buf, allocated(InData%K22)) if (allocated(InData%K22)) then - call RegPackBounds(Buf, 2, lbound(InData%K22), ubound(InData%K22)) + call RegPackBounds(Buf, 2, lbound(InData%K22, kind=B8Ki), ubound(InData%K22, kind=B8Ki)) call RegPack(Buf, InData%K22) end if call RegPack(Buf, allocated(InData%C11)) if (allocated(InData%C11)) then - call RegPackBounds(Buf, 2, lbound(InData%C11), ubound(InData%C11)) + call RegPackBounds(Buf, 2, lbound(InData%C11, kind=B8Ki), ubound(InData%C11, kind=B8Ki)) call RegPack(Buf, InData%C11) end if call RegPack(Buf, allocated(InData%C12)) if (allocated(InData%C12)) then - call RegPackBounds(Buf, 2, lbound(InData%C12), ubound(InData%C12)) + call RegPackBounds(Buf, 2, lbound(InData%C12, kind=B8Ki), ubound(InData%C12, kind=B8Ki)) call RegPack(Buf, InData%C12) end if call RegPack(Buf, allocated(InData%C22)) if (allocated(InData%C22)) then - call RegPackBounds(Buf, 2, lbound(InData%C22), ubound(InData%C22)) + call RegPackBounds(Buf, 2, lbound(InData%C22, kind=B8Ki), ubound(InData%C22, kind=B8Ki)) call RegPack(Buf, InData%C22) end if call RegPack(Buf, allocated(InData%C21)) if (allocated(InData%C21)) then - call RegPackBounds(Buf, 2, lbound(InData%C21), ubound(InData%C21)) + call RegPackBounds(Buf, 2, lbound(InData%C21, kind=B8Ki), ubound(InData%C21, kind=B8Ki)) call RegPack(Buf, InData%C21) end if call RegPack(Buf, InData%EP_DeltaT) @@ -1789,21 +1789,21 @@ subroutine ExtPtfm_PackParam(Buf, Indata) call RegPack(Buf, InData%IntMethod) call RegPack(Buf, allocated(InData%ActiveCBDOF)) if (allocated(InData%ActiveCBDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) + call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF, kind=B8Ki), ubound(InData%ActiveCBDOF, kind=B8Ki)) call RegPack(Buf, InData%ActiveCBDOF) end if call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if call RegPack(Buf, allocated(InData%OutParamLinIndx)) if (allocated(InData%OutParamLinIndx)) then - call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) + call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx, kind=B8Ki), ubound(InData%OutParamLinIndx, kind=B8Ki)) call RegPack(Buf, InData%OutParamLinIndx) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1813,8 +1813,8 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2223,7 +2223,7 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyOutput' @@ -2233,8 +2233,8 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2270,7 +2270,7 @@ subroutine ExtPtfm_PackOutput(Buf, Indata) call MeshPack(Buf, InData%PtfmMesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2280,7 +2280,7 @@ subroutine ExtPtfm_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 29b7bba7dd..70dbe328be 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -231,15 +231,15 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyInputFile' ErrStat = ErrID_None ErrMsg = '' DstInputFileData%DT = SrcInputFileData%DT if (allocated(SrcInputFileData%LineCI)) then - LB(1:1) = lbound(SrcInputFileData%LineCI) - UB(1:1) = ubound(SrcInputFileData%LineCI) + LB(1:1) = lbound(SrcInputFileData%LineCI, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LineCI, kind=B8Ki) if (.not. allocated(DstInputFileData%LineCI)) then allocate(DstInputFileData%LineCI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -250,8 +250,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LineCI = SrcInputFileData%LineCI end if if (allocated(SrcInputFileData%LineCD)) then - LB(1:1) = lbound(SrcInputFileData%LineCD) - UB(1:1) = ubound(SrcInputFileData%LineCD) + LB(1:1) = lbound(SrcInputFileData%LineCD, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LineCD, kind=B8Ki) if (.not. allocated(DstInputFileData%LineCD)) then allocate(DstInputFileData%LineCD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,8 +262,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LineCD = SrcInputFileData%LineCD end if if (allocated(SrcInputFileData%LEAStiff)) then - LB(1:1) = lbound(SrcInputFileData%LEAStiff) - UB(1:1) = ubound(SrcInputFileData%LEAStiff) + LB(1:1) = lbound(SrcInputFileData%LEAStiff, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LEAStiff, kind=B8Ki) if (.not. allocated(DstInputFileData%LEAStiff)) then allocate(DstInputFileData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -274,8 +274,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff end if if (allocated(SrcInputFileData%LMassDen)) then - LB(1:1) = lbound(SrcInputFileData%LMassDen) - UB(1:1) = ubound(SrcInputFileData%LMassDen) + LB(1:1) = lbound(SrcInputFileData%LMassDen, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LMassDen, kind=B8Ki) if (.not. allocated(DstInputFileData%LMassDen)) then allocate(DstInputFileData%LMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -286,8 +286,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LMassDen = SrcInputFileData%LMassDen end if if (allocated(SrcInputFileData%LDMassDen)) then - LB(1:1) = lbound(SrcInputFileData%LDMassDen) - UB(1:1) = ubound(SrcInputFileData%LDMassDen) + LB(1:1) = lbound(SrcInputFileData%LDMassDen, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LDMassDen, kind=B8Ki) if (.not. allocated(DstInputFileData%LDMassDen)) then allocate(DstInputFileData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -298,8 +298,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen end if if (allocated(SrcInputFileData%BottmStiff)) then - LB(1:1) = lbound(SrcInputFileData%BottmStiff) - UB(1:1) = ubound(SrcInputFileData%BottmStiff) + LB(1:1) = lbound(SrcInputFileData%BottmStiff, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BottmStiff, kind=B8Ki) if (.not. allocated(DstInputFileData%BottmStiff)) then allocate(DstInputFileData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -310,8 +310,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff end if if (allocated(SrcInputFileData%LRadAnch)) then - LB(1:1) = lbound(SrcInputFileData%LRadAnch) - UB(1:1) = ubound(SrcInputFileData%LRadAnch) + LB(1:1) = lbound(SrcInputFileData%LRadAnch, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LRadAnch, kind=B8Ki) if (.not. allocated(DstInputFileData%LRadAnch)) then allocate(DstInputFileData%LRadAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -322,8 +322,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch end if if (allocated(SrcInputFileData%LAngAnch)) then - LB(1:1) = lbound(SrcInputFileData%LAngAnch) - UB(1:1) = ubound(SrcInputFileData%LAngAnch) + LB(1:1) = lbound(SrcInputFileData%LAngAnch, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LAngAnch, kind=B8Ki) if (.not. allocated(DstInputFileData%LAngAnch)) then allocate(DstInputFileData%LAngAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -334,8 +334,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch end if if (allocated(SrcInputFileData%LDpthAnch)) then - LB(1:1) = lbound(SrcInputFileData%LDpthAnch) - UB(1:1) = ubound(SrcInputFileData%LDpthAnch) + LB(1:1) = lbound(SrcInputFileData%LDpthAnch, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LDpthAnch, kind=B8Ki) if (.not. allocated(DstInputFileData%LDpthAnch)) then allocate(DstInputFileData%LDpthAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -346,8 +346,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch end if if (allocated(SrcInputFileData%LRadFair)) then - LB(1:1) = lbound(SrcInputFileData%LRadFair) - UB(1:1) = ubound(SrcInputFileData%LRadFair) + LB(1:1) = lbound(SrcInputFileData%LRadFair, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LRadFair, kind=B8Ki) if (.not. allocated(DstInputFileData%LRadFair)) then allocate(DstInputFileData%LRadFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -358,8 +358,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LRadFair = SrcInputFileData%LRadFair end if if (allocated(SrcInputFileData%LAngFair)) then - LB(1:1) = lbound(SrcInputFileData%LAngFair) - UB(1:1) = ubound(SrcInputFileData%LAngFair) + LB(1:1) = lbound(SrcInputFileData%LAngFair, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LAngFair, kind=B8Ki) if (.not. allocated(DstInputFileData%LAngFair)) then allocate(DstInputFileData%LAngFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -370,8 +370,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LAngFair = SrcInputFileData%LAngFair end if if (allocated(SrcInputFileData%LDrftFair)) then - LB(1:1) = lbound(SrcInputFileData%LDrftFair) - UB(1:1) = ubound(SrcInputFileData%LDrftFair) + LB(1:1) = lbound(SrcInputFileData%LDrftFair, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LDrftFair, kind=B8Ki) if (.not. allocated(DstInputFileData%LDrftFair)) then allocate(DstInputFileData%LDrftFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -382,8 +382,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair end if if (allocated(SrcInputFileData%LUnstrLen)) then - LB(1:1) = lbound(SrcInputFileData%LUnstrLen) - UB(1:1) = ubound(SrcInputFileData%LUnstrLen) + LB(1:1) = lbound(SrcInputFileData%LUnstrLen, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LUnstrLen, kind=B8Ki) if (.not. allocated(DstInputFileData%LUnstrLen)) then allocate(DstInputFileData%LUnstrLen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -394,8 +394,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen end if if (allocated(SrcInputFileData%Tension)) then - LB(1:1) = lbound(SrcInputFileData%Tension) - UB(1:1) = ubound(SrcInputFileData%Tension) + LB(1:1) = lbound(SrcInputFileData%Tension, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%Tension, kind=B8Ki) if (.not. allocated(DstInputFileData%Tension)) then allocate(DstInputFileData%Tension(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -406,8 +406,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tension = SrcInputFileData%Tension end if if (allocated(SrcInputFileData%GSL)) then - LB(1:3) = lbound(SrcInputFileData%GSL) - UB(1:3) = ubound(SrcInputFileData%GSL) + LB(1:3) = lbound(SrcInputFileData%GSL, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%GSL, kind=B8Ki) if (.not. allocated(DstInputFileData%GSL)) then allocate(DstInputFileData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -418,8 +418,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GSL = SrcInputFileData%GSL end if if (allocated(SrcInputFileData%GSR)) then - LB(1:2) = lbound(SrcInputFileData%GSR) - UB(1:2) = ubound(SrcInputFileData%GSR) + LB(1:2) = lbound(SrcInputFileData%GSR, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileData%GSR, kind=B8Ki) if (.not. allocated(DstInputFileData%GSR)) then allocate(DstInputFileData%GSR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -430,8 +430,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GSR = SrcInputFileData%GSR end if if (allocated(SrcInputFileData%GE)) then - LB(1:3) = lbound(SrcInputFileData%GE) - UB(1:3) = ubound(SrcInputFileData%GE) + LB(1:3) = lbound(SrcInputFileData%GE, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%GE, kind=B8Ki) if (.not. allocated(DstInputFileData%GE)) then allocate(DstInputFileData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -454,8 +454,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -538,87 +538,87 @@ subroutine FEAM_PackInputFile(Buf, Indata) call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%LineCI)) if (allocated(InData%LineCI)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) + call RegPackBounds(Buf, 1, lbound(InData%LineCI, kind=B8Ki), ubound(InData%LineCI, kind=B8Ki)) call RegPack(Buf, InData%LineCI) end if call RegPack(Buf, allocated(InData%LineCD)) if (allocated(InData%LineCD)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) + call RegPackBounds(Buf, 1, lbound(InData%LineCD, kind=B8Ki), ubound(InData%LineCD, kind=B8Ki)) call RegPack(Buf, InData%LineCD) end if call RegPack(Buf, allocated(InData%LEAStiff)) if (allocated(InData%LEAStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) + call RegPackBounds(Buf, 1, lbound(InData%LEAStiff, kind=B8Ki), ubound(InData%LEAStiff, kind=B8Ki)) call RegPack(Buf, InData%LEAStiff) end if call RegPack(Buf, allocated(InData%LMassDen)) if (allocated(InData%LMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) + call RegPackBounds(Buf, 1, lbound(InData%LMassDen, kind=B8Ki), ubound(InData%LMassDen, kind=B8Ki)) call RegPack(Buf, InData%LMassDen) end if call RegPack(Buf, allocated(InData%LDMassDen)) if (allocated(InData%LDMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) + call RegPackBounds(Buf, 1, lbound(InData%LDMassDen, kind=B8Ki), ubound(InData%LDMassDen, kind=B8Ki)) call RegPack(Buf, InData%LDMassDen) end if call RegPack(Buf, allocated(InData%BottmStiff)) if (allocated(InData%BottmStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) + call RegPackBounds(Buf, 1, lbound(InData%BottmStiff, kind=B8Ki), ubound(InData%BottmStiff, kind=B8Ki)) call RegPack(Buf, InData%BottmStiff) end if call RegPack(Buf, allocated(InData%LRadAnch)) if (allocated(InData%LRadAnch)) then - call RegPackBounds(Buf, 1, lbound(InData%LRadAnch), ubound(InData%LRadAnch)) + call RegPackBounds(Buf, 1, lbound(InData%LRadAnch, kind=B8Ki), ubound(InData%LRadAnch, kind=B8Ki)) call RegPack(Buf, InData%LRadAnch) end if call RegPack(Buf, allocated(InData%LAngAnch)) if (allocated(InData%LAngAnch)) then - call RegPackBounds(Buf, 1, lbound(InData%LAngAnch), ubound(InData%LAngAnch)) + call RegPackBounds(Buf, 1, lbound(InData%LAngAnch, kind=B8Ki), ubound(InData%LAngAnch, kind=B8Ki)) call RegPack(Buf, InData%LAngAnch) end if call RegPack(Buf, allocated(InData%LDpthAnch)) if (allocated(InData%LDpthAnch)) then - call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch), ubound(InData%LDpthAnch)) + call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch, kind=B8Ki), ubound(InData%LDpthAnch, kind=B8Ki)) call RegPack(Buf, InData%LDpthAnch) end if call RegPack(Buf, allocated(InData%LRadFair)) if (allocated(InData%LRadFair)) then - call RegPackBounds(Buf, 1, lbound(InData%LRadFair), ubound(InData%LRadFair)) + call RegPackBounds(Buf, 1, lbound(InData%LRadFair, kind=B8Ki), ubound(InData%LRadFair, kind=B8Ki)) call RegPack(Buf, InData%LRadFair) end if call RegPack(Buf, allocated(InData%LAngFair)) if (allocated(InData%LAngFair)) then - call RegPackBounds(Buf, 1, lbound(InData%LAngFair), ubound(InData%LAngFair)) + call RegPackBounds(Buf, 1, lbound(InData%LAngFair, kind=B8Ki), ubound(InData%LAngFair, kind=B8Ki)) call RegPack(Buf, InData%LAngFair) end if call RegPack(Buf, allocated(InData%LDrftFair)) if (allocated(InData%LDrftFair)) then - call RegPackBounds(Buf, 1, lbound(InData%LDrftFair), ubound(InData%LDrftFair)) + call RegPackBounds(Buf, 1, lbound(InData%LDrftFair, kind=B8Ki), ubound(InData%LDrftFair, kind=B8Ki)) call RegPack(Buf, InData%LDrftFair) end if call RegPack(Buf, allocated(InData%LUnstrLen)) if (allocated(InData%LUnstrLen)) then - call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen), ubound(InData%LUnstrLen)) + call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen, kind=B8Ki), ubound(InData%LUnstrLen, kind=B8Ki)) call RegPack(Buf, InData%LUnstrLen) end if call RegPack(Buf, allocated(InData%Tension)) if (allocated(InData%Tension)) then - call RegPackBounds(Buf, 1, lbound(InData%Tension), ubound(InData%Tension)) + call RegPackBounds(Buf, 1, lbound(InData%Tension, kind=B8Ki), ubound(InData%Tension, kind=B8Ki)) call RegPack(Buf, InData%Tension) end if call RegPack(Buf, allocated(InData%GSL)) if (allocated(InData%GSL)) then - call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) + call RegPackBounds(Buf, 3, lbound(InData%GSL, kind=B8Ki), ubound(InData%GSL, kind=B8Ki)) call RegPack(Buf, InData%GSL) end if call RegPack(Buf, allocated(InData%GSR)) if (allocated(InData%GSR)) then - call RegPackBounds(Buf, 2, lbound(InData%GSR), ubound(InData%GSR)) + call RegPackBounds(Buf, 2, lbound(InData%GSR, kind=B8Ki), ubound(InData%GSR, kind=B8Ki)) call RegPack(Buf, InData%GSR) end if call RegPack(Buf, allocated(InData%GE)) if (allocated(InData%GE)) then - call RegPackBounds(Buf, 3, lbound(InData%GE), ubound(InData%GE)) + call RegPackBounds(Buf, 3, lbound(InData%GE, kind=B8Ki), ubound(InData%GE, kind=B8Ki)) call RegPack(Buf, InData%GE) end if call RegPack(Buf, InData%NumLines) @@ -635,7 +635,7 @@ subroutine FEAM_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return @@ -645,7 +645,7 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -935,7 +935,7 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyInitInput' ErrStat = ErrID_None @@ -945,8 +945,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit DstInitInputData%NStepWave = SrcInitInputData%NStepWave if (allocated(SrcInitInputData%WaveAcc0)) then - LB(1:3) = lbound(SrcInitInputData%WaveAcc0) - UB(1:3) = ubound(SrcInitInputData%WaveAcc0) + LB(1:3) = lbound(SrcInitInputData%WaveAcc0, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%WaveAcc0, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveAcc0)) then allocate(DstInitInputData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -957,8 +957,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 end if if (allocated(SrcInitInputData%WaveTime)) then - LB(1:1) = lbound(SrcInitInputData%WaveTime) - UB(1:1) = ubound(SrcInitInputData%WaveTime) + LB(1:1) = lbound(SrcInitInputData%WaveTime, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveTime, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveTime)) then allocate(DstInitInputData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -969,8 +969,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WaveTime = SrcInitInputData%WaveTime end if if (allocated(SrcInitInputData%WaveVel0)) then - LB(1:3) = lbound(SrcInitInputData%WaveVel0) - UB(1:3) = ubound(SrcInitInputData%WaveVel0) + LB(1:3) = lbound(SrcInitInputData%WaveVel0, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%WaveVel0, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveVel0)) then allocate(DstInitInputData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1013,17 +1013,17 @@ subroutine FEAM_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NStepWave) call RegPack(Buf, allocated(InData%WaveAcc0)) if (allocated(InData%WaveAcc0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) + call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0, kind=B8Ki), ubound(InData%WaveAcc0, kind=B8Ki)) call RegPack(Buf, InData%WaveAcc0) end if call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackBounds(Buf, 1, lbound(InData%WaveTime, kind=B8Ki), ubound(InData%WaveTime, kind=B8Ki)) call RegPack(Buf, InData%WaveTime) end if call RegPack(Buf, allocated(InData%WaveVel0)) if (allocated(InData%WaveVel0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) + call RegPackBounds(Buf, 3, lbound(InData%WaveVel0, kind=B8Ki), ubound(InData%WaveVel0, kind=B8Ki)) call RegPack(Buf, InData%WaveVel0) end if call RegPack(Buf, InData%Gravity) @@ -1035,7 +1035,7 @@ subroutine FEAM_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1101,15 +1101,15 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1120,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1135,8 +1135,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LAnchxi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchxi) - UB(1:1) = ubound(SrcInitOutputData%LAnchxi) + LB(1:1) = lbound(SrcInitOutputData%LAnchxi, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LAnchxi, kind=B8Ki) if (.not. allocated(DstInitOutputData%LAnchxi)) then allocate(DstInitOutputData%LAnchxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1147,8 +1147,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi end if if (allocated(SrcInitOutputData%LAnchyi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchyi) - UB(1:1) = ubound(SrcInitOutputData%LAnchyi) + LB(1:1) = lbound(SrcInitOutputData%LAnchyi, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LAnchyi, kind=B8Ki) if (.not. allocated(DstInitOutputData%LAnchyi)) then allocate(DstInitOutputData%LAnchyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1159,8 +1159,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi end if if (allocated(SrcInitOutputData%LAnchzi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchzi) - UB(1:1) = ubound(SrcInitOutputData%LAnchzi) + LB(1:1) = lbound(SrcInitOutputData%LAnchzi, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LAnchzi, kind=B8Ki) if (.not. allocated(DstInitOutputData%LAnchzi)) then allocate(DstInitOutputData%LAnchzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1171,8 +1171,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi end if if (allocated(SrcInitOutputData%LFairxt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairxt) - UB(1:1) = ubound(SrcInitOutputData%LFairxt) + LB(1:1) = lbound(SrcInitOutputData%LFairxt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LFairxt, kind=B8Ki) if (.not. allocated(DstInitOutputData%LFairxt)) then allocate(DstInitOutputData%LFairxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1183,8 +1183,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt end if if (allocated(SrcInitOutputData%LFairyt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairyt) - UB(1:1) = ubound(SrcInitOutputData%LFairyt) + LB(1:1) = lbound(SrcInitOutputData%LFairyt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LFairyt, kind=B8Ki) if (.not. allocated(DstInitOutputData%LFairyt)) then allocate(DstInitOutputData%LFairyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1195,8 +1195,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt end if if (allocated(SrcInitOutputData%LFairzt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairzt) - UB(1:1) = ubound(SrcInitOutputData%LFairzt) + LB(1:1) = lbound(SrcInitOutputData%LFairzt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LFairzt, kind=B8Ki) if (.not. allocated(DstInitOutputData%LFairzt)) then allocate(DstInitOutputData%LFairzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1252,43 +1252,43 @@ subroutine FEAM_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%LAnchxi)) if (allocated(InData%LAnchxi)) then - call RegPackBounds(Buf, 1, lbound(InData%LAnchxi), ubound(InData%LAnchxi)) + call RegPackBounds(Buf, 1, lbound(InData%LAnchxi, kind=B8Ki), ubound(InData%LAnchxi, kind=B8Ki)) call RegPack(Buf, InData%LAnchxi) end if call RegPack(Buf, allocated(InData%LAnchyi)) if (allocated(InData%LAnchyi)) then - call RegPackBounds(Buf, 1, lbound(InData%LAnchyi), ubound(InData%LAnchyi)) + call RegPackBounds(Buf, 1, lbound(InData%LAnchyi, kind=B8Ki), ubound(InData%LAnchyi, kind=B8Ki)) call RegPack(Buf, InData%LAnchyi) end if call RegPack(Buf, allocated(InData%LAnchzi)) if (allocated(InData%LAnchzi)) then - call RegPackBounds(Buf, 1, lbound(InData%LAnchzi), ubound(InData%LAnchzi)) + call RegPackBounds(Buf, 1, lbound(InData%LAnchzi, kind=B8Ki), ubound(InData%LAnchzi, kind=B8Ki)) call RegPack(Buf, InData%LAnchzi) end if call RegPack(Buf, allocated(InData%LFairxt)) if (allocated(InData%LFairxt)) then - call RegPackBounds(Buf, 1, lbound(InData%LFairxt), ubound(InData%LFairxt)) + call RegPackBounds(Buf, 1, lbound(InData%LFairxt, kind=B8Ki), ubound(InData%LFairxt, kind=B8Ki)) call RegPack(Buf, InData%LFairxt) end if call RegPack(Buf, allocated(InData%LFairyt)) if (allocated(InData%LFairyt)) then - call RegPackBounds(Buf, 1, lbound(InData%LFairyt), ubound(InData%LFairyt)) + call RegPackBounds(Buf, 1, lbound(InData%LFairyt, kind=B8Ki), ubound(InData%LFairyt, kind=B8Ki)) call RegPack(Buf, InData%LFairyt) end if call RegPack(Buf, allocated(InData%LFairzt)) if (allocated(InData%LFairzt)) then - call RegPackBounds(Buf, 1, lbound(InData%LFairzt), ubound(InData%LFairzt)) + call RegPackBounds(Buf, 1, lbound(InData%LFairzt, kind=B8Ki), ubound(InData%LFairzt, kind=B8Ki)) call RegPack(Buf, InData%LFairzt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1298,7 +1298,7 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1423,14 +1423,14 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%GLU)) then - LB(1:2) = lbound(SrcContStateData%GLU) - UB(1:2) = ubound(SrcContStateData%GLU) + LB(1:2) = lbound(SrcContStateData%GLU, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%GLU, kind=B8Ki) if (.not. allocated(DstContStateData%GLU)) then allocate(DstContStateData%GLU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1441,8 +1441,8 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS DstContStateData%GLU = SrcContStateData%GLU end if if (allocated(SrcContStateData%GLDU)) then - LB(1:2) = lbound(SrcContStateData%GLDU) - UB(1:2) = ubound(SrcContStateData%GLDU) + LB(1:2) = lbound(SrcContStateData%GLDU, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%GLDU, kind=B8Ki) if (.not. allocated(DstContStateData%GLDU)) then allocate(DstContStateData%GLDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1476,12 +1476,12 @@ subroutine FEAM_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%GLU)) if (allocated(InData%GLU)) then - call RegPackBounds(Buf, 2, lbound(InData%GLU), ubound(InData%GLU)) + call RegPackBounds(Buf, 2, lbound(InData%GLU, kind=B8Ki), ubound(InData%GLU, kind=B8Ki)) call RegPack(Buf, InData%GLU) end if call RegPack(Buf, allocated(InData%GLDU)) if (allocated(InData%GLDU)) then - call RegPackBounds(Buf, 2, lbound(InData%GLDU), ubound(InData%GLDU)) + call RegPackBounds(Buf, 2, lbound(InData%GLDU, kind=B8Ki), ubound(InData%GLDU, kind=B8Ki)) call RegPack(Buf, InData%GLDU) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1491,7 +1491,7 @@ subroutine FEAM_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackContState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1613,14 +1613,14 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%GLU0)) then - LB(1:2) = lbound(SrcOtherStateData%GLU0) - UB(1:2) = ubound(SrcOtherStateData%GLU0) + LB(1:2) = lbound(SrcOtherStateData%GLU0, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%GLU0, kind=B8Ki) if (.not. allocated(DstOtherStateData%GLU0)) then allocate(DstOtherStateData%GLU0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1631,8 +1631,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 end if if (allocated(SrcOtherStateData%GLDDU)) then - LB(1:2) = lbound(SrcOtherStateData%GLDDU) - UB(1:2) = ubound(SrcOtherStateData%GLDDU) + LB(1:2) = lbound(SrcOtherStateData%GLDDU, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%GLDDU, kind=B8Ki) if (.not. allocated(DstOtherStateData%GLDDU)) then allocate(DstOtherStateData%GLDDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1644,8 +1644,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch if (allocated(SrcOtherStateData%GFORC0)) then - LB(1:3) = lbound(SrcOtherStateData%GFORC0) - UB(1:3) = ubound(SrcOtherStateData%GFORC0) + LB(1:3) = lbound(SrcOtherStateData%GFORC0, kind=B8Ki) + UB(1:3) = ubound(SrcOtherStateData%GFORC0, kind=B8Ki) if (.not. allocated(DstOtherStateData%GFORC0)) then allocate(DstOtherStateData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1656,8 +1656,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 end if if (allocated(SrcOtherStateData%GMASS0)) then - LB(1:4) = lbound(SrcOtherStateData%GMASS0) - UB(1:4) = ubound(SrcOtherStateData%GMASS0) + LB(1:4) = lbound(SrcOtherStateData%GMASS0, kind=B8Ki) + UB(1:4) = ubound(SrcOtherStateData%GMASS0, kind=B8Ki) if (.not. allocated(DstOtherStateData%GMASS0)) then allocate(DstOtherStateData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1668,8 +1668,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 end if if (allocated(SrcOtherStateData%FAST_FPA)) then - LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) - UB(1:2) = ubound(SrcOtherStateData%FAST_FPA) + LB(1:2) = lbound(SrcOtherStateData%FAST_FPA, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%FAST_FPA, kind=B8Ki) if (.not. allocated(DstOtherStateData%FAST_FPA)) then allocate(DstOtherStateData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1680,8 +1680,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA end if if (allocated(SrcOtherStateData%FAST_RP)) then - LB(1:2) = lbound(SrcOtherStateData%FAST_RP) - UB(1:2) = ubound(SrcOtherStateData%FAST_RP) + LB(1:2) = lbound(SrcOtherStateData%FAST_RP, kind=B8Ki) + UB(1:2) = ubound(SrcOtherStateData%FAST_RP, kind=B8Ki) if (.not. allocated(DstOtherStateData%FAST_RP)) then allocate(DstOtherStateData%FAST_RP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1731,33 +1731,33 @@ subroutine FEAM_PackOtherState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%GLU0)) if (allocated(InData%GLU0)) then - call RegPackBounds(Buf, 2, lbound(InData%GLU0), ubound(InData%GLU0)) + call RegPackBounds(Buf, 2, lbound(InData%GLU0, kind=B8Ki), ubound(InData%GLU0, kind=B8Ki)) call RegPack(Buf, InData%GLU0) end if call RegPack(Buf, allocated(InData%GLDDU)) if (allocated(InData%GLDDU)) then - call RegPackBounds(Buf, 2, lbound(InData%GLDDU), ubound(InData%GLDDU)) + call RegPackBounds(Buf, 2, lbound(InData%GLDDU, kind=B8Ki), ubound(InData%GLDDU, kind=B8Ki)) call RegPack(Buf, InData%GLDDU) end if call RegPack(Buf, InData%BottomTouch) call RegPack(Buf, allocated(InData%GFORC0)) if (allocated(InData%GFORC0)) then - call RegPackBounds(Buf, 3, lbound(InData%GFORC0), ubound(InData%GFORC0)) + call RegPackBounds(Buf, 3, lbound(InData%GFORC0, kind=B8Ki), ubound(InData%GFORC0, kind=B8Ki)) call RegPack(Buf, InData%GFORC0) end if call RegPack(Buf, allocated(InData%GMASS0)) if (allocated(InData%GMASS0)) then - call RegPackBounds(Buf, 4, lbound(InData%GMASS0), ubound(InData%GMASS0)) + call RegPackBounds(Buf, 4, lbound(InData%GMASS0, kind=B8Ki), ubound(InData%GMASS0, kind=B8Ki)) call RegPack(Buf, InData%GMASS0) end if call RegPack(Buf, allocated(InData%FAST_FPA)) if (allocated(InData%FAST_FPA)) then - call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA), ubound(InData%FAST_FPA)) + call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA, kind=B8Ki), ubound(InData%FAST_FPA, kind=B8Ki)) call RegPack(Buf, InData%FAST_FPA) end if call RegPack(Buf, allocated(InData%FAST_RP)) if (allocated(InData%FAST_RP)) then - call RegPackBounds(Buf, 2, lbound(InData%FAST_RP), ubound(InData%FAST_RP)) + call RegPackBounds(Buf, 2, lbound(InData%FAST_RP, kind=B8Ki), ubound(InData%FAST_RP, kind=B8Ki)) call RegPack(Buf, InData%FAST_RP) end if call RegPack(Buf, InData%INCR) @@ -1771,7 +1771,7 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1877,14 +1877,14 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%GLF)) then - LB(1:2) = lbound(SrcMiscData%GLF) - UB(1:2) = ubound(SrcMiscData%GLF) + LB(1:2) = lbound(SrcMiscData%GLF, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%GLF, kind=B8Ki) if (.not. allocated(DstMiscData%GLF)) then allocate(DstMiscData%GLF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1895,8 +1895,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%GLF = SrcMiscData%GLF end if if (allocated(SrcMiscData%GLK)) then - LB(1:3) = lbound(SrcMiscData%GLK) - UB(1:3) = ubound(SrcMiscData%GLK) + LB(1:3) = lbound(SrcMiscData%GLK, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%GLK, kind=B8Ki) if (.not. allocated(DstMiscData%GLK)) then allocate(DstMiscData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1909,8 +1909,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%EMASS = SrcMiscData%EMASS DstMiscData%ESTIF = SrcMiscData%ESTIF if (allocated(SrcMiscData%FAST_FP)) then - LB(1:2) = lbound(SrcMiscData%FAST_FP) - UB(1:2) = ubound(SrcMiscData%FAST_FP) + LB(1:2) = lbound(SrcMiscData%FAST_FP, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%FAST_FP, kind=B8Ki) if (.not. allocated(DstMiscData%FAST_FP)) then allocate(DstMiscData%FAST_FP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1932,8 +1932,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SLIN = SrcMiscData%SLIN DstMiscData%STIFR = SrcMiscData%STIFR if (allocated(SrcMiscData%FAIR_ANG)) then - LB(1:2) = lbound(SrcMiscData%FAIR_ANG) - UB(1:2) = ubound(SrcMiscData%FAIR_ANG) + LB(1:2) = lbound(SrcMiscData%FAIR_ANG, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%FAIR_ANG, kind=B8Ki) if (.not. allocated(DstMiscData%FAIR_ANG)) then allocate(DstMiscData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1944,8 +1944,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG end if if (allocated(SrcMiscData%FAIR_T)) then - LB(1:1) = lbound(SrcMiscData%FAIR_T) - UB(1:1) = ubound(SrcMiscData%FAIR_T) + LB(1:1) = lbound(SrcMiscData%FAIR_T, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FAIR_T, kind=B8Ki) if (.not. allocated(DstMiscData%FAIR_T)) then allocate(DstMiscData%FAIR_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1956,8 +1956,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAIR_T = SrcMiscData%FAIR_T end if if (allocated(SrcMiscData%ANCH_ANG)) then - LB(1:2) = lbound(SrcMiscData%ANCH_ANG) - UB(1:2) = ubound(SrcMiscData%ANCH_ANG) + LB(1:2) = lbound(SrcMiscData%ANCH_ANG, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%ANCH_ANG, kind=B8Ki) if (.not. allocated(DstMiscData%ANCH_ANG)) then allocate(DstMiscData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1968,8 +1968,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG end if if (allocated(SrcMiscData%ANCH_T)) then - LB(1:1) = lbound(SrcMiscData%ANCH_T) - UB(1:1) = ubound(SrcMiscData%ANCH_T) + LB(1:1) = lbound(SrcMiscData%ANCH_T, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%ANCH_T, kind=B8Ki) if (.not. allocated(DstMiscData%ANCH_T)) then allocate(DstMiscData%ANCH_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1980,8 +1980,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ANCH_T = SrcMiscData%ANCH_T end if if (allocated(SrcMiscData%Line_Coordinate)) then - LB(1:3) = lbound(SrcMiscData%Line_Coordinate) - UB(1:3) = ubound(SrcMiscData%Line_Coordinate) + LB(1:3) = lbound(SrcMiscData%Line_Coordinate, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%Line_Coordinate, kind=B8Ki) if (.not. allocated(DstMiscData%Line_Coordinate)) then allocate(DstMiscData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1992,8 +1992,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate end if if (allocated(SrcMiscData%Line_Tangent)) then - LB(1:3) = lbound(SrcMiscData%Line_Tangent) - UB(1:3) = ubound(SrcMiscData%Line_Tangent) + LB(1:3) = lbound(SrcMiscData%Line_Tangent, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%Line_Tangent, kind=B8Ki) if (.not. allocated(DstMiscData%Line_Tangent)) then allocate(DstMiscData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2004,8 +2004,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent end if if (allocated(SrcMiscData%F_Lines)) then - LB(1:2) = lbound(SrcMiscData%F_Lines) - UB(1:2) = ubound(SrcMiscData%F_Lines) + LB(1:2) = lbound(SrcMiscData%F_Lines, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_Lines, kind=B8Ki) if (.not. allocated(DstMiscData%F_Lines)) then allocate(DstMiscData%F_Lines(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2064,19 +2064,19 @@ subroutine FEAM_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%GLF)) if (allocated(InData%GLF)) then - call RegPackBounds(Buf, 2, lbound(InData%GLF), ubound(InData%GLF)) + call RegPackBounds(Buf, 2, lbound(InData%GLF, kind=B8Ki), ubound(InData%GLF, kind=B8Ki)) call RegPack(Buf, InData%GLF) end if call RegPack(Buf, allocated(InData%GLK)) if (allocated(InData%GLK)) then - call RegPackBounds(Buf, 3, lbound(InData%GLK), ubound(InData%GLK)) + call RegPackBounds(Buf, 3, lbound(InData%GLK, kind=B8Ki), ubound(InData%GLK, kind=B8Ki)) call RegPack(Buf, InData%GLK) end if call RegPack(Buf, InData%EMASS) call RegPack(Buf, InData%ESTIF) call RegPack(Buf, allocated(InData%FAST_FP)) if (allocated(InData%FAST_FP)) then - call RegPackBounds(Buf, 2, lbound(InData%FAST_FP), ubound(InData%FAST_FP)) + call RegPackBounds(Buf, 2, lbound(InData%FAST_FP, kind=B8Ki), ubound(InData%FAST_FP, kind=B8Ki)) call RegPack(Buf, InData%FAST_FP) end if call RegPack(Buf, InData%FORCE) @@ -2092,37 +2092,37 @@ subroutine FEAM_PackMisc(Buf, Indata) call RegPack(Buf, InData%STIFR) call RegPack(Buf, allocated(InData%FAIR_ANG)) if (allocated(InData%FAIR_ANG)) then - call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG), ubound(InData%FAIR_ANG)) + call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG, kind=B8Ki), ubound(InData%FAIR_ANG, kind=B8Ki)) call RegPack(Buf, InData%FAIR_ANG) end if call RegPack(Buf, allocated(InData%FAIR_T)) if (allocated(InData%FAIR_T)) then - call RegPackBounds(Buf, 1, lbound(InData%FAIR_T), ubound(InData%FAIR_T)) + call RegPackBounds(Buf, 1, lbound(InData%FAIR_T, kind=B8Ki), ubound(InData%FAIR_T, kind=B8Ki)) call RegPack(Buf, InData%FAIR_T) end if call RegPack(Buf, allocated(InData%ANCH_ANG)) if (allocated(InData%ANCH_ANG)) then - call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG), ubound(InData%ANCH_ANG)) + call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG, kind=B8Ki), ubound(InData%ANCH_ANG, kind=B8Ki)) call RegPack(Buf, InData%ANCH_ANG) end if call RegPack(Buf, allocated(InData%ANCH_T)) if (allocated(InData%ANCH_T)) then - call RegPackBounds(Buf, 1, lbound(InData%ANCH_T), ubound(InData%ANCH_T)) + call RegPackBounds(Buf, 1, lbound(InData%ANCH_T, kind=B8Ki), ubound(InData%ANCH_T, kind=B8Ki)) call RegPack(Buf, InData%ANCH_T) end if call RegPack(Buf, allocated(InData%Line_Coordinate)) if (allocated(InData%Line_Coordinate)) then - call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate), ubound(InData%Line_Coordinate)) + call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate, kind=B8Ki), ubound(InData%Line_Coordinate, kind=B8Ki)) call RegPack(Buf, InData%Line_Coordinate) end if call RegPack(Buf, allocated(InData%Line_Tangent)) if (allocated(InData%Line_Tangent)) then - call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent), ubound(InData%Line_Tangent)) + call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent, kind=B8Ki), ubound(InData%Line_Tangent, kind=B8Ki)) call RegPack(Buf, InData%Line_Tangent) end if call RegPack(Buf, allocated(InData%F_Lines)) if (allocated(InData%F_Lines)) then - call RegPackBounds(Buf, 2, lbound(InData%F_Lines), ubound(InData%F_Lines)) + call RegPackBounds(Buf, 2, lbound(InData%F_Lines, kind=B8Ki), ubound(InData%F_Lines, kind=B8Ki)) call RegPack(Buf, InData%F_Lines) end if call RegPack(Buf, InData%LastIndWave) @@ -2133,7 +2133,7 @@ subroutine FEAM_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2313,8 +2313,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyParam' @@ -2329,8 +2329,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NHBD = SrcParamData%NHBD DstParamData%NDIM = SrcParamData%NDIM if (allocated(SrcParamData%NEQ)) then - LB(1:1) = lbound(SrcParamData%NEQ) - UB(1:1) = ubound(SrcParamData%NEQ) + LB(1:1) = lbound(SrcParamData%NEQ, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NEQ, kind=B8Ki) if (.not. allocated(DstParamData%NEQ)) then allocate(DstParamData%NEQ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2345,8 +2345,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumElems = SrcParamData%NumElems DstParamData%NumNodes = SrcParamData%NumNodes if (allocated(SrcParamData%GSL)) then - LB(1:3) = lbound(SrcParamData%GSL) - UB(1:3) = ubound(SrcParamData%GSL) + LB(1:3) = lbound(SrcParamData%GSL, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%GSL, kind=B8Ki) if (.not. allocated(DstParamData%GSL)) then allocate(DstParamData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2357,8 +2357,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GSL = SrcParamData%GSL end if if (allocated(SrcParamData%GP)) then - LB(1:2) = lbound(SrcParamData%GP) - UB(1:2) = ubound(SrcParamData%GP) + LB(1:2) = lbound(SrcParamData%GP, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%GP, kind=B8Ki) if (.not. allocated(DstParamData%GP)) then allocate(DstParamData%GP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2369,8 +2369,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GP = SrcParamData%GP end if if (allocated(SrcParamData%Elength)) then - LB(1:1) = lbound(SrcParamData%Elength) - UB(1:1) = ubound(SrcParamData%Elength) + LB(1:1) = lbound(SrcParamData%Elength, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Elength, kind=B8Ki) if (.not. allocated(DstParamData%Elength)) then allocate(DstParamData%Elength(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2381,8 +2381,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Elength = SrcParamData%Elength end if if (allocated(SrcParamData%BottmElev)) then - LB(1:1) = lbound(SrcParamData%BottmElev) - UB(1:1) = ubound(SrcParamData%BottmElev) + LB(1:1) = lbound(SrcParamData%BottmElev, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BottmElev, kind=B8Ki) if (.not. allocated(DstParamData%BottmElev)) then allocate(DstParamData%BottmElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2393,8 +2393,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BottmElev = SrcParamData%BottmElev end if if (allocated(SrcParamData%BottmStiff)) then - LB(1:1) = lbound(SrcParamData%BottmStiff) - UB(1:1) = ubound(SrcParamData%BottmStiff) + LB(1:1) = lbound(SrcParamData%BottmStiff, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BottmStiff, kind=B8Ki) if (.not. allocated(DstParamData%BottmStiff)) then allocate(DstParamData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2405,8 +2405,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BottmStiff = SrcParamData%BottmStiff end if if (allocated(SrcParamData%LMassDen)) then - LB(1:1) = lbound(SrcParamData%LMassDen) - UB(1:1) = ubound(SrcParamData%LMassDen) + LB(1:1) = lbound(SrcParamData%LMassDen, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%LMassDen, kind=B8Ki) if (.not. allocated(DstParamData%LMassDen)) then allocate(DstParamData%LMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2417,8 +2417,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LMassDen = SrcParamData%LMassDen end if if (allocated(SrcParamData%LDMassDen)) then - LB(1:1) = lbound(SrcParamData%LDMassDen) - UB(1:1) = ubound(SrcParamData%LDMassDen) + LB(1:1) = lbound(SrcParamData%LDMassDen, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%LDMassDen, kind=B8Ki) if (.not. allocated(DstParamData%LDMassDen)) then allocate(DstParamData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2429,8 +2429,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LDMassDen = SrcParamData%LDMassDen end if if (allocated(SrcParamData%LEAStiff)) then - LB(1:1) = lbound(SrcParamData%LEAStiff) - UB(1:1) = ubound(SrcParamData%LEAStiff) + LB(1:1) = lbound(SrcParamData%LEAStiff, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%LEAStiff, kind=B8Ki) if (.not. allocated(DstParamData%LEAStiff)) then allocate(DstParamData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2441,8 +2441,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LEAStiff = SrcParamData%LEAStiff end if if (allocated(SrcParamData%LineCI)) then - LB(1:1) = lbound(SrcParamData%LineCI) - UB(1:1) = ubound(SrcParamData%LineCI) + LB(1:1) = lbound(SrcParamData%LineCI, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%LineCI, kind=B8Ki) if (.not. allocated(DstParamData%LineCI)) then allocate(DstParamData%LineCI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2453,8 +2453,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LineCI = SrcParamData%LineCI end if if (allocated(SrcParamData%LineCD)) then - LB(1:1) = lbound(SrcParamData%LineCD) - UB(1:1) = ubound(SrcParamData%LineCD) + LB(1:1) = lbound(SrcParamData%LineCD, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%LineCD, kind=B8Ki) if (.not. allocated(DstParamData%LineCD)) then allocate(DstParamData%LineCD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2465,8 +2465,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LineCD = SrcParamData%LineCD end if if (allocated(SrcParamData%Bvp)) then - LB(1:2) = lbound(SrcParamData%Bvp) - UB(1:2) = ubound(SrcParamData%Bvp) + LB(1:2) = lbound(SrcParamData%Bvp, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Bvp, kind=B8Ki) if (.not. allocated(DstParamData%Bvp)) then allocate(DstParamData%Bvp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2477,8 +2477,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Bvp = SrcParamData%Bvp end if if (allocated(SrcParamData%WaveAcc0)) then - LB(1:3) = lbound(SrcParamData%WaveAcc0) - UB(1:3) = ubound(SrcParamData%WaveAcc0) + LB(1:3) = lbound(SrcParamData%WaveAcc0, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%WaveAcc0, kind=B8Ki) if (.not. allocated(DstParamData%WaveAcc0)) then allocate(DstParamData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2489,8 +2489,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 end if if (allocated(SrcParamData%WaveTime)) then - LB(1:1) = lbound(SrcParamData%WaveTime) - UB(1:1) = ubound(SrcParamData%WaveTime) + LB(1:1) = lbound(SrcParamData%WaveTime, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WaveTime, kind=B8Ki) if (.not. allocated(DstParamData%WaveTime)) then allocate(DstParamData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2501,8 +2501,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WaveTime = SrcParamData%WaveTime end if if (allocated(SrcParamData%WaveVel0)) then - LB(1:3) = lbound(SrcParamData%WaveVel0) - UB(1:3) = ubound(SrcParamData%WaveVel0) + LB(1:3) = lbound(SrcParamData%WaveVel0, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%WaveVel0, kind=B8Ki) if (.not. allocated(DstParamData%WaveVel0)) then allocate(DstParamData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2534,8 +2534,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2551,8 +2551,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Delim = SrcParamData%Delim if (allocated(SrcParamData%GLUZR)) then - LB(1:3) = lbound(SrcParamData%GLUZR) - UB(1:3) = ubound(SrcParamData%GLUZR) + LB(1:3) = lbound(SrcParamData%GLUZR, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%GLUZR, kind=B8Ki) if (.not. allocated(DstParamData%GLUZR)) then allocate(DstParamData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2563,8 +2563,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GLUZR = SrcParamData%GLUZR end if if (allocated(SrcParamData%GTZER)) then - LB(1:2) = lbound(SrcParamData%GTZER) - UB(1:2) = ubound(SrcParamData%GTZER) + LB(1:2) = lbound(SrcParamData%GTZER, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%GTZER, kind=B8Ki) if (.not. allocated(DstParamData%GTZER)) then allocate(DstParamData%GTZER(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2580,8 +2580,8 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) type(FEAM_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_DestroyParam' @@ -2633,8 +2633,8 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveVel0) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2653,8 +2653,8 @@ subroutine FEAM_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackParam' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%GRAV) @@ -2666,7 +2666,7 @@ subroutine FEAM_PackParam(Buf, Indata) call RegPack(Buf, InData%NDIM) call RegPack(Buf, allocated(InData%NEQ)) if (allocated(InData%NEQ)) then - call RegPackBounds(Buf, 1, lbound(InData%NEQ), ubound(InData%NEQ)) + call RegPackBounds(Buf, 1, lbound(InData%NEQ, kind=B8Ki), ubound(InData%NEQ, kind=B8Ki)) call RegPack(Buf, InData%NEQ) end if call RegPack(Buf, InData%NBAND) @@ -2675,72 +2675,72 @@ subroutine FEAM_PackParam(Buf, Indata) call RegPack(Buf, InData%NumNodes) call RegPack(Buf, allocated(InData%GSL)) if (allocated(InData%GSL)) then - call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) + call RegPackBounds(Buf, 3, lbound(InData%GSL, kind=B8Ki), ubound(InData%GSL, kind=B8Ki)) call RegPack(Buf, InData%GSL) end if call RegPack(Buf, allocated(InData%GP)) if (allocated(InData%GP)) then - call RegPackBounds(Buf, 2, lbound(InData%GP), ubound(InData%GP)) + call RegPackBounds(Buf, 2, lbound(InData%GP, kind=B8Ki), ubound(InData%GP, kind=B8Ki)) call RegPack(Buf, InData%GP) end if call RegPack(Buf, allocated(InData%Elength)) if (allocated(InData%Elength)) then - call RegPackBounds(Buf, 1, lbound(InData%Elength), ubound(InData%Elength)) + call RegPackBounds(Buf, 1, lbound(InData%Elength, kind=B8Ki), ubound(InData%Elength, kind=B8Ki)) call RegPack(Buf, InData%Elength) end if call RegPack(Buf, allocated(InData%BottmElev)) if (allocated(InData%BottmElev)) then - call RegPackBounds(Buf, 1, lbound(InData%BottmElev), ubound(InData%BottmElev)) + call RegPackBounds(Buf, 1, lbound(InData%BottmElev, kind=B8Ki), ubound(InData%BottmElev, kind=B8Ki)) call RegPack(Buf, InData%BottmElev) end if call RegPack(Buf, allocated(InData%BottmStiff)) if (allocated(InData%BottmStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) + call RegPackBounds(Buf, 1, lbound(InData%BottmStiff, kind=B8Ki), ubound(InData%BottmStiff, kind=B8Ki)) call RegPack(Buf, InData%BottmStiff) end if call RegPack(Buf, allocated(InData%LMassDen)) if (allocated(InData%LMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) + call RegPackBounds(Buf, 1, lbound(InData%LMassDen, kind=B8Ki), ubound(InData%LMassDen, kind=B8Ki)) call RegPack(Buf, InData%LMassDen) end if call RegPack(Buf, allocated(InData%LDMassDen)) if (allocated(InData%LDMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) + call RegPackBounds(Buf, 1, lbound(InData%LDMassDen, kind=B8Ki), ubound(InData%LDMassDen, kind=B8Ki)) call RegPack(Buf, InData%LDMassDen) end if call RegPack(Buf, allocated(InData%LEAStiff)) if (allocated(InData%LEAStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) + call RegPackBounds(Buf, 1, lbound(InData%LEAStiff, kind=B8Ki), ubound(InData%LEAStiff, kind=B8Ki)) call RegPack(Buf, InData%LEAStiff) end if call RegPack(Buf, allocated(InData%LineCI)) if (allocated(InData%LineCI)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) + call RegPackBounds(Buf, 1, lbound(InData%LineCI, kind=B8Ki), ubound(InData%LineCI, kind=B8Ki)) call RegPack(Buf, InData%LineCI) end if call RegPack(Buf, allocated(InData%LineCD)) if (allocated(InData%LineCD)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) + call RegPackBounds(Buf, 1, lbound(InData%LineCD, kind=B8Ki), ubound(InData%LineCD, kind=B8Ki)) call RegPack(Buf, InData%LineCD) end if call RegPack(Buf, allocated(InData%Bvp)) if (allocated(InData%Bvp)) then - call RegPackBounds(Buf, 2, lbound(InData%Bvp), ubound(InData%Bvp)) + call RegPackBounds(Buf, 2, lbound(InData%Bvp, kind=B8Ki), ubound(InData%Bvp, kind=B8Ki)) call RegPack(Buf, InData%Bvp) end if call RegPack(Buf, allocated(InData%WaveAcc0)) if (allocated(InData%WaveAcc0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) + call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0, kind=B8Ki), ubound(InData%WaveAcc0, kind=B8Ki)) call RegPack(Buf, InData%WaveAcc0) end if call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackBounds(Buf, 1, lbound(InData%WaveTime, kind=B8Ki), ubound(InData%WaveTime, kind=B8Ki)) call RegPack(Buf, InData%WaveTime) end if call RegPack(Buf, allocated(InData%WaveVel0)) if (allocated(InData%WaveVel0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) + call RegPackBounds(Buf, 3, lbound(InData%WaveVel0, kind=B8Ki), ubound(InData%WaveVel0, kind=B8Ki)) call RegPack(Buf, InData%WaveVel0) end if call RegPack(Buf, InData%NStepWave) @@ -2766,9 +2766,9 @@ subroutine FEAM_PackParam(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -2776,12 +2776,12 @@ subroutine FEAM_PackParam(Buf, Indata) call RegPack(Buf, InData%Delim) call RegPack(Buf, allocated(InData%GLUZR)) if (allocated(InData%GLUZR)) then - call RegPackBounds(Buf, 3, lbound(InData%GLUZR), ubound(InData%GLUZR)) + call RegPackBounds(Buf, 3, lbound(InData%GLUZR, kind=B8Ki), ubound(InData%GLUZR, kind=B8Ki)) call RegPack(Buf, InData%GLUZR) end if call RegPack(Buf, allocated(InData%GTZER)) if (allocated(InData%GTZER)) then - call RegPackBounds(Buf, 2, lbound(InData%GTZER), ubound(InData%GTZER)) + call RegPackBounds(Buf, 2, lbound(InData%GTZER, kind=B8Ki), ubound(InData%GTZER, kind=B8Ki)) call RegPack(Buf, InData%GTZER) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2791,8 +2791,8 @@ subroutine FEAM_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackParam' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3178,15 +3178,15 @@ subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3229,7 +3229,7 @@ subroutine FEAM_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call MeshPack(Buf, InData%PtFairleadLoad) @@ -3241,7 +3241,7 @@ subroutine FEAM_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAM_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index fe84e573c5..88f18e81de 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -106,7 +106,7 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitInput' ErrStat = ErrID_None @@ -117,8 +117,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HighFreq = SrcInitInputData%HighFreq DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile if (allocated(SrcInitInputData%HdroAddMs)) then - LB(1:3) = lbound(SrcInitInputData%HdroAddMs) - UB(1:3) = ubound(SrcInitInputData%HdroAddMs) + LB(1:3) = lbound(SrcInitInputData%HdroAddMs, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%HdroAddMs, kind=B8Ki) if (.not. allocated(DstInitInputData%HdroAddMs)) then allocate(DstInitInputData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -129,8 +129,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs end if if (allocated(SrcInitInputData%HdroFreq)) then - LB(1:1) = lbound(SrcInitInputData%HdroFreq) - UB(1:1) = ubound(SrcInitInputData%HdroFreq) + LB(1:1) = lbound(SrcInitInputData%HdroFreq, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%HdroFreq, kind=B8Ki) if (.not. allocated(DstInitInputData%HdroFreq)) then allocate(DstInitInputData%HdroFreq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -141,8 +141,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq end if if (allocated(SrcInitInputData%HdroDmpng)) then - LB(1:3) = lbound(SrcInitInputData%HdroDmpng) - UB(1:3) = ubound(SrcInitInputData%HdroDmpng) + LB(1:3) = lbound(SrcInitInputData%HdroDmpng, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%HdroDmpng, kind=B8Ki) if (.not. allocated(DstInitInputData%HdroDmpng)) then allocate(DstInitInputData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -186,17 +186,17 @@ subroutine Conv_Rdtn_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WAMITFile) call RegPack(Buf, allocated(InData%HdroAddMs)) if (allocated(InData%HdroAddMs)) then - call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs), ubound(InData%HdroAddMs)) + call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs, kind=B8Ki), ubound(InData%HdroAddMs, kind=B8Ki)) call RegPack(Buf, InData%HdroAddMs) end if call RegPack(Buf, allocated(InData%HdroFreq)) if (allocated(InData%HdroFreq)) then - call RegPackBounds(Buf, 1, lbound(InData%HdroFreq), ubound(InData%HdroFreq)) + call RegPackBounds(Buf, 1, lbound(InData%HdroFreq, kind=B8Ki), ubound(InData%HdroFreq, kind=B8Ki)) call RegPack(Buf, InData%HdroFreq) end if call RegPack(Buf, allocated(InData%HdroDmpng)) if (allocated(InData%HdroDmpng)) then - call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng), ubound(InData%HdroDmpng)) + call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng, kind=B8Ki), ubound(InData%HdroDmpng, kind=B8Ki)) call RegPack(Buf, InData%HdroDmpng) end if call RegPack(Buf, InData%NInpFreq) @@ -208,7 +208,7 @@ subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -354,14 +354,14 @@ subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%XDHistory)) then - LB(1:2) = lbound(SrcDiscStateData%XDHistory) - UB(1:2) = ubound(SrcDiscStateData%XDHistory) + LB(1:2) = lbound(SrcDiscStateData%XDHistory, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%XDHistory, kind=B8Ki) if (.not. allocated(DstDiscStateData%XDHistory)) then allocate(DstDiscStateData%XDHistory(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -393,7 +393,7 @@ subroutine Conv_Rdtn_PackDiscState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%XDHistory)) if (allocated(InData%XDHistory)) then - call RegPackBounds(Buf, 2, lbound(InData%XDHistory), ubound(InData%XDHistory)) + call RegPackBounds(Buf, 2, lbound(InData%XDHistory, kind=B8Ki), ubound(InData%XDHistory, kind=B8Ki)) call RegPack(Buf, InData%XDHistory) end if call RegPack(Buf, InData%LastTime) @@ -404,7 +404,7 @@ subroutine Conv_Rdtn_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -549,7 +549,7 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyParam' ErrStat = ErrID_None @@ -558,8 +558,8 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%RdtnDT = SrcParamData%RdtnDT DstParamData%NBody = SrcParamData%NBody if (allocated(SrcParamData%RdtnKrnl)) then - LB(1:3) = lbound(SrcParamData%RdtnKrnl) - UB(1:3) = ubound(SrcParamData%RdtnKrnl) + LB(1:3) = lbound(SrcParamData%RdtnKrnl, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%RdtnKrnl, kind=B8Ki) if (.not. allocated(DstParamData%RdtnKrnl)) then allocate(DstParamData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -595,7 +595,7 @@ subroutine Conv_Rdtn_PackParam(Buf, Indata) call RegPack(Buf, InData%NBody) call RegPack(Buf, allocated(InData%RdtnKrnl)) if (allocated(InData%RdtnKrnl)) then - call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl), ubound(InData%RdtnKrnl)) + call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl, kind=B8Ki), ubound(InData%RdtnKrnl, kind=B8Ki)) call RegPack(Buf, InData%RdtnKrnl) end if call RegPack(Buf, InData%NStepRdtn) @@ -607,7 +607,7 @@ subroutine Conv_Rdtn_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -643,14 +643,14 @@ subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Velocity)) then - LB(1:1) = lbound(SrcInputData%Velocity) - UB(1:1) = ubound(SrcInputData%Velocity) + LB(1:1) = lbound(SrcInputData%Velocity, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%Velocity, kind=B8Ki) if (.not. allocated(DstInputData%Velocity)) then allocate(DstInputData%Velocity(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -681,7 +681,7 @@ subroutine Conv_Rdtn_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Velocity)) if (allocated(InData%Velocity)) then - call RegPackBounds(Buf, 1, lbound(InData%Velocity), ubound(InData%Velocity)) + call RegPackBounds(Buf, 1, lbound(InData%Velocity, kind=B8Ki), ubound(InData%Velocity, kind=B8Ki)) call RegPack(Buf, InData%Velocity) end if if (RegCheckErr(Buf, RoutineName)) return @@ -691,7 +691,7 @@ subroutine Conv_Rdtn_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -717,14 +717,14 @@ subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%F_Rdtn)) then - LB(1:1) = lbound(SrcOutputData%F_Rdtn) - UB(1:1) = ubound(SrcOutputData%F_Rdtn) + LB(1:1) = lbound(SrcOutputData%F_Rdtn, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%F_Rdtn, kind=B8Ki) if (.not. allocated(DstOutputData%F_Rdtn)) then allocate(DstOutputData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -755,7 +755,7 @@ subroutine Conv_Rdtn_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%F_Rdtn)) if (allocated(InData%F_Rdtn)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) + call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn, kind=B8Ki), ubound(InData%F_Rdtn, kind=B8Ki)) call RegPack(Buf, InData%F_Rdtn) end if if (RegCheckErr(Buf, RoutineName)) return @@ -765,7 +765,7 @@ subroutine Conv_Rdtn_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 6e5e13a26c..21d8555c40 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -213,7 +213,7 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInputFile' @@ -221,8 +221,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrMsg = '' DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag if (allocated(SrcInputFileData%AddF0)) then - LB(1:2) = lbound(SrcInputFileData%AddF0) - UB(1:2) = ubound(SrcInputFileData%AddF0) + LB(1:2) = lbound(SrcInputFileData%AddF0, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileData%AddF0, kind=B8Ki) if (.not. allocated(DstInputFileData%AddF0)) then allocate(DstInputFileData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -233,8 +233,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddF0 = SrcInputFileData%AddF0 end if if (allocated(SrcInputFileData%AddCLin)) then - LB(1:3) = lbound(SrcInputFileData%AddCLin) - UB(1:3) = ubound(SrcInputFileData%AddCLin) + LB(1:3) = lbound(SrcInputFileData%AddCLin, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%AddCLin, kind=B8Ki) if (.not. allocated(DstInputFileData%AddCLin)) then allocate(DstInputFileData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -245,8 +245,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddCLin = SrcInputFileData%AddCLin end if if (allocated(SrcInputFileData%AddBLin)) then - LB(1:3) = lbound(SrcInputFileData%AddBLin) - UB(1:3) = ubound(SrcInputFileData%AddBLin) + LB(1:3) = lbound(SrcInputFileData%AddBLin, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%AddBLin, kind=B8Ki) if (.not. allocated(DstInputFileData%AddBLin)) then allocate(DstInputFileData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -257,8 +257,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddBLin = SrcInputFileData%AddBLin end if if (allocated(SrcInputFileData%AddBQuad)) then - LB(1:3) = lbound(SrcInputFileData%AddBQuad) - UB(1:3) = ubound(SrcInputFileData%AddBQuad) + LB(1:3) = lbound(SrcInputFileData%AddBQuad, kind=B8Ki) + UB(1:3) = ubound(SrcInputFileData%AddBQuad, kind=B8Ki) if (.not. allocated(DstInputFileData%AddBQuad)) then allocate(DstInputFileData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -269,8 +269,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad end if if (allocated(SrcInputFileData%PotFile)) then - LB(1:1) = lbound(SrcInputFileData%PotFile) - UB(1:1) = ubound(SrcInputFileData%PotFile) + LB(1:1) = lbound(SrcInputFileData%PotFile, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PotFile, kind=B8Ki) if (.not. allocated(DstInputFileData%PotFile)) then allocate(DstInputFileData%PotFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -285,8 +285,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%NBody = SrcInputFileData%NBody DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod if (allocated(SrcInputFileData%PtfmVol0)) then - LB(1:1) = lbound(SrcInputFileData%PtfmVol0) - UB(1:1) = ubound(SrcInputFileData%PtfmVol0) + LB(1:1) = lbound(SrcInputFileData%PtfmVol0, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmVol0, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmVol0)) then allocate(DstInputFileData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -298,8 +298,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT if (allocated(SrcInputFileData%WAMITULEN)) then - LB(1:1) = lbound(SrcInputFileData%WAMITULEN) - UB(1:1) = ubound(SrcInputFileData%WAMITULEN) + LB(1:1) = lbound(SrcInputFileData%WAMITULEN, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WAMITULEN, kind=B8Ki) if (.not. allocated(DstInputFileData%WAMITULEN)) then allocate(DstInputFileData%WAMITULEN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -310,8 +310,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN end if if (allocated(SrcInputFileData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) - UB(1:1) = ubound(SrcInputFileData%PtfmRefxt) + LB(1:1) = lbound(SrcInputFileData%PtfmRefxt, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmRefxt, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmRefxt)) then allocate(DstInputFileData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -322,8 +322,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt end if if (allocated(SrcInputFileData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) - UB(1:1) = ubound(SrcInputFileData%PtfmRefyt) + LB(1:1) = lbound(SrcInputFileData%PtfmRefyt, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmRefyt, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmRefyt)) then allocate(DstInputFileData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -334,8 +334,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt end if if (allocated(SrcInputFileData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) - UB(1:1) = ubound(SrcInputFileData%PtfmRefzt) + LB(1:1) = lbound(SrcInputFileData%PtfmRefzt, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmRefzt, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmRefzt)) then allocate(DstInputFileData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -346,8 +346,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt end if if (allocated(SrcInputFileData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) - UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot) + LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmRefztRot)) then allocate(DstInputFileData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -358,8 +358,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot end if if (allocated(SrcInputFileData%PtfmCOBxt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) - UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt) + LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmCOBxt)) then allocate(DstInputFileData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -370,8 +370,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt end if if (allocated(SrcInputFileData%PtfmCOByt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) - UB(1:1) = ubound(SrcInputFileData%PtfmCOByt) + LB(1:1) = lbound(SrcInputFileData%PtfmCOByt, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%PtfmCOByt, kind=B8Ki) if (.not. allocated(DstInputFileData%PtfmCOByt)) then allocate(DstInputFileData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -394,8 +394,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PotMod = SrcInputFileData%PotMod DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs if (allocated(SrcInputFileData%UserOutputs)) then - LB(1:1) = lbound(SrcInputFileData%UserOutputs) - UB(1:1) = ubound(SrcInputFileData%UserOutputs) + LB(1:1) = lbound(SrcInputFileData%UserOutputs, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%UserOutputs, kind=B8Ki) if (.not. allocated(DstInputFileData%UserOutputs)) then allocate(DstInputFileData%UserOutputs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -409,8 +409,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%OutAll = SrcInputFileData%OutAll DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -496,27 +496,27 @@ subroutine HydroDyn_PackInputFile(Buf, Indata) call RegPack(Buf, InData%EchoFlag) call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then - call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) + call RegPackBounds(Buf, 2, lbound(InData%AddF0, kind=B8Ki), ubound(InData%AddF0, kind=B8Ki)) call RegPack(Buf, InData%AddF0) end if call RegPack(Buf, allocated(InData%AddCLin)) if (allocated(InData%AddCLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) + call RegPackBounds(Buf, 3, lbound(InData%AddCLin, kind=B8Ki), ubound(InData%AddCLin, kind=B8Ki)) call RegPack(Buf, InData%AddCLin) end if call RegPack(Buf, allocated(InData%AddBLin)) if (allocated(InData%AddBLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) + call RegPackBounds(Buf, 3, lbound(InData%AddBLin, kind=B8Ki), ubound(InData%AddBLin, kind=B8Ki)) call RegPack(Buf, InData%AddBLin) end if call RegPack(Buf, allocated(InData%AddBQuad)) if (allocated(InData%AddBQuad)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) + call RegPackBounds(Buf, 3, lbound(InData%AddBQuad, kind=B8Ki), ubound(InData%AddBQuad, kind=B8Ki)) call RegPack(Buf, InData%AddBQuad) end if call RegPack(Buf, allocated(InData%PotFile)) if (allocated(InData%PotFile)) then - call RegPackBounds(Buf, 1, lbound(InData%PotFile), ubound(InData%PotFile)) + call RegPackBounds(Buf, 1, lbound(InData%PotFile, kind=B8Ki), ubound(InData%PotFile, kind=B8Ki)) call RegPack(Buf, InData%PotFile) end if call RegPack(Buf, InData%nWAMITObj) @@ -525,43 +525,43 @@ subroutine HydroDyn_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NBodyMod) call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0, kind=B8Ki), ubound(InData%PtfmVol0, kind=B8Ki)) call RegPack(Buf, InData%PtfmVol0) end if call RegPack(Buf, InData%HasWAMIT) call RegPack(Buf, allocated(InData%WAMITULEN)) if (allocated(InData%WAMITULEN)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN), ubound(InData%WAMITULEN)) + call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN, kind=B8Ki), ubound(InData%WAMITULEN, kind=B8Ki)) call RegPack(Buf, InData%WAMITULEN) end if call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt, kind=B8Ki), ubound(InData%PtfmRefxt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefxt) end if call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt, kind=B8Ki), ubound(InData%PtfmRefyt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefyt) end if call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt, kind=B8Ki), ubound(InData%PtfmRefzt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefzt) end if call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefztRot) end if call RegPack(Buf, allocated(InData%PtfmCOBxt)) if (allocated(InData%PtfmCOBxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt, kind=B8Ki), ubound(InData%PtfmCOBxt, kind=B8Ki)) call RegPack(Buf, InData%PtfmCOBxt) end if call RegPack(Buf, allocated(InData%PtfmCOByt)) if (allocated(InData%PtfmCOByt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt, kind=B8Ki), ubound(InData%PtfmCOByt, kind=B8Ki)) call RegPack(Buf, InData%PtfmCOByt) end if call WAMIT_PackInitInput(Buf, InData%WAMIT) @@ -572,7 +572,7 @@ subroutine HydroDyn_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NUserOutputs) call RegPack(Buf, allocated(InData%UserOutputs)) if (allocated(InData%UserOutputs)) then - call RegPackBounds(Buf, 1, lbound(InData%UserOutputs), ubound(InData%UserOutputs)) + call RegPackBounds(Buf, 1, lbound(InData%UserOutputs, kind=B8Ki), ubound(InData%UserOutputs, kind=B8Ki)) call RegPack(Buf, InData%UserOutputs) end if call RegPack(Buf, InData%OutSwtch) @@ -580,7 +580,7 @@ subroutine HydroDyn_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%HDSum) @@ -594,7 +594,7 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -851,7 +851,7 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(0), UB(0) + integer(B8Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' @@ -914,10 +914,10 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' - integer(IntKi) :: LB(0), UB(0) + integer(B8Ki) :: LB(0), UB(0) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%InputFile) @@ -965,7 +965,7 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' @@ -975,8 +975,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -987,8 +987,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1002,8 +1002,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1014,8 +1014,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,8 +1026,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1038,8 +1038,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1050,8 +1050,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1107,38 +1107,38 @@ subroutine HydroDyn_PackInitOutput(Buf, Indata) call Morison_PackInitOutput(Buf, InData%Morison) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1148,7 +1148,7 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1320,16 +1320,16 @@ subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%WAMIT)) then - LB(1:1) = lbound(SrcContStateData%WAMIT) - UB(1:1) = ubound(SrcContStateData%WAMIT) + LB(1:1) = lbound(SrcContStateData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%WAMIT, kind=B8Ki) if (.not. allocated(DstContStateData%WAMIT)) then allocate(DstContStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1352,16 +1352,16 @@ subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) type(HydroDyn_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%WAMIT)) then - LB(1:1) = lbound(ContStateData%WAMIT) - UB(1:1) = ubound(ContStateData%WAMIT) + LB(1:1) = lbound(ContStateData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(ContStateData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyContState(ContStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1376,14 +1376,14 @@ subroutine HydroDyn_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackContState(Buf, InData%WAMIT(i1)) end do @@ -1396,8 +1396,8 @@ subroutine HydroDyn_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1425,16 +1425,16 @@ subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%WAMIT)) then - LB(1:1) = lbound(SrcDiscStateData%WAMIT) - UB(1:1) = ubound(SrcDiscStateData%WAMIT) + LB(1:1) = lbound(SrcDiscStateData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%WAMIT, kind=B8Ki) if (.not. allocated(DstDiscStateData%WAMIT)) then allocate(DstDiscStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1457,16 +1457,16 @@ subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(HydroDyn_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%WAMIT)) then - LB(1:1) = lbound(DiscStateData%WAMIT) - UB(1:1) = ubound(DiscStateData%WAMIT) + LB(1:1) = lbound(DiscStateData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyDiscState(DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1481,14 +1481,14 @@ subroutine HydroDyn_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackDiscState(Buf, InData%WAMIT(i1)) end do @@ -1501,8 +1501,8 @@ subroutine HydroDyn_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1583,16 +1583,16 @@ subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%WAMIT)) then - LB(1:1) = lbound(SrcOtherStateData%WAMIT) - UB(1:1) = ubound(SrcOtherStateData%WAMIT) + LB(1:1) = lbound(SrcOtherStateData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%WAMIT, kind=B8Ki) if (.not. allocated(DstOtherStateData%WAMIT)) then allocate(DstOtherStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1615,16 +1615,16 @@ subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(HydroDyn_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%WAMIT)) then - LB(1:1) = lbound(OtherStateData%WAMIT) - UB(1:1) = ubound(OtherStateData%WAMIT) + LB(1:1) = lbound(OtherStateData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyOtherState(OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1639,14 +1639,14 @@ subroutine HydroDyn_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackOtherState(Buf, InData%WAMIT(i1)) end do @@ -1659,8 +1659,8 @@ subroutine HydroDyn_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1688,8 +1688,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' @@ -1704,8 +1704,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%Decimate = SrcMiscData%Decimate DstMiscData%LastOutTime = SrcMiscData%LastOutTime if (allocated(SrcMiscData%F_PtfmAdd)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) - UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd, kind=B8Ki) if (.not. allocated(DstMiscData%F_PtfmAdd)) then allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1717,8 +1717,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg end if DstMiscData%F_Hydro = SrcMiscData%F_Hydro if (allocated(SrcMiscData%F_Waves)) then - LB(1:1) = lbound(SrcMiscData%F_Waves) - UB(1:1) = ubound(SrcMiscData%F_Waves) + LB(1:1) = lbound(SrcMiscData%F_Waves, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_Waves, kind=B8Ki) if (.not. allocated(DstMiscData%F_Waves)) then allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1729,8 +1729,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg DstMiscData%F_Waves = SrcMiscData%F_Waves end if if (allocated(SrcMiscData%WAMIT)) then - LB(1:1) = lbound(SrcMiscData%WAMIT) - UB(1:1) = ubound(SrcMiscData%WAMIT) + LB(1:1) = lbound(SrcMiscData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WAMIT, kind=B8Ki) if (.not. allocated(DstMiscData%WAMIT)) then allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1745,8 +1745,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcMiscData%WAMIT2)) then - LB(1:1) = lbound(SrcMiscData%WAMIT2) - UB(1:1) = ubound(SrcMiscData%WAMIT2) + LB(1:1) = lbound(SrcMiscData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WAMIT2, kind=B8Ki) if (.not. allocated(DstMiscData%WAMIT2)) then allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1764,8 +1764,8 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%u_WAMIT)) then - LB(1:1) = lbound(SrcMiscData%u_WAMIT) - UB(1:1) = ubound(SrcMiscData%u_WAMIT) + LB(1:1) = lbound(SrcMiscData%u_WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%u_WAMIT, kind=B8Ki) if (.not. allocated(DstMiscData%u_WAMIT)) then allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1785,8 +1785,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) type(HydroDyn_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' @@ -1803,8 +1803,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%F_Waves) end if if (allocated(MiscData%WAMIT)) then - LB(1:1) = lbound(MiscData%WAMIT) - UB(1:1) = ubound(MiscData%WAMIT) + LB(1:1) = lbound(MiscData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(MiscData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1812,8 +1812,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%WAMIT) end if if (allocated(MiscData%WAMIT2)) then - LB(1:1) = lbound(MiscData%WAMIT2) - UB(1:1) = ubound(MiscData%WAMIT2) + LB(1:1) = lbound(MiscData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(MiscData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1823,8 +1823,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_WAMIT)) then - LB(1:1) = lbound(MiscData%u_WAMIT) - UB(1:1) = ubound(MiscData%u_WAMIT) + LB(1:1) = lbound(MiscData%u_WAMIT, kind=B8Ki) + UB(1:1) = ubound(MiscData%u_WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1837,8 +1837,8 @@ subroutine HydroDyn_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%AllHdroOrigin) call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) @@ -1846,29 +1846,29 @@ subroutine HydroDyn_PackMisc(Buf, Indata) call RegPack(Buf, InData%LastOutTime) call RegPack(Buf, allocated(InData%F_PtfmAdd)) if (allocated(InData%F_PtfmAdd)) then - call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd), ubound(InData%F_PtfmAdd)) + call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd, kind=B8Ki), ubound(InData%F_PtfmAdd, kind=B8Ki)) call RegPack(Buf, InData%F_PtfmAdd) end if call RegPack(Buf, InData%F_Hydro) call RegPack(Buf, allocated(InData%F_Waves)) if (allocated(InData%F_Waves)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Waves), ubound(InData%F_Waves)) + call RegPackBounds(Buf, 1, lbound(InData%F_Waves, kind=B8Ki), ubound(InData%F_Waves, kind=B8Ki)) call RegPack(Buf, InData%F_Waves) end if call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackMisc(Buf, InData%WAMIT(i1)) end do end if call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) - LB(1:1) = lbound(InData%WAMIT2) - UB(1:1) = ubound(InData%WAMIT2) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT2_PackMisc(Buf, InData%WAMIT2(i1)) end do @@ -1876,9 +1876,9 @@ subroutine HydroDyn_PackMisc(Buf, Indata) call Morison_PackMisc(Buf, InData%Morison) call RegPack(Buf, allocated(InData%u_WAMIT)) if (allocated(InData%u_WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) - LB(1:1) = lbound(InData%u_WAMIT) - UB(1:1) = ubound(InData%u_WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%u_WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%u_WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackInput(Buf, InData%u_WAMIT(i1)) end do @@ -1890,8 +1890,8 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1985,8 +1985,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' @@ -1995,8 +1995,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%nWAMITObj = SrcParamData%nWAMITObj DstParamData%vecMultiplier = SrcParamData%vecMultiplier if (allocated(SrcParamData%WAMIT)) then - LB(1:1) = lbound(SrcParamData%WAMIT) - UB(1:1) = ubound(SrcParamData%WAMIT) + LB(1:1) = lbound(SrcParamData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WAMIT, kind=B8Ki) if (.not. allocated(DstParamData%WAMIT)) then allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2011,8 +2011,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end do end if if (allocated(SrcParamData%WAMIT2)) then - LB(1:1) = lbound(SrcParamData%WAMIT2) - UB(1:1) = ubound(SrcParamData%WAMIT2) + LB(1:1) = lbound(SrcParamData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WAMIT2, kind=B8Ki) if (.not. allocated(DstParamData%WAMIT2)) then allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2037,8 +2037,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates if (allocated(SrcParamData%AddF0)) then - LB(1:2) = lbound(SrcParamData%AddF0) - UB(1:2) = ubound(SrcParamData%AddF0) + LB(1:2) = lbound(SrcParamData%AddF0, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AddF0, kind=B8Ki) if (.not. allocated(DstParamData%AddF0)) then allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2049,8 +2049,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddF0 = SrcParamData%AddF0 end if if (allocated(SrcParamData%AddCLin)) then - LB(1:3) = lbound(SrcParamData%AddCLin) - UB(1:3) = ubound(SrcParamData%AddCLin) + LB(1:3) = lbound(SrcParamData%AddCLin, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AddCLin, kind=B8Ki) if (.not. allocated(DstParamData%AddCLin)) then allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2061,8 +2061,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddCLin = SrcParamData%AddCLin end if if (allocated(SrcParamData%AddBLin)) then - LB(1:3) = lbound(SrcParamData%AddBLin) - UB(1:3) = ubound(SrcParamData%AddBLin) + LB(1:3) = lbound(SrcParamData%AddBLin, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AddBLin, kind=B8Ki) if (.not. allocated(DstParamData%AddBLin)) then allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2073,8 +2073,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddBLin = SrcParamData%AddBLin end if if (allocated(SrcParamData%AddBQuad)) then - LB(1:3) = lbound(SrcParamData%AddBQuad) - UB(1:3) = ubound(SrcParamData%AddBQuad) + LB(1:3) = lbound(SrcParamData%AddBQuad, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AddBQuad, kind=B8Ki) if (.not. allocated(DstParamData%AddBQuad)) then allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2086,8 +2086,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2110,8 +2110,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%UnOutFile = SrcParamData%UnOutFile DstParamData%OutDec = SrcParamData%OutDec if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2122,8 +2122,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2134,8 +2134,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2154,16 +2154,16 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) type(HydroDyn_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%WAMIT)) then - LB(1:1) = lbound(ParamData%WAMIT) - UB(1:1) = ubound(ParamData%WAMIT) + LB(1:1) = lbound(ParamData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(ParamData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2171,8 +2171,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WAMIT) end if if (allocated(ParamData%WAMIT2)) then - LB(1:1) = lbound(ParamData%WAMIT2) - UB(1:1) = ubound(ParamData%WAMIT2) + LB(1:1) = lbound(ParamData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(ParamData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT2_DestroyParam(ParamData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2194,8 +2194,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%AddBQuad) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2218,26 +2218,26 @@ subroutine HydroDyn_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nWAMITObj) call RegPack(Buf, InData%vecMultiplier) call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackParam(Buf, InData%WAMIT(i1)) end do end if call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) - LB(1:1) = lbound(InData%WAMIT2) - UB(1:1) = ubound(InData%WAMIT2) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT2_PackParam(Buf, InData%WAMIT2(i1)) end do @@ -2252,30 +2252,30 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%totalRdtnStates) call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then - call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) + call RegPackBounds(Buf, 2, lbound(InData%AddF0, kind=B8Ki), ubound(InData%AddF0, kind=B8Ki)) call RegPack(Buf, InData%AddF0) end if call RegPack(Buf, allocated(InData%AddCLin)) if (allocated(InData%AddCLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) + call RegPackBounds(Buf, 3, lbound(InData%AddCLin, kind=B8Ki), ubound(InData%AddCLin, kind=B8Ki)) call RegPack(Buf, InData%AddCLin) end if call RegPack(Buf, allocated(InData%AddBLin)) if (allocated(InData%AddBLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) + call RegPackBounds(Buf, 3, lbound(InData%AddBLin, kind=B8Ki), ubound(InData%AddBLin, kind=B8Ki)) call RegPack(Buf, InData%AddBLin) end if call RegPack(Buf, allocated(InData%AddBQuad)) if (allocated(InData%AddBQuad)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) + call RegPackBounds(Buf, 3, lbound(InData%AddBQuad, kind=B8Ki), ubound(InData%AddBQuad, kind=B8Ki)) call RegPack(Buf, InData%AddBQuad) end if call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -2290,17 +2290,17 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%OutDec) call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) call RegPack(Buf, InData%dx) end if call RegPack(Buf, InData%Jac_ny) @@ -2319,11 +2319,11 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%nWAMITObj) @@ -2598,16 +2598,16 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WAMIT)) then - LB(1:1) = lbound(SrcOutputData%WAMIT) - UB(1:1) = ubound(SrcOutputData%WAMIT) + LB(1:1) = lbound(SrcOutputData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WAMIT, kind=B8Ki) if (.not. allocated(DstOutputData%WAMIT)) then allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2622,8 +2622,8 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, end do end if if (allocated(SrcOutputData%WAMIT2)) then - LB(1:1) = lbound(SrcOutputData%WAMIT2) - UB(1:1) = ubound(SrcOutputData%WAMIT2) + LB(1:1) = lbound(SrcOutputData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WAMIT2, kind=B8Ki) if (.not. allocated(DstOutputData%WAMIT2)) then allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2644,8 +2644,8 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2661,16 +2661,16 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) type(HydroDyn_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%WAMIT)) then - LB(1:1) = lbound(OutputData%WAMIT) - UB(1:1) = ubound(OutputData%WAMIT) + LB(1:1) = lbound(OutputData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(OutputData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2678,8 +2678,8 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%WAMIT) end if if (allocated(OutputData%WAMIT2)) then - LB(1:1) = lbound(OutputData%WAMIT2) - UB(1:1) = ubound(OutputData%WAMIT2) + LB(1:1) = lbound(OutputData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(OutputData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2699,23 +2699,23 @@ subroutine HydroDyn_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) - LB(1:1) = lbound(InData%WAMIT) - UB(1:1) = ubound(InData%WAMIT) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT_PackOutput(Buf, InData%WAMIT(i1)) end do end if call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) - LB(1:1) = lbound(InData%WAMIT2) - UB(1:1) = ubound(InData%WAMIT2) + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) + UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) call WAMIT2_PackOutput(Buf, InData%WAMIT2(i1)) end do @@ -2724,7 +2724,7 @@ subroutine HydroDyn_PackOutput(Buf, Indata) call MeshPack(Buf, InData%WAMITMesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2734,8 +2734,8 @@ subroutine HydroDyn_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3049,13 +3049,13 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E a2 = t_out/t(2) IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) + DO i1 = LBOUND(y_out%WAMIT,1, kind=B8Ki),UBOUND(y_out%WAMIT,1, kind=B8Ki) CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) + DO i1 = LBOUND(y_out%WAMIT2,1, kind=B8Ki),UBOUND(y_out%WAMIT2,1, kind=B8Ki) CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -3125,13 +3125,13 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) + DO i1 = LBOUND(y_out%WAMIT,1, kind=B8Ki),UBOUND(y_out%WAMIT,1, kind=B8Ki) CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) + DO i1 = LBOUND(y_out%WAMIT2,1, kind=B8Ki),UBOUND(y_out%WAMIT2,1, kind=B8Ki) CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 0a37e81083..024346ed79 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -549,15 +549,15 @@ subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTyp integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyFilledGroupType' ErrStat = ErrID_None ErrMsg = '' DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM if (allocated(SrcFilledGroupTypeData%FillMList)) then - LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList) - UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList) + LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList, kind=B8Ki) + UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList, kind=B8Ki) if (.not. allocated(DstFilledGroupTypeData%FillMList)) then allocate(DstFilledGroupTypeData%FillMList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -592,7 +592,7 @@ subroutine Morison_PackFilledGroupType(Buf, Indata) call RegPack(Buf, InData%FillNumM) call RegPack(Buf, allocated(InData%FillMList)) if (allocated(InData%FillMList)) then - call RegPackBounds(Buf, 1, lbound(InData%FillMList), ubound(InData%FillMList)) + call RegPackBounds(Buf, 1, lbound(InData%FillMList, kind=B8Ki), ubound(InData%FillMList, kind=B8Ki)) call RegPack(Buf, InData%FillMList) end if call RegPack(Buf, InData%FillFSLoc) @@ -605,7 +605,7 @@ subroutine Morison_UnPackFilledGroupType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_FilledGroupType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -801,15 +801,15 @@ subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTyp integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberInputType' ErrStat = ErrID_None ErrMsg = '' DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID if (allocated(SrcMemberInputTypeData%NodeIndx)) then - LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx) - UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx) + LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx, kind=B8Ki) + UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx, kind=B8Ki) if (.not. allocated(DstMemberInputTypeData%NodeIndx)) then allocate(DstMemberInputTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -859,7 +859,7 @@ subroutine Morison_PackMemberInputType(Buf, Indata) call RegPack(Buf, InData%MemberID) call RegPack(Buf, allocated(InData%NodeIndx)) if (allocated(InData%NodeIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) + call RegPackBounds(Buf, 1, lbound(InData%NodeIndx, kind=B8Ki), ubound(InData%NodeIndx, kind=B8Ki)) call RegPack(Buf, InData%NodeIndx) end if call RegPack(Buf, InData%MJointID1) @@ -887,7 +887,7 @@ subroutine Morison_UnPackMemberInputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1046,14 +1046,14 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMemberTypeData%NodeIndx)) then - LB(1:1) = lbound(SrcMemberTypeData%NodeIndx) - UB(1:1) = ubound(SrcMemberTypeData%NodeIndx) + LB(1:1) = lbound(SrcMemberTypeData%NodeIndx, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%NodeIndx, kind=B8Ki) if (.not. allocated(DstMemberTypeData%NodeIndx)) then allocate(DstMemberTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1072,8 +1072,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%kkt = SrcMemberTypeData%kkt DstMemberTypeData%Ak = SrcMemberTypeData%Ak if (allocated(SrcMemberTypeData%R)) then - LB(1:1) = lbound(SrcMemberTypeData%R) - UB(1:1) = ubound(SrcMemberTypeData%R) + LB(1:1) = lbound(SrcMemberTypeData%R, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%R, kind=B8Ki) if (.not. allocated(DstMemberTypeData%R)) then allocate(DstMemberTypeData%R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1084,8 +1084,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%R = SrcMemberTypeData%R end if if (allocated(SrcMemberTypeData%RMG)) then - LB(1:1) = lbound(SrcMemberTypeData%RMG) - UB(1:1) = ubound(SrcMemberTypeData%RMG) + LB(1:1) = lbound(SrcMemberTypeData%RMG, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%RMG, kind=B8Ki) if (.not. allocated(DstMemberTypeData%RMG)) then allocate(DstMemberTypeData%RMG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1096,8 +1096,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%RMG = SrcMemberTypeData%RMG end if if (allocated(SrcMemberTypeData%RMGB)) then - LB(1:1) = lbound(SrcMemberTypeData%RMGB) - UB(1:1) = ubound(SrcMemberTypeData%RMGB) + LB(1:1) = lbound(SrcMemberTypeData%RMGB, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%RMGB, kind=B8Ki) if (.not. allocated(DstMemberTypeData%RMGB)) then allocate(DstMemberTypeData%RMGB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1108,8 +1108,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB end if if (allocated(SrcMemberTypeData%Rin)) then - LB(1:1) = lbound(SrcMemberTypeData%Rin) - UB(1:1) = ubound(SrcMemberTypeData%Rin) + LB(1:1) = lbound(SrcMemberTypeData%Rin, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Rin, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Rin)) then allocate(DstMemberTypeData%Rin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1120,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Rin = SrcMemberTypeData%Rin end if if (allocated(SrcMemberTypeData%tMG)) then - LB(1:1) = lbound(SrcMemberTypeData%tMG) - UB(1:1) = ubound(SrcMemberTypeData%tMG) + LB(1:1) = lbound(SrcMemberTypeData%tMG, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%tMG, kind=B8Ki) if (.not. allocated(DstMemberTypeData%tMG)) then allocate(DstMemberTypeData%tMG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1132,8 +1132,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%tMG = SrcMemberTypeData%tMG end if if (allocated(SrcMemberTypeData%MGdensity)) then - LB(1:1) = lbound(SrcMemberTypeData%MGdensity) - UB(1:1) = ubound(SrcMemberTypeData%MGdensity) + LB(1:1) = lbound(SrcMemberTypeData%MGdensity, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%MGdensity, kind=B8Ki) if (.not. allocated(DstMemberTypeData%MGdensity)) then allocate(DstMemberTypeData%MGdensity(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1144,8 +1144,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity end if if (allocated(SrcMemberTypeData%dRdl_mg)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg, kind=B8Ki) if (.not. allocated(DstMemberTypeData%dRdl_mg)) then allocate(DstMemberTypeData%dRdl_mg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1156,8 +1156,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg end if if (allocated(SrcMemberTypeData%dRdl_mg_b)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b, kind=B8Ki) if (.not. allocated(DstMemberTypeData%dRdl_mg_b)) then allocate(DstMemberTypeData%dRdl_mg_b(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1168,8 +1168,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b end if if (allocated(SrcMemberTypeData%dRdl_in)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_in) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_in, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_in, kind=B8Ki) if (.not. allocated(DstMemberTypeData%dRdl_in)) then allocate(DstMemberTypeData%dRdl_in(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1191,8 +1191,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus if (allocated(SrcMemberTypeData%floodstatus)) then - LB(1:1) = lbound(SrcMemberTypeData%floodstatus) - UB(1:1) = ubound(SrcMemberTypeData%floodstatus) + LB(1:1) = lbound(SrcMemberTypeData%floodstatus, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%floodstatus, kind=B8Ki) if (.not. allocated(DstMemberTypeData%floodstatus)) then allocate(DstMemberTypeData%floodstatus(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1203,8 +1203,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus end if if (allocated(SrcMemberTypeData%alpha)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha) - UB(1:1) = ubound(SrcMemberTypeData%alpha) + LB(1:1) = lbound(SrcMemberTypeData%alpha, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%alpha, kind=B8Ki) if (.not. allocated(DstMemberTypeData%alpha)) then allocate(DstMemberTypeData%alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1215,8 +1215,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha = SrcMemberTypeData%alpha end if if (allocated(SrcMemberTypeData%alpha_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) - UB(1:1) = ubound(SrcMemberTypeData%alpha_fb) + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb, kind=B8Ki) if (.not. allocated(DstMemberTypeData%alpha_fb)) then allocate(DstMemberTypeData%alpha_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1227,8 +1227,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb end if if (allocated(SrcMemberTypeData%alpha_fb_star)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) - UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star) + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star, kind=B8Ki) if (.not. allocated(DstMemberTypeData%alpha_fb_star)) then allocate(DstMemberTypeData%alpha_fb_star(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1239,8 +1239,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star end if if (allocated(SrcMemberTypeData%Cd)) then - LB(1:1) = lbound(SrcMemberTypeData%Cd) - UB(1:1) = ubound(SrcMemberTypeData%Cd) + LB(1:1) = lbound(SrcMemberTypeData%Cd, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Cd, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Cd)) then allocate(DstMemberTypeData%Cd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1251,8 +1251,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cd = SrcMemberTypeData%Cd end if if (allocated(SrcMemberTypeData%Ca)) then - LB(1:1) = lbound(SrcMemberTypeData%Ca) - UB(1:1) = ubound(SrcMemberTypeData%Ca) + LB(1:1) = lbound(SrcMemberTypeData%Ca, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Ca, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Ca)) then allocate(DstMemberTypeData%Ca(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1263,8 +1263,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Ca = SrcMemberTypeData%Ca end if if (allocated(SrcMemberTypeData%Cp)) then - LB(1:1) = lbound(SrcMemberTypeData%Cp) - UB(1:1) = ubound(SrcMemberTypeData%Cp) + LB(1:1) = lbound(SrcMemberTypeData%Cp, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Cp, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Cp)) then allocate(DstMemberTypeData%Cp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1275,8 +1275,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cp = SrcMemberTypeData%Cp end if if (allocated(SrcMemberTypeData%AxCd)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCd) - UB(1:1) = ubound(SrcMemberTypeData%AxCd) + LB(1:1) = lbound(SrcMemberTypeData%AxCd, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%AxCd, kind=B8Ki) if (.not. allocated(DstMemberTypeData%AxCd)) then allocate(DstMemberTypeData%AxCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1287,8 +1287,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd end if if (allocated(SrcMemberTypeData%AxCa)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCa) - UB(1:1) = ubound(SrcMemberTypeData%AxCa) + LB(1:1) = lbound(SrcMemberTypeData%AxCa, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%AxCa, kind=B8Ki) if (.not. allocated(DstMemberTypeData%AxCa)) then allocate(DstMemberTypeData%AxCa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1299,8 +1299,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa end if if (allocated(SrcMemberTypeData%AxCp)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCp) - UB(1:1) = ubound(SrcMemberTypeData%AxCp) + LB(1:1) = lbound(SrcMemberTypeData%AxCp, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%AxCp, kind=B8Ki) if (.not. allocated(DstMemberTypeData%AxCp)) then allocate(DstMemberTypeData%AxCp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1311,8 +1311,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp end if if (allocated(SrcMemberTypeData%Cb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cb) - UB(1:1) = ubound(SrcMemberTypeData%Cb) + LB(1:1) = lbound(SrcMemberTypeData%Cb, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Cb, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Cb)) then allocate(DstMemberTypeData%Cb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1323,8 +1323,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cb = SrcMemberTypeData%Cb end if if (allocated(SrcMemberTypeData%m_fb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) - UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) + LB(1:1) = lbound(SrcMemberTypeData%m_fb_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%m_fb_l)) then allocate(DstMemberTypeData%m_fb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1335,8 +1335,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l end if if (allocated(SrcMemberTypeData%m_fb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) - UB(1:1) = ubound(SrcMemberTypeData%m_fb_u) + LB(1:1) = lbound(SrcMemberTypeData%m_fb_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%m_fb_u)) then allocate(DstMemberTypeData%m_fb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1347,8 +1347,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u end if if (allocated(SrcMemberTypeData%h_cfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) - UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l) + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%h_cfb_l)) then allocate(DstMemberTypeData%h_cfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1359,8 +1359,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l end if if (allocated(SrcMemberTypeData%h_cfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) - UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u) + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%h_cfb_u)) then allocate(DstMemberTypeData%h_cfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1371,8 +1371,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u end if if (allocated(SrcMemberTypeData%I_lfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) - UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l) + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_lfb_l)) then allocate(DstMemberTypeData%I_lfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1383,8 +1383,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l end if if (allocated(SrcMemberTypeData%I_lfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) - UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u) + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_lfb_u)) then allocate(DstMemberTypeData%I_lfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1395,8 +1395,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u end if if (allocated(SrcMemberTypeData%I_rfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) - UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l) + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_rfb_l)) then allocate(DstMemberTypeData%I_rfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1407,8 +1407,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l end if if (allocated(SrcMemberTypeData%I_rfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) - UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u) + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_rfb_u)) then allocate(DstMemberTypeData%I_rfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1419,8 +1419,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u end if if (allocated(SrcMemberTypeData%m_mg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) - UB(1:1) = ubound(SrcMemberTypeData%m_mg_l) + LB(1:1) = lbound(SrcMemberTypeData%m_mg_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%m_mg_l)) then allocate(DstMemberTypeData%m_mg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1431,8 +1431,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l end if if (allocated(SrcMemberTypeData%m_mg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) - UB(1:1) = ubound(SrcMemberTypeData%m_mg_u) + LB(1:1) = lbound(SrcMemberTypeData%m_mg_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%m_mg_u)) then allocate(DstMemberTypeData%m_mg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1443,8 +1443,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u end if if (allocated(SrcMemberTypeData%h_cmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) - UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l) + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%h_cmg_l)) then allocate(DstMemberTypeData%h_cmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1455,8 +1455,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l end if if (allocated(SrcMemberTypeData%h_cmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) - UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u) + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%h_cmg_u)) then allocate(DstMemberTypeData%h_cmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1467,8 +1467,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u end if if (allocated(SrcMemberTypeData%I_lmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) - UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l) + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_lmg_l)) then allocate(DstMemberTypeData%I_lmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1479,8 +1479,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l end if if (allocated(SrcMemberTypeData%I_lmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) - UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u) + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_lmg_u)) then allocate(DstMemberTypeData%I_lmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1491,8 +1491,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u end if if (allocated(SrcMemberTypeData%I_rmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) - UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l) + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_rmg_l)) then allocate(DstMemberTypeData%I_rmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1503,8 +1503,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l end if if (allocated(SrcMemberTypeData%I_rmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) - UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u) + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u, kind=B8Ki) if (.not. allocated(DstMemberTypeData%I_rmg_u)) then allocate(DstMemberTypeData%I_rmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1515,8 +1515,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u end if if (allocated(SrcMemberTypeData%Cfl_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) - UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb) + LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Cfl_fb)) then allocate(DstMemberTypeData%Cfl_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1527,8 +1527,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb end if if (allocated(SrcMemberTypeData%Cfr_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) - UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb) + LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb, kind=B8Ki) if (.not. allocated(DstMemberTypeData%Cfr_fb)) then allocate(DstMemberTypeData%Cfr_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1539,8 +1539,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb end if if (allocated(SrcMemberTypeData%CM0_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) - UB(1:1) = ubound(SrcMemberTypeData%CM0_fb) + LB(1:1) = lbound(SrcMemberTypeData%CM0_fb, kind=B8Ki) + UB(1:1) = ubound(SrcMemberTypeData%CM0_fb, kind=B8Ki) if (.not. allocated(DstMemberTypeData%CM0_fb)) then allocate(DstMemberTypeData%CM0_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1699,7 +1699,7 @@ subroutine Morison_PackMemberType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%NodeIndx)) if (allocated(InData%NodeIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) + call RegPackBounds(Buf, 1, lbound(InData%NodeIndx, kind=B8Ki), ubound(InData%NodeIndx, kind=B8Ki)) call RegPack(Buf, InData%NodeIndx) end if call RegPack(Buf, InData%MemberID) @@ -1712,47 +1712,47 @@ subroutine Morison_PackMemberType(Buf, Indata) call RegPack(Buf, InData%Ak) call RegPack(Buf, allocated(InData%R)) if (allocated(InData%R)) then - call RegPackBounds(Buf, 1, lbound(InData%R), ubound(InData%R)) + call RegPackBounds(Buf, 1, lbound(InData%R, kind=B8Ki), ubound(InData%R, kind=B8Ki)) call RegPack(Buf, InData%R) end if call RegPack(Buf, allocated(InData%RMG)) if (allocated(InData%RMG)) then - call RegPackBounds(Buf, 1, lbound(InData%RMG), ubound(InData%RMG)) + call RegPackBounds(Buf, 1, lbound(InData%RMG, kind=B8Ki), ubound(InData%RMG, kind=B8Ki)) call RegPack(Buf, InData%RMG) end if call RegPack(Buf, allocated(InData%RMGB)) if (allocated(InData%RMGB)) then - call RegPackBounds(Buf, 1, lbound(InData%RMGB), ubound(InData%RMGB)) + call RegPackBounds(Buf, 1, lbound(InData%RMGB, kind=B8Ki), ubound(InData%RMGB, kind=B8Ki)) call RegPack(Buf, InData%RMGB) end if call RegPack(Buf, allocated(InData%Rin)) if (allocated(InData%Rin)) then - call RegPackBounds(Buf, 1, lbound(InData%Rin), ubound(InData%Rin)) + call RegPackBounds(Buf, 1, lbound(InData%Rin, kind=B8Ki), ubound(InData%Rin, kind=B8Ki)) call RegPack(Buf, InData%Rin) end if call RegPack(Buf, allocated(InData%tMG)) if (allocated(InData%tMG)) then - call RegPackBounds(Buf, 1, lbound(InData%tMG), ubound(InData%tMG)) + call RegPackBounds(Buf, 1, lbound(InData%tMG, kind=B8Ki), ubound(InData%tMG, kind=B8Ki)) call RegPack(Buf, InData%tMG) end if call RegPack(Buf, allocated(InData%MGdensity)) if (allocated(InData%MGdensity)) then - call RegPackBounds(Buf, 1, lbound(InData%MGdensity), ubound(InData%MGdensity)) + call RegPackBounds(Buf, 1, lbound(InData%MGdensity, kind=B8Ki), ubound(InData%MGdensity, kind=B8Ki)) call RegPack(Buf, InData%MGdensity) end if call RegPack(Buf, allocated(InData%dRdl_mg)) if (allocated(InData%dRdl_mg)) then - call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg), ubound(InData%dRdl_mg)) + call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg, kind=B8Ki), ubound(InData%dRdl_mg, kind=B8Ki)) call RegPack(Buf, InData%dRdl_mg) end if call RegPack(Buf, allocated(InData%dRdl_mg_b)) if (allocated(InData%dRdl_mg_b)) then - call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b), ubound(InData%dRdl_mg_b)) + call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b, kind=B8Ki), ubound(InData%dRdl_mg_b, kind=B8Ki)) call RegPack(Buf, InData%dRdl_mg_b) end if call RegPack(Buf, allocated(InData%dRdl_in)) if (allocated(InData%dRdl_in)) then - call RegPackBounds(Buf, 1, lbound(InData%dRdl_in), ubound(InData%dRdl_in)) + call RegPackBounds(Buf, 1, lbound(InData%dRdl_in, kind=B8Ki), ubound(InData%dRdl_in, kind=B8Ki)) call RegPack(Buf, InData%dRdl_in) end if call RegPack(Buf, InData%Vinner) @@ -1768,152 +1768,152 @@ subroutine Morison_PackMemberType(Buf, Indata) call RegPack(Buf, InData%memfloodstatus) call RegPack(Buf, allocated(InData%floodstatus)) if (allocated(InData%floodstatus)) then - call RegPackBounds(Buf, 1, lbound(InData%floodstatus), ubound(InData%floodstatus)) + call RegPackBounds(Buf, 1, lbound(InData%floodstatus, kind=B8Ki), ubound(InData%floodstatus, kind=B8Ki)) call RegPack(Buf, InData%floodstatus) end if call RegPack(Buf, allocated(InData%alpha)) if (allocated(InData%alpha)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha), ubound(InData%alpha)) + call RegPackBounds(Buf, 1, lbound(InData%alpha, kind=B8Ki), ubound(InData%alpha, kind=B8Ki)) call RegPack(Buf, InData%alpha) end if call RegPack(Buf, allocated(InData%alpha_fb)) if (allocated(InData%alpha_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha_fb), ubound(InData%alpha_fb)) + call RegPackBounds(Buf, 1, lbound(InData%alpha_fb, kind=B8Ki), ubound(InData%alpha_fb, kind=B8Ki)) call RegPack(Buf, InData%alpha_fb) end if call RegPack(Buf, allocated(InData%alpha_fb_star)) if (allocated(InData%alpha_fb_star)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star), ubound(InData%alpha_fb_star)) + call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star, kind=B8Ki), ubound(InData%alpha_fb_star, kind=B8Ki)) call RegPack(Buf, InData%alpha_fb_star) end if call RegPack(Buf, allocated(InData%Cd)) if (allocated(InData%Cd)) then - call RegPackBounds(Buf, 1, lbound(InData%Cd), ubound(InData%Cd)) + call RegPackBounds(Buf, 1, lbound(InData%Cd, kind=B8Ki), ubound(InData%Cd, kind=B8Ki)) call RegPack(Buf, InData%Cd) end if call RegPack(Buf, allocated(InData%Ca)) if (allocated(InData%Ca)) then - call RegPackBounds(Buf, 1, lbound(InData%Ca), ubound(InData%Ca)) + call RegPackBounds(Buf, 1, lbound(InData%Ca, kind=B8Ki), ubound(InData%Ca, kind=B8Ki)) call RegPack(Buf, InData%Ca) end if call RegPack(Buf, allocated(InData%Cp)) if (allocated(InData%Cp)) then - call RegPackBounds(Buf, 1, lbound(InData%Cp), ubound(InData%Cp)) + call RegPackBounds(Buf, 1, lbound(InData%Cp, kind=B8Ki), ubound(InData%Cp, kind=B8Ki)) call RegPack(Buf, InData%Cp) end if call RegPack(Buf, allocated(InData%AxCd)) if (allocated(InData%AxCd)) then - call RegPackBounds(Buf, 1, lbound(InData%AxCd), ubound(InData%AxCd)) + call RegPackBounds(Buf, 1, lbound(InData%AxCd, kind=B8Ki), ubound(InData%AxCd, kind=B8Ki)) call RegPack(Buf, InData%AxCd) end if call RegPack(Buf, allocated(InData%AxCa)) if (allocated(InData%AxCa)) then - call RegPackBounds(Buf, 1, lbound(InData%AxCa), ubound(InData%AxCa)) + call RegPackBounds(Buf, 1, lbound(InData%AxCa, kind=B8Ki), ubound(InData%AxCa, kind=B8Ki)) call RegPack(Buf, InData%AxCa) end if call RegPack(Buf, allocated(InData%AxCp)) if (allocated(InData%AxCp)) then - call RegPackBounds(Buf, 1, lbound(InData%AxCp), ubound(InData%AxCp)) + call RegPackBounds(Buf, 1, lbound(InData%AxCp, kind=B8Ki), ubound(InData%AxCp, kind=B8Ki)) call RegPack(Buf, InData%AxCp) end if call RegPack(Buf, allocated(InData%Cb)) if (allocated(InData%Cb)) then - call RegPackBounds(Buf, 1, lbound(InData%Cb), ubound(InData%Cb)) + call RegPackBounds(Buf, 1, lbound(InData%Cb, kind=B8Ki), ubound(InData%Cb, kind=B8Ki)) call RegPack(Buf, InData%Cb) end if call RegPack(Buf, allocated(InData%m_fb_l)) if (allocated(InData%m_fb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%m_fb_l), ubound(InData%m_fb_l)) + call RegPackBounds(Buf, 1, lbound(InData%m_fb_l, kind=B8Ki), ubound(InData%m_fb_l, kind=B8Ki)) call RegPack(Buf, InData%m_fb_l) end if call RegPack(Buf, allocated(InData%m_fb_u)) if (allocated(InData%m_fb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%m_fb_u), ubound(InData%m_fb_u)) + call RegPackBounds(Buf, 1, lbound(InData%m_fb_u, kind=B8Ki), ubound(InData%m_fb_u, kind=B8Ki)) call RegPack(Buf, InData%m_fb_u) end if call RegPack(Buf, allocated(InData%h_cfb_l)) if (allocated(InData%h_cfb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l), ubound(InData%h_cfb_l)) + call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l, kind=B8Ki), ubound(InData%h_cfb_l, kind=B8Ki)) call RegPack(Buf, InData%h_cfb_l) end if call RegPack(Buf, allocated(InData%h_cfb_u)) if (allocated(InData%h_cfb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u), ubound(InData%h_cfb_u)) + call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u, kind=B8Ki), ubound(InData%h_cfb_u, kind=B8Ki)) call RegPack(Buf, InData%h_cfb_u) end if call RegPack(Buf, allocated(InData%I_lfb_l)) if (allocated(InData%I_lfb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l), ubound(InData%I_lfb_l)) + call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l, kind=B8Ki), ubound(InData%I_lfb_l, kind=B8Ki)) call RegPack(Buf, InData%I_lfb_l) end if call RegPack(Buf, allocated(InData%I_lfb_u)) if (allocated(InData%I_lfb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u), ubound(InData%I_lfb_u)) + call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u, kind=B8Ki), ubound(InData%I_lfb_u, kind=B8Ki)) call RegPack(Buf, InData%I_lfb_u) end if call RegPack(Buf, allocated(InData%I_rfb_l)) if (allocated(InData%I_rfb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l), ubound(InData%I_rfb_l)) + call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l, kind=B8Ki), ubound(InData%I_rfb_l, kind=B8Ki)) call RegPack(Buf, InData%I_rfb_l) end if call RegPack(Buf, allocated(InData%I_rfb_u)) if (allocated(InData%I_rfb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u), ubound(InData%I_rfb_u)) + call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u, kind=B8Ki), ubound(InData%I_rfb_u, kind=B8Ki)) call RegPack(Buf, InData%I_rfb_u) end if call RegPack(Buf, allocated(InData%m_mg_l)) if (allocated(InData%m_mg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%m_mg_l), ubound(InData%m_mg_l)) + call RegPackBounds(Buf, 1, lbound(InData%m_mg_l, kind=B8Ki), ubound(InData%m_mg_l, kind=B8Ki)) call RegPack(Buf, InData%m_mg_l) end if call RegPack(Buf, allocated(InData%m_mg_u)) if (allocated(InData%m_mg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%m_mg_u), ubound(InData%m_mg_u)) + call RegPackBounds(Buf, 1, lbound(InData%m_mg_u, kind=B8Ki), ubound(InData%m_mg_u, kind=B8Ki)) call RegPack(Buf, InData%m_mg_u) end if call RegPack(Buf, allocated(InData%h_cmg_l)) if (allocated(InData%h_cmg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l), ubound(InData%h_cmg_l)) + call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l, kind=B8Ki), ubound(InData%h_cmg_l, kind=B8Ki)) call RegPack(Buf, InData%h_cmg_l) end if call RegPack(Buf, allocated(InData%h_cmg_u)) if (allocated(InData%h_cmg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u), ubound(InData%h_cmg_u)) + call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u, kind=B8Ki), ubound(InData%h_cmg_u, kind=B8Ki)) call RegPack(Buf, InData%h_cmg_u) end if call RegPack(Buf, allocated(InData%I_lmg_l)) if (allocated(InData%I_lmg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l), ubound(InData%I_lmg_l)) + call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l, kind=B8Ki), ubound(InData%I_lmg_l, kind=B8Ki)) call RegPack(Buf, InData%I_lmg_l) end if call RegPack(Buf, allocated(InData%I_lmg_u)) if (allocated(InData%I_lmg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u), ubound(InData%I_lmg_u)) + call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u, kind=B8Ki), ubound(InData%I_lmg_u, kind=B8Ki)) call RegPack(Buf, InData%I_lmg_u) end if call RegPack(Buf, allocated(InData%I_rmg_l)) if (allocated(InData%I_rmg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l), ubound(InData%I_rmg_l)) + call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l, kind=B8Ki), ubound(InData%I_rmg_l, kind=B8Ki)) call RegPack(Buf, InData%I_rmg_l) end if call RegPack(Buf, allocated(InData%I_rmg_u)) if (allocated(InData%I_rmg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u), ubound(InData%I_rmg_u)) + call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u, kind=B8Ki), ubound(InData%I_rmg_u, kind=B8Ki)) call RegPack(Buf, InData%I_rmg_u) end if call RegPack(Buf, allocated(InData%Cfl_fb)) if (allocated(InData%Cfl_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb), ubound(InData%Cfl_fb)) + call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb, kind=B8Ki), ubound(InData%Cfl_fb, kind=B8Ki)) call RegPack(Buf, InData%Cfl_fb) end if call RegPack(Buf, allocated(InData%Cfr_fb)) if (allocated(InData%Cfr_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb), ubound(InData%Cfr_fb)) + call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb, kind=B8Ki), ubound(InData%Cfr_fb, kind=B8Ki)) call RegPack(Buf, InData%Cfr_fb) end if call RegPack(Buf, allocated(InData%CM0_fb)) if (allocated(InData%CM0_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%CM0_fb), ubound(InData%CM0_fb)) + call RegPackBounds(Buf, 1, lbound(InData%CM0_fb, kind=B8Ki), ubound(InData%CM0_fb, kind=B8Ki)) call RegPack(Buf, InData%CM0_fb) end if call RegPack(Buf, InData%MGvolume) @@ -1934,7 +1934,7 @@ subroutine Morison_UnPackMemberType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2566,14 +2566,14 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberLoads' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMemberLoadsData%F_D)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_D) - UB(1:2) = ubound(SrcMemberLoadsData%F_D) + LB(1:2) = lbound(SrcMemberLoadsData%F_D, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_D, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_D)) then allocate(DstMemberLoadsData%F_D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2584,8 +2584,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D end if if (allocated(SrcMemberLoadsData%F_I)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_I) - UB(1:2) = ubound(SrcMemberLoadsData%F_I) + LB(1:2) = lbound(SrcMemberLoadsData%F_I, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_I, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_I)) then allocate(DstMemberLoadsData%F_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2596,8 +2596,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I end if if (allocated(SrcMemberLoadsData%F_A)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_A) - UB(1:2) = ubound(SrcMemberLoadsData%F_A) + LB(1:2) = lbound(SrcMemberLoadsData%F_A, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_A, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_A)) then allocate(DstMemberLoadsData%F_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2608,8 +2608,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A end if if (allocated(SrcMemberLoadsData%F_B)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_B) - UB(1:2) = ubound(SrcMemberLoadsData%F_B) + LB(1:2) = lbound(SrcMemberLoadsData%F_B, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_B, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_B)) then allocate(DstMemberLoadsData%F_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2620,8 +2620,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B end if if (allocated(SrcMemberLoadsData%F_BF)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_BF) - UB(1:2) = ubound(SrcMemberLoadsData%F_BF) + LB(1:2) = lbound(SrcMemberLoadsData%F_BF, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_BF, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_BF)) then allocate(DstMemberLoadsData%F_BF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2632,8 +2632,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF end if if (allocated(SrcMemberLoadsData%F_If)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_If) - UB(1:2) = ubound(SrcMemberLoadsData%F_If) + LB(1:2) = lbound(SrcMemberLoadsData%F_If, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_If, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_If)) then allocate(DstMemberLoadsData%F_If(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2644,8 +2644,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If end if if (allocated(SrcMemberLoadsData%F_WMG)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) - UB(1:2) = ubound(SrcMemberLoadsData%F_WMG) + LB(1:2) = lbound(SrcMemberLoadsData%F_WMG, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_WMG, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_WMG)) then allocate(DstMemberLoadsData%F_WMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2656,8 +2656,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG end if if (allocated(SrcMemberLoadsData%F_IMG)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) - UB(1:2) = ubound(SrcMemberLoadsData%F_IMG) + LB(1:2) = lbound(SrcMemberLoadsData%F_IMG, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_IMG, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_IMG)) then allocate(DstMemberLoadsData%F_IMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2668,8 +2668,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG end if if (allocated(SrcMemberLoadsData%FV)) then - LB(1:2) = lbound(SrcMemberLoadsData%FV) - UB(1:2) = ubound(SrcMemberLoadsData%FV) + LB(1:2) = lbound(SrcMemberLoadsData%FV, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%FV, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%FV)) then allocate(DstMemberLoadsData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2680,8 +2680,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%FV = SrcMemberLoadsData%FV end if if (allocated(SrcMemberLoadsData%FA)) then - LB(1:2) = lbound(SrcMemberLoadsData%FA) - UB(1:2) = ubound(SrcMemberLoadsData%FA) + LB(1:2) = lbound(SrcMemberLoadsData%FA, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%FA, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%FA)) then allocate(DstMemberLoadsData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2692,8 +2692,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%FA = SrcMemberLoadsData%FA end if if (allocated(SrcMemberLoadsData%F_DP)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_DP) - UB(1:2) = ubound(SrcMemberLoadsData%F_DP) + LB(1:2) = lbound(SrcMemberLoadsData%F_DP, kind=B8Ki) + UB(1:2) = ubound(SrcMemberLoadsData%F_DP, kind=B8Ki) if (.not. allocated(DstMemberLoadsData%F_DP)) then allocate(DstMemberLoadsData%F_DP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2754,57 +2754,57 @@ subroutine Morison_PackMemberLoads(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%F_D)) if (allocated(InData%F_D)) then - call RegPackBounds(Buf, 2, lbound(InData%F_D), ubound(InData%F_D)) + call RegPackBounds(Buf, 2, lbound(InData%F_D, kind=B8Ki), ubound(InData%F_D, kind=B8Ki)) call RegPack(Buf, InData%F_D) end if call RegPack(Buf, allocated(InData%F_I)) if (allocated(InData%F_I)) then - call RegPackBounds(Buf, 2, lbound(InData%F_I), ubound(InData%F_I)) + call RegPackBounds(Buf, 2, lbound(InData%F_I, kind=B8Ki), ubound(InData%F_I, kind=B8Ki)) call RegPack(Buf, InData%F_I) end if call RegPack(Buf, allocated(InData%F_A)) if (allocated(InData%F_A)) then - call RegPackBounds(Buf, 2, lbound(InData%F_A), ubound(InData%F_A)) + call RegPackBounds(Buf, 2, lbound(InData%F_A, kind=B8Ki), ubound(InData%F_A, kind=B8Ki)) call RegPack(Buf, InData%F_A) end if call RegPack(Buf, allocated(InData%F_B)) if (allocated(InData%F_B)) then - call RegPackBounds(Buf, 2, lbound(InData%F_B), ubound(InData%F_B)) + call RegPackBounds(Buf, 2, lbound(InData%F_B, kind=B8Ki), ubound(InData%F_B, kind=B8Ki)) call RegPack(Buf, InData%F_B) end if call RegPack(Buf, allocated(InData%F_BF)) if (allocated(InData%F_BF)) then - call RegPackBounds(Buf, 2, lbound(InData%F_BF), ubound(InData%F_BF)) + call RegPackBounds(Buf, 2, lbound(InData%F_BF, kind=B8Ki), ubound(InData%F_BF, kind=B8Ki)) call RegPack(Buf, InData%F_BF) end if call RegPack(Buf, allocated(InData%F_If)) if (allocated(InData%F_If)) then - call RegPackBounds(Buf, 2, lbound(InData%F_If), ubound(InData%F_If)) + call RegPackBounds(Buf, 2, lbound(InData%F_If, kind=B8Ki), ubound(InData%F_If, kind=B8Ki)) call RegPack(Buf, InData%F_If) end if call RegPack(Buf, allocated(InData%F_WMG)) if (allocated(InData%F_WMG)) then - call RegPackBounds(Buf, 2, lbound(InData%F_WMG), ubound(InData%F_WMG)) + call RegPackBounds(Buf, 2, lbound(InData%F_WMG, kind=B8Ki), ubound(InData%F_WMG, kind=B8Ki)) call RegPack(Buf, InData%F_WMG) end if call RegPack(Buf, allocated(InData%F_IMG)) if (allocated(InData%F_IMG)) then - call RegPackBounds(Buf, 2, lbound(InData%F_IMG), ubound(InData%F_IMG)) + call RegPackBounds(Buf, 2, lbound(InData%F_IMG, kind=B8Ki), ubound(InData%F_IMG, kind=B8Ki)) call RegPack(Buf, InData%F_IMG) end if call RegPack(Buf, allocated(InData%FV)) if (allocated(InData%FV)) then - call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) + call RegPackBounds(Buf, 2, lbound(InData%FV, kind=B8Ki), ubound(InData%FV, kind=B8Ki)) call RegPack(Buf, InData%FV) end if call RegPack(Buf, allocated(InData%FA)) if (allocated(InData%FA)) then - call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) + call RegPackBounds(Buf, 2, lbound(InData%FA, kind=B8Ki), ubound(InData%FA, kind=B8Ki)) call RegPack(Buf, InData%FA) end if call RegPack(Buf, allocated(InData%F_DP)) if (allocated(InData%F_DP)) then - call RegPackBounds(Buf, 2, lbound(InData%F_DP), ubound(InData%F_DP)) + call RegPackBounds(Buf, 2, lbound(InData%F_DP, kind=B8Ki), ubound(InData%F_DP, kind=B8Ki)) call RegPack(Buf, InData%F_DP) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2814,7 +2814,7 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberLoads), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3182,7 +3182,7 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMOutput' ErrStat = ErrID_None @@ -3190,8 +3190,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberID = SrcMOutputData%MemberID DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc if (allocated(SrcMOutputData%NodeLocs)) then - LB(1:1) = lbound(SrcMOutputData%NodeLocs) - UB(1:1) = ubound(SrcMOutputData%NodeLocs) + LB(1:1) = lbound(SrcMOutputData%NodeLocs, kind=B8Ki) + UB(1:1) = ubound(SrcMOutputData%NodeLocs, kind=B8Ki) if (.not. allocated(DstMOutputData%NodeLocs)) then allocate(DstMOutputData%NodeLocs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3203,8 +3203,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx if (allocated(SrcMOutputData%MeshIndx1)) then - LB(1:1) = lbound(SrcMOutputData%MeshIndx1) - UB(1:1) = ubound(SrcMOutputData%MeshIndx1) + LB(1:1) = lbound(SrcMOutputData%MeshIndx1, kind=B8Ki) + UB(1:1) = ubound(SrcMOutputData%MeshIndx1, kind=B8Ki) if (.not. allocated(DstMOutputData%MeshIndx1)) then allocate(DstMOutputData%MeshIndx1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3215,8 +3215,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 end if if (allocated(SrcMOutputData%MeshIndx2)) then - LB(1:1) = lbound(SrcMOutputData%MeshIndx2) - UB(1:1) = ubound(SrcMOutputData%MeshIndx2) + LB(1:1) = lbound(SrcMOutputData%MeshIndx2, kind=B8Ki) + UB(1:1) = ubound(SrcMOutputData%MeshIndx2, kind=B8Ki) if (.not. allocated(DstMOutputData%MeshIndx2)) then allocate(DstMOutputData%MeshIndx2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3227,8 +3227,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 end if if (allocated(SrcMOutputData%MemberIndx1)) then - LB(1:1) = lbound(SrcMOutputData%MemberIndx1) - UB(1:1) = ubound(SrcMOutputData%MemberIndx1) + LB(1:1) = lbound(SrcMOutputData%MemberIndx1, kind=B8Ki) + UB(1:1) = ubound(SrcMOutputData%MemberIndx1, kind=B8Ki) if (.not. allocated(DstMOutputData%MemberIndx1)) then allocate(DstMOutputData%MemberIndx1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3239,8 +3239,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 end if if (allocated(SrcMOutputData%MemberIndx2)) then - LB(1:1) = lbound(SrcMOutputData%MemberIndx2) - UB(1:1) = ubound(SrcMOutputData%MemberIndx2) + LB(1:1) = lbound(SrcMOutputData%MemberIndx2, kind=B8Ki) + UB(1:1) = ubound(SrcMOutputData%MemberIndx2, kind=B8Ki) if (.not. allocated(DstMOutputData%MemberIndx2)) then allocate(DstMOutputData%MemberIndx2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3251,8 +3251,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 end if if (allocated(SrcMOutputData%s)) then - LB(1:1) = lbound(SrcMOutputData%s) - UB(1:1) = ubound(SrcMOutputData%s) + LB(1:1) = lbound(SrcMOutputData%s, kind=B8Ki) + UB(1:1) = ubound(SrcMOutputData%s, kind=B8Ki) if (.not. allocated(DstMOutputData%s)) then allocate(DstMOutputData%s(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3300,33 +3300,33 @@ subroutine Morison_PackMOutput(Buf, Indata) call RegPack(Buf, InData%NOutLoc) call RegPack(Buf, allocated(InData%NodeLocs)) if (allocated(InData%NodeLocs)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeLocs), ubound(InData%NodeLocs)) + call RegPackBounds(Buf, 1, lbound(InData%NodeLocs, kind=B8Ki), ubound(InData%NodeLocs, kind=B8Ki)) call RegPack(Buf, InData%NodeLocs) end if call RegPack(Buf, InData%MemberIDIndx) call RegPack(Buf, allocated(InData%MeshIndx1)) if (allocated(InData%MeshIndx1)) then - call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1), ubound(InData%MeshIndx1)) + call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1, kind=B8Ki), ubound(InData%MeshIndx1, kind=B8Ki)) call RegPack(Buf, InData%MeshIndx1) end if call RegPack(Buf, allocated(InData%MeshIndx2)) if (allocated(InData%MeshIndx2)) then - call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2), ubound(InData%MeshIndx2)) + call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2, kind=B8Ki), ubound(InData%MeshIndx2, kind=B8Ki)) call RegPack(Buf, InData%MeshIndx2) end if call RegPack(Buf, allocated(InData%MemberIndx1)) if (allocated(InData%MemberIndx1)) then - call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1), ubound(InData%MemberIndx1)) + call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1, kind=B8Ki), ubound(InData%MemberIndx1, kind=B8Ki)) call RegPack(Buf, InData%MemberIndx1) end if call RegPack(Buf, allocated(InData%MemberIndx2)) if (allocated(InData%MemberIndx2)) then - call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2), ubound(InData%MemberIndx2)) + call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2, kind=B8Ki), ubound(InData%MemberIndx2, kind=B8Ki)) call RegPack(Buf, InData%MemberIndx2) end if call RegPack(Buf, allocated(InData%s)) if (allocated(InData%s)) then - call RegPackBounds(Buf, 1, lbound(InData%s), ubound(InData%s)) + call RegPackBounds(Buf, 1, lbound(InData%s, kind=B8Ki), ubound(InData%s, kind=B8Ki)) call RegPack(Buf, InData%s) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3336,7 +3336,7 @@ subroutine Morison_UnPackMOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_MOutput), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3481,8 +3481,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyInitInput' @@ -3494,8 +3494,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NJoints = SrcInitInputData%NJoints DstInitInputData%NNodes = SrcInitInputData%NNodes if (allocated(SrcInitInputData%InpJoints)) then - LB(1:1) = lbound(SrcInitInputData%InpJoints) - UB(1:1) = ubound(SrcInitInputData%InpJoints) + LB(1:1) = lbound(SrcInitInputData%InpJoints, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%InpJoints, kind=B8Ki) if (.not. allocated(DstInitInputData%InpJoints)) then allocate(DstInitInputData%InpJoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3510,8 +3510,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end do end if if (allocated(SrcInitInputData%Nodes)) then - LB(1:1) = lbound(SrcInitInputData%Nodes) - UB(1:1) = ubound(SrcInitInputData%Nodes) + LB(1:1) = lbound(SrcInitInputData%Nodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%Nodes, kind=B8Ki) if (.not. allocated(DstInitInputData%Nodes)) then allocate(DstInitInputData%Nodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3527,8 +3527,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs if (allocated(SrcInitInputData%AxialCoefs)) then - LB(1:1) = lbound(SrcInitInputData%AxialCoefs) - UB(1:1) = ubound(SrcInitInputData%AxialCoefs) + LB(1:1) = lbound(SrcInitInputData%AxialCoefs, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%AxialCoefs, kind=B8Ki) if (.not. allocated(DstInitInputData%AxialCoefs)) then allocate(DstInitInputData%AxialCoefs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3544,8 +3544,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NPropSets = SrcInitInputData%NPropSets if (allocated(SrcInitInputData%MPropSets)) then - LB(1:1) = lbound(SrcInitInputData%MPropSets) - UB(1:1) = ubound(SrcInitInputData%MPropSets) + LB(1:1) = lbound(SrcInitInputData%MPropSets, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%MPropSets, kind=B8Ki) if (.not. allocated(DstInitInputData%MPropSets)) then allocate(DstInitInputData%MPropSets(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3576,8 +3576,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth if (allocated(SrcInitInputData%CoefDpths)) then - LB(1:1) = lbound(SrcInitInputData%CoefDpths) - UB(1:1) = ubound(SrcInitInputData%CoefDpths) + LB(1:1) = lbound(SrcInitInputData%CoefDpths, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%CoefDpths, kind=B8Ki) if (.not. allocated(DstInitInputData%CoefDpths)) then allocate(DstInitInputData%CoefDpths(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3593,8 +3593,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers if (allocated(SrcInitInputData%CoefMembers)) then - LB(1:1) = lbound(SrcInitInputData%CoefMembers) - UB(1:1) = ubound(SrcInitInputData%CoefMembers) + LB(1:1) = lbound(SrcInitInputData%CoefMembers, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%CoefMembers, kind=B8Ki) if (.not. allocated(DstInitInputData%CoefMembers)) then allocate(DstInitInputData%CoefMembers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3610,8 +3610,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NMembers = SrcInitInputData%NMembers if (allocated(SrcInitInputData%InpMembers)) then - LB(1:1) = lbound(SrcInitInputData%InpMembers) - UB(1:1) = ubound(SrcInitInputData%InpMembers) + LB(1:1) = lbound(SrcInitInputData%InpMembers, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%InpMembers, kind=B8Ki) if (.not. allocated(DstInitInputData%InpMembers)) then allocate(DstInitInputData%InpMembers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3627,8 +3627,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups if (allocated(SrcInitInputData%FilledGroups)) then - LB(1:1) = lbound(SrcInitInputData%FilledGroups) - UB(1:1) = ubound(SrcInitInputData%FilledGroups) + LB(1:1) = lbound(SrcInitInputData%FilledGroups, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%FilledGroups, kind=B8Ki) if (.not. allocated(DstInitInputData%FilledGroups)) then allocate(DstInitInputData%FilledGroups(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3644,8 +3644,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths if (allocated(SrcInitInputData%MGDepths)) then - LB(1:1) = lbound(SrcInitInputData%MGDepths) - UB(1:1) = ubound(SrcInitInputData%MGDepths) + LB(1:1) = lbound(SrcInitInputData%MGDepths, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%MGDepths, kind=B8Ki) if (.not. allocated(DstInitInputData%MGDepths)) then allocate(DstInitInputData%MGDepths(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3663,8 +3663,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%MGBottom = SrcInitInputData%MGBottom DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs if (allocated(SrcInitInputData%MOutLst)) then - LB(1:1) = lbound(SrcInitInputData%MOutLst) - UB(1:1) = ubound(SrcInitInputData%MOutLst) + LB(1:1) = lbound(SrcInitInputData%MOutLst, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%MOutLst, kind=B8Ki) if (.not. allocated(DstInitInputData%MOutLst)) then allocate(DstInitInputData%MOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3680,8 +3680,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs if (allocated(SrcInitInputData%JOutLst)) then - LB(1:1) = lbound(SrcInitInputData%JOutLst) - UB(1:1) = ubound(SrcInitInputData%JOutLst) + LB(1:1) = lbound(SrcInitInputData%JOutLst, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%JOutLst, kind=B8Ki) if (.not. allocated(DstInitInputData%JOutLst)) then allocate(DstInitInputData%JOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3696,8 +3696,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end do end if if (allocated(SrcInitInputData%OutList)) then - LB(1:1) = lbound(SrcInitInputData%OutList) - UB(1:1) = ubound(SrcInitInputData%OutList) + LB(1:1) = lbound(SrcInitInputData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%OutList, kind=B8Ki) if (.not. allocated(DstInitInputData%OutList)) then allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3717,16 +3717,16 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(Morison_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%InpJoints)) then - LB(1:1) = lbound(InitInputData%InpJoints) - UB(1:1) = ubound(InitInputData%InpJoints) + LB(1:1) = lbound(InitInputData%InpJoints, kind=B8Ki) + UB(1:1) = ubound(InitInputData%InpJoints, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyJointType(InitInputData%InpJoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3734,8 +3734,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%InpJoints) end if if (allocated(InitInputData%Nodes)) then - LB(1:1) = lbound(InitInputData%Nodes) - UB(1:1) = ubound(InitInputData%Nodes) + LB(1:1) = lbound(InitInputData%Nodes, kind=B8Ki) + UB(1:1) = ubound(InitInputData%Nodes, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyNodeType(InitInputData%Nodes(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3743,8 +3743,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%Nodes) end if if (allocated(InitInputData%AxialCoefs)) then - LB(1:1) = lbound(InitInputData%AxialCoefs) - UB(1:1) = ubound(InitInputData%AxialCoefs) + LB(1:1) = lbound(InitInputData%AxialCoefs, kind=B8Ki) + UB(1:1) = ubound(InitInputData%AxialCoefs, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyAxialCoefType(InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3752,8 +3752,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%AxialCoefs) end if if (allocated(InitInputData%MPropSets)) then - LB(1:1) = lbound(InitInputData%MPropSets) - UB(1:1) = ubound(InitInputData%MPropSets) + LB(1:1) = lbound(InitInputData%MPropSets, kind=B8Ki) + UB(1:1) = ubound(InitInputData%MPropSets, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMemberPropType(InitInputData%MPropSets(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3761,8 +3761,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MPropSets) end if if (allocated(InitInputData%CoefDpths)) then - LB(1:1) = lbound(InitInputData%CoefDpths) - UB(1:1) = ubound(InitInputData%CoefDpths) + LB(1:1) = lbound(InitInputData%CoefDpths, kind=B8Ki) + UB(1:1) = ubound(InitInputData%CoefDpths, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyCoefDpths(InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3770,8 +3770,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%CoefDpths) end if if (allocated(InitInputData%CoefMembers)) then - LB(1:1) = lbound(InitInputData%CoefMembers) - UB(1:1) = ubound(InitInputData%CoefMembers) + LB(1:1) = lbound(InitInputData%CoefMembers, kind=B8Ki) + UB(1:1) = ubound(InitInputData%CoefMembers, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyCoefMembers(InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3779,8 +3779,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%CoefMembers) end if if (allocated(InitInputData%InpMembers)) then - LB(1:1) = lbound(InitInputData%InpMembers) - UB(1:1) = ubound(InitInputData%InpMembers) + LB(1:1) = lbound(InitInputData%InpMembers, kind=B8Ki) + UB(1:1) = ubound(InitInputData%InpMembers, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMemberInputType(InitInputData%InpMembers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3788,8 +3788,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%InpMembers) end if if (allocated(InitInputData%FilledGroups)) then - LB(1:1) = lbound(InitInputData%FilledGroups) - UB(1:1) = ubound(InitInputData%FilledGroups) + LB(1:1) = lbound(InitInputData%FilledGroups, kind=B8Ki) + UB(1:1) = ubound(InitInputData%FilledGroups, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyFilledGroupType(InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3797,8 +3797,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%FilledGroups) end if if (allocated(InitInputData%MGDepths)) then - LB(1:1) = lbound(InitInputData%MGDepths) - UB(1:1) = ubound(InitInputData%MGDepths) + LB(1:1) = lbound(InitInputData%MGDepths, kind=B8Ki) + UB(1:1) = ubound(InitInputData%MGDepths, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMGDepthsType(InitInputData%MGDepths(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3806,8 +3806,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MGDepths) end if if (allocated(InitInputData%MOutLst)) then - LB(1:1) = lbound(InitInputData%MOutLst) - UB(1:1) = ubound(InitInputData%MOutLst) + LB(1:1) = lbound(InitInputData%MOutLst, kind=B8Ki) + UB(1:1) = ubound(InitInputData%MOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMOutput(InitInputData%MOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3815,8 +3815,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MOutLst) end if if (allocated(InitInputData%JOutLst)) then - LB(1:1) = lbound(InitInputData%JOutLst) - UB(1:1) = ubound(InitInputData%JOutLst) + LB(1:1) = lbound(InitInputData%JOutLst, kind=B8Ki) + UB(1:1) = ubound(InitInputData%JOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyJOutput(InitInputData%JOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3833,8 +3833,8 @@ subroutine Morison_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInitInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) @@ -3844,18 +3844,18 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NNodes) call RegPack(Buf, allocated(InData%InpJoints)) if (allocated(InData%InpJoints)) then - call RegPackBounds(Buf, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) - LB(1:1) = lbound(InData%InpJoints) - UB(1:1) = ubound(InData%InpJoints) + call RegPackBounds(Buf, 1, lbound(InData%InpJoints, kind=B8Ki), ubound(InData%InpJoints, kind=B8Ki)) + LB(1:1) = lbound(InData%InpJoints, kind=B8Ki) + UB(1:1) = ubound(InData%InpJoints, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackJointType(Buf, InData%InpJoints(i1)) end do end if call RegPack(Buf, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then - call RegPackBounds(Buf, 1, lbound(InData%Nodes), ubound(InData%Nodes)) - LB(1:1) = lbound(InData%Nodes) - UB(1:1) = ubound(InData%Nodes) + call RegPackBounds(Buf, 1, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) + LB(1:1) = lbound(InData%Nodes, kind=B8Ki) + UB(1:1) = ubound(InData%Nodes, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackNodeType(Buf, InData%Nodes(i1)) end do @@ -3863,9 +3863,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NAxCoefs) call RegPack(Buf, allocated(InData%AxialCoefs)) if (allocated(InData%AxialCoefs)) then - call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) - LB(1:1) = lbound(InData%AxialCoefs) - UB(1:1) = ubound(InData%AxialCoefs) + call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs, kind=B8Ki), ubound(InData%AxialCoefs, kind=B8Ki)) + LB(1:1) = lbound(InData%AxialCoefs, kind=B8Ki) + UB(1:1) = ubound(InData%AxialCoefs, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackAxialCoefType(Buf, InData%AxialCoefs(i1)) end do @@ -3873,9 +3873,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NPropSets) call RegPack(Buf, allocated(InData%MPropSets)) if (allocated(InData%MPropSets)) then - call RegPackBounds(Buf, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) - LB(1:1) = lbound(InData%MPropSets) - UB(1:1) = ubound(InData%MPropSets) + call RegPackBounds(Buf, 1, lbound(InData%MPropSets, kind=B8Ki), ubound(InData%MPropSets, kind=B8Ki)) + LB(1:1) = lbound(InData%MPropSets, kind=B8Ki) + UB(1:1) = ubound(InData%MPropSets, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMemberPropType(Buf, InData%MPropSets(i1)) end do @@ -3898,9 +3898,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NCoefDpth) call RegPack(Buf, allocated(InData%CoefDpths)) if (allocated(InData%CoefDpths)) then - call RegPackBounds(Buf, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) - LB(1:1) = lbound(InData%CoefDpths) - UB(1:1) = ubound(InData%CoefDpths) + call RegPackBounds(Buf, 1, lbound(InData%CoefDpths, kind=B8Ki), ubound(InData%CoefDpths, kind=B8Ki)) + LB(1:1) = lbound(InData%CoefDpths, kind=B8Ki) + UB(1:1) = ubound(InData%CoefDpths, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackCoefDpths(Buf, InData%CoefDpths(i1)) end do @@ -3908,9 +3908,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NCoefMembers) call RegPack(Buf, allocated(InData%CoefMembers)) if (allocated(InData%CoefMembers)) then - call RegPackBounds(Buf, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) - LB(1:1) = lbound(InData%CoefMembers) - UB(1:1) = ubound(InData%CoefMembers) + call RegPackBounds(Buf, 1, lbound(InData%CoefMembers, kind=B8Ki), ubound(InData%CoefMembers, kind=B8Ki)) + LB(1:1) = lbound(InData%CoefMembers, kind=B8Ki) + UB(1:1) = ubound(InData%CoefMembers, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackCoefMembers(Buf, InData%CoefMembers(i1)) end do @@ -3918,9 +3918,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NMembers) call RegPack(Buf, allocated(InData%InpMembers)) if (allocated(InData%InpMembers)) then - call RegPackBounds(Buf, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) - LB(1:1) = lbound(InData%InpMembers) - UB(1:1) = ubound(InData%InpMembers) + call RegPackBounds(Buf, 1, lbound(InData%InpMembers, kind=B8Ki), ubound(InData%InpMembers, kind=B8Ki)) + LB(1:1) = lbound(InData%InpMembers, kind=B8Ki) + UB(1:1) = ubound(InData%InpMembers, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMemberInputType(Buf, InData%InpMembers(i1)) end do @@ -3928,9 +3928,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NFillGroups) call RegPack(Buf, allocated(InData%FilledGroups)) if (allocated(InData%FilledGroups)) then - call RegPackBounds(Buf, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) - LB(1:1) = lbound(InData%FilledGroups) - UB(1:1) = ubound(InData%FilledGroups) + call RegPackBounds(Buf, 1, lbound(InData%FilledGroups, kind=B8Ki), ubound(InData%FilledGroups, kind=B8Ki)) + LB(1:1) = lbound(InData%FilledGroups, kind=B8Ki) + UB(1:1) = ubound(InData%FilledGroups, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackFilledGroupType(Buf, InData%FilledGroups(i1)) end do @@ -3938,9 +3938,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NMGDepths) call RegPack(Buf, allocated(InData%MGDepths)) if (allocated(InData%MGDepths)) then - call RegPackBounds(Buf, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) - LB(1:1) = lbound(InData%MGDepths) - UB(1:1) = ubound(InData%MGDepths) + call RegPackBounds(Buf, 1, lbound(InData%MGDepths, kind=B8Ki), ubound(InData%MGDepths, kind=B8Ki)) + LB(1:1) = lbound(InData%MGDepths, kind=B8Ki) + UB(1:1) = ubound(InData%MGDepths, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMGDepthsType(Buf, InData%MGDepths(i1)) end do @@ -3950,9 +3950,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NMOutputs) call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) - LB(1:1) = lbound(InData%MOutLst) - UB(1:1) = ubound(InData%MOutLst) + call RegPackBounds(Buf, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) + LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) + UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMOutput(Buf, InData%MOutLst(i1)) end do @@ -3960,16 +3960,16 @@ subroutine Morison_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NJOutputs) call RegPack(Buf, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) - LB(1:1) = lbound(InData%JOutLst) - UB(1:1) = ubound(InData%JOutLst) + call RegPackBounds(Buf, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) + LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) + UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackJOutput(Buf, InData%JOutLst(i1)) end do end if call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%NumOuts) @@ -3989,11 +3989,11 @@ subroutine Morison_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Gravity) @@ -4271,14 +4271,14 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%MorisonVisRad)) then - LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad) - UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad) + LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad, kind=B8Ki) if (.not. allocated(DstInitOutputData%MorisonVisRad)) then allocate(DstInitOutputData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4289,8 +4289,8 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%MorisonVisRad = SrcInitOutputData%MorisonVisRad end if if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4301,8 +4301,8 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4339,17 +4339,17 @@ subroutine Morison_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%MorisonVisRad)) if (allocated(InData%MorisonVisRad)) then - call RegPackBounds(Buf, 1, lbound(InData%MorisonVisRad), ubound(InData%MorisonVisRad)) + call RegPackBounds(Buf, 1, lbound(InData%MorisonVisRad, kind=B8Ki), ubound(InData%MorisonVisRad, kind=B8Ki)) call RegPack(Buf, InData%MorisonVisRad) end if call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4359,7 +4359,7 @@ subroutine Morison_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4452,14 +4452,14 @@ subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%V_rel_n_FiltStat)) then - LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat) - UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat) + LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat, kind=B8Ki) if (.not. allocated(DstDiscStateData%V_rel_n_FiltStat)) then allocate(DstDiscStateData%V_rel_n_FiltStat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4490,7 +4490,7 @@ subroutine Morison_PackDiscState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%V_rel_n_FiltStat)) if (allocated(InData%V_rel_n_FiltStat)) then - call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_FiltStat), ubound(InData%V_rel_n_FiltStat)) + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_FiltStat, kind=B8Ki), ubound(InData%V_rel_n_FiltStat, kind=B8Ki)) call RegPack(Buf, InData%V_rel_n_FiltStat) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4500,7 +4500,7 @@ subroutine Morison_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4604,16 +4604,16 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%DispNodePosHdn)) then - LB(1:2) = lbound(SrcMiscData%DispNodePosHdn) - UB(1:2) = ubound(SrcMiscData%DispNodePosHdn) + LB(1:2) = lbound(SrcMiscData%DispNodePosHdn, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%DispNodePosHdn, kind=B8Ki) if (.not. allocated(DstMiscData%DispNodePosHdn)) then allocate(DstMiscData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4624,8 +4624,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn end if if (allocated(SrcMiscData%DispNodePosHst)) then - LB(1:2) = lbound(SrcMiscData%DispNodePosHst) - UB(1:2) = ubound(SrcMiscData%DispNodePosHst) + LB(1:2) = lbound(SrcMiscData%DispNodePosHst, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%DispNodePosHst, kind=B8Ki) if (.not. allocated(DstMiscData%DispNodePosHst)) then allocate(DstMiscData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4636,8 +4636,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst end if if (allocated(SrcMiscData%FV)) then - LB(1:2) = lbound(SrcMiscData%FV) - UB(1:2) = ubound(SrcMiscData%FV) + LB(1:2) = lbound(SrcMiscData%FV, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%FV, kind=B8Ki) if (.not. allocated(DstMiscData%FV)) then allocate(DstMiscData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4648,8 +4648,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FV = SrcMiscData%FV end if if (allocated(SrcMiscData%FA)) then - LB(1:2) = lbound(SrcMiscData%FA) - UB(1:2) = ubound(SrcMiscData%FA) + LB(1:2) = lbound(SrcMiscData%FA, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%FA, kind=B8Ki) if (.not. allocated(DstMiscData%FA)) then allocate(DstMiscData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4660,8 +4660,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FA = SrcMiscData%FA end if if (allocated(SrcMiscData%FAMCF)) then - LB(1:2) = lbound(SrcMiscData%FAMCF) - UB(1:2) = ubound(SrcMiscData%FAMCF) + LB(1:2) = lbound(SrcMiscData%FAMCF, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%FAMCF, kind=B8Ki) if (.not. allocated(DstMiscData%FAMCF)) then allocate(DstMiscData%FAMCF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4672,8 +4672,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAMCF = SrcMiscData%FAMCF end if if (allocated(SrcMiscData%FDynP)) then - LB(1:1) = lbound(SrcMiscData%FDynP) - UB(1:1) = ubound(SrcMiscData%FDynP) + LB(1:1) = lbound(SrcMiscData%FDynP, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FDynP, kind=B8Ki) if (.not. allocated(DstMiscData%FDynP)) then allocate(DstMiscData%FDynP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4684,8 +4684,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FDynP = SrcMiscData%FDynP end if if (allocated(SrcMiscData%WaveElev)) then - LB(1:1) = lbound(SrcMiscData%WaveElev) - UB(1:1) = ubound(SrcMiscData%WaveElev) + LB(1:1) = lbound(SrcMiscData%WaveElev, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WaveElev, kind=B8Ki) if (.not. allocated(DstMiscData%WaveElev)) then allocate(DstMiscData%WaveElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4696,8 +4696,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev = SrcMiscData%WaveElev end if if (allocated(SrcMiscData%WaveElev1)) then - LB(1:1) = lbound(SrcMiscData%WaveElev1) - UB(1:1) = ubound(SrcMiscData%WaveElev1) + LB(1:1) = lbound(SrcMiscData%WaveElev1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WaveElev1, kind=B8Ki) if (.not. allocated(DstMiscData%WaveElev1)) then allocate(DstMiscData%WaveElev1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4708,8 +4708,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 end if if (allocated(SrcMiscData%WaveElev2)) then - LB(1:1) = lbound(SrcMiscData%WaveElev2) - UB(1:1) = ubound(SrcMiscData%WaveElev2) + LB(1:1) = lbound(SrcMiscData%WaveElev2, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%WaveElev2, kind=B8Ki) if (.not. allocated(DstMiscData%WaveElev2)) then allocate(DstMiscData%WaveElev2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4720,8 +4720,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 end if if (allocated(SrcMiscData%vrel)) then - LB(1:2) = lbound(SrcMiscData%vrel) - UB(1:2) = ubound(SrcMiscData%vrel) + LB(1:2) = lbound(SrcMiscData%vrel, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%vrel, kind=B8Ki) if (.not. allocated(DstMiscData%vrel)) then allocate(DstMiscData%vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4732,8 +4732,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vrel = SrcMiscData%vrel end if if (allocated(SrcMiscData%nodeInWater)) then - LB(1:1) = lbound(SrcMiscData%nodeInWater) - UB(1:1) = ubound(SrcMiscData%nodeInWater) + LB(1:1) = lbound(SrcMiscData%nodeInWater, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%nodeInWater, kind=B8Ki) if (.not. allocated(DstMiscData%nodeInWater)) then allocate(DstMiscData%nodeInWater(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4744,8 +4744,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nodeInWater = SrcMiscData%nodeInWater end if if (allocated(SrcMiscData%memberLoads)) then - LB(1:1) = lbound(SrcMiscData%memberLoads) - UB(1:1) = ubound(SrcMiscData%memberLoads) + LB(1:1) = lbound(SrcMiscData%memberLoads, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%memberLoads, kind=B8Ki) if (.not. allocated(DstMiscData%memberLoads)) then allocate(DstMiscData%memberLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4760,8 +4760,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%F_B_End)) then - LB(1:2) = lbound(SrcMiscData%F_B_End) - UB(1:2) = ubound(SrcMiscData%F_B_End) + LB(1:2) = lbound(SrcMiscData%F_B_End, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_B_End, kind=B8Ki) if (.not. allocated(DstMiscData%F_B_End)) then allocate(DstMiscData%F_B_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4772,8 +4772,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_B_End = SrcMiscData%F_B_End end if if (allocated(SrcMiscData%F_D_End)) then - LB(1:2) = lbound(SrcMiscData%F_D_End) - UB(1:2) = ubound(SrcMiscData%F_D_End) + LB(1:2) = lbound(SrcMiscData%F_D_End, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_D_End, kind=B8Ki) if (.not. allocated(DstMiscData%F_D_End)) then allocate(DstMiscData%F_D_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4784,8 +4784,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_D_End = SrcMiscData%F_D_End end if if (allocated(SrcMiscData%F_I_End)) then - LB(1:2) = lbound(SrcMiscData%F_I_End) - UB(1:2) = ubound(SrcMiscData%F_I_End) + LB(1:2) = lbound(SrcMiscData%F_I_End, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_I_End, kind=B8Ki) if (.not. allocated(DstMiscData%F_I_End)) then allocate(DstMiscData%F_I_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4796,8 +4796,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_I_End = SrcMiscData%F_I_End end if if (allocated(SrcMiscData%F_IMG_End)) then - LB(1:2) = lbound(SrcMiscData%F_IMG_End) - UB(1:2) = ubound(SrcMiscData%F_IMG_End) + LB(1:2) = lbound(SrcMiscData%F_IMG_End, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_IMG_End, kind=B8Ki) if (.not. allocated(DstMiscData%F_IMG_End)) then allocate(DstMiscData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4808,8 +4808,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End end if if (allocated(SrcMiscData%F_A_End)) then - LB(1:2) = lbound(SrcMiscData%F_A_End) - UB(1:2) = ubound(SrcMiscData%F_A_End) + LB(1:2) = lbound(SrcMiscData%F_A_End, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_A_End, kind=B8Ki) if (.not. allocated(DstMiscData%F_A_End)) then allocate(DstMiscData%F_A_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4820,8 +4820,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_A_End = SrcMiscData%F_A_End end if if (allocated(SrcMiscData%F_BF_End)) then - LB(1:2) = lbound(SrcMiscData%F_BF_End) - UB(1:2) = ubound(SrcMiscData%F_BF_End) + LB(1:2) = lbound(SrcMiscData%F_BF_End, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_BF_End, kind=B8Ki) if (.not. allocated(DstMiscData%F_BF_End)) then allocate(DstMiscData%F_BF_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4832,8 +4832,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_BF_End = SrcMiscData%F_BF_End end if if (allocated(SrcMiscData%V_rel_n)) then - LB(1:1) = lbound(SrcMiscData%V_rel_n) - UB(1:1) = ubound(SrcMiscData%V_rel_n) + LB(1:1) = lbound(SrcMiscData%V_rel_n, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%V_rel_n, kind=B8Ki) if (.not. allocated(DstMiscData%V_rel_n)) then allocate(DstMiscData%V_rel_n(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4844,8 +4844,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%V_rel_n = SrcMiscData%V_rel_n end if if (allocated(SrcMiscData%V_rel_n_HiPass)) then - LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) - UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass) + LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass, kind=B8Ki) if (.not. allocated(DstMiscData%V_rel_n_HiPass)) then allocate(DstMiscData%V_rel_n_HiPass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4867,8 +4867,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Morison_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyMisc' @@ -4908,8 +4908,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%nodeInWater) end if if (allocated(MiscData%memberLoads)) then - LB(1:1) = lbound(MiscData%memberLoads) - UB(1:1) = ubound(MiscData%memberLoads) + LB(1:1) = lbound(MiscData%memberLoads, kind=B8Ki) + UB(1:1) = ubound(MiscData%memberLoads, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMemberLoads(MiscData%memberLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4950,111 +4950,111 @@ subroutine Morison_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%DispNodePosHdn)) if (allocated(InData%DispNodePosHdn)) then - call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHdn), ubound(InData%DispNodePosHdn)) + call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHdn, kind=B8Ki), ubound(InData%DispNodePosHdn, kind=B8Ki)) call RegPack(Buf, InData%DispNodePosHdn) end if call RegPack(Buf, allocated(InData%DispNodePosHst)) if (allocated(InData%DispNodePosHst)) then - call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHst), ubound(InData%DispNodePosHst)) + call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHst, kind=B8Ki), ubound(InData%DispNodePosHst, kind=B8Ki)) call RegPack(Buf, InData%DispNodePosHst) end if call RegPack(Buf, allocated(InData%FV)) if (allocated(InData%FV)) then - call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) + call RegPackBounds(Buf, 2, lbound(InData%FV, kind=B8Ki), ubound(InData%FV, kind=B8Ki)) call RegPack(Buf, InData%FV) end if call RegPack(Buf, allocated(InData%FA)) if (allocated(InData%FA)) then - call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) + call RegPackBounds(Buf, 2, lbound(InData%FA, kind=B8Ki), ubound(InData%FA, kind=B8Ki)) call RegPack(Buf, InData%FA) end if call RegPack(Buf, allocated(InData%FAMCF)) if (allocated(InData%FAMCF)) then - call RegPackBounds(Buf, 2, lbound(InData%FAMCF), ubound(InData%FAMCF)) + call RegPackBounds(Buf, 2, lbound(InData%FAMCF, kind=B8Ki), ubound(InData%FAMCF, kind=B8Ki)) call RegPack(Buf, InData%FAMCF) end if call RegPack(Buf, allocated(InData%FDynP)) if (allocated(InData%FDynP)) then - call RegPackBounds(Buf, 1, lbound(InData%FDynP), ubound(InData%FDynP)) + call RegPackBounds(Buf, 1, lbound(InData%FDynP, kind=B8Ki), ubound(InData%FDynP, kind=B8Ki)) call RegPack(Buf, InData%FDynP) end if call RegPack(Buf, allocated(InData%WaveElev)) if (allocated(InData%WaveElev)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElev, kind=B8Ki), ubound(InData%WaveElev, kind=B8Ki)) call RegPack(Buf, InData%WaveElev) end if call RegPack(Buf, allocated(InData%WaveElev1)) if (allocated(InData%WaveElev1)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElev1, kind=B8Ki), ubound(InData%WaveElev1, kind=B8Ki)) call RegPack(Buf, InData%WaveElev1) end if call RegPack(Buf, allocated(InData%WaveElev2)) if (allocated(InData%WaveElev2)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElev2, kind=B8Ki), ubound(InData%WaveElev2, kind=B8Ki)) call RegPack(Buf, InData%WaveElev2) end if call RegPack(Buf, allocated(InData%vrel)) if (allocated(InData%vrel)) then - call RegPackBounds(Buf, 2, lbound(InData%vrel), ubound(InData%vrel)) + call RegPackBounds(Buf, 2, lbound(InData%vrel, kind=B8Ki), ubound(InData%vrel, kind=B8Ki)) call RegPack(Buf, InData%vrel) end if call RegPack(Buf, allocated(InData%nodeInWater)) if (allocated(InData%nodeInWater)) then - call RegPackBounds(Buf, 1, lbound(InData%nodeInWater), ubound(InData%nodeInWater)) + call RegPackBounds(Buf, 1, lbound(InData%nodeInWater, kind=B8Ki), ubound(InData%nodeInWater, kind=B8Ki)) call RegPack(Buf, InData%nodeInWater) end if call RegPack(Buf, allocated(InData%memberLoads)) if (allocated(InData%memberLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) - LB(1:1) = lbound(InData%memberLoads) - UB(1:1) = ubound(InData%memberLoads) + call RegPackBounds(Buf, 1, lbound(InData%memberLoads, kind=B8Ki), ubound(InData%memberLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%memberLoads, kind=B8Ki) + UB(1:1) = ubound(InData%memberLoads, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMemberLoads(Buf, InData%memberLoads(i1)) end do end if call RegPack(Buf, allocated(InData%F_B_End)) if (allocated(InData%F_B_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_B_End), ubound(InData%F_B_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_B_End, kind=B8Ki), ubound(InData%F_B_End, kind=B8Ki)) call RegPack(Buf, InData%F_B_End) end if call RegPack(Buf, allocated(InData%F_D_End)) if (allocated(InData%F_D_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_D_End), ubound(InData%F_D_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_D_End, kind=B8Ki), ubound(InData%F_D_End, kind=B8Ki)) call RegPack(Buf, InData%F_D_End) end if call RegPack(Buf, allocated(InData%F_I_End)) if (allocated(InData%F_I_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_I_End), ubound(InData%F_I_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_I_End, kind=B8Ki), ubound(InData%F_I_End, kind=B8Ki)) call RegPack(Buf, InData%F_I_End) end if call RegPack(Buf, allocated(InData%F_IMG_End)) if (allocated(InData%F_IMG_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End), ubound(InData%F_IMG_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End, kind=B8Ki), ubound(InData%F_IMG_End, kind=B8Ki)) call RegPack(Buf, InData%F_IMG_End) end if call RegPack(Buf, allocated(InData%F_A_End)) if (allocated(InData%F_A_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_A_End), ubound(InData%F_A_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_A_End, kind=B8Ki), ubound(InData%F_A_End, kind=B8Ki)) call RegPack(Buf, InData%F_A_End) end if call RegPack(Buf, allocated(InData%F_BF_End)) if (allocated(InData%F_BF_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_BF_End), ubound(InData%F_BF_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_BF_End, kind=B8Ki), ubound(InData%F_BF_End, kind=B8Ki)) call RegPack(Buf, InData%F_BF_End) end if call RegPack(Buf, allocated(InData%V_rel_n)) if (allocated(InData%V_rel_n)) then - call RegPackBounds(Buf, 1, lbound(InData%V_rel_n), ubound(InData%V_rel_n)) + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n, kind=B8Ki), ubound(InData%V_rel_n, kind=B8Ki)) call RegPack(Buf, InData%V_rel_n) end if call RegPack(Buf, allocated(InData%V_rel_n_HiPass)) if (allocated(InData%V_rel_n_HiPass)) then - call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass), ubound(InData%V_rel_n_HiPass)) + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass, kind=B8Ki), ubound(InData%V_rel_n_HiPass, kind=B8Ki)) call RegPack(Buf, InData%V_rel_n_HiPass) end if call NWTC_Library_PackMeshMapType(Buf, InData%VisMeshMap) @@ -5066,8 +5066,8 @@ subroutine Morison_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5362,8 +5362,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyParam' @@ -5375,8 +5375,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%AMMod = SrcParamData%AMMod DstParamData%NMembers = SrcParamData%NMembers if (allocated(SrcParamData%Members)) then - LB(1:1) = lbound(SrcParamData%Members) - UB(1:1) = ubound(SrcParamData%Members) + LB(1:1) = lbound(SrcParamData%Members, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Members, kind=B8Ki) if (.not. allocated(DstParamData%Members)) then allocate(DstParamData%Members(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5393,8 +5393,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NNodes = SrcParamData%NNodes DstParamData%NJoints = SrcParamData%NJoints if (allocated(SrcParamData%I_MG_End)) then - LB(1:3) = lbound(SrcParamData%I_MG_End) - UB(1:3) = ubound(SrcParamData%I_MG_End) + LB(1:3) = lbound(SrcParamData%I_MG_End, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%I_MG_End, kind=B8Ki) if (.not. allocated(DstParamData%I_MG_End)) then allocate(DstParamData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5405,8 +5405,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%I_MG_End = SrcParamData%I_MG_End end if if (allocated(SrcParamData%An_End)) then - LB(1:2) = lbound(SrcParamData%An_End) - UB(1:2) = ubound(SrcParamData%An_End) + LB(1:2) = lbound(SrcParamData%An_End, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%An_End, kind=B8Ki) if (.not. allocated(DstParamData%An_End)) then allocate(DstParamData%An_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5417,8 +5417,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%An_End = SrcParamData%An_End end if if (allocated(SrcParamData%DragConst_End)) then - LB(1:1) = lbound(SrcParamData%DragConst_End) - UB(1:1) = ubound(SrcParamData%DragConst_End) + LB(1:1) = lbound(SrcParamData%DragConst_End, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DragConst_End, kind=B8Ki) if (.not. allocated(DstParamData%DragConst_End)) then allocate(DstParamData%DragConst_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5429,8 +5429,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragConst_End = SrcParamData%DragConst_End end if if (allocated(SrcParamData%VRelNFiltConst)) then - LB(1:1) = lbound(SrcParamData%VRelNFiltConst) - UB(1:1) = ubound(SrcParamData%VRelNFiltConst) + LB(1:1) = lbound(SrcParamData%VRelNFiltConst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%VRelNFiltConst, kind=B8Ki) if (.not. allocated(DstParamData%VRelNFiltConst)) then allocate(DstParamData%VRelNFiltConst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5441,8 +5441,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst end if if (allocated(SrcParamData%DragMod_End)) then - LB(1:1) = lbound(SrcParamData%DragMod_End) - UB(1:1) = ubound(SrcParamData%DragMod_End) + LB(1:1) = lbound(SrcParamData%DragMod_End, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DragMod_End, kind=B8Ki) if (.not. allocated(DstParamData%DragMod_End)) then allocate(DstParamData%DragMod_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5453,8 +5453,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragMod_End = SrcParamData%DragMod_End end if if (allocated(SrcParamData%DragLoFSc_End)) then - LB(1:1) = lbound(SrcParamData%DragLoFSc_End) - UB(1:1) = ubound(SrcParamData%DragLoFSc_End) + LB(1:1) = lbound(SrcParamData%DragLoFSc_End, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%DragLoFSc_End, kind=B8Ki) if (.not. allocated(DstParamData%DragLoFSc_End)) then allocate(DstParamData%DragLoFSc_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5465,8 +5465,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End end if if (allocated(SrcParamData%F_WMG_End)) then - LB(1:2) = lbound(SrcParamData%F_WMG_End) - UB(1:2) = ubound(SrcParamData%F_WMG_End) + LB(1:2) = lbound(SrcParamData%F_WMG_End, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%F_WMG_End, kind=B8Ki) if (.not. allocated(DstParamData%F_WMG_End)) then allocate(DstParamData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5477,8 +5477,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%F_WMG_End = SrcParamData%F_WMG_End end if if (allocated(SrcParamData%DP_Const_End)) then - LB(1:2) = lbound(SrcParamData%DP_Const_End) - UB(1:2) = ubound(SrcParamData%DP_Const_End) + LB(1:2) = lbound(SrcParamData%DP_Const_End, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%DP_Const_End, kind=B8Ki) if (.not. allocated(DstParamData%DP_Const_End)) then allocate(DstParamData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5489,8 +5489,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DP_Const_End = SrcParamData%DP_Const_End end if if (allocated(SrcParamData%Mass_MG_End)) then - LB(1:1) = lbound(SrcParamData%Mass_MG_End) - UB(1:1) = ubound(SrcParamData%Mass_MG_End) + LB(1:1) = lbound(SrcParamData%Mass_MG_End, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Mass_MG_End, kind=B8Ki) if (.not. allocated(DstParamData%Mass_MG_End)) then allocate(DstParamData%Mass_MG_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5501,8 +5501,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End end if if (allocated(SrcParamData%AM_End)) then - LB(1:3) = lbound(SrcParamData%AM_End) - UB(1:3) = ubound(SrcParamData%AM_End) + LB(1:3) = lbound(SrcParamData%AM_End, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%AM_End, kind=B8Ki) if (.not. allocated(DstParamData%AM_End)) then allocate(DstParamData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5514,8 +5514,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%NMOutputs = SrcParamData%NMOutputs if (allocated(SrcParamData%MOutLst)) then - LB(1:1) = lbound(SrcParamData%MOutLst) - UB(1:1) = ubound(SrcParamData%MOutLst) + LB(1:1) = lbound(SrcParamData%MOutLst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MOutLst, kind=B8Ki) if (.not. allocated(DstParamData%MOutLst)) then allocate(DstParamData%MOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5531,8 +5531,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%NJOutputs = SrcParamData%NJOutputs if (allocated(SrcParamData%JOutLst)) then - LB(1:1) = lbound(SrcParamData%JOutLst) - UB(1:1) = ubound(SrcParamData%JOutLst) + LB(1:1) = lbound(SrcParamData%JOutLst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%JOutLst, kind=B8Ki) if (.not. allocated(DstParamData%JOutLst)) then allocate(DstParamData%JOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5547,8 +5547,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5571,16 +5571,16 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) type(Morison_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%Members)) then - LB(1:1) = lbound(ParamData%Members) - UB(1:1) = ubound(ParamData%Members) + LB(1:1) = lbound(ParamData%Members, kind=B8Ki) + UB(1:1) = ubound(ParamData%Members, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMemberType(ParamData%Members(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5618,8 +5618,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%AM_End) end if if (allocated(ParamData%MOutLst)) then - LB(1:1) = lbound(ParamData%MOutLst) - UB(1:1) = ubound(ParamData%MOutLst) + LB(1:1) = lbound(ParamData%MOutLst, kind=B8Ki) + UB(1:1) = ubound(ParamData%MOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyMOutput(ParamData%MOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5627,8 +5627,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MOutLst) end if if (allocated(ParamData%JOutLst)) then - LB(1:1) = lbound(ParamData%JOutLst) - UB(1:1) = ubound(ParamData%JOutLst) + LB(1:1) = lbound(ParamData%JOutLst, kind=B8Ki) + UB(1:1) = ubound(ParamData%JOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_DestroyJOutput(ParamData%JOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5636,8 +5636,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%JOutLst) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5651,8 +5651,8 @@ subroutine Morison_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) @@ -5662,9 +5662,9 @@ subroutine Morison_PackParam(Buf, Indata) call RegPack(Buf, InData%NMembers) call RegPack(Buf, allocated(InData%Members)) if (allocated(InData%Members)) then - call RegPackBounds(Buf, 1, lbound(InData%Members), ubound(InData%Members)) - LB(1:1) = lbound(InData%Members) - UB(1:1) = ubound(InData%Members) + call RegPackBounds(Buf, 1, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) + LB(1:1) = lbound(InData%Members, kind=B8Ki) + UB(1:1) = ubound(InData%Members, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMemberType(Buf, InData%Members(i1)) end do @@ -5673,60 +5673,60 @@ subroutine Morison_PackParam(Buf, Indata) call RegPack(Buf, InData%NJoints) call RegPack(Buf, allocated(InData%I_MG_End)) if (allocated(InData%I_MG_End)) then - call RegPackBounds(Buf, 3, lbound(InData%I_MG_End), ubound(InData%I_MG_End)) + call RegPackBounds(Buf, 3, lbound(InData%I_MG_End, kind=B8Ki), ubound(InData%I_MG_End, kind=B8Ki)) call RegPack(Buf, InData%I_MG_End) end if call RegPack(Buf, allocated(InData%An_End)) if (allocated(InData%An_End)) then - call RegPackBounds(Buf, 2, lbound(InData%An_End), ubound(InData%An_End)) + call RegPackBounds(Buf, 2, lbound(InData%An_End, kind=B8Ki), ubound(InData%An_End, kind=B8Ki)) call RegPack(Buf, InData%An_End) end if call RegPack(Buf, allocated(InData%DragConst_End)) if (allocated(InData%DragConst_End)) then - call RegPackBounds(Buf, 1, lbound(InData%DragConst_End), ubound(InData%DragConst_End)) + call RegPackBounds(Buf, 1, lbound(InData%DragConst_End, kind=B8Ki), ubound(InData%DragConst_End, kind=B8Ki)) call RegPack(Buf, InData%DragConst_End) end if call RegPack(Buf, allocated(InData%VRelNFiltConst)) if (allocated(InData%VRelNFiltConst)) then - call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst), ubound(InData%VRelNFiltConst)) + call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst, kind=B8Ki), ubound(InData%VRelNFiltConst, kind=B8Ki)) call RegPack(Buf, InData%VRelNFiltConst) end if call RegPack(Buf, allocated(InData%DragMod_End)) if (allocated(InData%DragMod_End)) then - call RegPackBounds(Buf, 1, lbound(InData%DragMod_End), ubound(InData%DragMod_End)) + call RegPackBounds(Buf, 1, lbound(InData%DragMod_End, kind=B8Ki), ubound(InData%DragMod_End, kind=B8Ki)) call RegPack(Buf, InData%DragMod_End) end if call RegPack(Buf, allocated(InData%DragLoFSc_End)) if (allocated(InData%DragLoFSc_End)) then - call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End), ubound(InData%DragLoFSc_End)) + call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End, kind=B8Ki), ubound(InData%DragLoFSc_End, kind=B8Ki)) call RegPack(Buf, InData%DragLoFSc_End) end if call RegPack(Buf, allocated(InData%F_WMG_End)) if (allocated(InData%F_WMG_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End), ubound(InData%F_WMG_End)) + call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End, kind=B8Ki), ubound(InData%F_WMG_End, kind=B8Ki)) call RegPack(Buf, InData%F_WMG_End) end if call RegPack(Buf, allocated(InData%DP_Const_End)) if (allocated(InData%DP_Const_End)) then - call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End), ubound(InData%DP_Const_End)) + call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End, kind=B8Ki), ubound(InData%DP_Const_End, kind=B8Ki)) call RegPack(Buf, InData%DP_Const_End) end if call RegPack(Buf, allocated(InData%Mass_MG_End)) if (allocated(InData%Mass_MG_End)) then - call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End), ubound(InData%Mass_MG_End)) + call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End, kind=B8Ki), ubound(InData%Mass_MG_End, kind=B8Ki)) call RegPack(Buf, InData%Mass_MG_End) end if call RegPack(Buf, allocated(InData%AM_End)) if (allocated(InData%AM_End)) then - call RegPackBounds(Buf, 3, lbound(InData%AM_End), ubound(InData%AM_End)) + call RegPackBounds(Buf, 3, lbound(InData%AM_End, kind=B8Ki), ubound(InData%AM_End, kind=B8Ki)) call RegPack(Buf, InData%AM_End) end if call RegPack(Buf, InData%NMOutputs) call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) - LB(1:1) = lbound(InData%MOutLst) - UB(1:1) = ubound(InData%MOutLst) + call RegPackBounds(Buf, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) + LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) + UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackMOutput(Buf, InData%MOutLst(i1)) end do @@ -5734,18 +5734,18 @@ subroutine Morison_PackParam(Buf, Indata) call RegPack(Buf, InData%NJOutputs) call RegPack(Buf, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) - LB(1:1) = lbound(InData%JOutLst) - UB(1:1) = ubound(InData%JOutLst) + call RegPackBounds(Buf, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) + LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) + UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) do i1 = LB(1), UB(1) call Morison_PackJOutput(Buf, InData%JOutLst(i1)) end do end if call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -5766,11 +5766,11 @@ subroutine Morison_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%DT) @@ -6069,7 +6069,7 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyOutput' @@ -6082,8 +6082,8 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6122,7 +6122,7 @@ subroutine Morison_PackOutput(Buf, Indata) call MeshPack(Buf, InData%VisMesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6132,7 +6132,7 @@ subroutine Morison_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Morison_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index d2ba97c733..ba09d27160 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -110,7 +110,7 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' @@ -120,8 +120,8 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -160,7 +160,7 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPack(Buf, InData%ExctnDisp) call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefztRot) end if call RegPack(Buf, associated(InData%WaveField)) @@ -177,10 +177,10 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%InputFile) @@ -231,14 +231,14 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -249,8 +249,8 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -284,12 +284,12 @@ subroutine SS_Exc_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -299,7 +299,7 @@ subroutine SS_Exc_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -339,14 +339,14 @@ subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%x)) then - LB(1:1) = lbound(SrcContStateData%x) - UB(1:1) = ubound(SrcContStateData%x) + LB(1:1) = lbound(SrcContStateData%x, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%x, kind=B8Ki) if (.not. allocated(DstContStateData%x)) then allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -377,7 +377,7 @@ subroutine SS_Exc_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) call RegPack(Buf, InData%x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -387,7 +387,7 @@ subroutine SS_Exc_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -491,16 +491,16 @@ subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -512,15 +512,15 @@ subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SS_Exc_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Exc_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -531,12 +531,12 @@ subroutine SS_Exc_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Exc_PackContState(Buf, InData%xdot(i1)) end do @@ -547,13 +547,13 @@ subroutine SS_Exc_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - LB(1:1) = lbound(OutData%xdot) - UB(1:1) = ubound(OutData%xdot) + LB(1:1) = lbound(OutData%xdot, kind=B8Ki) + UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Exc_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do @@ -615,7 +615,7 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' @@ -625,8 +625,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%NBody = SrcParamData%NBody DstParamData%ExctnDisp = SrcParamData%ExctnDisp if (allocated(SrcParamData%spDOF)) then - LB(1:1) = lbound(SrcParamData%spDOF) - UB(1:1) = ubound(SrcParamData%spDOF) + LB(1:1) = lbound(SrcParamData%spDOF, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%spDOF, kind=B8Ki) if (.not. allocated(DstParamData%spDOF)) then allocate(DstParamData%spDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -637,8 +637,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%spDOF = SrcParamData%spDOF end if if (allocated(SrcParamData%A)) then - LB(1:2) = lbound(SrcParamData%A) - UB(1:2) = ubound(SrcParamData%A) + LB(1:2) = lbound(SrcParamData%A, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%A, kind=B8Ki) if (.not. allocated(DstParamData%A)) then allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -649,8 +649,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%A = SrcParamData%A end if if (allocated(SrcParamData%B)) then - LB(1:1) = lbound(SrcParamData%B) - UB(1:1) = ubound(SrcParamData%B) + LB(1:1) = lbound(SrcParamData%B, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%B, kind=B8Ki) if (.not. allocated(DstParamData%B)) then allocate(DstParamData%B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -661,8 +661,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%B = SrcParamData%B end if if (allocated(SrcParamData%C)) then - LB(1:2) = lbound(SrcParamData%C) - UB(1:2) = ubound(SrcParamData%C) + LB(1:2) = lbound(SrcParamData%C, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C, kind=B8Ki) if (.not. allocated(DstParamData%C)) then allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -712,22 +712,22 @@ subroutine SS_Exc_PackParam(Buf, Indata) call RegPack(Buf, InData%ExctnDisp) call RegPack(Buf, allocated(InData%spDOF)) if (allocated(InData%spDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%spDOF), ubound(InData%spDOF)) + call RegPackBounds(Buf, 1, lbound(InData%spDOF, kind=B8Ki), ubound(InData%spDOF, kind=B8Ki)) call RegPack(Buf, InData%spDOF) end if call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) call RegPack(Buf, InData%A) end if call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then - call RegPackBounds(Buf, 1, lbound(InData%B), ubound(InData%B)) + call RegPackBounds(Buf, 1, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) call RegPack(Buf, InData%B) end if call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPackBounds(Buf, 2, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) call RegPack(Buf, InData%C) end if call RegPack(Buf, InData%numStates) @@ -746,10 +746,10 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%DT) @@ -846,14 +846,14 @@ subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%PtfmPos)) then - LB(1:2) = lbound(SrcInputData%PtfmPos) - UB(1:2) = ubound(SrcInputData%PtfmPos) + LB(1:2) = lbound(SrcInputData%PtfmPos, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%PtfmPos, kind=B8Ki) if (.not. allocated(DstInputData%PtfmPos)) then allocate(DstInputData%PtfmPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -884,7 +884,7 @@ subroutine SS_Exc_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%PtfmPos)) if (allocated(InData%PtfmPos)) then - call RegPackBounds(Buf, 2, lbound(InData%PtfmPos), ubound(InData%PtfmPos)) + call RegPackBounds(Buf, 2, lbound(InData%PtfmPos, kind=B8Ki), ubound(InData%PtfmPos, kind=B8Ki)) call RegPack(Buf, InData%PtfmPos) end if if (RegCheckErr(Buf, RoutineName)) return @@ -894,7 +894,7 @@ subroutine SS_Exc_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -920,14 +920,14 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%y)) then - LB(1:1) = lbound(SrcOutputData%y) - UB(1:1) = ubound(SrcOutputData%y) + LB(1:1) = lbound(SrcOutputData%y, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%y, kind=B8Ki) if (.not. allocated(DstOutputData%y)) then allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -938,8 +938,8 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%y = SrcOutputData%y end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -973,12 +973,12 @@ subroutine SS_Exc_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPack(Buf, InData%y) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -988,7 +988,7 @@ subroutine SS_Exc_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 48280fc706..1c07721d8a 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -103,15 +103,15 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' DstInitInputData%InputFile = SrcInitInputData%InputFile if (allocated(SrcInitInputData%enabledDOFs)) then - LB(1:1) = lbound(SrcInitInputData%enabledDOFs) - UB(1:1) = ubound(SrcInitInputData%enabledDOFs) + LB(1:1) = lbound(SrcInitInputData%enabledDOFs, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%enabledDOFs, kind=B8Ki) if (.not. allocated(DstInitInputData%enabledDOFs)) then allocate(DstInitInputData%enabledDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -123,8 +123,8 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if DstInitInputData%NBody = SrcInitInputData%NBody if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -159,13 +159,13 @@ subroutine SS_Rad_PackInitInput(Buf, Indata) call RegPack(Buf, InData%InputFile) call RegPack(Buf, allocated(InData%enabledDOFs)) if (allocated(InData%enabledDOFs)) then - call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs), ubound(InData%enabledDOFs)) + call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs, kind=B8Ki), ubound(InData%enabledDOFs, kind=B8Ki)) call RegPack(Buf, InData%enabledDOFs) end if call RegPack(Buf, InData%NBody) call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefztRot) end if if (RegCheckErr(Buf, RoutineName)) return @@ -175,7 +175,7 @@ subroutine SS_Rad_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -219,14 +219,14 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -237,8 +237,8 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -272,12 +272,12 @@ subroutine SS_Rad_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -287,7 +287,7 @@ subroutine SS_Rad_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -327,14 +327,14 @@ subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%x)) then - LB(1:1) = lbound(SrcContStateData%x) - UB(1:1) = ubound(SrcContStateData%x) + LB(1:1) = lbound(SrcContStateData%x, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%x, kind=B8Ki) if (.not. allocated(DstContStateData%x)) then allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -365,7 +365,7 @@ subroutine SS_Rad_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) call RegPack(Buf, InData%x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -375,7 +375,7 @@ subroutine SS_Rad_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -479,16 +479,16 @@ subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Rad_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -500,15 +500,15 @@ subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SS_Rad_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Rad_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -519,12 +519,12 @@ subroutine SS_Rad_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Rad_PackContState(Buf, InData%xdot(i1)) end do @@ -535,13 +535,13 @@ subroutine SS_Rad_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - LB(1:1) = lbound(OutData%xdot) - UB(1:1) = ubound(OutData%xdot) + LB(1:1) = lbound(OutData%xdot, kind=B8Ki) + UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SS_Rad_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do @@ -592,15 +592,15 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%A)) then - LB(1:2) = lbound(SrcParamData%A) - UB(1:2) = ubound(SrcParamData%A) + LB(1:2) = lbound(SrcParamData%A, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%A, kind=B8Ki) if (.not. allocated(DstParamData%A)) then allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -611,8 +611,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%A = SrcParamData%A end if if (allocated(SrcParamData%B)) then - LB(1:2) = lbound(SrcParamData%B) - UB(1:2) = ubound(SrcParamData%B) + LB(1:2) = lbound(SrcParamData%B, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%B, kind=B8Ki) if (.not. allocated(DstParamData%B)) then allocate(DstParamData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -623,8 +623,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%B = SrcParamData%B end if if (allocated(SrcParamData%C)) then - LB(1:2) = lbound(SrcParamData%C) - UB(1:2) = ubound(SrcParamData%C) + LB(1:2) = lbound(SrcParamData%C, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C, kind=B8Ki) if (.not. allocated(DstParamData%C)) then allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -636,8 +636,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if DstParamData%numStates = SrcParamData%numStates if (allocated(SrcParamData%spdof)) then - LB(1:1) = lbound(SrcParamData%spdof) - UB(1:1) = ubound(SrcParamData%spdof) + LB(1:1) = lbound(SrcParamData%spdof, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%spdof, kind=B8Ki) if (.not. allocated(DstParamData%spdof)) then allocate(DstParamData%spdof(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -679,23 +679,23 @@ subroutine SS_Rad_PackParam(Buf, Indata) call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) call RegPack(Buf, InData%A) end if call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) call RegPack(Buf, InData%B) end if call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPackBounds(Buf, 2, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) call RegPack(Buf, InData%C) end if call RegPack(Buf, InData%numStates) call RegPack(Buf, allocated(InData%spdof)) if (allocated(InData%spdof)) then - call RegPackBounds(Buf, 1, lbound(InData%spdof), ubound(InData%spdof)) + call RegPackBounds(Buf, 1, lbound(InData%spdof, kind=B8Ki), ubound(InData%spdof, kind=B8Ki)) call RegPack(Buf, InData%spdof) end if call RegPack(Buf, InData%NBody) @@ -706,7 +706,7 @@ subroutine SS_Rad_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -780,14 +780,14 @@ subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%dq)) then - LB(1:1) = lbound(SrcInputData%dq) - UB(1:1) = ubound(SrcInputData%dq) + LB(1:1) = lbound(SrcInputData%dq, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%dq, kind=B8Ki) if (.not. allocated(DstInputData%dq)) then allocate(DstInputData%dq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -818,7 +818,7 @@ subroutine SS_Rad_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%dq)) if (allocated(InData%dq)) then - call RegPackBounds(Buf, 1, lbound(InData%dq), ubound(InData%dq)) + call RegPackBounds(Buf, 1, lbound(InData%dq, kind=B8Ki), ubound(InData%dq, kind=B8Ki)) call RegPack(Buf, InData%dq) end if if (RegCheckErr(Buf, RoutineName)) return @@ -828,7 +828,7 @@ subroutine SS_Rad_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -854,14 +854,14 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%y)) then - LB(1:1) = lbound(SrcOutputData%y) - UB(1:1) = ubound(SrcOutputData%y) + LB(1:1) = lbound(SrcOutputData%y, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%y, kind=B8Ki) if (.not. allocated(DstOutputData%y)) then allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -872,8 +872,8 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%y = SrcOutputData%y end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -907,12 +907,12 @@ subroutine SS_Rad_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPack(Buf, InData%y) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -922,7 +922,7 @@ subroutine SS_Rad_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 603be0c1d1..3a25ad9a6b 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -92,7 +92,7 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' @@ -103,8 +103,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod if (allocated(SrcInitInputData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) - UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefxt)) then allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -115,8 +115,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt end if if (allocated(SrcInitInputData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) - UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefyt)) then allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -127,8 +127,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt end if if (allocated(SrcInitInputData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) - UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefzt)) then allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -139,8 +139,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt end if if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -199,22 +199,22 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NBodyMod) call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt, kind=B8Ki), ubound(InData%PtfmRefxt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefxt) end if call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt, kind=B8Ki), ubound(InData%PtfmRefyt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefyt) end if call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt, kind=B8Ki), ubound(InData%PtfmRefzt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefzt) end if call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefztRot) end if call RegPack(Buf, InData%WAMITULEN) @@ -241,10 +241,10 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%HasWAMIT) @@ -359,14 +359,14 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WAMIT2_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%LastIndWave)) then - LB(1:1) = lbound(SrcMiscData%LastIndWave) - UB(1:1) = ubound(SrcMiscData%LastIndWave) + LB(1:1) = lbound(SrcMiscData%LastIndWave, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LastIndWave, kind=B8Ki) if (.not. allocated(DstMiscData%LastIndWave)) then allocate(DstMiscData%LastIndWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -377,8 +377,8 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastIndWave = SrcMiscData%LastIndWave end if if (allocated(SrcMiscData%F_Waves2)) then - LB(1:1) = lbound(SrcMiscData%F_Waves2) - UB(1:1) = ubound(SrcMiscData%F_Waves2) + LB(1:1) = lbound(SrcMiscData%F_Waves2, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_Waves2, kind=B8Ki) if (.not. allocated(DstMiscData%F_Waves2)) then allocate(DstMiscData%F_Waves2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -412,12 +412,12 @@ subroutine WAMIT2_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%LastIndWave)) if (allocated(InData%LastIndWave)) then - call RegPackBounds(Buf, 1, lbound(InData%LastIndWave), ubound(InData%LastIndWave)) + call RegPackBounds(Buf, 1, lbound(InData%LastIndWave, kind=B8Ki), ubound(InData%LastIndWave, kind=B8Ki)) call RegPack(Buf, InData%LastIndWave) end if call RegPack(Buf, allocated(InData%F_Waves2)) if (allocated(InData%F_Waves2)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Waves2), ubound(InData%F_Waves2)) + call RegPackBounds(Buf, 1, lbound(InData%F_Waves2, kind=B8Ki), ubound(InData%F_Waves2, kind=B8Ki)) call RegPack(Buf, InData%F_Waves2) end if if (RegCheckErr(Buf, RoutineName)) return @@ -427,7 +427,7 @@ subroutine WAMIT2_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -467,7 +467,7 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' ErrStat = ErrID_None @@ -475,8 +475,8 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%WaveExctn2)) then - LB(1:2) = lbound(SrcParamData%WaveExctn2) - UB(1:2) = ubound(SrcParamData%WaveExctn2) + LB(1:2) = lbound(SrcParamData%WaveExctn2, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%WaveExctn2, kind=B8Ki) if (.not. allocated(DstParamData%WaveExctn2)) then allocate(DstParamData%WaveExctn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -517,7 +517,7 @@ subroutine WAMIT2_PackParam(Buf, Indata) call RegPack(Buf, InData%NBodyMod) call RegPack(Buf, allocated(InData%WaveExctn2)) if (allocated(InData%WaveExctn2)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2), ubound(InData%WaveExctn2)) + call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2, kind=B8Ki), ubound(InData%WaveExctn2, kind=B8Ki)) call RegPack(Buf, InData%WaveExctn2) end if call RegPack(Buf, InData%MnDriftDims) @@ -535,7 +535,7 @@ subroutine WAMIT2_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 5ec3700014..d801d3ad76 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -147,7 +147,7 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' @@ -157,8 +157,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod DstInitInputData%Gravity = SrcInitInputData%Gravity if (allocated(SrcInitInputData%PtfmVol0)) then - LB(1:1) = lbound(SrcInitInputData%PtfmVol0) - UB(1:1) = ubound(SrcInitInputData%PtfmVol0) + LB(1:1) = lbound(SrcInitInputData%PtfmVol0, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmVol0, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmVol0)) then allocate(DstInitInputData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -171,8 +171,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN if (allocated(SrcInitInputData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) - UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefxt)) then allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -183,8 +183,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt end if if (allocated(SrcInitInputData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) - UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefyt)) then allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -195,8 +195,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt end if if (allocated(SrcInitInputData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) - UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefzt)) then allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -207,8 +207,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt end if if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -219,8 +219,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if if (allocated(SrcInitInputData%PtfmCOBxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) - UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt) + LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmCOBxt)) then allocate(DstInitInputData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -231,8 +231,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt end if if (allocated(SrcInitInputData%PtfmCOByt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) - UB(1:1) = ubound(SrcInitInputData%PtfmCOByt) + LB(1:1) = lbound(SrcInitInputData%PtfmCOByt, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%PtfmCOByt, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmCOByt)) then allocate(DstInitInputData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -300,39 +300,39 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%Gravity) call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0, kind=B8Ki), ubound(InData%PtfmVol0, kind=B8Ki)) call RegPack(Buf, InData%PtfmVol0) end if call RegPack(Buf, InData%HasWAMIT) call RegPack(Buf, InData%WAMITULEN) call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt, kind=B8Ki), ubound(InData%PtfmRefxt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefxt) end if call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt, kind=B8Ki), ubound(InData%PtfmRefyt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefyt) end if call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt, kind=B8Ki), ubound(InData%PtfmRefzt, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefzt) end if call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) call RegPack(Buf, InData%PtfmRefztRot) end if call RegPack(Buf, allocated(InData%PtfmCOBxt)) if (allocated(InData%PtfmCOBxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt, kind=B8Ki), ubound(InData%PtfmCOBxt, kind=B8Ki)) call RegPack(Buf, InData%PtfmCOBxt) end if call RegPack(Buf, allocated(InData%PtfmCOByt)) if (allocated(InData%PtfmCOByt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt, kind=B8Ki), ubound(InData%PtfmCOByt, kind=B8Ki)) call RegPack(Buf, InData%PtfmCOByt) end if call RegPack(Buf, InData%RdtnMod) @@ -356,10 +356,10 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%NBody) @@ -571,7 +571,7 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyDiscState' @@ -587,8 +587,8 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDiscStateData%BdyPosFilt)) then - LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt) - UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt) + LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt, kind=B8Ki) + UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt, kind=B8Ki) if (.not. allocated(DstDiscStateData%BdyPosFilt)) then allocate(DstDiscStateData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,7 +630,7 @@ subroutine WAMIT_PackDiscState(Buf, Indata) call SS_Exc_PackDiscState(Buf, InData%SS_Exctn) call RegPack(Buf, allocated(InData%BdyPosFilt)) if (allocated(InData%BdyPosFilt)) then - call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt), ubound(InData%BdyPosFilt)) + call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt, kind=B8Ki), ubound(InData%BdyPosFilt, kind=B8Ki)) call RegPack(Buf, InData%BdyPosFilt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -640,7 +640,7 @@ subroutine WAMIT_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -789,7 +789,7 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyMisc' @@ -797,8 +797,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstMiscData%LastIndWave = SrcMiscData%LastIndWave if (allocated(SrcMiscData%F_HS)) then - LB(1:1) = lbound(SrcMiscData%F_HS) - UB(1:1) = ubound(SrcMiscData%F_HS) + LB(1:1) = lbound(SrcMiscData%F_HS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_HS, kind=B8Ki) if (.not. allocated(DstMiscData%F_HS)) then allocate(DstMiscData%F_HS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -809,8 +809,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_HS = SrcMiscData%F_HS end if if (allocated(SrcMiscData%F_Waves1)) then - LB(1:1) = lbound(SrcMiscData%F_Waves1) - UB(1:1) = ubound(SrcMiscData%F_Waves1) + LB(1:1) = lbound(SrcMiscData%F_Waves1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_Waves1, kind=B8Ki) if (.not. allocated(DstMiscData%F_Waves1)) then allocate(DstMiscData%F_Waves1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,8 +821,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 end if if (allocated(SrcMiscData%F_Rdtn)) then - LB(1:1) = lbound(SrcMiscData%F_Rdtn) - UB(1:1) = ubound(SrcMiscData%F_Rdtn) + LB(1:1) = lbound(SrcMiscData%F_Rdtn, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_Rdtn, kind=B8Ki) if (.not. allocated(DstMiscData%F_Rdtn)) then allocate(DstMiscData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -833,8 +833,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn end if if (allocated(SrcMiscData%F_PtfmAM)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAM) - UB(1:1) = ubound(SrcMiscData%F_PtfmAM) + LB(1:1) = lbound(SrcMiscData%F_PtfmAM, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_PtfmAM, kind=B8Ki) if (.not. allocated(DstMiscData%F_PtfmAM)) then allocate(DstMiscData%F_PtfmAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -927,22 +927,22 @@ subroutine WAMIT_PackMisc(Buf, Indata) call RegPack(Buf, InData%LastIndWave) call RegPack(Buf, allocated(InData%F_HS)) if (allocated(InData%F_HS)) then - call RegPackBounds(Buf, 1, lbound(InData%F_HS), ubound(InData%F_HS)) + call RegPackBounds(Buf, 1, lbound(InData%F_HS, kind=B8Ki), ubound(InData%F_HS, kind=B8Ki)) call RegPack(Buf, InData%F_HS) end if call RegPack(Buf, allocated(InData%F_Waves1)) if (allocated(InData%F_Waves1)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Waves1), ubound(InData%F_Waves1)) + call RegPackBounds(Buf, 1, lbound(InData%F_Waves1, kind=B8Ki), ubound(InData%F_Waves1, kind=B8Ki)) call RegPack(Buf, InData%F_Waves1) end if call RegPack(Buf, allocated(InData%F_Rdtn)) if (allocated(InData%F_Rdtn)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) + call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn, kind=B8Ki), ubound(InData%F_Rdtn, kind=B8Ki)) call RegPack(Buf, InData%F_Rdtn) end if call RegPack(Buf, allocated(InData%F_PtfmAM)) if (allocated(InData%F_PtfmAM)) then - call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM), ubound(InData%F_PtfmAM)) + call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM, kind=B8Ki), ubound(InData%F_PtfmAM, kind=B8Ki)) call RegPack(Buf, InData%F_PtfmAM) end if call SS_Rad_PackMisc(Buf, InData%SS_Rdtn) @@ -962,7 +962,7 @@ subroutine WAMIT_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1042,7 +1042,7 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyParam' @@ -1051,8 +1051,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%F_HS_Moment_Offset)) then - LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset) - UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset) + LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset, kind=B8Ki) if (.not. allocated(DstParamData%F_HS_Moment_Offset)) then allocate(DstParamData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1063,8 +1063,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset end if if (allocated(SrcParamData%HdroAdMsI)) then - LB(1:2) = lbound(SrcParamData%HdroAdMsI) - UB(1:2) = ubound(SrcParamData%HdroAdMsI) + LB(1:2) = lbound(SrcParamData%HdroAdMsI, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%HdroAdMsI, kind=B8Ki) if (.not. allocated(DstParamData%HdroAdMsI)) then allocate(DstParamData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1075,8 +1075,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI end if if (allocated(SrcParamData%HdroSttc)) then - LB(1:2) = lbound(SrcParamData%HdroSttc) - UB(1:2) = ubound(SrcParamData%HdroSttc) + LB(1:2) = lbound(SrcParamData%HdroSttc, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%HdroSttc, kind=B8Ki) if (.not. allocated(DstParamData%HdroSttc)) then allocate(DstParamData%HdroSttc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1092,8 +1092,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%ExctnCutOff = SrcParamData%ExctnCutOff DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst if (allocated(SrcParamData%WaveExctn)) then - LB(1:2) = lbound(SrcParamData%WaveExctn) - UB(1:2) = ubound(SrcParamData%WaveExctn) + LB(1:2) = lbound(SrcParamData%WaveExctn, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%WaveExctn, kind=B8Ki) if (.not. allocated(DstParamData%WaveExctn)) then allocate(DstParamData%WaveExctn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1104,8 +1104,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveExctn = SrcParamData%WaveExctn end if if (allocated(SrcParamData%WaveExctnGrid)) then - LB(1:4) = lbound(SrcParamData%WaveExctnGrid) - UB(1:4) = ubound(SrcParamData%WaveExctnGrid) + LB(1:4) = lbound(SrcParamData%WaveExctnGrid, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%WaveExctnGrid, kind=B8Ki) if (.not. allocated(DstParamData%WaveExctnGrid)) then allocate(DstParamData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1171,17 +1171,17 @@ subroutine WAMIT_PackParam(Buf, Indata) call RegPack(Buf, InData%NBodyMod) call RegPack(Buf, allocated(InData%F_HS_Moment_Offset)) if (allocated(InData%F_HS_Moment_Offset)) then - call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset), ubound(InData%F_HS_Moment_Offset)) + call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset, kind=B8Ki), ubound(InData%F_HS_Moment_Offset, kind=B8Ki)) call RegPack(Buf, InData%F_HS_Moment_Offset) end if call RegPack(Buf, allocated(InData%HdroAdMsI)) if (allocated(InData%HdroAdMsI)) then - call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI), ubound(InData%HdroAdMsI)) + call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI, kind=B8Ki), ubound(InData%HdroAdMsI, kind=B8Ki)) call RegPack(Buf, InData%HdroAdMsI) end if call RegPack(Buf, allocated(InData%HdroSttc)) if (allocated(InData%HdroSttc)) then - call RegPackBounds(Buf, 2, lbound(InData%HdroSttc), ubound(InData%HdroSttc)) + call RegPackBounds(Buf, 2, lbound(InData%HdroSttc, kind=B8Ki), ubound(InData%HdroSttc, kind=B8Ki)) call RegPack(Buf, InData%HdroSttc) end if call RegPack(Buf, InData%RdtnMod) @@ -1191,12 +1191,12 @@ subroutine WAMIT_PackParam(Buf, Indata) call RegPack(Buf, InData%ExctnFiltConst) call RegPack(Buf, allocated(InData%WaveExctn)) if (allocated(InData%WaveExctn)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveExctn), ubound(InData%WaveExctn)) + call RegPackBounds(Buf, 2, lbound(InData%WaveExctn, kind=B8Ki), ubound(InData%WaveExctn, kind=B8Ki)) call RegPack(Buf, InData%WaveExctn) end if call RegPack(Buf, allocated(InData%WaveExctnGrid)) if (allocated(InData%WaveExctnGrid)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid), ubound(InData%WaveExctnGrid)) + call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid, kind=B8Ki), ubound(InData%WaveExctnGrid, kind=B8Ki)) call RegPack(Buf, InData%WaveExctnGrid) end if call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) @@ -1217,10 +1217,10 @@ subroutine WAMIT_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WAMIT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%NBody) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 56e7b92ace..299b42c9a0 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -232,7 +232,7 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceD_CopyInputFile' ErrStat = ErrID_None @@ -249,8 +249,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Seed2 = SrcInputFileData%Seed2 DstInputFileData%NumLegs = SrcInputFileData%NumLegs if (allocated(SrcInputFileData%LegPosX)) then - LB(1:1) = lbound(SrcInputFileData%LegPosX) - UB(1:1) = ubound(SrcInputFileData%LegPosX) + LB(1:1) = lbound(SrcInputFileData%LegPosX, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LegPosX, kind=B8Ki) if (.not. allocated(DstInputFileData%LegPosX)) then allocate(DstInputFileData%LegPosX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -261,8 +261,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LegPosX = SrcInputFileData%LegPosX end if if (allocated(SrcInputFileData%LegPosY)) then - LB(1:1) = lbound(SrcInputFileData%LegPosY) - UB(1:1) = ubound(SrcInputFileData%LegPosY) + LB(1:1) = lbound(SrcInputFileData%LegPosY, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%LegPosY, kind=B8Ki) if (.not. allocated(DstInputFileData%LegPosY)) then allocate(DstInputFileData%LegPosY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -273,8 +273,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LegPosY = SrcInputFileData%LegPosY end if if (allocated(SrcInputFileData%StrWd)) then - LB(1:1) = lbound(SrcInputFileData%StrWd) - UB(1:1) = ubound(SrcInputFileData%StrWd) + LB(1:1) = lbound(SrcInputFileData%StrWd, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%StrWd, kind=B8Ki) if (.not. allocated(DstInputFileData%StrWd)) then allocate(DstInputFileData%StrWd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -368,17 +368,17 @@ subroutine IceD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumLegs) call RegPack(Buf, allocated(InData%LegPosX)) if (allocated(InData%LegPosX)) then - call RegPackBounds(Buf, 1, lbound(InData%LegPosX), ubound(InData%LegPosX)) + call RegPackBounds(Buf, 1, lbound(InData%LegPosX, kind=B8Ki), ubound(InData%LegPosX, kind=B8Ki)) call RegPack(Buf, InData%LegPosX) end if call RegPack(Buf, allocated(InData%LegPosY)) if (allocated(InData%LegPosY)) then - call RegPackBounds(Buf, 1, lbound(InData%LegPosY), ubound(InData%LegPosY)) + call RegPackBounds(Buf, 1, lbound(InData%LegPosY, kind=B8Ki), ubound(InData%LegPosY, kind=B8Ki)) call RegPack(Buf, InData%LegPosY) end if call RegPack(Buf, allocated(InData%StrWd)) if (allocated(InData%StrWd)) then - call RegPackBounds(Buf, 1, lbound(InData%StrWd), ubound(InData%StrWd)) + call RegPackBounds(Buf, 1, lbound(InData%StrWd, kind=B8Ki), ubound(InData%StrWd, kind=B8Ki)) call RegPack(Buf, InData%StrWd) end if call RegPack(Buf, InData%Ikm) @@ -434,7 +434,7 @@ subroutine IceD_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -665,15 +665,15 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -684,8 +684,8 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -727,12 +727,12 @@ subroutine IceD_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call RegPack(Buf, InData%numLegs) @@ -744,7 +744,7 @@ subroutine IceD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -908,8 +908,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyOtherState' @@ -917,8 +917,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E ErrMsg = '' DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 if (allocated(SrcOtherStateData%Nc)) then - LB(1:1) = lbound(SrcOtherStateData%Nc) - UB(1:1) = ubound(SrcOtherStateData%Nc) + LB(1:1) = lbound(SrcOtherStateData%Nc, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Nc, kind=B8Ki) if (.not. allocated(DstOtherStateData%Nc)) then allocate(DstOtherStateData%Nc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -929,8 +929,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Nc = SrcOtherStateData%Nc end if if (allocated(SrcOtherStateData%Psum)) then - LB(1:1) = lbound(SrcOtherStateData%Psum) - UB(1:1) = ubound(SrcOtherStateData%Psum) + LB(1:1) = lbound(SrcOtherStateData%Psum, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Psum, kind=B8Ki) if (.not. allocated(DstOtherStateData%Psum)) then allocate(DstOtherStateData%Psum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -941,8 +941,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Psum = SrcOtherStateData%Psum end if if (allocated(SrcOtherStateData%IceTthNo)) then - LB(1:1) = lbound(SrcOtherStateData%IceTthNo) - UB(1:1) = ubound(SrcOtherStateData%IceTthNo) + LB(1:1) = lbound(SrcOtherStateData%IceTthNo, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%IceTthNo, kind=B8Ki) if (.not. allocated(DstOtherStateData%IceTthNo)) then allocate(DstOtherStateData%IceTthNo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -957,8 +957,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Splitf = SrcOtherStateData%Splitf DstOtherStateData%dxc = SrcOtherStateData%dxc if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -979,8 +979,8 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(IceD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_DestroyOtherState' @@ -996,8 +996,8 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%IceTthNo) end if if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1010,23 +1010,23 @@ subroutine IceD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IceTthNo2) call RegPack(Buf, allocated(InData%Nc)) if (allocated(InData%Nc)) then - call RegPackBounds(Buf, 1, lbound(InData%Nc), ubound(InData%Nc)) + call RegPackBounds(Buf, 1, lbound(InData%Nc, kind=B8Ki), ubound(InData%Nc, kind=B8Ki)) call RegPack(Buf, InData%Nc) end if call RegPack(Buf, allocated(InData%Psum)) if (allocated(InData%Psum)) then - call RegPackBounds(Buf, 1, lbound(InData%Psum), ubound(InData%Psum)) + call RegPackBounds(Buf, 1, lbound(InData%Psum, kind=B8Ki), ubound(InData%Psum, kind=B8Ki)) call RegPack(Buf, InData%Psum) end if call RegPack(Buf, allocated(InData%IceTthNo)) if (allocated(InData%IceTthNo)) then - call RegPackBounds(Buf, 1, lbound(InData%IceTthNo), ubound(InData%IceTthNo)) + call RegPackBounds(Buf, 1, lbound(InData%IceTthNo, kind=B8Ki), ubound(InData%IceTthNo, kind=B8Ki)) call RegPack(Buf, InData%IceTthNo) end if call RegPack(Buf, InData%Beta) @@ -1035,9 +1035,9 @@ subroutine IceD_PackOtherState(Buf, Indata) call RegPack(Buf, InData%dxc) call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + call RegPackBounds(Buf, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_PackContState(Buf, InData%xdot(i1)) end do @@ -1050,8 +1050,8 @@ subroutine IceD_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1171,7 +1171,7 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceD_CopyParam' ErrStat = ErrID_None @@ -1191,8 +1191,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%method = SrcParamData%method DstParamData%TmStep = SrcParamData%TmStep if (allocated(SrcParamData%OutName)) then - LB(1:1) = lbound(SrcParamData%OutName) - UB(1:1) = ubound(SrcParamData%OutName) + LB(1:1) = lbound(SrcParamData%OutName, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutName, kind=B8Ki) if (.not. allocated(DstParamData%OutName)) then allocate(DstParamData%OutName(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1203,8 +1203,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutName = SrcParamData%OutName end if if (allocated(SrcParamData%OutUnit)) then - LB(1:1) = lbound(SrcParamData%OutUnit) - UB(1:1) = ubound(SrcParamData%OutUnit) + LB(1:1) = lbound(SrcParamData%OutUnit, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutUnit, kind=B8Ki) if (.not. allocated(DstParamData%OutUnit)) then allocate(DstParamData%OutUnit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,8 +1228,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Pitch = SrcParamData%Pitch DstParamData%Kice2 = SrcParamData%Kice2 if (allocated(SrcParamData%rdmFm)) then - LB(1:1) = lbound(SrcParamData%rdmFm) - UB(1:1) = ubound(SrcParamData%rdmFm) + LB(1:1) = lbound(SrcParamData%rdmFm, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rdmFm, kind=B8Ki) if (.not. allocated(DstParamData%rdmFm)) then allocate(DstParamData%rdmFm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1240,8 +1240,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmFm = SrcParamData%rdmFm end if if (allocated(SrcParamData%rdmt0)) then - LB(1:1) = lbound(SrcParamData%rdmt0) - UB(1:1) = ubound(SrcParamData%rdmt0) + LB(1:1) = lbound(SrcParamData%rdmt0, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rdmt0, kind=B8Ki) if (.not. allocated(DstParamData%rdmt0)) then allocate(DstParamData%rdmt0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1252,8 +1252,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmt0 = SrcParamData%rdmt0 end if if (allocated(SrcParamData%rdmtm)) then - LB(1:1) = lbound(SrcParamData%rdmtm) - UB(1:1) = ubound(SrcParamData%rdmtm) + LB(1:1) = lbound(SrcParamData%rdmtm, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rdmtm, kind=B8Ki) if (.not. allocated(DstParamData%rdmtm)) then allocate(DstParamData%rdmtm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1264,8 +1264,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmtm = SrcParamData%rdmtm end if if (allocated(SrcParamData%rdmDm)) then - LB(1:1) = lbound(SrcParamData%rdmDm) - UB(1:1) = ubound(SrcParamData%rdmDm) + LB(1:1) = lbound(SrcParamData%rdmDm, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rdmDm, kind=B8Ki) if (.not. allocated(DstParamData%rdmDm)) then allocate(DstParamData%rdmDm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1276,8 +1276,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmDm = SrcParamData%rdmDm end if if (allocated(SrcParamData%rdmP)) then - LB(1:1) = lbound(SrcParamData%rdmP) - UB(1:1) = ubound(SrcParamData%rdmP) + LB(1:1) = lbound(SrcParamData%rdmP, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rdmP, kind=B8Ki) if (.not. allocated(DstParamData%rdmP)) then allocate(DstParamData%rdmP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1288,8 +1288,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmP = SrcParamData%rdmP end if if (allocated(SrcParamData%rdmKi)) then - LB(1:1) = lbound(SrcParamData%rdmKi) - UB(1:1) = ubound(SrcParamData%rdmKi) + LB(1:1) = lbound(SrcParamData%rdmKi, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rdmKi, kind=B8Ki) if (.not. allocated(DstParamData%rdmKi)) then allocate(DstParamData%rdmKi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1303,8 +1303,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Kice = SrcParamData%Kice DstParamData%Delmax = SrcParamData%Delmax if (allocated(SrcParamData%Y0)) then - LB(1:1) = lbound(SrcParamData%Y0) - UB(1:1) = ubound(SrcParamData%Y0) + LB(1:1) = lbound(SrcParamData%Y0, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Y0, kind=B8Ki) if (.not. allocated(DstParamData%Y0)) then allocate(DstParamData%Y0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1315,8 +1315,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0 = SrcParamData%Y0 end if if (allocated(SrcParamData%ContPrfl)) then - LB(1:1) = lbound(SrcParamData%ContPrfl) - UB(1:1) = ubound(SrcParamData%ContPrfl) + LB(1:1) = lbound(SrcParamData%ContPrfl, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ContPrfl, kind=B8Ki) if (.not. allocated(DstParamData%ContPrfl)) then allocate(DstParamData%ContPrfl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1406,12 +1406,12 @@ subroutine IceD_PackParam(Buf, Indata) call RegPack(Buf, InData%TmStep) call RegPack(Buf, allocated(InData%OutName)) if (allocated(InData%OutName)) then - call RegPackBounds(Buf, 1, lbound(InData%OutName), ubound(InData%OutName)) + call RegPackBounds(Buf, 1, lbound(InData%OutName, kind=B8Ki), ubound(InData%OutName, kind=B8Ki)) call RegPack(Buf, InData%OutName) end if call RegPack(Buf, allocated(InData%OutUnit)) if (allocated(InData%OutUnit)) then - call RegPackBounds(Buf, 1, lbound(InData%OutUnit), ubound(InData%OutUnit)) + call RegPackBounds(Buf, 1, lbound(InData%OutUnit, kind=B8Ki), ubound(InData%OutUnit, kind=B8Ki)) call RegPack(Buf, InData%OutUnit) end if call RegPack(Buf, InData%RootName) @@ -1429,32 +1429,32 @@ subroutine IceD_PackParam(Buf, Indata) call RegPack(Buf, InData%Kice2) call RegPack(Buf, allocated(InData%rdmFm)) if (allocated(InData%rdmFm)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmFm), ubound(InData%rdmFm)) + call RegPackBounds(Buf, 1, lbound(InData%rdmFm, kind=B8Ki), ubound(InData%rdmFm, kind=B8Ki)) call RegPack(Buf, InData%rdmFm) end if call RegPack(Buf, allocated(InData%rdmt0)) if (allocated(InData%rdmt0)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmt0), ubound(InData%rdmt0)) + call RegPackBounds(Buf, 1, lbound(InData%rdmt0, kind=B8Ki), ubound(InData%rdmt0, kind=B8Ki)) call RegPack(Buf, InData%rdmt0) end if call RegPack(Buf, allocated(InData%rdmtm)) if (allocated(InData%rdmtm)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmtm), ubound(InData%rdmtm)) + call RegPackBounds(Buf, 1, lbound(InData%rdmtm, kind=B8Ki), ubound(InData%rdmtm, kind=B8Ki)) call RegPack(Buf, InData%rdmtm) end if call RegPack(Buf, allocated(InData%rdmDm)) if (allocated(InData%rdmDm)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmDm), ubound(InData%rdmDm)) + call RegPackBounds(Buf, 1, lbound(InData%rdmDm, kind=B8Ki), ubound(InData%rdmDm, kind=B8Ki)) call RegPack(Buf, InData%rdmDm) end if call RegPack(Buf, allocated(InData%rdmP)) if (allocated(InData%rdmP)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmP), ubound(InData%rdmP)) + call RegPackBounds(Buf, 1, lbound(InData%rdmP, kind=B8Ki), ubound(InData%rdmP, kind=B8Ki)) call RegPack(Buf, InData%rdmP) end if call RegPack(Buf, allocated(InData%rdmKi)) if (allocated(InData%rdmKi)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmKi), ubound(InData%rdmKi)) + call RegPackBounds(Buf, 1, lbound(InData%rdmKi, kind=B8Ki), ubound(InData%rdmKi, kind=B8Ki)) call RegPack(Buf, InData%rdmKi) end if call RegPack(Buf, InData%ZonePitch) @@ -1462,12 +1462,12 @@ subroutine IceD_PackParam(Buf, Indata) call RegPack(Buf, InData%Delmax) call RegPack(Buf, allocated(InData%Y0)) if (allocated(InData%Y0)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0), ubound(InData%Y0)) + call RegPackBounds(Buf, 1, lbound(InData%Y0, kind=B8Ki), ubound(InData%Y0, kind=B8Ki)) call RegPack(Buf, InData%Y0) end if call RegPack(Buf, allocated(InData%ContPrfl)) if (allocated(InData%ContPrfl)) then - call RegPackBounds(Buf, 1, lbound(InData%ContPrfl), ubound(InData%ContPrfl)) + call RegPackBounds(Buf, 1, lbound(InData%ContPrfl, kind=B8Ki), ubound(InData%ContPrfl, kind=B8Ki)) call RegPack(Buf, InData%ContPrfl) end if call RegPack(Buf, InData%Zn) @@ -1495,7 +1495,7 @@ subroutine IceD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackParam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1789,7 +1789,7 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyOutput' @@ -1799,8 +1799,8 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1836,7 +1836,7 @@ subroutine IceD_PackOutput(Buf, Indata) call MeshPack(Buf, InData%PointMesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1846,7 +1846,7 @@ subroutine IceD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 2a7230ceb8..5d53911bed 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -171,15 +171,15 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceFloe_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -190,8 +190,8 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -232,12 +232,12 @@ subroutine IceFloe_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) @@ -248,7 +248,7 @@ subroutine IceFloe_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceFloe_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -484,14 +484,14 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceFloe_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%loadSeries)) then - LB(1:2) = lbound(SrcParamData%loadSeries) - UB(1:2) = ubound(SrcParamData%loadSeries) + LB(1:2) = lbound(SrcParamData%loadSeries, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%loadSeries, kind=B8Ki) if (.not. allocated(DstParamData%loadSeries)) then allocate(DstParamData%loadSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -512,8 +512,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%dt = SrcParamData%dt DstParamData%rampTime = SrcParamData%rampTime if (allocated(SrcParamData%legX)) then - LB(1:1) = lbound(SrcParamData%legX) - UB(1:1) = ubound(SrcParamData%legX) + LB(1:1) = lbound(SrcParamData%legX, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%legX, kind=B8Ki) if (.not. allocated(DstParamData%legX)) then allocate(DstParamData%legX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -524,8 +524,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%legX = SrcParamData%legX end if if (allocated(SrcParamData%legY)) then - LB(1:1) = lbound(SrcParamData%legY) - UB(1:1) = ubound(SrcParamData%legY) + LB(1:1) = lbound(SrcParamData%legY, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%legY, kind=B8Ki) if (.not. allocated(DstParamData%legY)) then allocate(DstParamData%legY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -536,8 +536,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%legY = SrcParamData%legY end if if (allocated(SrcParamData%ks)) then - LB(1:1) = lbound(SrcParamData%ks) - UB(1:1) = ubound(SrcParamData%ks) + LB(1:1) = lbound(SrcParamData%ks, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ks, kind=B8Ki) if (.not. allocated(DstParamData%ks)) then allocate(DstParamData%ks(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -582,7 +582,7 @@ subroutine IceFloe_PackParam(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%loadSeries)) if (allocated(InData%loadSeries)) then - call RegPackBounds(Buf, 2, lbound(InData%loadSeries), ubound(InData%loadSeries)) + call RegPackBounds(Buf, 2, lbound(InData%loadSeries, kind=B8Ki), ubound(InData%loadSeries, kind=B8Ki)) call RegPack(Buf, InData%loadSeries) end if call RegPack(Buf, InData%iceVel) @@ -597,17 +597,17 @@ subroutine IceFloe_PackParam(Buf, Indata) call RegPack(Buf, InData%rampTime) call RegPack(Buf, allocated(InData%legX)) if (allocated(InData%legX)) then - call RegPackBounds(Buf, 1, lbound(InData%legX), ubound(InData%legX)) + call RegPackBounds(Buf, 1, lbound(InData%legX, kind=B8Ki), ubound(InData%legX, kind=B8Ki)) call RegPack(Buf, InData%legX) end if call RegPack(Buf, allocated(InData%legY)) if (allocated(InData%legY)) then - call RegPackBounds(Buf, 1, lbound(InData%legY), ubound(InData%legY)) + call RegPackBounds(Buf, 1, lbound(InData%legY, kind=B8Ki), ubound(InData%legY, kind=B8Ki)) call RegPack(Buf, InData%legY) end if call RegPack(Buf, allocated(InData%ks)) if (allocated(InData%ks)) then - call RegPackBounds(Buf, 1, lbound(InData%ks), ubound(InData%ks)) + call RegPackBounds(Buf, 1, lbound(InData%ks, kind=B8Ki), ubound(InData%ks, kind=B8Ki)) call RegPack(Buf, InData%ks) end if call RegPack(Buf, InData%numLegs) @@ -622,7 +622,7 @@ subroutine IceFloe_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceFloe_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -766,7 +766,7 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceFloe_CopyOutput' @@ -776,8 +776,8 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -813,7 +813,7 @@ subroutine IceFloe_PackOutput(Buf, Indata) call MeshPack(Buf, InData%iceMesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -823,7 +823,7 @@ subroutine IceFloe_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceFloe_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index bb8a9b991f..415a47a057 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -172,7 +172,7 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' ErrStat = ErrID_None @@ -181,8 +181,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize if (allocated(SrcUniformFieldTypeData%Time)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%Time) - UB(1:1) = ubound(SrcUniformFieldTypeData%Time) + LB(1:1) = lbound(SrcUniformFieldTypeData%Time, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%Time, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%Time)) then allocate(DstUniformFieldTypeData%Time(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -193,8 +193,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time end if if (allocated(SrcUniformFieldTypeData%VelH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelH) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelH, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelH, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%VelH)) then allocate(DstUniformFieldTypeData%VelH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -205,8 +205,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH end if if (allocated(SrcUniformFieldTypeData%VelHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%VelHDot)) then allocate(DstUniformFieldTypeData%VelHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -217,8 +217,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot end if if (allocated(SrcUniformFieldTypeData%VelV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelV) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelV, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelV, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%VelV)) then allocate(DstUniformFieldTypeData%VelV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -229,8 +229,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV end if if (allocated(SrcUniformFieldTypeData%VelVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%VelVDot)) then allocate(DstUniformFieldTypeData%VelVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -241,8 +241,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot end if if (allocated(SrcUniformFieldTypeData%VelGust)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%VelGust)) then allocate(DstUniformFieldTypeData%VelGust(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -253,8 +253,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust end if if (allocated(SrcUniformFieldTypeData%VelGustDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%VelGustDot)) then allocate(DstUniformFieldTypeData%VelGustDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -265,8 +265,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot end if if (allocated(SrcUniformFieldTypeData%AngleH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%AngleH)) then allocate(DstUniformFieldTypeData%AngleH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -277,8 +277,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH end if if (allocated(SrcUniformFieldTypeData%AngleHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%AngleHDot)) then allocate(DstUniformFieldTypeData%AngleHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -289,8 +289,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot end if if (allocated(SrcUniformFieldTypeData%AngleV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%AngleV)) then allocate(DstUniformFieldTypeData%AngleV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -301,8 +301,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV end if if (allocated(SrcUniformFieldTypeData%AngleVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%AngleVDot)) then allocate(DstUniformFieldTypeData%AngleVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -313,8 +313,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot end if if (allocated(SrcUniformFieldTypeData%ShrH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%ShrH)) then allocate(DstUniformFieldTypeData%ShrH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -325,8 +325,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH end if if (allocated(SrcUniformFieldTypeData%ShrHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%ShrHDot)) then allocate(DstUniformFieldTypeData%ShrHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -337,8 +337,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot end if if (allocated(SrcUniformFieldTypeData%ShrV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%ShrV)) then allocate(DstUniformFieldTypeData%ShrV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -349,8 +349,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV end if if (allocated(SrcUniformFieldTypeData%ShrVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%ShrVDot)) then allocate(DstUniformFieldTypeData%ShrVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -361,8 +361,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot end if if (allocated(SrcUniformFieldTypeData%LinShrV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) - UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV) + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%LinShrV)) then allocate(DstUniformFieldTypeData%LinShrV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -373,8 +373,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV end if if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) - UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot) + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot, kind=B8Ki) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot, kind=B8Ki) if (.not. allocated(DstUniformFieldTypeData%LinShrVDot)) then allocate(DstUniformFieldTypeData%LinShrVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -456,87 +456,87 @@ subroutine IfW_FlowField_PackUniformFieldType(Buf, Indata) call RegPack(Buf, InData%DataSize) call RegPack(Buf, allocated(InData%Time)) if (allocated(InData%Time)) then - call RegPackBounds(Buf, 1, lbound(InData%Time), ubound(InData%Time)) + call RegPackBounds(Buf, 1, lbound(InData%Time, kind=B8Ki), ubound(InData%Time, kind=B8Ki)) call RegPack(Buf, InData%Time) end if call RegPack(Buf, allocated(InData%VelH)) if (allocated(InData%VelH)) then - call RegPackBounds(Buf, 1, lbound(InData%VelH), ubound(InData%VelH)) + call RegPackBounds(Buf, 1, lbound(InData%VelH, kind=B8Ki), ubound(InData%VelH, kind=B8Ki)) call RegPack(Buf, InData%VelH) end if call RegPack(Buf, allocated(InData%VelHDot)) if (allocated(InData%VelHDot)) then - call RegPackBounds(Buf, 1, lbound(InData%VelHDot), ubound(InData%VelHDot)) + call RegPackBounds(Buf, 1, lbound(InData%VelHDot, kind=B8Ki), ubound(InData%VelHDot, kind=B8Ki)) call RegPack(Buf, InData%VelHDot) end if call RegPack(Buf, allocated(InData%VelV)) if (allocated(InData%VelV)) then - call RegPackBounds(Buf, 1, lbound(InData%VelV), ubound(InData%VelV)) + call RegPackBounds(Buf, 1, lbound(InData%VelV, kind=B8Ki), ubound(InData%VelV, kind=B8Ki)) call RegPack(Buf, InData%VelV) end if call RegPack(Buf, allocated(InData%VelVDot)) if (allocated(InData%VelVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%VelVDot), ubound(InData%VelVDot)) + call RegPackBounds(Buf, 1, lbound(InData%VelVDot, kind=B8Ki), ubound(InData%VelVDot, kind=B8Ki)) call RegPack(Buf, InData%VelVDot) end if call RegPack(Buf, allocated(InData%VelGust)) if (allocated(InData%VelGust)) then - call RegPackBounds(Buf, 1, lbound(InData%VelGust), ubound(InData%VelGust)) + call RegPackBounds(Buf, 1, lbound(InData%VelGust, kind=B8Ki), ubound(InData%VelGust, kind=B8Ki)) call RegPack(Buf, InData%VelGust) end if call RegPack(Buf, allocated(InData%VelGustDot)) if (allocated(InData%VelGustDot)) then - call RegPackBounds(Buf, 1, lbound(InData%VelGustDot), ubound(InData%VelGustDot)) + call RegPackBounds(Buf, 1, lbound(InData%VelGustDot, kind=B8Ki), ubound(InData%VelGustDot, kind=B8Ki)) call RegPack(Buf, InData%VelGustDot) end if call RegPack(Buf, allocated(InData%AngleH)) if (allocated(InData%AngleH)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleH), ubound(InData%AngleH)) + call RegPackBounds(Buf, 1, lbound(InData%AngleH, kind=B8Ki), ubound(InData%AngleH, kind=B8Ki)) call RegPack(Buf, InData%AngleH) end if call RegPack(Buf, allocated(InData%AngleHDot)) if (allocated(InData%AngleHDot)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleHDot), ubound(InData%AngleHDot)) + call RegPackBounds(Buf, 1, lbound(InData%AngleHDot, kind=B8Ki), ubound(InData%AngleHDot, kind=B8Ki)) call RegPack(Buf, InData%AngleHDot) end if call RegPack(Buf, allocated(InData%AngleV)) if (allocated(InData%AngleV)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleV), ubound(InData%AngleV)) + call RegPackBounds(Buf, 1, lbound(InData%AngleV, kind=B8Ki), ubound(InData%AngleV, kind=B8Ki)) call RegPack(Buf, InData%AngleV) end if call RegPack(Buf, allocated(InData%AngleVDot)) if (allocated(InData%AngleVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleVDot), ubound(InData%AngleVDot)) + call RegPackBounds(Buf, 1, lbound(InData%AngleVDot, kind=B8Ki), ubound(InData%AngleVDot, kind=B8Ki)) call RegPack(Buf, InData%AngleVDot) end if call RegPack(Buf, allocated(InData%ShrH)) if (allocated(InData%ShrH)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrH), ubound(InData%ShrH)) + call RegPackBounds(Buf, 1, lbound(InData%ShrH, kind=B8Ki), ubound(InData%ShrH, kind=B8Ki)) call RegPack(Buf, InData%ShrH) end if call RegPack(Buf, allocated(InData%ShrHDot)) if (allocated(InData%ShrHDot)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrHDot), ubound(InData%ShrHDot)) + call RegPackBounds(Buf, 1, lbound(InData%ShrHDot, kind=B8Ki), ubound(InData%ShrHDot, kind=B8Ki)) call RegPack(Buf, InData%ShrHDot) end if call RegPack(Buf, allocated(InData%ShrV)) if (allocated(InData%ShrV)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrV), ubound(InData%ShrV)) + call RegPackBounds(Buf, 1, lbound(InData%ShrV, kind=B8Ki), ubound(InData%ShrV, kind=B8Ki)) call RegPack(Buf, InData%ShrV) end if call RegPack(Buf, allocated(InData%ShrVDot)) if (allocated(InData%ShrVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrVDot), ubound(InData%ShrVDot)) + call RegPackBounds(Buf, 1, lbound(InData%ShrVDot, kind=B8Ki), ubound(InData%ShrVDot, kind=B8Ki)) call RegPack(Buf, InData%ShrVDot) end if call RegPack(Buf, allocated(InData%LinShrV)) if (allocated(InData%LinShrV)) then - call RegPackBounds(Buf, 1, lbound(InData%LinShrV), ubound(InData%LinShrV)) + call RegPackBounds(Buf, 1, lbound(InData%LinShrV, kind=B8Ki), ubound(InData%LinShrV, kind=B8Ki)) call RegPack(Buf, InData%LinShrV) end if call RegPack(Buf, allocated(InData%LinShrVDot)) if (allocated(InData%LinShrVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot), ubound(InData%LinShrVDot)) + call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot, kind=B8Ki), ubound(InData%LinShrVDot, kind=B8Ki)) call RegPack(Buf, InData%LinShrVDot) end if if (RegCheckErr(Buf, RoutineName)) return @@ -546,7 +546,7 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(UniformFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -917,7 +917,7 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' ErrStat = ErrID_None @@ -930,8 +930,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength if (allocated(SrcGrid3DFieldTypeData%Vel)) then - LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel) - UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel) + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel, kind=B8Ki) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel, kind=B8Ki) if (.not. allocated(DstGrid3DFieldTypeData%Vel)) then allocate(DstGrid3DFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -942,8 +942,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel end if if (allocated(SrcGrid3DFieldTypeData%Acc)) then - LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) - UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc) + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc, kind=B8Ki) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc, kind=B8Ki) if (.not. allocated(DstGrid3DFieldTypeData%Acc)) then allocate(DstGrid3DFieldTypeData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -954,8 +954,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc end if if (allocated(SrcGrid3DFieldTypeData%VelTower)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower, kind=B8Ki) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower, kind=B8Ki) if (.not. allocated(DstGrid3DFieldTypeData%VelTower)) then allocate(DstGrid3DFieldTypeData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -966,8 +966,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower end if if (allocated(SrcGrid3DFieldTypeData%AccTower)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower, kind=B8Ki) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower, kind=B8Ki) if (.not. allocated(DstGrid3DFieldTypeData%AccTower)) then allocate(DstGrid3DFieldTypeData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -978,8 +978,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower end if if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg, kind=B8Ki) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg, kind=B8Ki) if (.not. allocated(DstGrid3DFieldTypeData%VelAvg)) then allocate(DstGrid3DFieldTypeData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -990,8 +990,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg end if if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg, kind=B8Ki) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg, kind=B8Ki) if (.not. allocated(DstGrid3DFieldTypeData%AccAvg)) then allocate(DstGrid3DFieldTypeData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1066,32 +1066,32 @@ subroutine IfW_FlowField_PackGrid3DFieldType(Buf, Indata) call RegPack(Buf, InData%RefLength) call RegPack(Buf, allocated(InData%Vel)) if (allocated(InData%Vel)) then - call RegPackBounds(Buf, 4, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackBounds(Buf, 4, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) call RegPack(Buf, InData%Vel) end if call RegPack(Buf, allocated(InData%Acc)) if (allocated(InData%Acc)) then - call RegPackBounds(Buf, 4, lbound(InData%Acc), ubound(InData%Acc)) + call RegPackBounds(Buf, 4, lbound(InData%Acc, kind=B8Ki), ubound(InData%Acc, kind=B8Ki)) call RegPack(Buf, InData%Acc) end if call RegPack(Buf, allocated(InData%VelTower)) if (allocated(InData%VelTower)) then - call RegPackBounds(Buf, 3, lbound(InData%VelTower), ubound(InData%VelTower)) + call RegPackBounds(Buf, 3, lbound(InData%VelTower, kind=B8Ki), ubound(InData%VelTower, kind=B8Ki)) call RegPack(Buf, InData%VelTower) end if call RegPack(Buf, allocated(InData%AccTower)) if (allocated(InData%AccTower)) then - call RegPackBounds(Buf, 3, lbound(InData%AccTower), ubound(InData%AccTower)) + call RegPackBounds(Buf, 3, lbound(InData%AccTower, kind=B8Ki), ubound(InData%AccTower, kind=B8Ki)) call RegPack(Buf, InData%AccTower) end if call RegPack(Buf, allocated(InData%VelAvg)) if (allocated(InData%VelAvg)) then - call RegPackBounds(Buf, 3, lbound(InData%VelAvg), ubound(InData%VelAvg)) + call RegPackBounds(Buf, 3, lbound(InData%VelAvg, kind=B8Ki), ubound(InData%VelAvg, kind=B8Ki)) call RegPack(Buf, InData%VelAvg) end if call RegPack(Buf, allocated(InData%AccAvg)) if (allocated(InData%AccAvg)) then - call RegPackBounds(Buf, 3, lbound(InData%AccAvg), ubound(InData%AccAvg)) + call RegPackBounds(Buf, 3, lbound(InData%AccAvg, kind=B8Ki), ubound(InData%AccAvg, kind=B8Ki)) call RegPack(Buf, InData%AccAvg) end if call RegPack(Buf, InData%DTime) @@ -1123,7 +1123,7 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Grid3DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1277,7 +1277,7 @@ subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' ErrStat = ErrID_None @@ -1311,7 +1311,7 @@ subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) call RegPack(Buf, InData%pZero) call RegPack(Buf, associated(InData%Vel)) if (associated(InData%Vel)) then - call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackBounds(Buf, 5, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Vel) @@ -1326,10 +1326,10 @@ subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Grid4DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%n) @@ -1374,14 +1374,14 @@ subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcPointsFieldTypeData%Vel)) then - LB(1:2) = lbound(SrcPointsFieldTypeData%Vel) - UB(1:2) = ubound(SrcPointsFieldTypeData%Vel) + LB(1:2) = lbound(SrcPointsFieldTypeData%Vel, kind=B8Ki) + UB(1:2) = ubound(SrcPointsFieldTypeData%Vel, kind=B8Ki) if (.not. allocated(DstPointsFieldTypeData%Vel)) then allocate(DstPointsFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1412,7 +1412,7 @@ subroutine IfW_FlowField_PackPointsFieldType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Vel)) if (allocated(InData%Vel)) then - call RegPackBounds(Buf, 2, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackBounds(Buf, 2, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) call RegPack(Buf, InData%Vel) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1422,7 +1422,7 @@ subroutine IfW_FlowField_UnPackPointsFieldType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(PointsFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index defa03ae42..310d88ebc9 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -705,7 +705,7 @@ subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' ErrStat = ErrID_None @@ -737,7 +737,7 @@ subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) call RegPack(Buf, InData%pZero) call RegPack(Buf, associated(InData%Vel)) if (associated(InData%Vel)) then - call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackBounds(Buf, 5, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Vel) @@ -750,10 +750,10 @@ subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Grid4D_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%n) diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index b6ffde83d3..b637ad8deb 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -208,7 +208,7 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInputFile' @@ -221,8 +221,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic DstInputFileData%NWindVel = SrcInputFileData%NWindVel if (allocated(SrcInputFileData%WindVxiList)) then - LB(1:1) = lbound(SrcInputFileData%WindVxiList) - UB(1:1) = ubound(SrcInputFileData%WindVxiList) + LB(1:1) = lbound(SrcInputFileData%WindVxiList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WindVxiList, kind=B8Ki) if (.not. allocated(DstInputFileData%WindVxiList)) then allocate(DstInputFileData%WindVxiList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -233,8 +233,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList end if if (allocated(SrcInputFileData%WindVyiList)) then - LB(1:1) = lbound(SrcInputFileData%WindVyiList) - UB(1:1) = ubound(SrcInputFileData%WindVyiList) + LB(1:1) = lbound(SrcInputFileData%WindVyiList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WindVyiList, kind=B8Ki) if (.not. allocated(DstInputFileData%WindVyiList)) then allocate(DstInputFileData%WindVyiList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -245,8 +245,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList end if if (allocated(SrcInputFileData%WindVziList)) then - LB(1:1) = lbound(SrcInputFileData%WindVziList) - UB(1:1) = ubound(SrcInputFileData%WindVziList) + LB(1:1) = lbound(SrcInputFileData%WindVziList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WindVziList, kind=B8Ki) if (.not. allocated(DstInputFileData%WindVziList)) then allocate(DstInputFileData%WindVziList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -280,8 +280,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -296,8 +296,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos if (allocated(SrcInputFileData%FocalDistanceX)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceX) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceX) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceX, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceX, kind=B8Ki) if (.not. allocated(DstInputFileData%FocalDistanceX)) then allocate(DstInputFileData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -308,8 +308,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX end if if (allocated(SrcInputFileData%FocalDistanceY)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceY) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceY, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceY, kind=B8Ki) if (.not. allocated(DstInputFileData%FocalDistanceY)) then allocate(DstInputFileData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -320,8 +320,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY end if if (allocated(SrcInputFileData%FocalDistanceZ)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ, kind=B8Ki) if (.not. allocated(DstInputFileData%FocalDistanceZ)) then allocate(DstInputFileData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -388,17 +388,17 @@ subroutine InflowWind_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NWindVel) call RegPack(Buf, allocated(InData%WindVxiList)) if (allocated(InData%WindVxiList)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVxiList), ubound(InData%WindVxiList)) + call RegPackBounds(Buf, 1, lbound(InData%WindVxiList, kind=B8Ki), ubound(InData%WindVxiList, kind=B8Ki)) call RegPack(Buf, InData%WindVxiList) end if call RegPack(Buf, allocated(InData%WindVyiList)) if (allocated(InData%WindVyiList)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVyiList), ubound(InData%WindVyiList)) + call RegPackBounds(Buf, 1, lbound(InData%WindVyiList, kind=B8Ki), ubound(InData%WindVyiList, kind=B8Ki)) call RegPack(Buf, InData%WindVyiList) end if call RegPack(Buf, allocated(InData%WindVziList)) if (allocated(InData%WindVziList)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVziList), ubound(InData%WindVziList)) + call RegPackBounds(Buf, 1, lbound(InData%WindVziList, kind=B8Ki), ubound(InData%WindVziList, kind=B8Ki)) call RegPack(Buf, InData%WindVziList) end if call RegPack(Buf, InData%Steady_HWindSpeed) @@ -426,7 +426,7 @@ subroutine InflowWind_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%SensorType) @@ -435,17 +435,17 @@ subroutine InflowWind_PackInputFile(Buf, Indata) call RegPack(Buf, InData%RotorApexOffsetPos) call RegPack(Buf, allocated(InData%FocalDistanceX)) if (allocated(InData%FocalDistanceX)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX, kind=B8Ki), ubound(InData%FocalDistanceX, kind=B8Ki)) call RegPack(Buf, InData%FocalDistanceX) end if call RegPack(Buf, allocated(InData%FocalDistanceY)) if (allocated(InData%FocalDistanceY)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY, kind=B8Ki), ubound(InData%FocalDistanceY, kind=B8Ki)) call RegPack(Buf, InData%FocalDistanceY) end if call RegPack(Buf, allocated(InData%FocalDistanceZ)) if (allocated(InData%FocalDistanceZ)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ, kind=B8Ki), ubound(InData%FocalDistanceZ, kind=B8Ki)) call RegPack(Buf, InData%FocalDistanceZ) end if call RegPack(Buf, InData%PulseSpacing) @@ -461,7 +461,7 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -775,15 +775,15 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -794,8 +794,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -812,8 +812,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -824,8 +824,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -836,8 +836,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -848,8 +848,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -860,8 +860,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -919,39 +919,39 @@ subroutine InflowWind_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call InflowWind_IO_PackWindFileDat(Buf, InData%WindFileInfo) call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, associated(InData%FlowField)) @@ -968,10 +968,10 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) @@ -1102,8 +1102,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyParam' @@ -1112,8 +1112,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%RootFileName = SrcParamData%RootFileName DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%WindViXYZprime)) then - LB(1:2) = lbound(SrcParamData%WindViXYZprime) - UB(1:2) = ubound(SrcParamData%WindViXYZprime) + LB(1:2) = lbound(SrcParamData%WindViXYZprime, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%WindViXYZprime, kind=B8Ki) if (.not. allocated(DstParamData%WindViXYZprime)) then allocate(DstParamData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1124,8 +1124,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime end if if (allocated(SrcParamData%WindViXYZ)) then - LB(1:2) = lbound(SrcParamData%WindViXYZ) - UB(1:2) = ubound(SrcParamData%WindViXYZ) + LB(1:2) = lbound(SrcParamData%WindViXYZ, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%WindViXYZ, kind=B8Ki) if (.not. allocated(DstParamData%WindViXYZ)) then allocate(DstParamData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1148,8 +1148,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E if (ErrStat >= AbortErrLev) return end if if (allocated(SrcParamData%PositionAvg)) then - LB(1:2) = lbound(SrcParamData%PositionAvg) - UB(1:2) = ubound(SrcParamData%PositionAvg) + LB(1:2) = lbound(SrcParamData%PositionAvg, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PositionAvg, kind=B8Ki) if (.not. allocated(DstParamData%PositionAvg)) then allocate(DstParamData%PositionAvg(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1162,8 +1162,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%NWindVel = SrcParamData%NWindVel DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1178,8 +1178,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1199,8 +1199,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) type(InflowWind_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' @@ -1222,8 +1222,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%PositionAvg) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1241,20 +1241,20 @@ subroutine InflowWind_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%RootFileName) call RegPack(Buf, InData%DT) call RegPack(Buf, allocated(InData%WindViXYZprime)) if (allocated(InData%WindViXYZprime)) then - call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime), ubound(InData%WindViXYZprime)) + call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime, kind=B8Ki), ubound(InData%WindViXYZprime, kind=B8Ki)) call RegPack(Buf, InData%WindViXYZprime) end if call RegPack(Buf, allocated(InData%WindViXYZ)) if (allocated(InData%WindViXYZ)) then - call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ), ubound(InData%WindViXYZ)) + call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ, kind=B8Ki), ubound(InData%WindViXYZ, kind=B8Ki)) call RegPack(Buf, InData%WindViXYZ) end if call RegPack(Buf, associated(InData%FlowField)) @@ -1266,23 +1266,23 @@ subroutine InflowWind_PackParam(Buf, Indata) end if call RegPack(Buf, allocated(InData%PositionAvg)) if (allocated(InData%PositionAvg)) then - call RegPackBounds(Buf, 2, lbound(InData%PositionAvg), ubound(InData%PositionAvg)) + call RegPackBounds(Buf, 2, lbound(InData%PositionAvg, kind=B8Ki), ubound(InData%PositionAvg, kind=B8Ki)) call RegPack(Buf, InData%PositionAvg) end if call RegPack(Buf, InData%NWindVel) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if call RegPack(Buf, allocated(InData%OutParamLinIndx)) if (allocated(InData%OutParamLinIndx)) then - call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) + call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx, kind=B8Ki), ubound(InData%OutParamLinIndx, kind=B8Ki)) call RegPack(Buf, InData%OutParamLinIndx) end if call Lidar_PackParam(Buf, InData%lidar) @@ -1294,11 +1294,11 @@ subroutine InflowWind_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%RootFileName) @@ -1411,15 +1411,15 @@ subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%PositionXYZ)) then - LB(1:2) = lbound(SrcInputData%PositionXYZ) - UB(1:2) = ubound(SrcInputData%PositionXYZ) + LB(1:2) = lbound(SrcInputData%PositionXYZ, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%PositionXYZ, kind=B8Ki) if (.not. allocated(DstInputData%PositionXYZ)) then allocate(DstInputData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1459,7 +1459,7 @@ subroutine InflowWind_PackInput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%PositionXYZ)) if (allocated(InData%PositionXYZ)) then - call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ), ubound(InData%PositionXYZ)) + call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ, kind=B8Ki), ubound(InData%PositionXYZ, kind=B8Ki)) call RegPack(Buf, InData%PositionXYZ) end if call Lidar_PackInput(Buf, InData%lidar) @@ -1472,7 +1472,7 @@ subroutine InflowWind_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1503,15 +1503,15 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%VelocityUVW)) then - LB(1:2) = lbound(SrcOutputData%VelocityUVW) - UB(1:2) = ubound(SrcOutputData%VelocityUVW) + LB(1:2) = lbound(SrcOutputData%VelocityUVW, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%VelocityUVW, kind=B8Ki) if (.not. allocated(DstOutputData%VelocityUVW)) then allocate(DstOutputData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1522,8 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW end if if (allocated(SrcOutputData%AccelUVW)) then - LB(1:2) = lbound(SrcOutputData%AccelUVW) - UB(1:2) = ubound(SrcOutputData%AccelUVW) + LB(1:2) = lbound(SrcOutputData%AccelUVW, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%AccelUVW, kind=B8Ki) if (.not. allocated(DstOutputData%AccelUVW)) then allocate(DstOutputData%AccelUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1534,8 +1534,8 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat DstOutputData%AccelUVW = SrcOutputData%AccelUVW end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1581,17 +1581,17 @@ subroutine InflowWind_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%VelocityUVW)) if (allocated(InData%VelocityUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW), ubound(InData%VelocityUVW)) + call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW, kind=B8Ki), ubound(InData%VelocityUVW, kind=B8Ki)) call RegPack(Buf, InData%VelocityUVW) end if call RegPack(Buf, allocated(InData%AccelUVW)) if (allocated(InData%AccelUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%AccelUVW), ubound(InData%AccelUVW)) + call RegPackBounds(Buf, 2, lbound(InData%AccelUVW, kind=B8Ki), ubound(InData%AccelUVW, kind=B8Ki)) call RegPack(Buf, InData%AccelUVW) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, InData%DiskVel) @@ -1604,7 +1604,7 @@ subroutine InflowWind_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1819,15 +1819,15 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1838,8 +1838,8 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%WindViUVW)) then - LB(1:2) = lbound(SrcMiscData%WindViUVW) - UB(1:2) = ubound(SrcMiscData%WindViUVW) + LB(1:2) = lbound(SrcMiscData%WindViUVW, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindViUVW, kind=B8Ki) if (.not. allocated(DstMiscData%WindViUVW)) then allocate(DstMiscData%WindViUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1850,8 +1850,8 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%WindViUVW = SrcMiscData%WindViUVW end if if (allocated(SrcMiscData%WindAiUVW)) then - LB(1:2) = lbound(SrcMiscData%WindAiUVW) - UB(1:2) = ubound(SrcMiscData%WindAiUVW) + LB(1:2) = lbound(SrcMiscData%WindAiUVW, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%WindAiUVW, kind=B8Ki) if (.not. allocated(DstMiscData%WindAiUVW)) then allocate(DstMiscData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1910,17 +1910,17 @@ subroutine InflowWind_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, allocated(InData%WindViUVW)) if (allocated(InData%WindViUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%WindViUVW), ubound(InData%WindViUVW)) + call RegPackBounds(Buf, 2, lbound(InData%WindViUVW, kind=B8Ki), ubound(InData%WindViUVW, kind=B8Ki)) call RegPack(Buf, InData%WindViUVW) end if call RegPack(Buf, allocated(InData%WindAiUVW)) if (allocated(InData%WindAiUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW), ubound(InData%WindAiUVW)) + call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW, kind=B8Ki), ubound(InData%WindAiUVW, kind=B8Ki)) call RegPack(Buf, InData%WindAiUVW) end if call InflowWind_PackInput(Buf, InData%u_Avg) @@ -1934,7 +1934,7 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index a8e83bafe1..9c2eb09d1c 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -229,7 +229,7 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Lidar_CopyParam' ErrStat = ErrID_None @@ -250,8 +250,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ DstParamData%NumBeam = SrcParamData%NumBeam if (allocated(SrcParamData%FocalDistanceX)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceX) - UB(1:1) = ubound(SrcParamData%FocalDistanceX) + LB(1:1) = lbound(SrcParamData%FocalDistanceX, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FocalDistanceX, kind=B8Ki) if (.not. allocated(DstParamData%FocalDistanceX)) then allocate(DstParamData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,8 +262,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX end if if (allocated(SrcParamData%FocalDistanceY)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceY) - UB(1:1) = ubound(SrcParamData%FocalDistanceY) + LB(1:1) = lbound(SrcParamData%FocalDistanceY, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FocalDistanceY, kind=B8Ki) if (.not. allocated(DstParamData%FocalDistanceY)) then allocate(DstParamData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -274,8 +274,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY end if if (allocated(SrcParamData%FocalDistanceZ)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceZ) - UB(1:1) = ubound(SrcParamData%FocalDistanceZ) + LB(1:1) = lbound(SrcParamData%FocalDistanceZ, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FocalDistanceZ, kind=B8Ki) if (.not. allocated(DstParamData%FocalDistanceZ)) then allocate(DstParamData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -286,8 +286,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ end if if (allocated(SrcParamData%MsrPosition)) then - LB(1:2) = lbound(SrcParamData%MsrPosition) - UB(1:2) = ubound(SrcParamData%MsrPosition) + LB(1:2) = lbound(SrcParamData%MsrPosition, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MsrPosition, kind=B8Ki) if (.not. allocated(DstParamData%MsrPosition)) then allocate(DstParamData%MsrPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -347,22 +347,22 @@ subroutine Lidar_PackParam(Buf, Indata) call RegPack(Buf, InData%NumBeam) call RegPack(Buf, allocated(InData%FocalDistanceX)) if (allocated(InData%FocalDistanceX)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX, kind=B8Ki), ubound(InData%FocalDistanceX, kind=B8Ki)) call RegPack(Buf, InData%FocalDistanceX) end if call RegPack(Buf, allocated(InData%FocalDistanceY)) if (allocated(InData%FocalDistanceY)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY, kind=B8Ki), ubound(InData%FocalDistanceY, kind=B8Ki)) call RegPack(Buf, InData%FocalDistanceY) end if call RegPack(Buf, allocated(InData%FocalDistanceZ)) if (allocated(InData%FocalDistanceZ)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ, kind=B8Ki), ubound(InData%FocalDistanceZ, kind=B8Ki)) call RegPack(Buf, InData%FocalDistanceZ) end if call RegPack(Buf, allocated(InData%MsrPosition)) if (allocated(InData%MsrPosition)) then - call RegPackBounds(Buf, 2, lbound(InData%MsrPosition), ubound(InData%MsrPosition)) + call RegPackBounds(Buf, 2, lbound(InData%MsrPosition, kind=B8Ki), ubound(InData%MsrPosition, kind=B8Ki)) call RegPack(Buf, InData%MsrPosition) end if call RegPack(Buf, InData%PulseSpacing) @@ -377,7 +377,7 @@ subroutine Lidar_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Lidar_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -735,14 +735,14 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Lidar_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%LidSpeed)) then - LB(1:1) = lbound(SrcOutputData%LidSpeed) - UB(1:1) = ubound(SrcOutputData%LidSpeed) + LB(1:1) = lbound(SrcOutputData%LidSpeed, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%LidSpeed, kind=B8Ki) if (.not. allocated(DstOutputData%LidSpeed)) then allocate(DstOutputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -753,8 +753,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%LidSpeed = SrcOutputData%LidSpeed end if if (allocated(SrcOutputData%WtTrunc)) then - LB(1:1) = lbound(SrcOutputData%WtTrunc) - UB(1:1) = ubound(SrcOutputData%WtTrunc) + LB(1:1) = lbound(SrcOutputData%WtTrunc, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WtTrunc, kind=B8Ki) if (.not. allocated(DstOutputData%WtTrunc)) then allocate(DstOutputData%WtTrunc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -765,8 +765,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%WtTrunc = SrcOutputData%WtTrunc end if if (allocated(SrcOutputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsX) - UB(1:1) = ubound(SrcOutputData%MsrPositionsX) + LB(1:1) = lbound(SrcOutputData%MsrPositionsX, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%MsrPositionsX, kind=B8Ki) if (.not. allocated(DstOutputData%MsrPositionsX)) then allocate(DstOutputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -777,8 +777,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX end if if (allocated(SrcOutputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsY) - UB(1:1) = ubound(SrcOutputData%MsrPositionsY) + LB(1:1) = lbound(SrcOutputData%MsrPositionsY, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%MsrPositionsY, kind=B8Ki) if (.not. allocated(DstOutputData%MsrPositionsY)) then allocate(DstOutputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -789,8 +789,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY end if if (allocated(SrcOutputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) - UB(1:1) = ubound(SrcOutputData%MsrPositionsZ) + LB(1:1) = lbound(SrcOutputData%MsrPositionsZ, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%MsrPositionsZ, kind=B8Ki) if (.not. allocated(DstOutputData%MsrPositionsZ)) then allocate(DstOutputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -833,27 +833,27 @@ subroutine Lidar_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) call RegPack(Buf, InData%LidSpeed) end if call RegPack(Buf, allocated(InData%WtTrunc)) if (allocated(InData%WtTrunc)) then - call RegPackBounds(Buf, 1, lbound(InData%WtTrunc), ubound(InData%WtTrunc)) + call RegPackBounds(Buf, 1, lbound(InData%WtTrunc, kind=B8Ki), ubound(InData%WtTrunc, kind=B8Ki)) call RegPack(Buf, InData%WtTrunc) end if call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsX) end if call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsY) end if call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsZ) end if if (RegCheckErr(Buf, RoutineName)) return @@ -863,7 +863,7 @@ subroutine Lidar_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Lidar_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index ac349c062b..25a5ca9be2 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -99,14 +99,14 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y) + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y, kind=B8Ki) if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -117,8 +117,8 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y end if if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u) + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u, kind=B8Ki) if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -129,8 +129,8 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u end if if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u) + LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -167,17 +167,17 @@ subroutine MAP_Fortran_PackLin_InitOutputType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return @@ -187,7 +187,7 @@ subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Lin_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -241,14 +241,14 @@ subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx) - UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx) + LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -281,7 +281,7 @@ subroutine MAP_Fortran_PackLin_ParamType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, InData%du) @@ -293,7 +293,7 @@ subroutine MAP_Fortran_UnPackLin_ParamType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Lin_ParamType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 3df4cf9291..a75a018aff 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -409,7 +409,7 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInitOutput' @@ -422,8 +422,8 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%compilingData = SrcInitOutputData%compilingData DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData if (allocated(SrcInitOutputData%writeOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%writeOutputHdr)) then allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -434,8 +434,8 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr end if if (allocated(SrcInitOutputData%writeOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%writeOutputUnt)) then allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -488,12 +488,12 @@ subroutine MAP_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%compilingData) call RegPack(Buf, allocated(InData%writeOutputHdr)) if (allocated(InData%writeOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr, kind=B8Ki), ubound(InData%writeOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%writeOutputHdr) end if call RegPack(Buf, allocated(InData%writeOutputUnt)) if (allocated(InData%writeOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt, kind=B8Ki), ubound(InData%writeOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%writeOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) @@ -505,7 +505,7 @@ subroutine MAP_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MAP_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -758,14 +758,14 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOtherStateData%H)) then - LB(1:1) = lbound(SrcOtherStateData%H) - UB(1:1) = ubound(SrcOtherStateData%H) + LB(1:1) = lbound(SrcOtherStateData%H, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%H, kind=B8Ki) if (.not. associated(DstOtherStateData%H)) then allocate(DstOtherStateData%H(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -779,8 +779,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%H = SrcOtherStateData%H end if if (associated(SrcOtherStateData%V)) then - LB(1:1) = lbound(SrcOtherStateData%V) - UB(1:1) = ubound(SrcOtherStateData%V) + LB(1:1) = lbound(SrcOtherStateData%V, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%V, kind=B8Ki) if (.not. associated(DstOtherStateData%V)) then allocate(DstOtherStateData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -794,8 +794,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%V = SrcOtherStateData%V end if if (associated(SrcOtherStateData%Ha)) then - LB(1:1) = lbound(SrcOtherStateData%Ha) - UB(1:1) = ubound(SrcOtherStateData%Ha) + LB(1:1) = lbound(SrcOtherStateData%Ha, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Ha, kind=B8Ki) if (.not. associated(DstOtherStateData%Ha)) then allocate(DstOtherStateData%Ha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -809,8 +809,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Ha = SrcOtherStateData%Ha end if if (associated(SrcOtherStateData%Va)) then - LB(1:1) = lbound(SrcOtherStateData%Va) - UB(1:1) = ubound(SrcOtherStateData%Va) + LB(1:1) = lbound(SrcOtherStateData%Va, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Va, kind=B8Ki) if (.not. associated(DstOtherStateData%Va)) then allocate(DstOtherStateData%Va(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -824,8 +824,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Va = SrcOtherStateData%Va end if if (associated(SrcOtherStateData%x)) then - LB(1:1) = lbound(SrcOtherStateData%x) - UB(1:1) = ubound(SrcOtherStateData%x) + LB(1:1) = lbound(SrcOtherStateData%x, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%x, kind=B8Ki) if (.not. associated(DstOtherStateData%x)) then allocate(DstOtherStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -839,8 +839,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%x = SrcOtherStateData%x end if if (associated(SrcOtherStateData%y)) then - LB(1:1) = lbound(SrcOtherStateData%y) - UB(1:1) = ubound(SrcOtherStateData%y) + LB(1:1) = lbound(SrcOtherStateData%y, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%y, kind=B8Ki) if (.not. associated(DstOtherStateData%y)) then allocate(DstOtherStateData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -854,8 +854,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%y = SrcOtherStateData%y end if if (associated(SrcOtherStateData%z)) then - LB(1:1) = lbound(SrcOtherStateData%z) - UB(1:1) = ubound(SrcOtherStateData%z) + LB(1:1) = lbound(SrcOtherStateData%z, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%z, kind=B8Ki) if (.not. associated(DstOtherStateData%z)) then allocate(DstOtherStateData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -869,8 +869,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%z = SrcOtherStateData%z end if if (associated(SrcOtherStateData%xa)) then - LB(1:1) = lbound(SrcOtherStateData%xa) - UB(1:1) = ubound(SrcOtherStateData%xa) + LB(1:1) = lbound(SrcOtherStateData%xa, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xa, kind=B8Ki) if (.not. associated(DstOtherStateData%xa)) then allocate(DstOtherStateData%xa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -884,8 +884,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%xa = SrcOtherStateData%xa end if if (associated(SrcOtherStateData%ya)) then - LB(1:1) = lbound(SrcOtherStateData%ya) - UB(1:1) = ubound(SrcOtherStateData%ya) + LB(1:1) = lbound(SrcOtherStateData%ya, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%ya, kind=B8Ki) if (.not. associated(DstOtherStateData%ya)) then allocate(DstOtherStateData%ya(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -899,8 +899,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%ya = SrcOtherStateData%ya end if if (associated(SrcOtherStateData%za)) then - LB(1:1) = lbound(SrcOtherStateData%za) - UB(1:1) = ubound(SrcOtherStateData%za) + LB(1:1) = lbound(SrcOtherStateData%za, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%za, kind=B8Ki) if (.not. associated(DstOtherStateData%za)) then allocate(DstOtherStateData%za(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -914,8 +914,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%za = SrcOtherStateData%za end if if (associated(SrcOtherStateData%Fx_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fx_connect) - UB(1:1) = ubound(SrcOtherStateData%Fx_connect) + LB(1:1) = lbound(SrcOtherStateData%Fx_connect, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Fx_connect, kind=B8Ki) if (.not. associated(DstOtherStateData%Fx_connect)) then allocate(DstOtherStateData%Fx_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -929,8 +929,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect end if if (associated(SrcOtherStateData%Fy_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fy_connect) - UB(1:1) = ubound(SrcOtherStateData%Fy_connect) + LB(1:1) = lbound(SrcOtherStateData%Fy_connect, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Fy_connect, kind=B8Ki) if (.not. associated(DstOtherStateData%Fy_connect)) then allocate(DstOtherStateData%Fy_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -944,8 +944,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect end if if (associated(SrcOtherStateData%Fz_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fz_connect) - UB(1:1) = ubound(SrcOtherStateData%Fz_connect) + LB(1:1) = lbound(SrcOtherStateData%Fz_connect, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Fz_connect, kind=B8Ki) if (.not. associated(DstOtherStateData%Fz_connect)) then allocate(DstOtherStateData%Fz_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -959,8 +959,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect end if if (associated(SrcOtherStateData%Fx_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) - UB(1:1) = ubound(SrcOtherStateData%Fx_anchor) + LB(1:1) = lbound(SrcOtherStateData%Fx_anchor, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Fx_anchor, kind=B8Ki) if (.not. associated(DstOtherStateData%Fx_anchor)) then allocate(DstOtherStateData%Fx_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -974,8 +974,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor end if if (associated(SrcOtherStateData%Fy_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) - UB(1:1) = ubound(SrcOtherStateData%Fy_anchor) + LB(1:1) = lbound(SrcOtherStateData%Fy_anchor, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Fy_anchor, kind=B8Ki) if (.not. associated(DstOtherStateData%Fy_anchor)) then allocate(DstOtherStateData%Fy_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -989,8 +989,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor end if if (associated(SrcOtherStateData%Fz_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) - UB(1:1) = ubound(SrcOtherStateData%Fz_anchor) + LB(1:1) = lbound(SrcOtherStateData%Fz_anchor, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%Fz_anchor, kind=B8Ki) if (.not. associated(DstOtherStateData%Fz_anchor)) then allocate(DstOtherStateData%Fz_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1122,7 +1122,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%H)) if (associated(InData%H)) then - call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) + call RegPackBounds(Buf, 1, lbound(InData%H, kind=B8Ki), ubound(InData%H, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%H) @@ -1130,7 +1130,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%V)) if (associated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%V) @@ -1138,7 +1138,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Ha)) if (associated(InData%Ha)) then - call RegPackBounds(Buf, 1, lbound(InData%Ha), ubound(InData%Ha)) + call RegPackBounds(Buf, 1, lbound(InData%Ha, kind=B8Ki), ubound(InData%Ha, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Ha), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Ha) @@ -1146,7 +1146,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Va)) if (associated(InData%Va)) then - call RegPackBounds(Buf, 1, lbound(InData%Va), ubound(InData%Va)) + call RegPackBounds(Buf, 1, lbound(InData%Va, kind=B8Ki), ubound(InData%Va, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Va), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Va) @@ -1154,7 +1154,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%x) @@ -1162,7 +1162,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%y) @@ -1170,7 +1170,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%z) @@ -1178,7 +1178,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%xa)) if (associated(InData%xa)) then - call RegPackBounds(Buf, 1, lbound(InData%xa), ubound(InData%xa)) + call RegPackBounds(Buf, 1, lbound(InData%xa, kind=B8Ki), ubound(InData%xa, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%xa), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%xa) @@ -1186,7 +1186,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%ya)) if (associated(InData%ya)) then - call RegPackBounds(Buf, 1, lbound(InData%ya), ubound(InData%ya)) + call RegPackBounds(Buf, 1, lbound(InData%ya, kind=B8Ki), ubound(InData%ya, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%ya), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%ya) @@ -1194,7 +1194,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%za)) if (associated(InData%za)) then - call RegPackBounds(Buf, 1, lbound(InData%za), ubound(InData%za)) + call RegPackBounds(Buf, 1, lbound(InData%za, kind=B8Ki), ubound(InData%za, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%za), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%za) @@ -1202,7 +1202,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Fx_connect)) if (associated(InData%Fx_connect)) then - call RegPackBounds(Buf, 1, lbound(InData%Fx_connect), ubound(InData%Fx_connect)) + call RegPackBounds(Buf, 1, lbound(InData%Fx_connect, kind=B8Ki), ubound(InData%Fx_connect, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fx_connect), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fx_connect) @@ -1210,7 +1210,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Fy_connect)) if (associated(InData%Fy_connect)) then - call RegPackBounds(Buf, 1, lbound(InData%Fy_connect), ubound(InData%Fy_connect)) + call RegPackBounds(Buf, 1, lbound(InData%Fy_connect, kind=B8Ki), ubound(InData%Fy_connect, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fy_connect), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fy_connect) @@ -1218,7 +1218,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Fz_connect)) if (associated(InData%Fz_connect)) then - call RegPackBounds(Buf, 1, lbound(InData%Fz_connect), ubound(InData%Fz_connect)) + call RegPackBounds(Buf, 1, lbound(InData%Fz_connect, kind=B8Ki), ubound(InData%Fz_connect, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fz_connect), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fz_connect) @@ -1226,7 +1226,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Fx_anchor)) if (associated(InData%Fx_anchor)) then - call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor), ubound(InData%Fx_anchor)) + call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor, kind=B8Ki), ubound(InData%Fx_anchor, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fx_anchor), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fx_anchor) @@ -1234,7 +1234,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Fy_anchor)) if (associated(InData%Fy_anchor)) then - call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor), ubound(InData%Fy_anchor)) + call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor, kind=B8Ki), ubound(InData%Fy_anchor, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fy_anchor), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fy_anchor) @@ -1242,7 +1242,7 @@ subroutine MAP_PackOtherState(Buf, Indata) end if call RegPack(Buf, associated(InData%Fz_anchor)) if (associated(InData%Fz_anchor)) then - call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor), ubound(InData%Fz_anchor)) + call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor, kind=B8Ki), ubound(InData%Fz_anchor, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fz_anchor), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fz_anchor) @@ -1255,10 +1255,10 @@ subroutine MAP_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MAP_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%H)) deallocate(OutData%H) @@ -1864,7 +1864,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) IF (OtherStateData%C_obj%H_Len > 0) & - OtherStateData%C_obj%H = C_LOC(OtherStateData%H(LBOUND(OtherStateData%H,1))) + OtherStateData%C_obj%H = C_LOC(OtherStateData%H(LBOUND(OtherStateData%H,1, kind=B8Ki))) END IF END IF @@ -1876,7 +1876,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) IF (OtherStateData%C_obj%V_Len > 0) & - OtherStateData%C_obj%V = C_LOC(OtherStateData%V(LBOUND(OtherStateData%V,1))) + OtherStateData%C_obj%V = C_LOC(OtherStateData%V(LBOUND(OtherStateData%V,1, kind=B8Ki))) END IF END IF @@ -1888,7 +1888,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) IF (OtherStateData%C_obj%Ha_Len > 0) & - OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(LBOUND(OtherStateData%Ha,1))) + OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(LBOUND(OtherStateData%Ha,1, kind=B8Ki))) END IF END IF @@ -1900,7 +1900,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) IF (OtherStateData%C_obj%Va_Len > 0) & - OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(LBOUND(OtherStateData%Va,1))) + OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(LBOUND(OtherStateData%Va,1, kind=B8Ki))) END IF END IF @@ -1912,7 +1912,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) IF (OtherStateData%C_obj%x_Len > 0) & - OtherStateData%C_obj%x = C_LOC(OtherStateData%x(LBOUND(OtherStateData%x,1))) + OtherStateData%C_obj%x = C_LOC(OtherStateData%x(LBOUND(OtherStateData%x,1, kind=B8Ki))) END IF END IF @@ -1924,7 +1924,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) IF (OtherStateData%C_obj%y_Len > 0) & - OtherStateData%C_obj%y = C_LOC(OtherStateData%y(LBOUND(OtherStateData%y,1))) + OtherStateData%C_obj%y = C_LOC(OtherStateData%y(LBOUND(OtherStateData%y,1, kind=B8Ki))) END IF END IF @@ -1936,7 +1936,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) IF (OtherStateData%C_obj%z_Len > 0) & - OtherStateData%C_obj%z = C_LOC(OtherStateData%z(LBOUND(OtherStateData%z,1))) + OtherStateData%C_obj%z = C_LOC(OtherStateData%z(LBOUND(OtherStateData%z,1, kind=B8Ki))) END IF END IF @@ -1948,7 +1948,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) IF (OtherStateData%C_obj%xa_Len > 0) & - OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(LBOUND(OtherStateData%xa,1))) + OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(LBOUND(OtherStateData%xa,1, kind=B8Ki))) END IF END IF @@ -1960,7 +1960,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) IF (OtherStateData%C_obj%ya_Len > 0) & - OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(LBOUND(OtherStateData%ya,1))) + OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(LBOUND(OtherStateData%ya,1, kind=B8Ki))) END IF END IF @@ -1972,7 +1972,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) IF (OtherStateData%C_obj%za_Len > 0) & - OtherStateData%C_obj%za = C_LOC(OtherStateData%za(LBOUND(OtherStateData%za,1))) + OtherStateData%C_obj%za = C_LOC(OtherStateData%za(LBOUND(OtherStateData%za,1, kind=B8Ki))) END IF END IF @@ -1984,7 +1984,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) IF (OtherStateData%C_obj%Fx_connect_Len > 0) & - OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(LBOUND(OtherStateData%Fx_connect,1))) + OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(LBOUND(OtherStateData%Fx_connect,1, kind=B8Ki))) END IF END IF @@ -1996,7 +1996,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) IF (OtherStateData%C_obj%Fy_connect_Len > 0) & - OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(LBOUND(OtherStateData%Fy_connect,1))) + OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(LBOUND(OtherStateData%Fy_connect,1, kind=B8Ki))) END IF END IF @@ -2008,7 +2008,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) IF (OtherStateData%C_obj%Fz_connect_Len > 0) & - OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(LBOUND(OtherStateData%Fz_connect,1))) + OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(LBOUND(OtherStateData%Fz_connect,1, kind=B8Ki))) END IF END IF @@ -2020,7 +2020,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & - OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(LBOUND(OtherStateData%Fx_anchor,1))) + OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(LBOUND(OtherStateData%Fx_anchor,1, kind=B8Ki))) END IF END IF @@ -2032,7 +2032,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & - OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(LBOUND(OtherStateData%Fy_anchor,1))) + OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(LBOUND(OtherStateData%Fy_anchor,1, kind=B8Ki))) END IF END IF @@ -2044,7 +2044,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & - OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(LBOUND(OtherStateData%Fz_anchor,1))) + OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(LBOUND(OtherStateData%Fz_anchor,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -2055,14 +2055,14 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcConstrStateData%H)) then - LB(1:1) = lbound(SrcConstrStateData%H) - UB(1:1) = ubound(SrcConstrStateData%H) + LB(1:1) = lbound(SrcConstrStateData%H, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%H, kind=B8Ki) if (.not. associated(DstConstrStateData%H)) then allocate(DstConstrStateData%H(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2076,8 +2076,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%H = SrcConstrStateData%H end if if (associated(SrcConstrStateData%V)) then - LB(1:1) = lbound(SrcConstrStateData%V) - UB(1:1) = ubound(SrcConstrStateData%V) + LB(1:1) = lbound(SrcConstrStateData%V, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%V, kind=B8Ki) if (.not. associated(DstConstrStateData%V)) then allocate(DstConstrStateData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2091,8 +2091,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%V = SrcConstrStateData%V end if if (associated(SrcConstrStateData%x)) then - LB(1:1) = lbound(SrcConstrStateData%x) - UB(1:1) = ubound(SrcConstrStateData%x) + LB(1:1) = lbound(SrcConstrStateData%x, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%x, kind=B8Ki) if (.not. associated(DstConstrStateData%x)) then allocate(DstConstrStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2106,8 +2106,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%x = SrcConstrStateData%x end if if (associated(SrcConstrStateData%y)) then - LB(1:1) = lbound(SrcConstrStateData%y) - UB(1:1) = ubound(SrcConstrStateData%y) + LB(1:1) = lbound(SrcConstrStateData%y, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%y, kind=B8Ki) if (.not. associated(DstConstrStateData%y)) then allocate(DstConstrStateData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2121,8 +2121,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%y = SrcConstrStateData%y end if if (associated(SrcConstrStateData%z)) then - LB(1:1) = lbound(SrcConstrStateData%z) - UB(1:1) = ubound(SrcConstrStateData%z) + LB(1:1) = lbound(SrcConstrStateData%z, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%z, kind=B8Ki) if (.not. associated(DstConstrStateData%z)) then allocate(DstConstrStateData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2188,7 +2188,7 @@ subroutine MAP_PackConstrState(Buf, Indata) end if call RegPack(Buf, associated(InData%H)) if (associated(InData%H)) then - call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) + call RegPackBounds(Buf, 1, lbound(InData%H, kind=B8Ki), ubound(InData%H, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%H) @@ -2196,7 +2196,7 @@ subroutine MAP_PackConstrState(Buf, Indata) end if call RegPack(Buf, associated(InData%V)) if (associated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%V) @@ -2204,7 +2204,7 @@ subroutine MAP_PackConstrState(Buf, Indata) end if call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%x) @@ -2212,7 +2212,7 @@ subroutine MAP_PackConstrState(Buf, Indata) end if call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%y) @@ -2220,7 +2220,7 @@ subroutine MAP_PackConstrState(Buf, Indata) end if call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%z) @@ -2233,10 +2233,10 @@ subroutine MAP_UnPackConstrState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MAP_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%H)) deallocate(OutData%H) @@ -2457,7 +2457,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) IF (ConstrStateData%C_obj%H_Len > 0) & - ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(LBOUND(ConstrStateData%H,1))) + ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(LBOUND(ConstrStateData%H,1, kind=B8Ki))) END IF END IF @@ -2469,7 +2469,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) IF (ConstrStateData%C_obj%V_Len > 0) & - ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(LBOUND(ConstrStateData%V,1))) + ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(LBOUND(ConstrStateData%V,1, kind=B8Ki))) END IF END IF @@ -2481,7 +2481,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) IF (ConstrStateData%C_obj%x_Len > 0) & - ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(LBOUND(ConstrStateData%x,1))) + ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(LBOUND(ConstrStateData%x,1, kind=B8Ki))) END IF END IF @@ -2493,7 +2493,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) IF (ConstrStateData%C_obj%y_Len > 0) & - ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(LBOUND(ConstrStateData%y,1))) + ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(LBOUND(ConstrStateData%y,1, kind=B8Ki))) END IF END IF @@ -2505,7 +2505,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) IF (ConstrStateData%C_obj%z_Len > 0) & - ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(LBOUND(ConstrStateData%z,1))) + ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(LBOUND(ConstrStateData%z,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -2648,15 +2648,15 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%x)) then - LB(1:1) = lbound(SrcInputData%x) - UB(1:1) = ubound(SrcInputData%x) + LB(1:1) = lbound(SrcInputData%x, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%x, kind=B8Ki) if (.not. associated(DstInputData%x)) then allocate(DstInputData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2670,8 +2670,8 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%x = SrcInputData%x end if if (associated(SrcInputData%y)) then - LB(1:1) = lbound(SrcInputData%y) - UB(1:1) = ubound(SrcInputData%y) + LB(1:1) = lbound(SrcInputData%y, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%y, kind=B8Ki) if (.not. associated(DstInputData%y)) then allocate(DstInputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2685,8 +2685,8 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%y = SrcInputData%y end if if (associated(SrcInputData%z)) then - LB(1:1) = lbound(SrcInputData%z) - UB(1:1) = ubound(SrcInputData%z) + LB(1:1) = lbound(SrcInputData%z, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%z, kind=B8Ki) if (.not. associated(DstInputData%z)) then allocate(DstInputData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2747,7 +2747,7 @@ subroutine MAP_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%x) @@ -2755,7 +2755,7 @@ subroutine MAP_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%y) @@ -2763,7 +2763,7 @@ subroutine MAP_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%z) @@ -2777,10 +2777,10 @@ subroutine MAP_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MAP_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%x)) deallocate(OutData%x) @@ -2932,7 +2932,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%x_Len = SIZE(InputData%x) IF (InputData%C_obj%x_Len > 0) & - InputData%C_obj%x = C_LOC(InputData%x(LBOUND(InputData%x,1))) + InputData%C_obj%x = C_LOC(InputData%x(LBOUND(InputData%x,1, kind=B8Ki))) END IF END IF @@ -2944,7 +2944,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%y_Len = SIZE(InputData%y) IF (InputData%C_obj%y_Len > 0) & - InputData%C_obj%y = C_LOC(InputData%y(LBOUND(InputData%y,1))) + InputData%C_obj%y = C_LOC(InputData%y(LBOUND(InputData%y,1, kind=B8Ki))) END IF END IF @@ -2956,7 +2956,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%z_Len = SIZE(InputData%z) IF (InputData%C_obj%z_Len > 0) & - InputData%C_obj%z = C_LOC(InputData%z(LBOUND(InputData%z,1))) + InputData%C_obj%z = C_LOC(InputData%z(LBOUND(InputData%z,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -2967,15 +2967,15 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%Fx)) then - LB(1:1) = lbound(SrcOutputData%Fx) - UB(1:1) = ubound(SrcOutputData%Fx) + LB(1:1) = lbound(SrcOutputData%Fx, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Fx, kind=B8Ki) if (.not. associated(DstOutputData%Fx)) then allocate(DstOutputData%Fx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2989,8 +2989,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fx = SrcOutputData%Fx end if if (associated(SrcOutputData%Fy)) then - LB(1:1) = lbound(SrcOutputData%Fy) - UB(1:1) = ubound(SrcOutputData%Fy) + LB(1:1) = lbound(SrcOutputData%Fy, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Fy, kind=B8Ki) if (.not. associated(DstOutputData%Fy)) then allocate(DstOutputData%Fy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3004,8 +3004,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fy = SrcOutputData%Fy end if if (associated(SrcOutputData%Fz)) then - LB(1:1) = lbound(SrcOutputData%Fz) - UB(1:1) = ubound(SrcOutputData%Fz) + LB(1:1) = lbound(SrcOutputData%Fz, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Fz, kind=B8Ki) if (.not. associated(DstOutputData%Fz)) then allocate(DstOutputData%Fz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3019,8 +3019,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fz = SrcOutputData%Fz end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3031,8 +3031,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (associated(SrcOutputData%wrtOutput)) then - LB(1:1) = lbound(SrcOutputData%wrtOutput) - UB(1:1) = ubound(SrcOutputData%wrtOutput) + LB(1:1) = lbound(SrcOutputData%wrtOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%wrtOutput, kind=B8Ki) if (.not. associated(DstOutputData%wrtOutput)) then allocate(DstOutputData%wrtOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3102,7 +3102,7 @@ subroutine MAP_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%Fx)) if (associated(InData%Fx)) then - call RegPackBounds(Buf, 1, lbound(InData%Fx), ubound(InData%Fx)) + call RegPackBounds(Buf, 1, lbound(InData%Fx, kind=B8Ki), ubound(InData%Fx, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fx), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fx) @@ -3110,7 +3110,7 @@ subroutine MAP_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%Fy)) if (associated(InData%Fy)) then - call RegPackBounds(Buf, 1, lbound(InData%Fy), ubound(InData%Fy)) + call RegPackBounds(Buf, 1, lbound(InData%Fy, kind=B8Ki), ubound(InData%Fy, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fy), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fy) @@ -3118,7 +3118,7 @@ subroutine MAP_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%Fz)) if (associated(InData%Fz)) then - call RegPackBounds(Buf, 1, lbound(InData%Fz), ubound(InData%Fz)) + call RegPackBounds(Buf, 1, lbound(InData%Fz, kind=B8Ki), ubound(InData%Fz, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Fz), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Fz) @@ -3126,12 +3126,12 @@ subroutine MAP_PackOutput(Buf, Indata) end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, associated(InData%wrtOutput)) if (associated(InData%wrtOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%wrtOutput), ubound(InData%wrtOutput)) + call RegPackBounds(Buf, 1, lbound(InData%wrtOutput, kind=B8Ki), ubound(InData%wrtOutput, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%wrtOutput), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%wrtOutput) @@ -3145,10 +3145,10 @@ subroutine MAP_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MAP_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%Fx)) deallocate(OutData%Fx) @@ -3349,7 +3349,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) IF (OutputData%C_obj%Fx_Len > 0) & - OutputData%C_obj%Fx = C_LOC(OutputData%Fx(LBOUND(OutputData%Fx,1))) + OutputData%C_obj%Fx = C_LOC(OutputData%Fx(LBOUND(OutputData%Fx,1, kind=B8Ki))) END IF END IF @@ -3361,7 +3361,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) IF (OutputData%C_obj%Fy_Len > 0) & - OutputData%C_obj%Fy = C_LOC(OutputData%Fy(LBOUND(OutputData%Fy,1))) + OutputData%C_obj%Fy = C_LOC(OutputData%Fy(LBOUND(OutputData%Fy,1, kind=B8Ki))) END IF END IF @@ -3373,7 +3373,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) IF (OutputData%C_obj%Fz_Len > 0) & - OutputData%C_obj%Fz = C_LOC(OutputData%Fz(LBOUND(OutputData%Fz,1))) + OutputData%C_obj%Fz = C_LOC(OutputData%Fz(LBOUND(OutputData%Fz,1, kind=B8Ki))) END IF END IF @@ -3385,7 +3385,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) IF (OutputData%C_obj%wrtOutput_Len > 0) & - OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(LBOUND(OutputData%wrtOutput,1))) + OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(LBOUND(OutputData%wrtOutput,1, kind=B8Ki))) END IF END IF END SUBROUTINE diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index dc15971c83..4d09dee8d2 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -532,7 +532,7 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInitInput' @@ -542,8 +542,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%rhoW = SrcInitInputData%rhoW DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth if (allocated(SrcInitInputData%PtfmInit)) then - LB(1:2) = lbound(SrcInitInputData%PtfmInit) - UB(1:2) = ubound(SrcInitInputData%PtfmInit) + LB(1:2) = lbound(SrcInitInputData%PtfmInit, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%PtfmInit, kind=B8Ki) if (.not. allocated(DstInitInputData%PtfmInit)) then allocate(DstInitInputData%PtfmInit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -555,8 +555,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%FarmSize = SrcInitInputData%FarmSize if (allocated(SrcInitInputData%TurbineRefPos)) then - LB(1:2) = lbound(SrcInitInputData%TurbineRefPos) - UB(1:2) = ubound(SrcInitInputData%TurbineRefPos) + LB(1:2) = lbound(SrcInitInputData%TurbineRefPos, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%TurbineRefPos, kind=B8Ki) if (.not. allocated(DstInitInputData%TurbineRefPos)) then allocate(DstInitInputData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -575,8 +575,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta if (ErrStat >= AbortErrLev) return DstInitInputData%Echo = SrcInitInputData%Echo if (allocated(SrcInitInputData%OutList)) then - LB(1:1) = lbound(SrcInitInputData%OutList) - UB(1:1) = ubound(SrcInitInputData%OutList) + LB(1:1) = lbound(SrcInitInputData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%OutList, kind=B8Ki) if (.not. allocated(DstInitInputData%OutList)) then allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -622,13 +622,13 @@ subroutine MD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WtrDepth) call RegPack(Buf, allocated(InData%PtfmInit)) if (allocated(InData%PtfmInit)) then - call RegPackBounds(Buf, 2, lbound(InData%PtfmInit), ubound(InData%PtfmInit)) + call RegPackBounds(Buf, 2, lbound(InData%PtfmInit, kind=B8Ki), ubound(InData%PtfmInit, kind=B8Ki)) call RegPack(Buf, InData%PtfmInit) end if call RegPack(Buf, InData%FarmSize) call RegPack(Buf, allocated(InData%TurbineRefPos)) if (allocated(InData%TurbineRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) + call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos, kind=B8Ki), ubound(InData%TurbineRefPos, kind=B8Ki)) call RegPack(Buf, InData%TurbineRefPos) end if call RegPack(Buf, InData%Tmax) @@ -639,7 +639,7 @@ subroutine MD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%Echo) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%Linearize) @@ -651,7 +651,7 @@ subroutine MD_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1069,7 +1069,7 @@ subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyPoint' ErrStat = ErrID_None @@ -1095,8 +1095,8 @@ subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) DstPointData%Ud = SrcPointData%Ud DstPointData%zeta = SrcPointData%zeta if (allocated(SrcPointData%PDyn)) then - LB(1:1) = lbound(SrcPointData%PDyn) - UB(1:1) = ubound(SrcPointData%PDyn) + LB(1:1) = lbound(SrcPointData%PDyn, kind=B8Ki) + UB(1:1) = ubound(SrcPointData%PDyn, kind=B8Ki) if (.not. allocated(DstPointData%PDyn)) then allocate(DstPointData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1149,7 +1149,7 @@ subroutine MD_PackPoint(Buf, Indata) call RegPack(Buf, InData%zeta) call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPackBounds(Buf, 1, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) call RegPack(Buf, InData%PDyn) end if call RegPack(Buf, InData%Fnet) @@ -1161,7 +1161,7 @@ subroutine MD_UnPackPoint(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_Point), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackPoint' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1231,7 +1231,7 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyRod' ErrStat = ErrID_None @@ -1265,8 +1265,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%pitch = SrcRodData%pitch DstRodData%h0 = SrcRodData%h0 if (allocated(SrcRodData%r)) then - LB(1:2) = lbound(SrcRodData%r) - UB(1:2) = ubound(SrcRodData%r) + LB(1:2) = lbound(SrcRodData%r, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%r, kind=B8Ki) if (.not. allocated(DstRodData%r)) then allocate(DstRodData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1277,8 +1277,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%r = SrcRodData%r end if if (allocated(SrcRodData%rd)) then - LB(1:2) = lbound(SrcRodData%rd) - UB(1:2) = ubound(SrcRodData%rd) + LB(1:2) = lbound(SrcRodData%rd, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%rd, kind=B8Ki) if (.not. allocated(DstRodData%rd)) then allocate(DstRodData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1290,8 +1290,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if DstRodData%q = SrcRodData%q if (allocated(SrcRodData%l)) then - LB(1:1) = lbound(SrcRodData%l) - UB(1:1) = ubound(SrcRodData%l) + LB(1:1) = lbound(SrcRodData%l, kind=B8Ki) + UB(1:1) = ubound(SrcRodData%l, kind=B8Ki) if (.not. allocated(DstRodData%l)) then allocate(DstRodData%l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1302,8 +1302,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%l = SrcRodData%l end if if (allocated(SrcRodData%V)) then - LB(1:1) = lbound(SrcRodData%V) - UB(1:1) = ubound(SrcRodData%V) + LB(1:1) = lbound(SrcRodData%V, kind=B8Ki) + UB(1:1) = ubound(SrcRodData%V, kind=B8Ki) if (.not. allocated(DstRodData%V)) then allocate(DstRodData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1314,8 +1314,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%V = SrcRodData%V end if if (allocated(SrcRodData%U)) then - LB(1:2) = lbound(SrcRodData%U) - UB(1:2) = ubound(SrcRodData%U) + LB(1:2) = lbound(SrcRodData%U, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%U, kind=B8Ki) if (.not. allocated(DstRodData%U)) then allocate(DstRodData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1326,8 +1326,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%U = SrcRodData%U end if if (allocated(SrcRodData%Ud)) then - LB(1:2) = lbound(SrcRodData%Ud) - UB(1:2) = ubound(SrcRodData%Ud) + LB(1:2) = lbound(SrcRodData%Ud, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Ud, kind=B8Ki) if (.not. allocated(DstRodData%Ud)) then allocate(DstRodData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1338,8 +1338,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Ud = SrcRodData%Ud end if if (allocated(SrcRodData%zeta)) then - LB(1:1) = lbound(SrcRodData%zeta) - UB(1:1) = ubound(SrcRodData%zeta) + LB(1:1) = lbound(SrcRodData%zeta, kind=B8Ki) + UB(1:1) = ubound(SrcRodData%zeta, kind=B8Ki) if (.not. allocated(DstRodData%zeta)) then allocate(DstRodData%zeta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1350,8 +1350,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%zeta = SrcRodData%zeta end if if (allocated(SrcRodData%PDyn)) then - LB(1:1) = lbound(SrcRodData%PDyn) - UB(1:1) = ubound(SrcRodData%PDyn) + LB(1:1) = lbound(SrcRodData%PDyn, kind=B8Ki) + UB(1:1) = ubound(SrcRodData%PDyn, kind=B8Ki) if (.not. allocated(DstRodData%PDyn)) then allocate(DstRodData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1362,8 +1362,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%PDyn = SrcRodData%PDyn end if if (allocated(SrcRodData%W)) then - LB(1:2) = lbound(SrcRodData%W) - UB(1:2) = ubound(SrcRodData%W) + LB(1:2) = lbound(SrcRodData%W, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%W, kind=B8Ki) if (.not. allocated(DstRodData%W)) then allocate(DstRodData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1374,8 +1374,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%W = SrcRodData%W end if if (allocated(SrcRodData%Bo)) then - LB(1:2) = lbound(SrcRodData%Bo) - UB(1:2) = ubound(SrcRodData%Bo) + LB(1:2) = lbound(SrcRodData%Bo, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Bo, kind=B8Ki) if (.not. allocated(DstRodData%Bo)) then allocate(DstRodData%Bo(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1386,8 +1386,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Bo = SrcRodData%Bo end if if (allocated(SrcRodData%Pd)) then - LB(1:2) = lbound(SrcRodData%Pd) - UB(1:2) = ubound(SrcRodData%Pd) + LB(1:2) = lbound(SrcRodData%Pd, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Pd, kind=B8Ki) if (.not. allocated(DstRodData%Pd)) then allocate(DstRodData%Pd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1398,8 +1398,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Pd = SrcRodData%Pd end if if (allocated(SrcRodData%Dp)) then - LB(1:2) = lbound(SrcRodData%Dp) - UB(1:2) = ubound(SrcRodData%Dp) + LB(1:2) = lbound(SrcRodData%Dp, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Dp, kind=B8Ki) if (.not. allocated(DstRodData%Dp)) then allocate(DstRodData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1410,8 +1410,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Dp = SrcRodData%Dp end if if (allocated(SrcRodData%Dq)) then - LB(1:2) = lbound(SrcRodData%Dq) - UB(1:2) = ubound(SrcRodData%Dq) + LB(1:2) = lbound(SrcRodData%Dq, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Dq, kind=B8Ki) if (.not. allocated(DstRodData%Dq)) then allocate(DstRodData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1422,8 +1422,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Dq = SrcRodData%Dq end if if (allocated(SrcRodData%Ap)) then - LB(1:2) = lbound(SrcRodData%Ap) - UB(1:2) = ubound(SrcRodData%Ap) + LB(1:2) = lbound(SrcRodData%Ap, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Ap, kind=B8Ki) if (.not. allocated(DstRodData%Ap)) then allocate(DstRodData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1434,8 +1434,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Ap = SrcRodData%Ap end if if (allocated(SrcRodData%Aq)) then - LB(1:2) = lbound(SrcRodData%Aq) - UB(1:2) = ubound(SrcRodData%Aq) + LB(1:2) = lbound(SrcRodData%Aq, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Aq, kind=B8Ki) if (.not. allocated(DstRodData%Aq)) then allocate(DstRodData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1446,8 +1446,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Aq = SrcRodData%Aq end if if (allocated(SrcRodData%B)) then - LB(1:2) = lbound(SrcRodData%B) - UB(1:2) = ubound(SrcRodData%B) + LB(1:2) = lbound(SrcRodData%B, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%B, kind=B8Ki) if (.not. allocated(DstRodData%B)) then allocate(DstRodData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1458,8 +1458,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%B = SrcRodData%B end if if (allocated(SrcRodData%Fnet)) then - LB(1:2) = lbound(SrcRodData%Fnet) - UB(1:2) = ubound(SrcRodData%Fnet) + LB(1:2) = lbound(SrcRodData%Fnet, kind=B8Ki) + UB(1:2) = ubound(SrcRodData%Fnet, kind=B8Ki) if (.not. allocated(DstRodData%Fnet)) then allocate(DstRodData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1470,8 +1470,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Fnet = SrcRodData%Fnet end if if (allocated(SrcRodData%M)) then - LB(1:3) = lbound(SrcRodData%M) - UB(1:3) = ubound(SrcRodData%M) + LB(1:3) = lbound(SrcRodData%M, kind=B8Ki) + UB(1:3) = ubound(SrcRodData%M, kind=B8Ki) if (.not. allocated(DstRodData%M)) then allocate(DstRodData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1492,8 +1492,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%OrMat = SrcRodData%OrMat DstRodData%RodUnOut = SrcRodData%RodUnOut if (allocated(SrcRodData%RodWrOutput)) then - LB(1:1) = lbound(SrcRodData%RodWrOutput) - UB(1:1) = ubound(SrcRodData%RodWrOutput) + LB(1:1) = lbound(SrcRodData%RodWrOutput, kind=B8Ki) + UB(1:1) = ubound(SrcRodData%RodWrOutput, kind=B8Ki) if (.not. allocated(DstRodData%RodWrOutput)) then allocate(DstRodData%RodWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1606,93 +1606,93 @@ subroutine MD_PackRod(Buf, Indata) call RegPack(Buf, InData%h0) call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then - call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) + call RegPackBounds(Buf, 2, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) call RegPack(Buf, InData%r) end if call RegPack(Buf, allocated(InData%rd)) if (allocated(InData%rd)) then - call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) + call RegPackBounds(Buf, 2, lbound(InData%rd, kind=B8Ki), ubound(InData%rd, kind=B8Ki)) call RegPack(Buf, InData%rd) end if call RegPack(Buf, InData%q) call RegPack(Buf, allocated(InData%l)) if (allocated(InData%l)) then - call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) + call RegPackBounds(Buf, 1, lbound(InData%l, kind=B8Ki), ubound(InData%l, kind=B8Ki)) call RegPack(Buf, InData%l) end if call RegPack(Buf, allocated(InData%V)) if (allocated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) call RegPack(Buf, InData%V) end if call RegPack(Buf, allocated(InData%U)) if (allocated(InData%U)) then - call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) + call RegPackBounds(Buf, 2, lbound(InData%U, kind=B8Ki), ubound(InData%U, kind=B8Ki)) call RegPack(Buf, InData%U) end if call RegPack(Buf, allocated(InData%Ud)) if (allocated(InData%Ud)) then - call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) + call RegPackBounds(Buf, 2, lbound(InData%Ud, kind=B8Ki), ubound(InData%Ud, kind=B8Ki)) call RegPack(Buf, InData%Ud) end if call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then - call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) + call RegPackBounds(Buf, 1, lbound(InData%zeta, kind=B8Ki), ubound(InData%zeta, kind=B8Ki)) call RegPack(Buf, InData%zeta) end if call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPackBounds(Buf, 1, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) call RegPack(Buf, InData%PDyn) end if call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) + call RegPackBounds(Buf, 2, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) call RegPack(Buf, InData%W) end if call RegPack(Buf, allocated(InData%Bo)) if (allocated(InData%Bo)) then - call RegPackBounds(Buf, 2, lbound(InData%Bo), ubound(InData%Bo)) + call RegPackBounds(Buf, 2, lbound(InData%Bo, kind=B8Ki), ubound(InData%Bo, kind=B8Ki)) call RegPack(Buf, InData%Bo) end if call RegPack(Buf, allocated(InData%Pd)) if (allocated(InData%Pd)) then - call RegPackBounds(Buf, 2, lbound(InData%Pd), ubound(InData%Pd)) + call RegPackBounds(Buf, 2, lbound(InData%Pd, kind=B8Ki), ubound(InData%Pd, kind=B8Ki)) call RegPack(Buf, InData%Pd) end if call RegPack(Buf, allocated(InData%Dp)) if (allocated(InData%Dp)) then - call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) + call RegPackBounds(Buf, 2, lbound(InData%Dp, kind=B8Ki), ubound(InData%Dp, kind=B8Ki)) call RegPack(Buf, InData%Dp) end if call RegPack(Buf, allocated(InData%Dq)) if (allocated(InData%Dq)) then - call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) + call RegPackBounds(Buf, 2, lbound(InData%Dq, kind=B8Ki), ubound(InData%Dq, kind=B8Ki)) call RegPack(Buf, InData%Dq) end if call RegPack(Buf, allocated(InData%Ap)) if (allocated(InData%Ap)) then - call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) + call RegPackBounds(Buf, 2, lbound(InData%Ap, kind=B8Ki), ubound(InData%Ap, kind=B8Ki)) call RegPack(Buf, InData%Ap) end if call RegPack(Buf, allocated(InData%Aq)) if (allocated(InData%Aq)) then - call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) + call RegPackBounds(Buf, 2, lbound(InData%Aq, kind=B8Ki), ubound(InData%Aq, kind=B8Ki)) call RegPack(Buf, InData%Aq) end if call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) call RegPack(Buf, InData%B) end if call RegPack(Buf, allocated(InData%Fnet)) if (allocated(InData%Fnet)) then - call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) + call RegPackBounds(Buf, 2, lbound(InData%Fnet, kind=B8Ki), ubound(InData%Fnet, kind=B8Ki)) call RegPack(Buf, InData%Fnet) end if call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then - call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) + call RegPackBounds(Buf, 3, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) call RegPack(Buf, InData%M) end if call RegPack(Buf, InData%FextA) @@ -1707,7 +1707,7 @@ subroutine MD_PackRod(Buf, Indata) call RegPack(Buf, InData%RodUnOut) call RegPack(Buf, allocated(InData%RodWrOutput)) if (allocated(InData%RodWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput), ubound(InData%RodWrOutput)) + call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput, kind=B8Ki), ubound(InData%RodWrOutput, kind=B8Ki)) call RegPack(Buf, InData%RodWrOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1717,7 +1717,7 @@ subroutine MD_UnPackRod(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_Rod), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackRod' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2073,7 +2073,7 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyLine' ErrStat = ErrID_None @@ -2111,8 +2111,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%bstiffYs = SrcLineData%bstiffYs DstLineData%time = SrcLineData%time if (allocated(SrcLineData%r)) then - LB(1:2) = lbound(SrcLineData%r) - UB(1:2) = ubound(SrcLineData%r) + LB(1:2) = lbound(SrcLineData%r, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%r, kind=B8Ki) if (.not. allocated(DstLineData%r)) then allocate(DstLineData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2123,8 +2123,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%r = SrcLineData%r end if if (allocated(SrcLineData%rd)) then - LB(1:2) = lbound(SrcLineData%rd) - UB(1:2) = ubound(SrcLineData%rd) + LB(1:2) = lbound(SrcLineData%rd, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%rd, kind=B8Ki) if (.not. allocated(DstLineData%rd)) then allocate(DstLineData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2135,8 +2135,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%rd = SrcLineData%rd end if if (allocated(SrcLineData%q)) then - LB(1:2) = lbound(SrcLineData%q) - UB(1:2) = ubound(SrcLineData%q) + LB(1:2) = lbound(SrcLineData%q, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%q, kind=B8Ki) if (.not. allocated(DstLineData%q)) then allocate(DstLineData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2147,8 +2147,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%q = SrcLineData%q end if if (allocated(SrcLineData%qs)) then - LB(1:2) = lbound(SrcLineData%qs) - UB(1:2) = ubound(SrcLineData%qs) + LB(1:2) = lbound(SrcLineData%qs, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%qs, kind=B8Ki) if (.not. allocated(DstLineData%qs)) then allocate(DstLineData%qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2159,8 +2159,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%qs = SrcLineData%qs end if if (allocated(SrcLineData%l)) then - LB(1:1) = lbound(SrcLineData%l) - UB(1:1) = ubound(SrcLineData%l) + LB(1:1) = lbound(SrcLineData%l, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%l, kind=B8Ki) if (.not. allocated(DstLineData%l)) then allocate(DstLineData%l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2171,8 +2171,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%l = SrcLineData%l end if if (allocated(SrcLineData%ld)) then - LB(1:1) = lbound(SrcLineData%ld) - UB(1:1) = ubound(SrcLineData%ld) + LB(1:1) = lbound(SrcLineData%ld, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%ld, kind=B8Ki) if (.not. allocated(DstLineData%ld)) then allocate(DstLineData%ld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2183,8 +2183,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%ld = SrcLineData%ld end if if (allocated(SrcLineData%lstr)) then - LB(1:1) = lbound(SrcLineData%lstr) - UB(1:1) = ubound(SrcLineData%lstr) + LB(1:1) = lbound(SrcLineData%lstr, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%lstr, kind=B8Ki) if (.not. allocated(DstLineData%lstr)) then allocate(DstLineData%lstr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2195,8 +2195,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%lstr = SrcLineData%lstr end if if (allocated(SrcLineData%lstrd)) then - LB(1:1) = lbound(SrcLineData%lstrd) - UB(1:1) = ubound(SrcLineData%lstrd) + LB(1:1) = lbound(SrcLineData%lstrd, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%lstrd, kind=B8Ki) if (.not. allocated(DstLineData%lstrd)) then allocate(DstLineData%lstrd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2207,8 +2207,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%lstrd = SrcLineData%lstrd end if if (allocated(SrcLineData%Kurv)) then - LB(1:1) = lbound(SrcLineData%Kurv) - UB(1:1) = ubound(SrcLineData%Kurv) + LB(1:1) = lbound(SrcLineData%Kurv, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%Kurv, kind=B8Ki) if (.not. allocated(DstLineData%Kurv)) then allocate(DstLineData%Kurv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2219,8 +2219,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Kurv = SrcLineData%Kurv end if if (allocated(SrcLineData%dl_1)) then - LB(1:1) = lbound(SrcLineData%dl_1) - UB(1:1) = ubound(SrcLineData%dl_1) + LB(1:1) = lbound(SrcLineData%dl_1, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%dl_1, kind=B8Ki) if (.not. allocated(DstLineData%dl_1)) then allocate(DstLineData%dl_1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2231,8 +2231,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%dl_1 = SrcLineData%dl_1 end if if (allocated(SrcLineData%V)) then - LB(1:1) = lbound(SrcLineData%V) - UB(1:1) = ubound(SrcLineData%V) + LB(1:1) = lbound(SrcLineData%V, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%V, kind=B8Ki) if (.not. allocated(DstLineData%V)) then allocate(DstLineData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2243,8 +2243,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%V = SrcLineData%V end if if (allocated(SrcLineData%U)) then - LB(1:2) = lbound(SrcLineData%U) - UB(1:2) = ubound(SrcLineData%U) + LB(1:2) = lbound(SrcLineData%U, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%U, kind=B8Ki) if (.not. allocated(DstLineData%U)) then allocate(DstLineData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2255,8 +2255,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%U = SrcLineData%U end if if (allocated(SrcLineData%Ud)) then - LB(1:2) = lbound(SrcLineData%Ud) - UB(1:2) = ubound(SrcLineData%Ud) + LB(1:2) = lbound(SrcLineData%Ud, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Ud, kind=B8Ki) if (.not. allocated(DstLineData%Ud)) then allocate(DstLineData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2267,8 +2267,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Ud = SrcLineData%Ud end if if (allocated(SrcLineData%zeta)) then - LB(1:1) = lbound(SrcLineData%zeta) - UB(1:1) = ubound(SrcLineData%zeta) + LB(1:1) = lbound(SrcLineData%zeta, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%zeta, kind=B8Ki) if (.not. allocated(DstLineData%zeta)) then allocate(DstLineData%zeta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2279,8 +2279,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%zeta = SrcLineData%zeta end if if (allocated(SrcLineData%PDyn)) then - LB(1:1) = lbound(SrcLineData%PDyn) - UB(1:1) = ubound(SrcLineData%PDyn) + LB(1:1) = lbound(SrcLineData%PDyn, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%PDyn, kind=B8Ki) if (.not. allocated(DstLineData%PDyn)) then allocate(DstLineData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2291,8 +2291,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%PDyn = SrcLineData%PDyn end if if (allocated(SrcLineData%T)) then - LB(1:2) = lbound(SrcLineData%T) - UB(1:2) = ubound(SrcLineData%T) + LB(1:2) = lbound(SrcLineData%T, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%T, kind=B8Ki) if (.not. allocated(DstLineData%T)) then allocate(DstLineData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2303,8 +2303,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%T = SrcLineData%T end if if (allocated(SrcLineData%Td)) then - LB(1:2) = lbound(SrcLineData%Td) - UB(1:2) = ubound(SrcLineData%Td) + LB(1:2) = lbound(SrcLineData%Td, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Td, kind=B8Ki) if (.not. allocated(DstLineData%Td)) then allocate(DstLineData%Td(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2315,8 +2315,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Td = SrcLineData%Td end if if (allocated(SrcLineData%W)) then - LB(1:2) = lbound(SrcLineData%W) - UB(1:2) = ubound(SrcLineData%W) + LB(1:2) = lbound(SrcLineData%W, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%W, kind=B8Ki) if (.not. allocated(DstLineData%W)) then allocate(DstLineData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2327,8 +2327,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%W = SrcLineData%W end if if (allocated(SrcLineData%Dp)) then - LB(1:2) = lbound(SrcLineData%Dp) - UB(1:2) = ubound(SrcLineData%Dp) + LB(1:2) = lbound(SrcLineData%Dp, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Dp, kind=B8Ki) if (.not. allocated(DstLineData%Dp)) then allocate(DstLineData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2339,8 +2339,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Dp = SrcLineData%Dp end if if (allocated(SrcLineData%Dq)) then - LB(1:2) = lbound(SrcLineData%Dq) - UB(1:2) = ubound(SrcLineData%Dq) + LB(1:2) = lbound(SrcLineData%Dq, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Dq, kind=B8Ki) if (.not. allocated(DstLineData%Dq)) then allocate(DstLineData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2351,8 +2351,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Dq = SrcLineData%Dq end if if (allocated(SrcLineData%Ap)) then - LB(1:2) = lbound(SrcLineData%Ap) - UB(1:2) = ubound(SrcLineData%Ap) + LB(1:2) = lbound(SrcLineData%Ap, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Ap, kind=B8Ki) if (.not. allocated(DstLineData%Ap)) then allocate(DstLineData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2363,8 +2363,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Ap = SrcLineData%Ap end if if (allocated(SrcLineData%Aq)) then - LB(1:2) = lbound(SrcLineData%Aq) - UB(1:2) = ubound(SrcLineData%Aq) + LB(1:2) = lbound(SrcLineData%Aq, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Aq, kind=B8Ki) if (.not. allocated(DstLineData%Aq)) then allocate(DstLineData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2375,8 +2375,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Aq = SrcLineData%Aq end if if (allocated(SrcLineData%B)) then - LB(1:2) = lbound(SrcLineData%B) - UB(1:2) = ubound(SrcLineData%B) + LB(1:2) = lbound(SrcLineData%B, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%B, kind=B8Ki) if (.not. allocated(DstLineData%B)) then allocate(DstLineData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2387,8 +2387,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%B = SrcLineData%B end if if (allocated(SrcLineData%Bs)) then - LB(1:2) = lbound(SrcLineData%Bs) - UB(1:2) = ubound(SrcLineData%Bs) + LB(1:2) = lbound(SrcLineData%Bs, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Bs, kind=B8Ki) if (.not. allocated(DstLineData%Bs)) then allocate(DstLineData%Bs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2399,8 +2399,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Bs = SrcLineData%Bs end if if (allocated(SrcLineData%Fnet)) then - LB(1:2) = lbound(SrcLineData%Fnet) - UB(1:2) = ubound(SrcLineData%Fnet) + LB(1:2) = lbound(SrcLineData%Fnet, kind=B8Ki) + UB(1:2) = ubound(SrcLineData%Fnet, kind=B8Ki) if (.not. allocated(DstLineData%Fnet)) then allocate(DstLineData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2411,8 +2411,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Fnet = SrcLineData%Fnet end if if (allocated(SrcLineData%S)) then - LB(1:3) = lbound(SrcLineData%S) - UB(1:3) = ubound(SrcLineData%S) + LB(1:3) = lbound(SrcLineData%S, kind=B8Ki) + UB(1:3) = ubound(SrcLineData%S, kind=B8Ki) if (.not. allocated(DstLineData%S)) then allocate(DstLineData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2423,8 +2423,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%S = SrcLineData%S end if if (allocated(SrcLineData%M)) then - LB(1:3) = lbound(SrcLineData%M) - UB(1:3) = ubound(SrcLineData%M) + LB(1:3) = lbound(SrcLineData%M, kind=B8Ki) + UB(1:3) = ubound(SrcLineData%M, kind=B8Ki) if (.not. allocated(DstLineData%M)) then allocate(DstLineData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2438,8 +2438,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%EndMomentB = SrcLineData%EndMomentB DstLineData%LineUnOut = SrcLineData%LineUnOut if (allocated(SrcLineData%LineWrOutput)) then - LB(1:1) = lbound(SrcLineData%LineWrOutput) - UB(1:1) = ubound(SrcLineData%LineWrOutput) + LB(1:1) = lbound(SrcLineData%LineWrOutput, kind=B8Ki) + UB(1:1) = ubound(SrcLineData%LineWrOutput, kind=B8Ki) if (.not. allocated(DstLineData%LineWrOutput)) then allocate(DstLineData%LineWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2583,137 +2583,137 @@ subroutine MD_PackLine(Buf, Indata) call RegPack(Buf, InData%time) call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then - call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) + call RegPackBounds(Buf, 2, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) call RegPack(Buf, InData%r) end if call RegPack(Buf, allocated(InData%rd)) if (allocated(InData%rd)) then - call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) + call RegPackBounds(Buf, 2, lbound(InData%rd, kind=B8Ki), ubound(InData%rd, kind=B8Ki)) call RegPack(Buf, InData%rd) end if call RegPack(Buf, allocated(InData%q)) if (allocated(InData%q)) then - call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPackBounds(Buf, 2, lbound(InData%q, kind=B8Ki), ubound(InData%q, kind=B8Ki)) call RegPack(Buf, InData%q) end if call RegPack(Buf, allocated(InData%qs)) if (allocated(InData%qs)) then - call RegPackBounds(Buf, 2, lbound(InData%qs), ubound(InData%qs)) + call RegPackBounds(Buf, 2, lbound(InData%qs, kind=B8Ki), ubound(InData%qs, kind=B8Ki)) call RegPack(Buf, InData%qs) end if call RegPack(Buf, allocated(InData%l)) if (allocated(InData%l)) then - call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) + call RegPackBounds(Buf, 1, lbound(InData%l, kind=B8Ki), ubound(InData%l, kind=B8Ki)) call RegPack(Buf, InData%l) end if call RegPack(Buf, allocated(InData%ld)) if (allocated(InData%ld)) then - call RegPackBounds(Buf, 1, lbound(InData%ld), ubound(InData%ld)) + call RegPackBounds(Buf, 1, lbound(InData%ld, kind=B8Ki), ubound(InData%ld, kind=B8Ki)) call RegPack(Buf, InData%ld) end if call RegPack(Buf, allocated(InData%lstr)) if (allocated(InData%lstr)) then - call RegPackBounds(Buf, 1, lbound(InData%lstr), ubound(InData%lstr)) + call RegPackBounds(Buf, 1, lbound(InData%lstr, kind=B8Ki), ubound(InData%lstr, kind=B8Ki)) call RegPack(Buf, InData%lstr) end if call RegPack(Buf, allocated(InData%lstrd)) if (allocated(InData%lstrd)) then - call RegPackBounds(Buf, 1, lbound(InData%lstrd), ubound(InData%lstrd)) + call RegPackBounds(Buf, 1, lbound(InData%lstrd, kind=B8Ki), ubound(InData%lstrd, kind=B8Ki)) call RegPack(Buf, InData%lstrd) end if call RegPack(Buf, allocated(InData%Kurv)) if (allocated(InData%Kurv)) then - call RegPackBounds(Buf, 1, lbound(InData%Kurv), ubound(InData%Kurv)) + call RegPackBounds(Buf, 1, lbound(InData%Kurv, kind=B8Ki), ubound(InData%Kurv, kind=B8Ki)) call RegPack(Buf, InData%Kurv) end if call RegPack(Buf, allocated(InData%dl_1)) if (allocated(InData%dl_1)) then - call RegPackBounds(Buf, 1, lbound(InData%dl_1), ubound(InData%dl_1)) + call RegPackBounds(Buf, 1, lbound(InData%dl_1, kind=B8Ki), ubound(InData%dl_1, kind=B8Ki)) call RegPack(Buf, InData%dl_1) end if call RegPack(Buf, allocated(InData%V)) if (allocated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) call RegPack(Buf, InData%V) end if call RegPack(Buf, allocated(InData%U)) if (allocated(InData%U)) then - call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) + call RegPackBounds(Buf, 2, lbound(InData%U, kind=B8Ki), ubound(InData%U, kind=B8Ki)) call RegPack(Buf, InData%U) end if call RegPack(Buf, allocated(InData%Ud)) if (allocated(InData%Ud)) then - call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) + call RegPackBounds(Buf, 2, lbound(InData%Ud, kind=B8Ki), ubound(InData%Ud, kind=B8Ki)) call RegPack(Buf, InData%Ud) end if call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then - call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) + call RegPackBounds(Buf, 1, lbound(InData%zeta, kind=B8Ki), ubound(InData%zeta, kind=B8Ki)) call RegPack(Buf, InData%zeta) end if call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPackBounds(Buf, 1, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) call RegPack(Buf, InData%PDyn) end if call RegPack(Buf, allocated(InData%T)) if (allocated(InData%T)) then - call RegPackBounds(Buf, 2, lbound(InData%T), ubound(InData%T)) + call RegPackBounds(Buf, 2, lbound(InData%T, kind=B8Ki), ubound(InData%T, kind=B8Ki)) call RegPack(Buf, InData%T) end if call RegPack(Buf, allocated(InData%Td)) if (allocated(InData%Td)) then - call RegPackBounds(Buf, 2, lbound(InData%Td), ubound(InData%Td)) + call RegPackBounds(Buf, 2, lbound(InData%Td, kind=B8Ki), ubound(InData%Td, kind=B8Ki)) call RegPack(Buf, InData%Td) end if call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) + call RegPackBounds(Buf, 2, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) call RegPack(Buf, InData%W) end if call RegPack(Buf, allocated(InData%Dp)) if (allocated(InData%Dp)) then - call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) + call RegPackBounds(Buf, 2, lbound(InData%Dp, kind=B8Ki), ubound(InData%Dp, kind=B8Ki)) call RegPack(Buf, InData%Dp) end if call RegPack(Buf, allocated(InData%Dq)) if (allocated(InData%Dq)) then - call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) + call RegPackBounds(Buf, 2, lbound(InData%Dq, kind=B8Ki), ubound(InData%Dq, kind=B8Ki)) call RegPack(Buf, InData%Dq) end if call RegPack(Buf, allocated(InData%Ap)) if (allocated(InData%Ap)) then - call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) + call RegPackBounds(Buf, 2, lbound(InData%Ap, kind=B8Ki), ubound(InData%Ap, kind=B8Ki)) call RegPack(Buf, InData%Ap) end if call RegPack(Buf, allocated(InData%Aq)) if (allocated(InData%Aq)) then - call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) + call RegPackBounds(Buf, 2, lbound(InData%Aq, kind=B8Ki), ubound(InData%Aq, kind=B8Ki)) call RegPack(Buf, InData%Aq) end if call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) call RegPack(Buf, InData%B) end if call RegPack(Buf, allocated(InData%Bs)) if (allocated(InData%Bs)) then - call RegPackBounds(Buf, 2, lbound(InData%Bs), ubound(InData%Bs)) + call RegPackBounds(Buf, 2, lbound(InData%Bs, kind=B8Ki), ubound(InData%Bs, kind=B8Ki)) call RegPack(Buf, InData%Bs) end if call RegPack(Buf, allocated(InData%Fnet)) if (allocated(InData%Fnet)) then - call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) + call RegPackBounds(Buf, 2, lbound(InData%Fnet, kind=B8Ki), ubound(InData%Fnet, kind=B8Ki)) call RegPack(Buf, InData%Fnet) end if call RegPack(Buf, allocated(InData%S)) if (allocated(InData%S)) then - call RegPackBounds(Buf, 3, lbound(InData%S), ubound(InData%S)) + call RegPackBounds(Buf, 3, lbound(InData%S, kind=B8Ki), ubound(InData%S, kind=B8Ki)) call RegPack(Buf, InData%S) end if call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then - call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) + call RegPackBounds(Buf, 3, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) call RegPack(Buf, InData%M) end if call RegPack(Buf, InData%EndMomentA) @@ -2721,7 +2721,7 @@ subroutine MD_PackLine(Buf, Indata) call RegPack(Buf, InData%LineUnOut) call RegPack(Buf, allocated(InData%LineWrOutput)) if (allocated(InData%LineWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput), ubound(InData%LineWrOutput)) + call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput, kind=B8Ki), ubound(InData%LineWrOutput, kind=B8Ki)) call RegPack(Buf, InData%LineWrOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2731,7 +2731,7 @@ subroutine MD_UnPackLine(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_Line), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackLine' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3303,14 +3303,14 @@ subroutine MD_CopyVisDiam(SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyVisDiam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVisDiamData%Diam)) then - LB(1:1) = lbound(SrcVisDiamData%Diam) - UB(1:1) = ubound(SrcVisDiamData%Diam) + LB(1:1) = lbound(SrcVisDiamData%Diam, kind=B8Ki) + UB(1:1) = ubound(SrcVisDiamData%Diam, kind=B8Ki) if (.not. allocated(DstVisDiamData%Diam)) then allocate(DstVisDiamData%Diam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3341,7 +3341,7 @@ subroutine MD_PackVisDiam(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Diam)) if (allocated(InData%Diam)) then - call RegPackBounds(Buf, 1, lbound(InData%Diam), ubound(InData%Diam)) + call RegPackBounds(Buf, 1, lbound(InData%Diam, kind=B8Ki), ubound(InData%Diam, kind=B8Ki)) call RegPack(Buf, InData%Diam) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3351,7 +3351,7 @@ subroutine MD_UnPackVisDiam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(VisDiam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackVisDiam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3377,15 +3377,15 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%writeOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%writeOutputHdr)) then allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3396,8 +3396,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr end if if (allocated(SrcInitOutputData%writeOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%writeOutputUnt)) then allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3411,8 +3411,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%CableCChanRqst)) then - LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) - UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) if (.not. allocated(DstInitOutputData%CableCChanRqst)) then allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3423,8 +3423,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3435,8 +3435,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3447,8 +3447,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3459,8 +3459,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3471,8 +3471,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3483,8 +3483,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3495,8 +3495,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3507,8 +3507,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3573,58 +3573,58 @@ subroutine MD_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%writeOutputHdr)) if (allocated(InData%writeOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr, kind=B8Ki), ubound(InData%writeOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%writeOutputHdr) end if call RegPack(Buf, allocated(InData%writeOutputUnt)) if (allocated(InData%writeOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt, kind=B8Ki), ubound(InData%writeOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%writeOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%CableCChanRqst)) if (allocated(InData%CableCChanRqst)) then - call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) + call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst, kind=B8Ki), ubound(InData%CableCChanRqst, kind=B8Ki)) call RegPack(Buf, InData%CableCChanRqst) end if call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3634,7 +3634,7 @@ subroutine MD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3801,14 +3801,14 @@ subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%states)) then - LB(1:1) = lbound(SrcContStateData%states) - UB(1:1) = ubound(SrcContStateData%states) + LB(1:1) = lbound(SrcContStateData%states, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%states, kind=B8Ki) if (.not. allocated(DstContStateData%states)) then allocate(DstContStateData%states(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3839,7 +3839,7 @@ subroutine MD_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%states)) if (allocated(InData%states)) then - call RegPackBounds(Buf, 1, lbound(InData%states), ubound(InData%states)) + call RegPackBounds(Buf, 1, lbound(InData%states, kind=B8Ki), ubound(InData%states, kind=B8Ki)) call RegPack(Buf, InData%states) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3849,7 +3849,7 @@ subroutine MD_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackContState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3992,16 +3992,16 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%LineTypeList)) then - LB(1:1) = lbound(SrcMiscData%LineTypeList) - UB(1:1) = ubound(SrcMiscData%LineTypeList) + LB(1:1) = lbound(SrcMiscData%LineTypeList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineTypeList, kind=B8Ki) if (.not. allocated(DstMiscData%LineTypeList)) then allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4016,8 +4016,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%RodTypeList)) then - LB(1:1) = lbound(SrcMiscData%RodTypeList) - UB(1:1) = ubound(SrcMiscData%RodTypeList) + LB(1:1) = lbound(SrcMiscData%RodTypeList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodTypeList, kind=B8Ki) if (.not. allocated(DstMiscData%RodTypeList)) then allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4035,8 +4035,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%BodyList)) then - LB(1:1) = lbound(SrcMiscData%BodyList) - UB(1:1) = ubound(SrcMiscData%BodyList) + LB(1:1) = lbound(SrcMiscData%BodyList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BodyList, kind=B8Ki) if (.not. allocated(DstMiscData%BodyList)) then allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4051,8 +4051,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%RodList)) then - LB(1:1) = lbound(SrcMiscData%RodList) - UB(1:1) = ubound(SrcMiscData%RodList) + LB(1:1) = lbound(SrcMiscData%RodList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodList, kind=B8Ki) if (.not. allocated(DstMiscData%RodList)) then allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4067,8 +4067,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%PointList)) then - LB(1:1) = lbound(SrcMiscData%PointList) - UB(1:1) = ubound(SrcMiscData%PointList) + LB(1:1) = lbound(SrcMiscData%PointList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%PointList, kind=B8Ki) if (.not. allocated(DstMiscData%PointList)) then allocate(DstMiscData%PointList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4083,8 +4083,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%LineList)) then - LB(1:1) = lbound(SrcMiscData%LineList) - UB(1:1) = ubound(SrcMiscData%LineList) + LB(1:1) = lbound(SrcMiscData%LineList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineList, kind=B8Ki) if (.not. allocated(DstMiscData%LineList)) then allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4099,8 +4099,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%FailList)) then - LB(1:1) = lbound(SrcMiscData%FailList) - UB(1:1) = ubound(SrcMiscData%FailList) + LB(1:1) = lbound(SrcMiscData%FailList, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FailList, kind=B8Ki) if (.not. allocated(DstMiscData%FailList)) then allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4115,8 +4115,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%FreePointIs)) then - LB(1:1) = lbound(SrcMiscData%FreePointIs) - UB(1:1) = ubound(SrcMiscData%FreePointIs) + LB(1:1) = lbound(SrcMiscData%FreePointIs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FreePointIs, kind=B8Ki) if (.not. allocated(DstMiscData%FreePointIs)) then allocate(DstMiscData%FreePointIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4127,8 +4127,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FreePointIs = SrcMiscData%FreePointIs end if if (allocated(SrcMiscData%CpldPointIs)) then - LB(1:2) = lbound(SrcMiscData%CpldPointIs) - UB(1:2) = ubound(SrcMiscData%CpldPointIs) + LB(1:2) = lbound(SrcMiscData%CpldPointIs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CpldPointIs, kind=B8Ki) if (.not. allocated(DstMiscData%CpldPointIs)) then allocate(DstMiscData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4139,8 +4139,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs end if if (allocated(SrcMiscData%FreeRodIs)) then - LB(1:1) = lbound(SrcMiscData%FreeRodIs) - UB(1:1) = ubound(SrcMiscData%FreeRodIs) + LB(1:1) = lbound(SrcMiscData%FreeRodIs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FreeRodIs, kind=B8Ki) if (.not. allocated(DstMiscData%FreeRodIs)) then allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4151,8 +4151,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs end if if (allocated(SrcMiscData%CpldRodIs)) then - LB(1:2) = lbound(SrcMiscData%CpldRodIs) - UB(1:2) = ubound(SrcMiscData%CpldRodIs) + LB(1:2) = lbound(SrcMiscData%CpldRodIs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CpldRodIs, kind=B8Ki) if (.not. allocated(DstMiscData%CpldRodIs)) then allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4163,8 +4163,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs end if if (allocated(SrcMiscData%FreeBodyIs)) then - LB(1:1) = lbound(SrcMiscData%FreeBodyIs) - UB(1:1) = ubound(SrcMiscData%FreeBodyIs) + LB(1:1) = lbound(SrcMiscData%FreeBodyIs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs, kind=B8Ki) if (.not. allocated(DstMiscData%FreeBodyIs)) then allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4175,8 +4175,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs end if if (allocated(SrcMiscData%CpldBodyIs)) then - LB(1:2) = lbound(SrcMiscData%CpldBodyIs) - UB(1:2) = ubound(SrcMiscData%CpldBodyIs) + LB(1:2) = lbound(SrcMiscData%CpldBodyIs, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs, kind=B8Ki) if (.not. allocated(DstMiscData%CpldBodyIs)) then allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4187,8 +4187,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs end if if (allocated(SrcMiscData%LineStateIs1)) then - LB(1:1) = lbound(SrcMiscData%LineStateIs1) - UB(1:1) = ubound(SrcMiscData%LineStateIs1) + LB(1:1) = lbound(SrcMiscData%LineStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineStateIs1, kind=B8Ki) if (.not. allocated(DstMiscData%LineStateIs1)) then allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4199,8 +4199,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 end if if (allocated(SrcMiscData%LineStateIsN)) then - LB(1:1) = lbound(SrcMiscData%LineStateIsN) - UB(1:1) = ubound(SrcMiscData%LineStateIsN) + LB(1:1) = lbound(SrcMiscData%LineStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%LineStateIsN, kind=B8Ki) if (.not. allocated(DstMiscData%LineStateIsN)) then allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4211,8 +4211,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN end if if (allocated(SrcMiscData%PointStateIs1)) then - LB(1:1) = lbound(SrcMiscData%PointStateIs1) - UB(1:1) = ubound(SrcMiscData%PointStateIs1) + LB(1:1) = lbound(SrcMiscData%PointStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%PointStateIs1, kind=B8Ki) if (.not. allocated(DstMiscData%PointStateIs1)) then allocate(DstMiscData%PointStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4223,8 +4223,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 end if if (allocated(SrcMiscData%PointStateIsN)) then - LB(1:1) = lbound(SrcMiscData%PointStateIsN) - UB(1:1) = ubound(SrcMiscData%PointStateIsN) + LB(1:1) = lbound(SrcMiscData%PointStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%PointStateIsN, kind=B8Ki) if (.not. allocated(DstMiscData%PointStateIsN)) then allocate(DstMiscData%PointStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4235,8 +4235,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN end if if (allocated(SrcMiscData%RodStateIs1)) then - LB(1:1) = lbound(SrcMiscData%RodStateIs1) - UB(1:1) = ubound(SrcMiscData%RodStateIs1) + LB(1:1) = lbound(SrcMiscData%RodStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodStateIs1, kind=B8Ki) if (.not. allocated(DstMiscData%RodStateIs1)) then allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4247,8 +4247,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 end if if (allocated(SrcMiscData%RodStateIsN)) then - LB(1:1) = lbound(SrcMiscData%RodStateIsN) - UB(1:1) = ubound(SrcMiscData%RodStateIsN) + LB(1:1) = lbound(SrcMiscData%RodStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%RodStateIsN, kind=B8Ki) if (.not. allocated(DstMiscData%RodStateIsN)) then allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4259,8 +4259,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN end if if (allocated(SrcMiscData%BodyStateIs1)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIs1) - UB(1:1) = ubound(SrcMiscData%BodyStateIs1) + LB(1:1) = lbound(SrcMiscData%BodyStateIs1, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1, kind=B8Ki) if (.not. allocated(DstMiscData%BodyStateIs1)) then allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4271,8 +4271,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 end if if (allocated(SrcMiscData%BodyStateIsN)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIsN) - UB(1:1) = ubound(SrcMiscData%BodyStateIsN) + LB(1:1) = lbound(SrcMiscData%BodyStateIsN, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN, kind=B8Ki) if (.not. allocated(DstMiscData%BodyStateIsN)) then allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4292,8 +4292,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return DstMiscData%zeros6 = SrcMiscData%zeros6 if (allocated(SrcMiscData%MDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%MDWrOutput) - UB(1:1) = ubound(SrcMiscData%MDWrOutput) + LB(1:1) = lbound(SrcMiscData%MDWrOutput, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%MDWrOutput, kind=B8Ki) if (.not. allocated(DstMiscData%MDWrOutput)) then allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4306,8 +4306,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%PtfmInit = SrcMiscData%PtfmInit if (allocated(SrcMiscData%BathymetryGrid)) then - LB(1:2) = lbound(SrcMiscData%BathymetryGrid) - UB(1:2) = ubound(SrcMiscData%BathymetryGrid) + LB(1:2) = lbound(SrcMiscData%BathymetryGrid, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid, kind=B8Ki) if (.not. allocated(DstMiscData%BathymetryGrid)) then allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4318,8 +4318,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid end if if (allocated(SrcMiscData%BathGrid_Xs)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) - UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs, kind=B8Ki) if (.not. allocated(DstMiscData%BathGrid_Xs)) then allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4330,8 +4330,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs end if if (allocated(SrcMiscData%BathGrid_Ys)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) - UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys, kind=B8Ki) if (.not. allocated(DstMiscData%BathGrid_Ys)) then allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4342,8 +4342,8 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys end if if (allocated(SrcMiscData%BathGrid_npoints)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) - UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints, kind=B8Ki) if (.not. allocated(DstMiscData%BathGrid_npoints)) then allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4359,16 +4359,16 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(MD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%LineTypeList)) then - LB(1:1) = lbound(MiscData%LineTypeList) - UB(1:1) = ubound(MiscData%LineTypeList) + LB(1:1) = lbound(MiscData%LineTypeList, kind=B8Ki) + UB(1:1) = ubound(MiscData%LineTypeList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4376,8 +4376,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%LineTypeList) end if if (allocated(MiscData%RodTypeList)) then - LB(1:1) = lbound(MiscData%RodTypeList) - UB(1:1) = ubound(MiscData%RodTypeList) + LB(1:1) = lbound(MiscData%RodTypeList, kind=B8Ki) + UB(1:1) = ubound(MiscData%RodTypeList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4387,8 +4387,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%BodyList)) then - LB(1:1) = lbound(MiscData%BodyList) - UB(1:1) = ubound(MiscData%BodyList) + LB(1:1) = lbound(MiscData%BodyList, kind=B8Ki) + UB(1:1) = ubound(MiscData%BodyList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4396,8 +4396,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%BodyList) end if if (allocated(MiscData%RodList)) then - LB(1:1) = lbound(MiscData%RodList) - UB(1:1) = ubound(MiscData%RodList) + LB(1:1) = lbound(MiscData%RodList, kind=B8Ki) + UB(1:1) = ubound(MiscData%RodList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4405,8 +4405,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%RodList) end if if (allocated(MiscData%PointList)) then - LB(1:1) = lbound(MiscData%PointList) - UB(1:1) = ubound(MiscData%PointList) + LB(1:1) = lbound(MiscData%PointList, kind=B8Ki) + UB(1:1) = ubound(MiscData%PointList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4414,8 +4414,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%PointList) end if if (allocated(MiscData%LineList)) then - LB(1:1) = lbound(MiscData%LineList) - UB(1:1) = ubound(MiscData%LineList) + LB(1:1) = lbound(MiscData%LineList, kind=B8Ki) + UB(1:1) = ubound(MiscData%LineList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4423,8 +4423,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%LineList) end if if (allocated(MiscData%FailList)) then - LB(1:1) = lbound(MiscData%FailList) - UB(1:1) = ubound(MiscData%FailList) + LB(1:1) = lbound(MiscData%FailList, kind=B8Ki) + UB(1:1) = ubound(MiscData%FailList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4498,23 +4498,23 @@ subroutine MD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%LineTypeList)) if (allocated(InData%LineTypeList)) then - call RegPackBounds(Buf, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) - LB(1:1) = lbound(InData%LineTypeList) - UB(1:1) = ubound(InData%LineTypeList) + call RegPackBounds(Buf, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) + LB(1:1) = lbound(InData%LineTypeList, kind=B8Ki) + UB(1:1) = ubound(InData%LineTypeList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackLineProp(Buf, InData%LineTypeList(i1)) end do end if call RegPack(Buf, allocated(InData%RodTypeList)) if (allocated(InData%RodTypeList)) then - call RegPackBounds(Buf, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) - LB(1:1) = lbound(InData%RodTypeList) - UB(1:1) = ubound(InData%RodTypeList) + call RegPackBounds(Buf, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) + LB(1:1) = lbound(InData%RodTypeList, kind=B8Ki) + UB(1:1) = ubound(InData%RodTypeList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackRodProp(Buf, InData%RodTypeList(i1)) end do @@ -4522,117 +4522,117 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackBody(Buf, InData%GroundBody) call RegPack(Buf, allocated(InData%BodyList)) if (allocated(InData%BodyList)) then - call RegPackBounds(Buf, 1, lbound(InData%BodyList), ubound(InData%BodyList)) - LB(1:1) = lbound(InData%BodyList) - UB(1:1) = ubound(InData%BodyList) + call RegPackBounds(Buf, 1, lbound(InData%BodyList, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) + LB(1:1) = lbound(InData%BodyList, kind=B8Ki) + UB(1:1) = ubound(InData%BodyList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackBody(Buf, InData%BodyList(i1)) end do end if call RegPack(Buf, allocated(InData%RodList)) if (allocated(InData%RodList)) then - call RegPackBounds(Buf, 1, lbound(InData%RodList), ubound(InData%RodList)) - LB(1:1) = lbound(InData%RodList) - UB(1:1) = ubound(InData%RodList) + call RegPackBounds(Buf, 1, lbound(InData%RodList, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) + LB(1:1) = lbound(InData%RodList, kind=B8Ki) + UB(1:1) = ubound(InData%RodList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackRod(Buf, InData%RodList(i1)) end do end if call RegPack(Buf, allocated(InData%PointList)) if (allocated(InData%PointList)) then - call RegPackBounds(Buf, 1, lbound(InData%PointList), ubound(InData%PointList)) - LB(1:1) = lbound(InData%PointList) - UB(1:1) = ubound(InData%PointList) + call RegPackBounds(Buf, 1, lbound(InData%PointList, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) + LB(1:1) = lbound(InData%PointList, kind=B8Ki) + UB(1:1) = ubound(InData%PointList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackPoint(Buf, InData%PointList(i1)) end do end if call RegPack(Buf, allocated(InData%LineList)) if (allocated(InData%LineList)) then - call RegPackBounds(Buf, 1, lbound(InData%LineList), ubound(InData%LineList)) - LB(1:1) = lbound(InData%LineList) - UB(1:1) = ubound(InData%LineList) + call RegPackBounds(Buf, 1, lbound(InData%LineList, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) + LB(1:1) = lbound(InData%LineList, kind=B8Ki) + UB(1:1) = ubound(InData%LineList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackLine(Buf, InData%LineList(i1)) end do end if call RegPack(Buf, allocated(InData%FailList)) if (allocated(InData%FailList)) then - call RegPackBounds(Buf, 1, lbound(InData%FailList), ubound(InData%FailList)) - LB(1:1) = lbound(InData%FailList) - UB(1:1) = ubound(InData%FailList) + call RegPackBounds(Buf, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) + LB(1:1) = lbound(InData%FailList, kind=B8Ki) + UB(1:1) = ubound(InData%FailList, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackFail(Buf, InData%FailList(i1)) end do end if call RegPack(Buf, allocated(InData%FreePointIs)) if (allocated(InData%FreePointIs)) then - call RegPackBounds(Buf, 1, lbound(InData%FreePointIs), ubound(InData%FreePointIs)) + call RegPackBounds(Buf, 1, lbound(InData%FreePointIs, kind=B8Ki), ubound(InData%FreePointIs, kind=B8Ki)) call RegPack(Buf, InData%FreePointIs) end if call RegPack(Buf, allocated(InData%CpldPointIs)) if (allocated(InData%CpldPointIs)) then - call RegPackBounds(Buf, 2, lbound(InData%CpldPointIs), ubound(InData%CpldPointIs)) + call RegPackBounds(Buf, 2, lbound(InData%CpldPointIs, kind=B8Ki), ubound(InData%CpldPointIs, kind=B8Ki)) call RegPack(Buf, InData%CpldPointIs) end if call RegPack(Buf, allocated(InData%FreeRodIs)) if (allocated(InData%FreeRodIs)) then - call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs), ubound(InData%FreeRodIs)) + call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs, kind=B8Ki), ubound(InData%FreeRodIs, kind=B8Ki)) call RegPack(Buf, InData%FreeRodIs) end if call RegPack(Buf, allocated(InData%CpldRodIs)) if (allocated(InData%CpldRodIs)) then - call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs), ubound(InData%CpldRodIs)) + call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs, kind=B8Ki), ubound(InData%CpldRodIs, kind=B8Ki)) call RegPack(Buf, InData%CpldRodIs) end if call RegPack(Buf, allocated(InData%FreeBodyIs)) if (allocated(InData%FreeBodyIs)) then - call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs), ubound(InData%FreeBodyIs)) + call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs, kind=B8Ki), ubound(InData%FreeBodyIs, kind=B8Ki)) call RegPack(Buf, InData%FreeBodyIs) end if call RegPack(Buf, allocated(InData%CpldBodyIs)) if (allocated(InData%CpldBodyIs)) then - call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs), ubound(InData%CpldBodyIs)) + call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs, kind=B8Ki), ubound(InData%CpldBodyIs, kind=B8Ki)) call RegPack(Buf, InData%CpldBodyIs) end if call RegPack(Buf, allocated(InData%LineStateIs1)) if (allocated(InData%LineStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1), ubound(InData%LineStateIs1)) + call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1, kind=B8Ki), ubound(InData%LineStateIs1, kind=B8Ki)) call RegPack(Buf, InData%LineStateIs1) end if call RegPack(Buf, allocated(InData%LineStateIsN)) if (allocated(InData%LineStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN), ubound(InData%LineStateIsN)) + call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN, kind=B8Ki), ubound(InData%LineStateIsN, kind=B8Ki)) call RegPack(Buf, InData%LineStateIsN) end if call RegPack(Buf, allocated(InData%PointStateIs1)) if (allocated(InData%PointStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%PointStateIs1), ubound(InData%PointStateIs1)) + call RegPackBounds(Buf, 1, lbound(InData%PointStateIs1, kind=B8Ki), ubound(InData%PointStateIs1, kind=B8Ki)) call RegPack(Buf, InData%PointStateIs1) end if call RegPack(Buf, allocated(InData%PointStateIsN)) if (allocated(InData%PointStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%PointStateIsN), ubound(InData%PointStateIsN)) + call RegPackBounds(Buf, 1, lbound(InData%PointStateIsN, kind=B8Ki), ubound(InData%PointStateIsN, kind=B8Ki)) call RegPack(Buf, InData%PointStateIsN) end if call RegPack(Buf, allocated(InData%RodStateIs1)) if (allocated(InData%RodStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1), ubound(InData%RodStateIs1)) + call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1, kind=B8Ki), ubound(InData%RodStateIs1, kind=B8Ki)) call RegPack(Buf, InData%RodStateIs1) end if call RegPack(Buf, allocated(InData%RodStateIsN)) if (allocated(InData%RodStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN), ubound(InData%RodStateIsN)) + call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN, kind=B8Ki), ubound(InData%RodStateIsN, kind=B8Ki)) call RegPack(Buf, InData%RodStateIsN) end if call RegPack(Buf, allocated(InData%BodyStateIs1)) if (allocated(InData%BodyStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1), ubound(InData%BodyStateIs1)) + call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1, kind=B8Ki), ubound(InData%BodyStateIs1, kind=B8Ki)) call RegPack(Buf, InData%BodyStateIs1) end if call RegPack(Buf, allocated(InData%BodyStateIsN)) if (allocated(InData%BodyStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN), ubound(InData%BodyStateIsN)) + call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN, kind=B8Ki), ubound(InData%BodyStateIsN, kind=B8Ki)) call RegPack(Buf, InData%BodyStateIsN) end if call RegPack(Buf, InData%Nx) @@ -4642,29 +4642,29 @@ subroutine MD_PackMisc(Buf, Indata) call RegPack(Buf, InData%zeros6) call RegPack(Buf, allocated(InData%MDWrOutput)) if (allocated(InData%MDWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput), ubound(InData%MDWrOutput)) + call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput, kind=B8Ki), ubound(InData%MDWrOutput, kind=B8Ki)) call RegPack(Buf, InData%MDWrOutput) end if call RegPack(Buf, InData%LastOutTime) call RegPack(Buf, InData%PtfmInit) call RegPack(Buf, allocated(InData%BathymetryGrid)) if (allocated(InData%BathymetryGrid)) then - call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid), ubound(InData%BathymetryGrid)) + call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid, kind=B8Ki), ubound(InData%BathymetryGrid, kind=B8Ki)) call RegPack(Buf, InData%BathymetryGrid) end if call RegPack(Buf, allocated(InData%BathGrid_Xs)) if (allocated(InData%BathGrid_Xs)) then - call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs), ubound(InData%BathGrid_Xs)) + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs, kind=B8Ki), ubound(InData%BathGrid_Xs, kind=B8Ki)) call RegPack(Buf, InData%BathGrid_Xs) end if call RegPack(Buf, allocated(InData%BathGrid_Ys)) if (allocated(InData%BathGrid_Ys)) then - call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys), ubound(InData%BathGrid_Ys)) + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys, kind=B8Ki), ubound(InData%BathGrid_Ys, kind=B8Ki)) call RegPack(Buf, InData%BathGrid_Ys) end if call RegPack(Buf, allocated(InData%BathGrid_npoints)) if (allocated(InData%BathGrid_npoints)) then - call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints), ubound(InData%BathGrid_npoints)) + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints, kind=B8Ki), ubound(InData%BathGrid_npoints, kind=B8Ki)) call RegPack(Buf, InData%BathGrid_npoints) end if if (RegCheckErr(Buf, RoutineName)) return @@ -4674,8 +4674,8 @@ subroutine MD_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5071,8 +5071,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyParam' @@ -5091,8 +5091,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nFreeRods = SrcParamData%nFreeRods DstParamData%nFreePoints = SrcParamData%nFreePoints if (allocated(SrcParamData%nCpldBodies)) then - LB(1:1) = lbound(SrcParamData%nCpldBodies) - UB(1:1) = ubound(SrcParamData%nCpldBodies) + LB(1:1) = lbound(SrcParamData%nCpldBodies, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%nCpldBodies, kind=B8Ki) if (.not. allocated(DstParamData%nCpldBodies)) then allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5103,8 +5103,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nCpldBodies = SrcParamData%nCpldBodies end if if (allocated(SrcParamData%nCpldRods)) then - LB(1:1) = lbound(SrcParamData%nCpldRods) - UB(1:1) = ubound(SrcParamData%nCpldRods) + LB(1:1) = lbound(SrcParamData%nCpldRods, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%nCpldRods, kind=B8Ki) if (.not. allocated(DstParamData%nCpldRods)) then allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5115,8 +5115,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nCpldRods = SrcParamData%nCpldRods end if if (allocated(SrcParamData%nCpldPoints)) then - LB(1:1) = lbound(SrcParamData%nCpldPoints) - UB(1:1) = ubound(SrcParamData%nCpldPoints) + LB(1:1) = lbound(SrcParamData%nCpldPoints, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%nCpldPoints, kind=B8Ki) if (.not. allocated(DstParamData%nCpldPoints)) then allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5140,8 +5140,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dtOut = SrcParamData%dtOut DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5164,8 +5164,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Current = SrcParamData%Current DstParamData%nTurbines = SrcParamData%nTurbines if (allocated(SrcParamData%TurbineRefPos)) then - LB(1:2) = lbound(SrcParamData%TurbineRefPos) - UB(1:2) = ubound(SrcParamData%TurbineRefPos) + LB(1:2) = lbound(SrcParamData%TurbineRefPos, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TurbineRefPos, kind=B8Ki) if (.not. allocated(DstParamData%TurbineRefPos)) then allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5184,8 +5184,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nzWave = SrcParamData%nzWave DstParamData%ntWave = SrcParamData%ntWave if (allocated(SrcParamData%pxWave)) then - LB(1:1) = lbound(SrcParamData%pxWave) - UB(1:1) = ubound(SrcParamData%pxWave) + LB(1:1) = lbound(SrcParamData%pxWave, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pxWave, kind=B8Ki) if (.not. allocated(DstParamData%pxWave)) then allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5196,8 +5196,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%pxWave = SrcParamData%pxWave end if if (allocated(SrcParamData%pyWave)) then - LB(1:1) = lbound(SrcParamData%pyWave) - UB(1:1) = ubound(SrcParamData%pyWave) + LB(1:1) = lbound(SrcParamData%pyWave, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pyWave, kind=B8Ki) if (.not. allocated(DstParamData%pyWave)) then allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5208,8 +5208,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%pyWave = SrcParamData%pyWave end if if (allocated(SrcParamData%pzWave)) then - LB(1:1) = lbound(SrcParamData%pzWave) - UB(1:1) = ubound(SrcParamData%pzWave) + LB(1:1) = lbound(SrcParamData%pzWave, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pzWave, kind=B8Ki) if (.not. allocated(DstParamData%pzWave)) then allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5221,8 +5221,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%dtWave = SrcParamData%dtWave if (allocated(SrcParamData%uxWave)) then - LB(1:4) = lbound(SrcParamData%uxWave) - UB(1:4) = ubound(SrcParamData%uxWave) + LB(1:4) = lbound(SrcParamData%uxWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%uxWave, kind=B8Ki) if (.not. allocated(DstParamData%uxWave)) then allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5233,8 +5233,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uxWave = SrcParamData%uxWave end if if (allocated(SrcParamData%uyWave)) then - LB(1:4) = lbound(SrcParamData%uyWave) - UB(1:4) = ubound(SrcParamData%uyWave) + LB(1:4) = lbound(SrcParamData%uyWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%uyWave, kind=B8Ki) if (.not. allocated(DstParamData%uyWave)) then allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5245,8 +5245,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uyWave = SrcParamData%uyWave end if if (allocated(SrcParamData%uzWave)) then - LB(1:4) = lbound(SrcParamData%uzWave) - UB(1:4) = ubound(SrcParamData%uzWave) + LB(1:4) = lbound(SrcParamData%uzWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%uzWave, kind=B8Ki) if (.not. allocated(DstParamData%uzWave)) then allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5257,8 +5257,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uzWave = SrcParamData%uzWave end if if (allocated(SrcParamData%axWave)) then - LB(1:4) = lbound(SrcParamData%axWave) - UB(1:4) = ubound(SrcParamData%axWave) + LB(1:4) = lbound(SrcParamData%axWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%axWave, kind=B8Ki) if (.not. allocated(DstParamData%axWave)) then allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5269,8 +5269,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%axWave = SrcParamData%axWave end if if (allocated(SrcParamData%ayWave)) then - LB(1:4) = lbound(SrcParamData%ayWave) - UB(1:4) = ubound(SrcParamData%ayWave) + LB(1:4) = lbound(SrcParamData%ayWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%ayWave, kind=B8Ki) if (.not. allocated(DstParamData%ayWave)) then allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5281,8 +5281,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ayWave = SrcParamData%ayWave end if if (allocated(SrcParamData%azWave)) then - LB(1:4) = lbound(SrcParamData%azWave) - UB(1:4) = ubound(SrcParamData%azWave) + LB(1:4) = lbound(SrcParamData%azWave, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%azWave, kind=B8Ki) if (.not. allocated(DstParamData%azWave)) then allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5293,8 +5293,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%azWave = SrcParamData%azWave end if if (allocated(SrcParamData%PDyn)) then - LB(1:4) = lbound(SrcParamData%PDyn) - UB(1:4) = ubound(SrcParamData%PDyn) + LB(1:4) = lbound(SrcParamData%PDyn, kind=B8Ki) + UB(1:4) = ubound(SrcParamData%PDyn, kind=B8Ki) if (.not. allocated(DstParamData%PDyn)) then allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5305,8 +5305,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PDyn = SrcParamData%PDyn end if if (allocated(SrcParamData%zeta)) then - LB(1:3) = lbound(SrcParamData%zeta) - UB(1:3) = ubound(SrcParamData%zeta) + LB(1:3) = lbound(SrcParamData%zeta, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%zeta, kind=B8Ki) if (.not. allocated(DstParamData%zeta)) then allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5318,8 +5318,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%nzCurrent = SrcParamData%nzCurrent if (allocated(SrcParamData%pzCurrent)) then - LB(1:1) = lbound(SrcParamData%pzCurrent) - UB(1:1) = ubound(SrcParamData%pzCurrent) + LB(1:1) = lbound(SrcParamData%pzCurrent, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%pzCurrent, kind=B8Ki) if (.not. allocated(DstParamData%pzCurrent)) then allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5330,8 +5330,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%pzCurrent = SrcParamData%pzCurrent end if if (allocated(SrcParamData%uxCurrent)) then - LB(1:1) = lbound(SrcParamData%uxCurrent) - UB(1:1) = ubound(SrcParamData%uxCurrent) + LB(1:1) = lbound(SrcParamData%uxCurrent, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%uxCurrent, kind=B8Ki) if (.not. allocated(DstParamData%uxCurrent)) then allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5342,8 +5342,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uxCurrent = SrcParamData%uxCurrent end if if (allocated(SrcParamData%uyCurrent)) then - LB(1:1) = lbound(SrcParamData%uyCurrent) - UB(1:1) = ubound(SrcParamData%uyCurrent) + LB(1:1) = lbound(SrcParamData%uyCurrent, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%uyCurrent, kind=B8Ki) if (.not. allocated(DstParamData%uyCurrent)) then allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5355,8 +5355,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Nx0 = SrcParamData%Nx0 if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5367,8 +5367,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5379,8 +5379,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5393,8 +5393,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%Jac_nx = SrcParamData%Jac_nx if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then - LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) - UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5406,8 +5406,8 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%VisMeshes = SrcParamData%VisMeshes if (allocated(SrcParamData%VisRodsDiam)) then - LB(1:1) = lbound(SrcParamData%VisRodsDiam) - UB(1:1) = ubound(SrcParamData%VisRodsDiam) + LB(1:1) = lbound(SrcParamData%VisRodsDiam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%VisRodsDiam, kind=B8Ki) if (.not. allocated(DstParamData%VisRodsDiam)) then allocate(DstParamData%VisRodsDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5427,8 +5427,8 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) type(MD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyParam' @@ -5444,8 +5444,8 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%nCpldPoints) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5510,8 +5510,8 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%dxIdx_map2_xStateIdx) end if if (allocated(ParamData%VisRodsDiam)) then - LB(1:1) = lbound(ParamData%VisRodsDiam) - UB(1:1) = ubound(ParamData%VisRodsDiam) + LB(1:1) = lbound(ParamData%VisRodsDiam, kind=B8Ki) + UB(1:1) = ubound(ParamData%VisRodsDiam, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyVisDiam(ParamData%VisRodsDiam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5524,8 +5524,8 @@ subroutine MD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackParam' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nLineTypes) call RegPack(Buf, InData%nRodTypes) @@ -5541,17 +5541,17 @@ subroutine MD_PackParam(Buf, Indata) call RegPack(Buf, InData%nFreePoints) call RegPack(Buf, allocated(InData%nCpldBodies)) if (allocated(InData%nCpldBodies)) then - call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies), ubound(InData%nCpldBodies)) + call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies, kind=B8Ki), ubound(InData%nCpldBodies, kind=B8Ki)) call RegPack(Buf, InData%nCpldBodies) end if call RegPack(Buf, allocated(InData%nCpldRods)) if (allocated(InData%nCpldRods)) then - call RegPackBounds(Buf, 1, lbound(InData%nCpldRods), ubound(InData%nCpldRods)) + call RegPackBounds(Buf, 1, lbound(InData%nCpldRods, kind=B8Ki), ubound(InData%nCpldRods, kind=B8Ki)) call RegPack(Buf, InData%nCpldRods) end if call RegPack(Buf, allocated(InData%nCpldPoints)) if (allocated(InData%nCpldPoints)) then - call RegPackBounds(Buf, 1, lbound(InData%nCpldPoints), ubound(InData%nCpldPoints)) + call RegPackBounds(Buf, 1, lbound(InData%nCpldPoints, kind=B8Ki), ubound(InData%nCpldPoints, kind=B8Ki)) call RegPack(Buf, InData%nCpldPoints) end if call RegPack(Buf, InData%NConns) @@ -5569,9 +5569,9 @@ subroutine MD_PackParam(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -5586,7 +5586,7 @@ subroutine MD_PackParam(Buf, Indata) call RegPack(Buf, InData%nTurbines) call RegPack(Buf, allocated(InData%TurbineRefPos)) if (allocated(InData%TurbineRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) + call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos, kind=B8Ki), ubound(InData%TurbineRefPos, kind=B8Ki)) call RegPack(Buf, InData%TurbineRefPos) end if call RegPack(Buf, InData%mu_kT) @@ -5599,105 +5599,105 @@ subroutine MD_PackParam(Buf, Indata) call RegPack(Buf, InData%ntWave) call RegPack(Buf, allocated(InData%pxWave)) if (allocated(InData%pxWave)) then - call RegPackBounds(Buf, 1, lbound(InData%pxWave), ubound(InData%pxWave)) + call RegPackBounds(Buf, 1, lbound(InData%pxWave, kind=B8Ki), ubound(InData%pxWave, kind=B8Ki)) call RegPack(Buf, InData%pxWave) end if call RegPack(Buf, allocated(InData%pyWave)) if (allocated(InData%pyWave)) then - call RegPackBounds(Buf, 1, lbound(InData%pyWave), ubound(InData%pyWave)) + call RegPackBounds(Buf, 1, lbound(InData%pyWave, kind=B8Ki), ubound(InData%pyWave, kind=B8Ki)) call RegPack(Buf, InData%pyWave) end if call RegPack(Buf, allocated(InData%pzWave)) if (allocated(InData%pzWave)) then - call RegPackBounds(Buf, 1, lbound(InData%pzWave), ubound(InData%pzWave)) + call RegPackBounds(Buf, 1, lbound(InData%pzWave, kind=B8Ki), ubound(InData%pzWave, kind=B8Ki)) call RegPack(Buf, InData%pzWave) end if call RegPack(Buf, InData%dtWave) call RegPack(Buf, allocated(InData%uxWave)) if (allocated(InData%uxWave)) then - call RegPackBounds(Buf, 4, lbound(InData%uxWave), ubound(InData%uxWave)) + call RegPackBounds(Buf, 4, lbound(InData%uxWave, kind=B8Ki), ubound(InData%uxWave, kind=B8Ki)) call RegPack(Buf, InData%uxWave) end if call RegPack(Buf, allocated(InData%uyWave)) if (allocated(InData%uyWave)) then - call RegPackBounds(Buf, 4, lbound(InData%uyWave), ubound(InData%uyWave)) + call RegPackBounds(Buf, 4, lbound(InData%uyWave, kind=B8Ki), ubound(InData%uyWave, kind=B8Ki)) call RegPack(Buf, InData%uyWave) end if call RegPack(Buf, allocated(InData%uzWave)) if (allocated(InData%uzWave)) then - call RegPackBounds(Buf, 4, lbound(InData%uzWave), ubound(InData%uzWave)) + call RegPackBounds(Buf, 4, lbound(InData%uzWave, kind=B8Ki), ubound(InData%uzWave, kind=B8Ki)) call RegPack(Buf, InData%uzWave) end if call RegPack(Buf, allocated(InData%axWave)) if (allocated(InData%axWave)) then - call RegPackBounds(Buf, 4, lbound(InData%axWave), ubound(InData%axWave)) + call RegPackBounds(Buf, 4, lbound(InData%axWave, kind=B8Ki), ubound(InData%axWave, kind=B8Ki)) call RegPack(Buf, InData%axWave) end if call RegPack(Buf, allocated(InData%ayWave)) if (allocated(InData%ayWave)) then - call RegPackBounds(Buf, 4, lbound(InData%ayWave), ubound(InData%ayWave)) + call RegPackBounds(Buf, 4, lbound(InData%ayWave, kind=B8Ki), ubound(InData%ayWave, kind=B8Ki)) call RegPack(Buf, InData%ayWave) end if call RegPack(Buf, allocated(InData%azWave)) if (allocated(InData%azWave)) then - call RegPackBounds(Buf, 4, lbound(InData%azWave), ubound(InData%azWave)) + call RegPackBounds(Buf, 4, lbound(InData%azWave, kind=B8Ki), ubound(InData%azWave, kind=B8Ki)) call RegPack(Buf, InData%azWave) end if call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 4, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPackBounds(Buf, 4, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) call RegPack(Buf, InData%PDyn) end if call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then - call RegPackBounds(Buf, 3, lbound(InData%zeta), ubound(InData%zeta)) + call RegPackBounds(Buf, 3, lbound(InData%zeta, kind=B8Ki), ubound(InData%zeta, kind=B8Ki)) call RegPack(Buf, InData%zeta) end if call RegPack(Buf, InData%nzCurrent) call RegPack(Buf, allocated(InData%pzCurrent)) if (allocated(InData%pzCurrent)) then - call RegPackBounds(Buf, 1, lbound(InData%pzCurrent), ubound(InData%pzCurrent)) + call RegPackBounds(Buf, 1, lbound(InData%pzCurrent, kind=B8Ki), ubound(InData%pzCurrent, kind=B8Ki)) call RegPack(Buf, InData%pzCurrent) end if call RegPack(Buf, allocated(InData%uxCurrent)) if (allocated(InData%uxCurrent)) then - call RegPackBounds(Buf, 1, lbound(InData%uxCurrent), ubound(InData%uxCurrent)) + call RegPackBounds(Buf, 1, lbound(InData%uxCurrent, kind=B8Ki), ubound(InData%uxCurrent, kind=B8Ki)) call RegPack(Buf, InData%uxCurrent) end if call RegPack(Buf, allocated(InData%uyCurrent)) if (allocated(InData%uyCurrent)) then - call RegPackBounds(Buf, 1, lbound(InData%uyCurrent), ubound(InData%uyCurrent)) + call RegPackBounds(Buf, 1, lbound(InData%uyCurrent, kind=B8Ki), ubound(InData%uyCurrent, kind=B8Ki)) call RegPack(Buf, InData%uyCurrent) end if call RegPack(Buf, InData%Nx0) call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) call RegPack(Buf, InData%dx) end if call RegPack(Buf, InData%Jac_ny) call RegPack(Buf, InData%Jac_nx) call RegPack(Buf, allocated(InData%dxIdx_map2_xStateIdx)) if (allocated(InData%dxIdx_map2_xStateIdx)) then - call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx), ubound(InData%dxIdx_map2_xStateIdx)) + call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx, kind=B8Ki), ubound(InData%dxIdx_map2_xStateIdx, kind=B8Ki)) call RegPack(Buf, InData%dxIdx_map2_xStateIdx) end if call RegPack(Buf, InData%VisMeshes) call RegPack(Buf, allocated(InData%VisRodsDiam)) if (allocated(InData%VisRodsDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%VisRodsDiam), ubound(InData%VisRodsDiam)) - LB(1:1) = lbound(InData%VisRodsDiam) - UB(1:1) = ubound(InData%VisRodsDiam) + call RegPackBounds(Buf, 1, lbound(InData%VisRodsDiam, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) + LB(1:1) = lbound(InData%VisRodsDiam, kind=B8Ki) + UB(1:1) = ubound(InData%VisRodsDiam, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackVisDiam(Buf, InData%VisRodsDiam(i1)) end do @@ -5709,8 +5709,8 @@ subroutine MD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackParam' - integer(IntKi) :: i1, i2, i3, i4 - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: i1, i2, i3, i4 + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6154,16 +6154,16 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%CoupledKinematics)) then - LB(1:1) = lbound(SrcInputData%CoupledKinematics) - UB(1:1) = ubound(SrcInputData%CoupledKinematics) + LB(1:1) = lbound(SrcInputData%CoupledKinematics, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%CoupledKinematics, kind=B8Ki) if (.not. allocated(DstInputData%CoupledKinematics)) then allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6178,8 +6178,8 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%DeltaL)) then - LB(1:1) = lbound(SrcInputData%DeltaL) - UB(1:1) = ubound(SrcInputData%DeltaL) + LB(1:1) = lbound(SrcInputData%DeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%DeltaL, kind=B8Ki) if (.not. allocated(DstInputData%DeltaL)) then allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6190,8 +6190,8 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%DeltaL = SrcInputData%DeltaL end if if (allocated(SrcInputData%DeltaLdot)) then - LB(1:1) = lbound(SrcInputData%DeltaLdot) - UB(1:1) = ubound(SrcInputData%DeltaLdot) + LB(1:1) = lbound(SrcInputData%DeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%DeltaLdot, kind=B8Ki) if (.not. allocated(DstInputData%DeltaLdot)) then allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6207,16 +6207,16 @@ subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) type(MD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%CoupledKinematics)) then - LB(1:1) = lbound(InputData%CoupledKinematics) - UB(1:1) = ubound(InputData%CoupledKinematics) + LB(1:1) = lbound(InputData%CoupledKinematics, kind=B8Ki) + UB(1:1) = ubound(InputData%CoupledKinematics, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6235,26 +6235,26 @@ subroutine MD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%CoupledKinematics)) if (allocated(InData%CoupledKinematics)) then - call RegPackBounds(Buf, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) - LB(1:1) = lbound(InData%CoupledKinematics) - UB(1:1) = ubound(InData%CoupledKinematics) + call RegPackBounds(Buf, 1, lbound(InData%CoupledKinematics, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) + LB(1:1) = lbound(InData%CoupledKinematics, kind=B8Ki) + UB(1:1) = ubound(InData%CoupledKinematics, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%CoupledKinematics(i1)) end do end if call RegPack(Buf, allocated(InData%DeltaL)) if (allocated(InData%DeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%DeltaL), ubound(InData%DeltaL)) + call RegPackBounds(Buf, 1, lbound(InData%DeltaL, kind=B8Ki), ubound(InData%DeltaL, kind=B8Ki)) call RegPack(Buf, InData%DeltaL) end if call RegPack(Buf, allocated(InData%DeltaLdot)) if (allocated(InData%DeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot), ubound(InData%DeltaLdot)) + call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot, kind=B8Ki), ubound(InData%DeltaLdot, kind=B8Ki)) call RegPack(Buf, InData%DeltaLdot) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6264,8 +6264,8 @@ subroutine MD_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6320,16 +6320,16 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%CoupledLoads)) then - LB(1:1) = lbound(SrcOutputData%CoupledLoads) - UB(1:1) = ubound(SrcOutputData%CoupledLoads) + LB(1:1) = lbound(SrcOutputData%CoupledLoads, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%CoupledLoads, kind=B8Ki) if (.not. allocated(DstOutputData%CoupledLoads)) then allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6344,8 +6344,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6356,8 +6356,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%VisLinesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisLinesMesh) - UB(1:1) = ubound(SrcOutputData%VisLinesMesh) + LB(1:1) = lbound(SrcOutputData%VisLinesMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisLinesMesh, kind=B8Ki) if (.not. allocated(DstOutputData%VisLinesMesh)) then allocate(DstOutputData%VisLinesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6372,8 +6372,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%VisRodsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisRodsMesh) - UB(1:1) = ubound(SrcOutputData%VisRodsMesh) + LB(1:1) = lbound(SrcOutputData%VisRodsMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisRodsMesh, kind=B8Ki) if (.not. allocated(DstOutputData%VisRodsMesh)) then allocate(DstOutputData%VisRodsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6388,8 +6388,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%VisBodiesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisBodiesMesh) - UB(1:1) = ubound(SrcOutputData%VisBodiesMesh) + LB(1:1) = lbound(SrcOutputData%VisBodiesMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisBodiesMesh, kind=B8Ki) if (.not. allocated(DstOutputData%VisBodiesMesh)) then allocate(DstOutputData%VisBodiesMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6404,8 +6404,8 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcOutputData%VisAnchsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisAnchsMesh) - UB(1:1) = ubound(SrcOutputData%VisAnchsMesh) + LB(1:1) = lbound(SrcOutputData%VisAnchsMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%VisAnchsMesh, kind=B8Ki) if (.not. allocated(DstOutputData%VisAnchsMesh)) then allocate(DstOutputData%VisAnchsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6425,16 +6425,16 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) type(MD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%CoupledLoads)) then - LB(1:1) = lbound(OutputData%CoupledLoads) - UB(1:1) = ubound(OutputData%CoupledLoads) + LB(1:1) = lbound(OutputData%CoupledLoads, kind=B8Ki) + UB(1:1) = ubound(OutputData%CoupledLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6445,8 +6445,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%WriteOutput) end if if (allocated(OutputData%VisLinesMesh)) then - LB(1:1) = lbound(OutputData%VisLinesMesh) - UB(1:1) = ubound(OutputData%VisLinesMesh) + LB(1:1) = lbound(OutputData%VisLinesMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisLinesMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisLinesMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6454,8 +6454,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%VisLinesMesh) end if if (allocated(OutputData%VisRodsMesh)) then - LB(1:1) = lbound(OutputData%VisRodsMesh) - UB(1:1) = ubound(OutputData%VisRodsMesh) + LB(1:1) = lbound(OutputData%VisRodsMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisRodsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisRodsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6463,8 +6463,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%VisRodsMesh) end if if (allocated(OutputData%VisBodiesMesh)) then - LB(1:1) = lbound(OutputData%VisBodiesMesh) - UB(1:1) = ubound(OutputData%VisBodiesMesh) + LB(1:1) = lbound(OutputData%VisBodiesMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisBodiesMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisBodiesMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6472,8 +6472,8 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%VisBodiesMesh) end if if (allocated(OutputData%VisAnchsMesh)) then - LB(1:1) = lbound(OutputData%VisAnchsMesh) - UB(1:1) = ubound(OutputData%VisAnchsMesh) + LB(1:1) = lbound(OutputData%VisAnchsMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%VisAnchsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%VisAnchsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6486,55 +6486,55 @@ subroutine MD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%CoupledLoads)) if (allocated(InData%CoupledLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) - LB(1:1) = lbound(InData%CoupledLoads) - UB(1:1) = ubound(InData%CoupledLoads) + call RegPackBounds(Buf, 1, lbound(InData%CoupledLoads, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%CoupledLoads, kind=B8Ki) + UB(1:1) = ubound(InData%CoupledLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%CoupledLoads(i1)) end do end if call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, allocated(InData%VisLinesMesh)) if (allocated(InData%VisLinesMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisLinesMesh), ubound(InData%VisLinesMesh)) - LB(1:1) = lbound(InData%VisLinesMesh) - UB(1:1) = ubound(InData%VisLinesMesh) + call RegPackBounds(Buf, 1, lbound(InData%VisLinesMesh, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisLinesMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisLinesMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%VisLinesMesh(i1)) end do end if call RegPack(Buf, allocated(InData%VisRodsMesh)) if (allocated(InData%VisRodsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisRodsMesh), ubound(InData%VisRodsMesh)) - LB(1:1) = lbound(InData%VisRodsMesh) - UB(1:1) = ubound(InData%VisRodsMesh) + call RegPackBounds(Buf, 1, lbound(InData%VisRodsMesh, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisRodsMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisRodsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%VisRodsMesh(i1)) end do end if call RegPack(Buf, allocated(InData%VisBodiesMesh)) if (allocated(InData%VisBodiesMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisBodiesMesh), ubound(InData%VisBodiesMesh)) - LB(1:1) = lbound(InData%VisBodiesMesh) - UB(1:1) = ubound(InData%VisBodiesMesh) + call RegPackBounds(Buf, 1, lbound(InData%VisBodiesMesh, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisBodiesMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisBodiesMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%VisBodiesMesh(i1)) end do end if call RegPack(Buf, allocated(InData%VisAnchsMesh)) if (allocated(InData%VisAnchsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisAnchsMesh), ubound(InData%VisAnchsMesh)) - LB(1:1) = lbound(InData%VisAnchsMesh) - UB(1:1) = ubound(InData%VisAnchsMesh) + call RegPackBounds(Buf, 1, lbound(InData%VisAnchsMesh, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%VisAnchsMesh, kind=B8Ki) + UB(1:1) = ubound(InData%VisAnchsMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%VisAnchsMesh(i1)) end do @@ -6546,8 +6546,8 @@ subroutine MD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOutput' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6740,7 +6740,7 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + DO i1 = LBOUND(u_out%CoupledKinematics,1, kind=B8Ki),UBOUND(u_out%CoupledKinematics,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6809,7 +6809,7 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + DO i1 = LBOUND(u_out%CoupledKinematics,1, kind=B8Ki),UBOUND(u_out%CoupledKinematics,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6920,7 +6920,7 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + DO i1 = LBOUND(y_out%CoupledLoads,1, kind=B8Ki),UBOUND(y_out%CoupledLoads,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6929,25 +6929,25 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1),UBOUND(y_out%VisLinesMesh,1) + DO i1 = LBOUND(y_out%VisLinesMesh,1, kind=B8Ki),UBOUND(y_out%VisLinesMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1),UBOUND(y_out%VisRodsMesh,1) + DO i1 = LBOUND(y_out%VisRodsMesh,1, kind=B8Ki),UBOUND(y_out%VisRodsMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1),UBOUND(y_out%VisBodiesMesh,1) + DO i1 = LBOUND(y_out%VisBodiesMesh,1, kind=B8Ki),UBOUND(y_out%VisBodiesMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1),UBOUND(y_out%VisAnchsMesh,1) + DO i1 = LBOUND(y_out%VisAnchsMesh,1, kind=B8Ki),UBOUND(y_out%VisAnchsMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7010,7 +7010,7 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + DO i1 = LBOUND(y_out%CoupledLoads,1, kind=B8Ki),UBOUND(y_out%CoupledLoads,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7019,25 +7019,25 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1),UBOUND(y_out%VisLinesMesh,1) + DO i1 = LBOUND(y_out%VisLinesMesh,1, kind=B8Ki),UBOUND(y_out%VisLinesMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), y3%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1),UBOUND(y_out%VisRodsMesh,1) + DO i1 = LBOUND(y_out%VisRodsMesh,1, kind=B8Ki),UBOUND(y_out%VisRodsMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), y3%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1),UBOUND(y_out%VisBodiesMesh,1) + DO i1 = LBOUND(y_out%VisBodiesMesh,1, kind=B8Ki),UBOUND(y_out%VisBodiesMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), y3%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1),UBOUND(y_out%VisAnchsMesh,1) + DO i1 = LBOUND(y_out%VisAnchsMesh,1, kind=B8Ki),UBOUND(y_out%VisAnchsMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), y3%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index fab4131327..998bb11ec9 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -14,8 +14,19 @@ # limitations under the License. # +# if (GENERATE_TYPES) +# generate_f90_types(src/Registry_NWTC_Library_typedef_nomesh.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) +# endif() + if (GENERATE_TYPES) - generate_f90_types(src/Registry_NWTC_Library_typedef_nomesh.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) + # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt + set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS + src/Registry_NWTC_Library_mesh.txt + src/Registry_NWTC_Library_base.txt) # if these files change, rerun configure + file(READ src/Registry_NWTC_Library_base.txt BASE_CONTENTS) + file(READ src/Registry_NWTC_Library_mesh.txt MESH_CONTENTS) + file(WRITE src/Registry_NWTC_Library.txt "${BASE_CONTENTS}\n${MESH_CONTENTS}") + generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) endif() #------------------------------------------------------------------------------- diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py index 82ee7d3feb..4af818cc1c 100644 --- a/modules/nwtc-library/ModRegGen.py +++ b/modules/nwtc-library/ModRegGen.py @@ -7,6 +7,7 @@ 'C1': 'character(*)', 'L1': 'logical', 'I4': 'integer(B4Ki)', + 'I8': 'integer(B8Ki)', 'R4': 'real(R4Ki)', 'R8': 'real(R8Ki)', } @@ -20,15 +21,15 @@ private public :: PackBuffer - public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, RegCheckErr + public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, DestroyPackBuffer, RegCheckErr public :: RegPack, RegPackBounds, RegPackPointer public :: RegUnpack, RegUnpackBounds, RegUnpackPointer type :: PackBuffer integer(B1Ki), allocatable :: Bytes(:) - integer(IntKi) :: NB + integer(B8Ki) :: NB type(c_ptr), allocatable :: Pointers(:) - integer(IntKi) :: NP + integer(B8Ki) :: NP integer(IntKi) :: ErrStat = ErrID_Fatal character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' end type @@ -42,8 +43,8 @@ character(ErrMsgLen), intent(out) :: ErrMsg character(*), parameter :: RoutineName = "InitPackBuffer" - integer(IntKi), parameter :: NumPointersInit = 128 - integer(IntKi), parameter :: NumBytesInit = 1024 + integer(B8Ki), parameter :: NumPointersInit = 128 + integer(B8Ki), parameter :: NumBytesInit = 1024 integer(IntKi) :: stat ErrStat = ErrID_None @@ -79,6 +80,25 @@ end subroutine + subroutine DestroyPackBuffer(Buf, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "DestroyPackBuffer" + + ErrStat = ErrID_None + ErrMsg = "" + + Buf%ErrStat = ErrID_None + Buf%ErrMsg = "" + Buf%NP = 0 + Buf%NB = 0 + + if (allocated(Buf%Pointers)) deallocate (Buf%Pointers) + if (allocated(Buf%Bytes )) deallocate (Buf%Bytes) + end subroutine + subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) type(PackBuffer), intent(inout) :: Buf integer(IntKi), intent(in) :: Unit @@ -205,8 +225,8 @@ logical, intent(out) :: Found type(c_ptr), allocatable :: PointersTmp(:) - integer(IntKi) :: NewSize - integer(B4Ki) :: i + integer(B8Ki) :: NewSize + integer(B8Ki) :: i ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -225,7 +245,7 @@ ! If pointer index is full, grow pointer index if (Buf%NP == size(Buf%Pointers)) then - NewSize = int(1.5_R4Ki * real(Buf%NP, R4Ki), IntKi) + NewSize = int(1.5_R8Ki * real(Buf%NP, R8Ki), B8Ki) call move_alloc(Buf%Pointers, PointersTmp) allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) if (Buf%ErrStat /= ErrID_None) then @@ -249,7 +269,7 @@ subroutine RegUnpackPointer(Buf, Ptr, Idx) type(PackBuffer), intent(inout) :: Buf type(c_ptr), intent(out) :: Ptr - integer(B4Ki), intent(out) :: Idx + integer(B8Ki), intent(out) :: Idx ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -264,7 +284,8 @@ subroutine RegPackBounds(Buf, R, LB, UB) type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: R, LB(:), UB(:) + integer(B4Ki), intent(in) :: R + integer(B8Ki), intent(in) :: LB(:), UB(:) ! If buffer has an error, return if (Buf%ErrStat /= ErrID_None) return @@ -278,7 +299,7 @@ subroutine RegUnpackBounds(Buf, R, LB, UB) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: R - integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(B8Ki), intent(out) :: LB(:), UB(:) ! If buffer has an error, return if (Buf%ErrStat /= ErrID_None) return @@ -291,10 +312,10 @@ subroutine GrowBuffer(Buf, N) type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: N + integer(B8Ki), intent(in) :: N integer(B1Ki), allocatable :: BytesTmp(:) - integer(B4Ki) :: NewSize + integer(B8Ki) :: NewSize integer(IntKi) :: stat ! Return if there is a buffer error @@ -304,7 +325,7 @@ if (size(Buf%Bytes) > Buf%NB + N) return ! Calculate new size - NewSize = int(real(Buf%NB + N, R4Ki) * 1.8_R4Ki, IntKi) + NewSize = int(real(Buf%NB + N, R8Ki) * 1.8_R8Ki, B8Ki) ! Move allocation to temporary array and allocate buffer with new size call move_alloc(Buf%Bytes, BytesTmp) @@ -329,7 +350,7 @@ def gen_pack(w, dt, decl, rank): w.write(f'\n\n subroutine {name}(Buf, Data)') w.write(f'\n type(PackBuffer), intent(inout) :: Buf') w.write(f'\n {decl+", intent(in)":<38s} :: Data{dims}') - w.write(f'\n integer(IntKi) :: DataSize') + w.write(f'\n integer(B8Ki) :: DataSize') w.write(f'\n') w.write(f'\n ! If buffer error, return') w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') @@ -368,7 +389,7 @@ def gen_unpack(w, dt, decl, rank): w.write(f'\n subroutine {name}(Buf, Data)') w.write(f'\n type(PackBuffer), intent(inout) :: Buf') w.write(f'\n {decl+", intent(out)":<38s} :: Data{dims}') - w.write(f'\n integer(IntKi) :: DataSize') + w.write(f'\n integer(B8Ki) :: DataSize') w.write(f'\n') w.write(f'\n ! If buffer error, return') w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') @@ -424,7 +445,7 @@ def gen_pack_alloc(w, dt, decl, rank): w.write(f'\n') if rank > 0: w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') w.write(f'\n') w.write(f'\n ! Write data to buffer') w.write(f'\n call RegPack(Buf, Data)') @@ -444,7 +465,7 @@ def gen_unpack_alloc(w, dt, decl, rank): w.write(f'\n integer(IntKi) :: stat') w.write(f'\n logical :: IsAllocated') if rank > 0: - w.write(f'\n integer(IntKi) :: LB({rank}), UB({rank})') + w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') w.write(f'\n') w.write(f'\n ! If buffer error, return') w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') @@ -499,7 +520,7 @@ def gen_pack_ptr(w, dt, decl, rank): if rank > 0: w.write(f'\n') w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') w.write(f'\n') w.write(f'\n ! Write pointer info') w.write(f'\n call RegPackPointer(Buf, c_loc(Data), PtrInIndex)') @@ -520,11 +541,11 @@ def gen_unpack_ptr(w, dt, decl, rank): w.write(f'\n subroutine {name}(Buf, Data)') w.write(f'\n type(PackBuffer), intent(inout) :: Buf') w.write(f'\n {decl+", pointer, intent(out)":<38s} :: Data{dims}') - w.write(f'\n integer(IntKi) :: PtrIdx, stat') + w.write(f'\n integer(B8Ki) :: PtrIdx, stat') w.write(f'\n logical :: IsAssociated') w.write(f'\n type(c_ptr) :: Ptr') if rank > 0: - w.write(f'\n integer(IntKi) :: LB({rank}), UB({rank})') + w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') w.write(f'\n') w.write(f'\n ! If buffer error, return') w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') @@ -594,10 +615,4 @@ def gen_unpack_ptr(w, dt, decl, rank): gen_pack(w, dt, decl, rank) gen_unpack(w, dt, decl, rank) - # gen_pack_alloc(w, dt, decl, rank) - # gen_unpack_alloc(w, dt, decl, rank) - - # gen_pack_ptr(w, dt, decl, rank) - # gen_unpack_ptr(w, dt, decl, rank) - w.write('\nend module') diff --git a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat index d6c0ef77f4..020b426a71 100644 --- a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat +++ b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat @@ -13,11 +13,11 @@ REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- ECHO on :mesh -%REGISTRY% Registry_NWTC_Library_typedef_mesh.txt -noextrap +%REGISTRY% Registry_NWTC_Library_mesh.txt -noextrap goto end :nomesh -%REGISTRY% Registry_NWTC_Library_typedef_nomesh.txt -noextrap +%REGISTRY% Registry_NWTC_Library_base.txt -noextrap :end diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index d2e08297bd..440c8e193a 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -5769,58 +5769,39 @@ END SUBROUTINE WriteMappingTransferToFile ! ! FAST Registry !********************************************************************************************************************************* -SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MapType), INTENT(IN) :: SrcMapTypeData - TYPE(MapType), INTENT(INOUT) :: DstMapTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyMapType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMapTypeData%OtherMesh_Element = SrcMapTypeData%OtherMesh_Element - DstMapTypeData%distance = SrcMapTypeData%distance - DstMapTypeData%couple_arm = SrcMapTypeData%couple_arm - DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn - END SUBROUTINE NWTC_Library_CopyMapType - - SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg ) - TYPE(MapType), INTENT(INOUT) :: MapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMapType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE NWTC_Library_DestroyMapType +subroutine NWTC_Library_CopyMapType(SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(MapType), intent(in) :: SrcMapTypeData + type(MapType), intent(inout) :: DstMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstMapTypeData%OtherMesh_Element = SrcMapTypeData%OtherMesh_Element + DstMapTypeData%distance = SrcMapTypeData%distance + DstMapTypeData%couple_arm = SrcMapTypeData%couple_arm + DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn +end subroutine +subroutine NWTC_Library_DestroyMapType(MapTypeData, ErrStat, ErrMsg) + type(MapType), intent(inout) :: MapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMapType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine NWTC_Library_PackMapType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MapType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackMapType' if (Buf%ErrStat >= AbortErrLev) return - ! OtherMesh_Element call RegPack(Buf, InData%OtherMesh_Element) - if (RegCheckErr(Buf, RoutineName)) return - ! distance call RegPack(Buf, InData%distance) - if (RegCheckErr(Buf, RoutineName)) return - ! couple_arm call RegPack(Buf, InData%couple_arm) - if (RegCheckErr(Buf, RoutineName)) return - ! shape_fn call RegPack(Buf, InData%shape_fn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5830,319 +5811,261 @@ subroutine NWTC_Library_UnPackMapType(Buf, OutData) type(MapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMapType' if (Buf%ErrStat /= ErrID_None) return - ! OtherMesh_Element call RegUnpack(Buf, OutData%OtherMesh_Element) if (RegCheckErr(Buf, RoutineName)) return - ! distance call RegUnpack(Buf, OutData%distance) if (RegCheckErr(Buf, RoutineName)) return - ! couple_arm call RegUnpack(Buf, OutData%couple_arm) if (RegCheckErr(Buf, RoutineName)) return - ! shape_fn call RegUnpack(Buf, OutData%shape_fn) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshMapLinearizationType), INTENT(IN) :: SrcMeshMapLinearizationTypeData - TYPE(MeshMapLinearizationType), INTENT(INOUT) :: DstMeshMapLinearizationTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' -! + +subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshMapLinearizationType), intent(in) :: SrcMeshMapLinearizationTypeData + type(MeshMapLinearizationType), intent(inout) :: DstMeshMapLinearizationTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%mi)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%mi,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%mi,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%mi,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%mi,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%mi)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%mi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%fx_p)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%fx_p,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%fx_p,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%fx_p,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%fx_p,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%fx_p)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%fx_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%fx_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%tv_uD)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uD,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uD,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uD,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uD,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%tv_uD)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%tv_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%tv_uS)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uS,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uS,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%tv_uS,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%tv_uS,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%tv_uS)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%tv_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%ta_uD)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uD,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uD,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uD,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uD,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%ta_uD)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%ta_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%ta_uS)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uS,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uS,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_uS,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_uS,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%ta_uS)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%ta_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%ta_rv)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_rv,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_rv,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%ta_rv,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%ta_rv,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%ta_rv)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%ta_rv(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_rv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%li)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%li,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%li,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%li,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%li,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%li)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%li(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%M_uS)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uS,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uS,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uS,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uS,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%M_uS)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%M_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%M_uD)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uD,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uD,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%M_uD,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%M_uD,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%M_uD)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%M_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD -ENDIF -IF (ALLOCATED(SrcMeshMapLinearizationTypeData%M_f)) THEN - i1_l = LBOUND(SrcMeshMapLinearizationTypeData%M_f,1) - i1_u = UBOUND(SrcMeshMapLinearizationTypeData%M_f,1) - i2_l = LBOUND(SrcMeshMapLinearizationTypeData%M_f,2) - i2_u = UBOUND(SrcMeshMapLinearizationTypeData%M_f,2) - IF (.NOT. ALLOCATED(DstMeshMapLinearizationTypeData%M_f)) THEN - ALLOCATE(DstMeshMapLinearizationTypeData%M_f(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_f.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapLinearizationTypeData%M_f = SrcMeshMapLinearizationTypeData%M_f -ENDIF - END SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType - - SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg ) - TYPE(MeshMapLinearizationType), INTENT(INOUT) :: MeshMapLinearizationTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MeshMapLinearizationTypeData%mi)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%mi) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%fx_p)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%fx_p) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%tv_uD)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%tv_uD) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%tv_uS)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%tv_uS) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%ta_uD)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%ta_uD) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%ta_uS)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%ta_uS) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%ta_rv)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%ta_rv) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%li)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%li) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%M_uS)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%M_uS) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%M_uD)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%M_uD) -ENDIF -IF (ALLOCATED(MeshMapLinearizationTypeData%M_f)) THEN - DEALLOCATE(MeshMapLinearizationTypeData%M_f) -ENDIF - END SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType + ErrMsg = '' + if (allocated(SrcMeshMapLinearizationTypeData%mi)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%mi)) then + allocate(DstMeshMapLinearizationTypeData%mi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%mi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi + end if + if (allocated(SrcMeshMapLinearizationTypeData%fx_p)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%fx_p)) then + allocate(DstMeshMapLinearizationTypeData%fx_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%fx_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p + end if + if (allocated(SrcMeshMapLinearizationTypeData%tv_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uD)) then + allocate(DstMeshMapLinearizationTypeData%tv_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%tv_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uS)) then + allocate(DstMeshMapLinearizationTypeData%tv_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uD)) then + allocate(DstMeshMapLinearizationTypeData%ta_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uS)) then + allocate(DstMeshMapLinearizationTypeData%ta_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_rv)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_rv)) then + allocate(DstMeshMapLinearizationTypeData%ta_rv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_rv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv + end if + if (allocated(SrcMeshMapLinearizationTypeData%li)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%li)) then + allocate(DstMeshMapLinearizationTypeData%li(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%li.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_uS)) then + allocate(DstMeshMapLinearizationTypeData%M_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_uD)) then + allocate(DstMeshMapLinearizationTypeData%M_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_f)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_f)) then + allocate(DstMeshMapLinearizationTypeData%M_f(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_f.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_f = SrcMeshMapLinearizationTypeData%M_f + end if +end subroutine +subroutine NWTC_Library_DestroyMeshMapLinearizationType(MeshMapLinearizationTypeData, ErrStat, ErrMsg) + type(MeshMapLinearizationType), intent(inout) :: MeshMapLinearizationTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshMapLinearizationTypeData%mi)) then + deallocate(MeshMapLinearizationTypeData%mi) + end if + if (allocated(MeshMapLinearizationTypeData%fx_p)) then + deallocate(MeshMapLinearizationTypeData%fx_p) + end if + if (allocated(MeshMapLinearizationTypeData%tv_uD)) then + deallocate(MeshMapLinearizationTypeData%tv_uD) + end if + if (allocated(MeshMapLinearizationTypeData%tv_uS)) then + deallocate(MeshMapLinearizationTypeData%tv_uS) + end if + if (allocated(MeshMapLinearizationTypeData%ta_uD)) then + deallocate(MeshMapLinearizationTypeData%ta_uD) + end if + if (allocated(MeshMapLinearizationTypeData%ta_uS)) then + deallocate(MeshMapLinearizationTypeData%ta_uS) + end if + if (allocated(MeshMapLinearizationTypeData%ta_rv)) then + deallocate(MeshMapLinearizationTypeData%ta_rv) + end if + if (allocated(MeshMapLinearizationTypeData%li)) then + deallocate(MeshMapLinearizationTypeData%li) + end if + if (allocated(MeshMapLinearizationTypeData%M_uS)) then + deallocate(MeshMapLinearizationTypeData%M_uS) + end if + if (allocated(MeshMapLinearizationTypeData%M_uD)) then + deallocate(MeshMapLinearizationTypeData%M_uD) + end if + if (allocated(MeshMapLinearizationTypeData%M_f)) then + deallocate(MeshMapLinearizationTypeData%M_f) + end if +end subroutine subroutine NWTC_Library_PackMeshMapLinearizationType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MeshMapLinearizationType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' if (Buf%ErrStat >= AbortErrLev) return - ! mi call RegPack(Buf, allocated(InData%mi)) if (allocated(InData%mi)) then - call RegPackBounds(Buf, 2, lbound(InData%mi), ubound(InData%mi)) + call RegPackBounds(Buf, 2, lbound(InData%mi, kind=B8Ki), ubound(InData%mi, kind=B8Ki)) call RegPack(Buf, InData%mi) end if - if (RegCheckErr(Buf, RoutineName)) return - ! fx_p call RegPack(Buf, allocated(InData%fx_p)) if (allocated(InData%fx_p)) then - call RegPackBounds(Buf, 2, lbound(InData%fx_p), ubound(InData%fx_p)) + call RegPackBounds(Buf, 2, lbound(InData%fx_p, kind=B8Ki), ubound(InData%fx_p, kind=B8Ki)) call RegPack(Buf, InData%fx_p) end if - if (RegCheckErr(Buf, RoutineName)) return - ! tv_uD call RegPack(Buf, allocated(InData%tv_uD)) if (allocated(InData%tv_uD)) then - call RegPackBounds(Buf, 2, lbound(InData%tv_uD), ubound(InData%tv_uD)) + call RegPackBounds(Buf, 2, lbound(InData%tv_uD, kind=B8Ki), ubound(InData%tv_uD, kind=B8Ki)) call RegPack(Buf, InData%tv_uD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! tv_uS call RegPack(Buf, allocated(InData%tv_uS)) if (allocated(InData%tv_uS)) then - call RegPackBounds(Buf, 2, lbound(InData%tv_uS), ubound(InData%tv_uS)) + call RegPackBounds(Buf, 2, lbound(InData%tv_uS, kind=B8Ki), ubound(InData%tv_uS, kind=B8Ki)) call RegPack(Buf, InData%tv_uS) end if - if (RegCheckErr(Buf, RoutineName)) return - ! ta_uD call RegPack(Buf, allocated(InData%ta_uD)) if (allocated(InData%ta_uD)) then - call RegPackBounds(Buf, 2, lbound(InData%ta_uD), ubound(InData%ta_uD)) + call RegPackBounds(Buf, 2, lbound(InData%ta_uD, kind=B8Ki), ubound(InData%ta_uD, kind=B8Ki)) call RegPack(Buf, InData%ta_uD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! ta_uS call RegPack(Buf, allocated(InData%ta_uS)) if (allocated(InData%ta_uS)) then - call RegPackBounds(Buf, 2, lbound(InData%ta_uS), ubound(InData%ta_uS)) + call RegPackBounds(Buf, 2, lbound(InData%ta_uS, kind=B8Ki), ubound(InData%ta_uS, kind=B8Ki)) call RegPack(Buf, InData%ta_uS) end if - if (RegCheckErr(Buf, RoutineName)) return - ! ta_rv call RegPack(Buf, allocated(InData%ta_rv)) if (allocated(InData%ta_rv)) then - call RegPackBounds(Buf, 2, lbound(InData%ta_rv), ubound(InData%ta_rv)) + call RegPackBounds(Buf, 2, lbound(InData%ta_rv, kind=B8Ki), ubound(InData%ta_rv, kind=B8Ki)) call RegPack(Buf, InData%ta_rv) end if - if (RegCheckErr(Buf, RoutineName)) return - ! li call RegPack(Buf, allocated(InData%li)) if (allocated(InData%li)) then - call RegPackBounds(Buf, 2, lbound(InData%li), ubound(InData%li)) + call RegPackBounds(Buf, 2, lbound(InData%li, kind=B8Ki), ubound(InData%li, kind=B8Ki)) call RegPack(Buf, InData%li) end if - if (RegCheckErr(Buf, RoutineName)) return - ! M_uS call RegPack(Buf, allocated(InData%M_uS)) if (allocated(InData%M_uS)) then - call RegPackBounds(Buf, 2, lbound(InData%M_uS), ubound(InData%M_uS)) + call RegPackBounds(Buf, 2, lbound(InData%M_uS, kind=B8Ki), ubound(InData%M_uS, kind=B8Ki)) call RegPack(Buf, InData%M_uS) end if - if (RegCheckErr(Buf, RoutineName)) return - ! M_uD call RegPack(Buf, allocated(InData%M_uD)) if (allocated(InData%M_uD)) then - call RegPackBounds(Buf, 2, lbound(InData%M_uD), ubound(InData%M_uD)) + call RegPackBounds(Buf, 2, lbound(InData%M_uD, kind=B8Ki), ubound(InData%M_uD, kind=B8Ki)) call RegPack(Buf, InData%M_uD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! M_f call RegPack(Buf, allocated(InData%M_f)) if (allocated(InData%M_f)) then - call RegPackBounds(Buf, 2, lbound(InData%M_f), ubound(InData%M_f)) + call RegPackBounds(Buf, 2, lbound(InData%M_f, kind=B8Ki), ubound(InData%M_f, kind=B8Ki)) call RegPack(Buf, InData%M_f) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6152,11 +6075,10 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MeshMapLinearizationType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! mi if (allocated(OutData%mi)) deallocate(OutData%mi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6171,7 +6093,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%mi) if (RegCheckErr(Buf, RoutineName)) return end if - ! fx_p if (allocated(OutData%fx_p)) deallocate(OutData%fx_p) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6186,7 +6107,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%fx_p) if (RegCheckErr(Buf, RoutineName)) return end if - ! tv_uD if (allocated(OutData%tv_uD)) deallocate(OutData%tv_uD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6201,7 +6121,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%tv_uD) if (RegCheckErr(Buf, RoutineName)) return end if - ! tv_uS if (allocated(OutData%tv_uS)) deallocate(OutData%tv_uS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6216,7 +6135,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%tv_uS) if (RegCheckErr(Buf, RoutineName)) return end if - ! ta_uD if (allocated(OutData%ta_uD)) deallocate(OutData%ta_uD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6231,7 +6149,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%ta_uD) if (RegCheckErr(Buf, RoutineName)) return end if - ! ta_uS if (allocated(OutData%ta_uS)) deallocate(OutData%ta_uS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6246,7 +6163,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%ta_uS) if (RegCheckErr(Buf, RoutineName)) return end if - ! ta_rv if (allocated(OutData%ta_rv)) deallocate(OutData%ta_rv) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6261,7 +6177,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%ta_rv) if (RegCheckErr(Buf, RoutineName)) return end if - ! li if (allocated(OutData%li)) deallocate(OutData%li) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6276,7 +6191,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%li) if (RegCheckErr(Buf, RoutineName)) return end if - ! M_uS if (allocated(OutData%M_uS)) deallocate(OutData%M_uS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6291,7 +6205,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%M_uS) if (RegCheckErr(Buf, RoutineName)) return end if - ! M_uD if (allocated(OutData%M_uD)) deallocate(OutData%M_uD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6306,7 +6219,6 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) call RegUnpack(Buf, OutData%M_uD) if (RegCheckErr(Buf, RoutineName)) return end if - ! M_f if (allocated(OutData%M_f)) deallocate(OutData%M_f) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6322,292 +6234,261 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshMapType), INTENT(INOUT) :: SrcMeshMapTypeData - TYPE(MeshMapType), INTENT(INOUT) :: DstMeshMapTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyMeshMapType' -! + +subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshMapType), intent(inout) :: SrcMeshMapTypeData + type(MeshMapType), intent(inout) :: DstMeshMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMeshMapTypeData%MapLoads)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%MapLoads,1) - i1_u = UBOUND(SrcMeshMapTypeData%MapLoads,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%MapLoads)) THEN - ALLOCATE(DstMeshMapTypeData%MapLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMeshMapTypeData%MapLoads,1), UBOUND(SrcMeshMapTypeData%MapLoads,1) - CALL NWTC_Library_Copymaptype( SrcMeshMapTypeData%MapLoads(i1), DstMeshMapTypeData%MapLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%MapMotions)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%MapMotions,1) - i1_u = UBOUND(SrcMeshMapTypeData%MapMotions,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%MapMotions)) THEN - ALLOCATE(DstMeshMapTypeData%MapMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMeshMapTypeData%MapMotions,1), UBOUND(SrcMeshMapTypeData%MapMotions,1) - CALL NWTC_Library_Copymaptype( SrcMeshMapTypeData%MapMotions(i1), DstMeshMapTypeData%MapMotions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%MapSrcToAugmt)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1) - i1_u = UBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%MapSrcToAugmt)) THEN - ALLOCATE(DstMeshMapTypeData%MapSrcToAugmt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapSrcToAugmt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1), UBOUND(SrcMeshMapTypeData%MapSrcToAugmt,1) - CALL NWTC_Library_Copymaptype( SrcMeshMapTypeData%MapSrcToAugmt(i1), DstMeshMapTypeData%MapSrcToAugmt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcMeshMapTypeData%Augmented_Ln2_Src, DstMeshMapTypeData%Augmented_Ln2_Src, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcMeshMapTypeData%Lumped_Points_Src, DstMeshMapTypeData%Lumped_Points_Src, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv,1) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%DisplacedPosition)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%DisplacedPosition,1) - i1_u = UBOUND(SrcMeshMapTypeData%DisplacedPosition,1) - i2_l = LBOUND(SrcMeshMapTypeData%DisplacedPosition,2) - i2_u = UBOUND(SrcMeshMapTypeData%DisplacedPosition,2) - i3_l = LBOUND(SrcMeshMapTypeData%DisplacedPosition,3) - i3_u = UBOUND(SrcMeshMapTypeData%DisplacedPosition,3) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%DisplacedPosition)) THEN - ALLOCATE(DstMeshMapTypeData%DisplacedPosition(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_A_Mat)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F -ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_M)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_M)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_M = SrcMeshMapTypeData%LoadLn2_M -ENDIF - CALL NWTC_Library_Copymeshmaplinearizationtype( SrcMeshMapTypeData%dM, DstMeshMapTypeData%dM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE NWTC_Library_CopyMeshMapType - - SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) - TYPE(MeshMapType), INTENT(INOUT) :: MeshMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MeshMapTypeData%MapLoads)) THEN -DO i1 = LBOUND(MeshMapTypeData%MapLoads,1), UBOUND(MeshMapTypeData%MapLoads,1) - CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MeshMapTypeData%MapLoads) -ENDIF -IF (ALLOCATED(MeshMapTypeData%MapMotions)) THEN -DO i1 = LBOUND(MeshMapTypeData%MapMotions,1), UBOUND(MeshMapTypeData%MapMotions,1) - CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MeshMapTypeData%MapMotions) -ENDIF -IF (ALLOCATED(MeshMapTypeData%MapSrcToAugmt)) THEN -DO i1 = LBOUND(MeshMapTypeData%MapSrcToAugmt,1), UBOUND(MeshMapTypeData%MapSrcToAugmt,1) - CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MeshMapTypeData%MapSrcToAugmt) -ENDIF - CALL MeshDestroy( MeshMapTypeData%Augmented_Ln2_Src, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat_Piv)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat_Piv) -ENDIF -IF (ALLOCATED(MeshMapTypeData%DisplacedPosition)) THEN - DEALLOCATE(MeshMapTypeData%DisplacedPosition) -ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat) -ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_F) -ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_M) -ENDIF - CALL NWTC_Library_DestroyMeshMapLinearizationType( MeshMapTypeData%dM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE NWTC_Library_DestroyMeshMapType + ErrMsg = '' + if (allocated(SrcMeshMapTypeData%MapLoads)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%MapLoads)) then + allocate(DstMeshMapTypeData%MapLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapLoads(i1), DstMeshMapTypeData%MapLoads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshMapTypeData%MapMotions)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%MapMotions)) then + allocate(DstMeshMapTypeData%MapMotions(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapMotions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapMotions(i1), DstMeshMapTypeData%MapMotions(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshMapTypeData%MapSrcToAugmt)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%MapSrcToAugmt)) then + allocate(DstMeshMapTypeData%MapSrcToAugmt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapSrcToAugmt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapSrcToAugmt(i1), DstMeshMapTypeData%MapSrcToAugmt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcMeshMapTypeData%Augmented_Ln2_Src, DstMeshMapTypeData%Augmented_Ln2_Src, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshMapTypeData%Lumped_Points_Src, DstMeshMapTypeData%Lumped_Points_Src, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) then + LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) then + allocate(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv + end if + if (allocated(SrcMeshMapTypeData%DisplacedPosition)) then + LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) + UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%DisplacedPosition)) then + allocate(DstMeshMapTypeData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%DisplacedPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat)) then + allocate(DstMeshMapTypeData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_F)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_F)) then + allocate(DstMeshMapTypeData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_M)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_M)) then + allocate(DstMeshMapTypeData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_M = SrcMeshMapTypeData%LoadLn2_M + end if + call NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapTypeData%dM, DstMeshMapTypeData%dM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) + type(MeshMapType), intent(inout) :: MeshMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshMapTypeData%MapLoads)) then + LB(1:1) = lbound(MeshMapTypeData%MapLoads, kind=B8Ki) + UB(1:1) = ubound(MeshMapTypeData%MapLoads, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapLoads) + end if + if (allocated(MeshMapTypeData%MapMotions)) then + LB(1:1) = lbound(MeshMapTypeData%MapMotions, kind=B8Ki) + UB(1:1) = ubound(MeshMapTypeData%MapMotions, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapMotions) + end if + if (allocated(MeshMapTypeData%MapSrcToAugmt)) then + LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapSrcToAugmt) + end if + call MeshDestroy( MeshMapTypeData%Augmented_Ln2_Src, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MeshMapTypeData%LoadLn2_A_Mat_Piv)) then + deallocate(MeshMapTypeData%LoadLn2_A_Mat_Piv) + end if + if (allocated(MeshMapTypeData%DisplacedPosition)) then + deallocate(MeshMapTypeData%DisplacedPosition) + end if + if (allocated(MeshMapTypeData%LoadLn2_A_Mat)) then + deallocate(MeshMapTypeData%LoadLn2_A_Mat) + end if + if (allocated(MeshMapTypeData%LoadLn2_F)) then + deallocate(MeshMapTypeData%LoadLn2_F) + end if + if (allocated(MeshMapTypeData%LoadLn2_M)) then + deallocate(MeshMapTypeData%LoadLn2_M) + end if + call NWTC_Library_DestroyMeshMapLinearizationType(MeshMapTypeData%dM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine subroutine NWTC_Library_PackMeshMapType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MeshMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! MapLoads call RegPack(Buf, allocated(InData%MapLoads)) if (allocated(InData%MapLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%MapLoads), ubound(InData%MapLoads)) - LB(1:1) = lbound(InData%MapLoads) - UB(1:1) = ubound(InData%MapLoads) + call RegPackBounds(Buf, 1, lbound(InData%MapLoads, kind=B8Ki), ubound(InData%MapLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%MapLoads, kind=B8Ki) + UB(1:1) = ubound(InData%MapLoads, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(Buf, InData%MapLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return - ! MapMotions call RegPack(Buf, allocated(InData%MapMotions)) if (allocated(InData%MapMotions)) then - call RegPackBounds(Buf, 1, lbound(InData%MapMotions), ubound(InData%MapMotions)) - LB(1:1) = lbound(InData%MapMotions) - UB(1:1) = ubound(InData%MapMotions) + call RegPackBounds(Buf, 1, lbound(InData%MapMotions, kind=B8Ki), ubound(InData%MapMotions, kind=B8Ki)) + LB(1:1) = lbound(InData%MapMotions, kind=B8Ki) + UB(1:1) = ubound(InData%MapMotions, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(Buf, InData%MapMotions(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return - ! MapSrcToAugmt call RegPack(Buf, allocated(InData%MapSrcToAugmt)) if (allocated(InData%MapSrcToAugmt)) then - call RegPackBounds(Buf, 1, lbound(InData%MapSrcToAugmt), ubound(InData%MapSrcToAugmt)) - LB(1:1) = lbound(InData%MapSrcToAugmt) - UB(1:1) = ubound(InData%MapSrcToAugmt) + call RegPackBounds(Buf, 1, lbound(InData%MapSrcToAugmt, kind=B8Ki), ubound(InData%MapSrcToAugmt, kind=B8Ki)) + LB(1:1) = lbound(InData%MapSrcToAugmt, kind=B8Ki) + UB(1:1) = ubound(InData%MapSrcToAugmt, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(Buf, InData%MapSrcToAugmt(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return - ! Augmented_Ln2_Src call MeshPack(Buf, InData%Augmented_Ln2_Src) - if (RegCheckErr(Buf, RoutineName)) return - ! Lumped_Points_Src call MeshPack(Buf, InData%Lumped_Points_Src) - if (RegCheckErr(Buf, RoutineName)) return - ! LoadLn2_A_Mat_Piv call RegPack(Buf, allocated(InData%LoadLn2_A_Mat_Piv)) if (allocated(InData%LoadLn2_A_Mat_Piv)) then - call RegPackBounds(Buf, 1, lbound(InData%LoadLn2_A_Mat_Piv), ubound(InData%LoadLn2_A_Mat_Piv)) + call RegPackBounds(Buf, 1, lbound(InData%LoadLn2_A_Mat_Piv, kind=B8Ki), ubound(InData%LoadLn2_A_Mat_Piv, kind=B8Ki)) call RegPack(Buf, InData%LoadLn2_A_Mat_Piv) end if - if (RegCheckErr(Buf, RoutineName)) return - ! DisplacedPosition call RegPack(Buf, allocated(InData%DisplacedPosition)) if (allocated(InData%DisplacedPosition)) then - call RegPackBounds(Buf, 3, lbound(InData%DisplacedPosition), ubound(InData%DisplacedPosition)) + call RegPackBounds(Buf, 3, lbound(InData%DisplacedPosition, kind=B8Ki), ubound(InData%DisplacedPosition, kind=B8Ki)) call RegPack(Buf, InData%DisplacedPosition) end if - if (RegCheckErr(Buf, RoutineName)) return - ! LoadLn2_A_Mat call RegPack(Buf, allocated(InData%LoadLn2_A_Mat)) if (allocated(InData%LoadLn2_A_Mat)) then - call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_A_Mat), ubound(InData%LoadLn2_A_Mat)) + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_A_Mat, kind=B8Ki), ubound(InData%LoadLn2_A_Mat, kind=B8Ki)) call RegPack(Buf, InData%LoadLn2_A_Mat) end if - if (RegCheckErr(Buf, RoutineName)) return - ! LoadLn2_F call RegPack(Buf, allocated(InData%LoadLn2_F)) if (allocated(InData%LoadLn2_F)) then - call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_F), ubound(InData%LoadLn2_F)) + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_F, kind=B8Ki), ubound(InData%LoadLn2_F, kind=B8Ki)) call RegPack(Buf, InData%LoadLn2_F) end if - if (RegCheckErr(Buf, RoutineName)) return - ! LoadLn2_M call RegPack(Buf, allocated(InData%LoadLn2_M)) if (allocated(InData%LoadLn2_M)) then - call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_M), ubound(InData%LoadLn2_M)) + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_M, kind=B8Ki), ubound(InData%LoadLn2_M, kind=B8Ki)) call RegPack(Buf, InData%LoadLn2_M) end if - if (RegCheckErr(Buf, RoutineName)) return - ! dM call NWTC_Library_PackMeshMapLinearizationType(Buf, InData%dM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6616,12 +6497,11 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MeshMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MapLoads if (allocated(OutData%MapLoads)) deallocate(OutData%MapLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6637,7 +6517,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call NWTC_Library_UnpackMapType(Buf, OutData%MapLoads(i1)) ! MapLoads end do end if - ! MapMotions if (allocated(OutData%MapMotions)) deallocate(OutData%MapMotions) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6653,7 +6532,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call NWTC_Library_UnpackMapType(Buf, OutData%MapMotions(i1)) ! MapMotions end do end if - ! MapSrcToAugmt if (allocated(OutData%MapSrcToAugmt)) deallocate(OutData%MapSrcToAugmt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6669,11 +6547,8 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call NWTC_Library_UnpackMapType(Buf, OutData%MapSrcToAugmt(i1)) ! MapSrcToAugmt end do end if - ! Augmented_Ln2_Src call MeshUnpack(Buf, OutData%Augmented_Ln2_Src) ! Augmented_Ln2_Src - ! Lumped_Points_Src call MeshUnpack(Buf, OutData%Lumped_Points_Src) ! Lumped_Points_Src - ! LoadLn2_A_Mat_Piv if (allocated(OutData%LoadLn2_A_Mat_Piv)) deallocate(OutData%LoadLn2_A_Mat_Piv) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6688,7 +6563,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call RegUnpack(Buf, OutData%LoadLn2_A_Mat_Piv) if (RegCheckErr(Buf, RoutineName)) return end if - ! DisplacedPosition if (allocated(OutData%DisplacedPosition)) deallocate(OutData%DisplacedPosition) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6703,7 +6577,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call RegUnpack(Buf, OutData%DisplacedPosition) if (RegCheckErr(Buf, RoutineName)) return end if - ! LoadLn2_A_Mat if (allocated(OutData%LoadLn2_A_Mat)) deallocate(OutData%LoadLn2_A_Mat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6718,7 +6591,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call RegUnpack(Buf, OutData%LoadLn2_A_Mat) if (RegCheckErr(Buf, RoutineName)) return end if - ! LoadLn2_F if (allocated(OutData%LoadLn2_F)) deallocate(OutData%LoadLn2_F) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6733,7 +6605,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call RegUnpack(Buf, OutData%LoadLn2_F) if (RegCheckErr(Buf, RoutineName)) return end if - ! LoadLn2_M if (allocated(OutData%LoadLn2_M)) deallocate(OutData%LoadLn2_M) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6748,7 +6619,6 @@ subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) call RegUnpack(Buf, OutData%LoadLn2_M) if (RegCheckErr(Buf, RoutineName)) return end if - ! dM call NWTC_Library_UnpackMeshMapLinearizationType(Buf, OutData%dM) ! dM end subroutine diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 index 8ba353b4b7..f0ee258bce 100644 --- a/modules/nwtc-library/src/ModReg.f90 +++ b/modules/nwtc-library/src/ModReg.f90 @@ -11,9 +11,9 @@ module ModReg type :: PackBuffer integer(B1Ki), allocatable :: Bytes(:) - integer(IntKi) :: NB + integer(B8Ki) :: NB type(c_ptr), allocatable :: Pointers(:) - integer(IntKi) :: NP + integer(B8Ki) :: NP integer(IntKi) :: ErrStat = ErrID_Fatal character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' end type @@ -23,10 +23,11 @@ module ModReg module procedure Pack_C1, Pack_C1_Rank1, Pack_C1_Rank2, Pack_C1_Rank3, & Pack_C1_Rank4, Pack_C1_Rank5, Pack_L1, Pack_L1_Rank1, Pack_L1_Rank2, & Pack_L1_Rank3, Pack_L1_Rank4, Pack_L1_Rank5, Pack_I4, Pack_I4_Rank1, & - Pack_I4_Rank2, Pack_I4_Rank3, Pack_I4_Rank4, Pack_I4_Rank5, Pack_R4, & - Pack_R4_Rank1, Pack_R4_Rank2, Pack_R4_Rank3, Pack_R4_Rank4, & - Pack_R4_Rank5, Pack_R8, Pack_R8_Rank1, Pack_R8_Rank2, Pack_R8_Rank3, & - Pack_R8_Rank4, Pack_R8_Rank5 + Pack_I4_Rank2, Pack_I4_Rank3, Pack_I4_Rank4, Pack_I4_Rank5, Pack_I8, & + Pack_I8_Rank1, Pack_I8_Rank2, Pack_I8_Rank3, Pack_I8_Rank4, & + Pack_I8_Rank5, Pack_R4, Pack_R4_Rank1, Pack_R4_Rank2, Pack_R4_Rank3, & + Pack_R4_Rank4, Pack_R4_Rank5, Pack_R8, Pack_R8_Rank1, Pack_R8_Rank2, & + Pack_R8_Rank3, Pack_R8_Rank4, Pack_R8_Rank5 end interface interface RegUnpack @@ -34,10 +35,12 @@ module ModReg Unpack_C1_Rank3, Unpack_C1_Rank4, Unpack_C1_Rank5, Unpack_L1, & Unpack_L1_Rank1, Unpack_L1_Rank2, Unpack_L1_Rank3, Unpack_L1_Rank4, & Unpack_L1_Rank5, Unpack_I4, Unpack_I4_Rank1, Unpack_I4_Rank2, & - Unpack_I4_Rank3, Unpack_I4_Rank4, Unpack_I4_Rank5, Unpack_R4, & - Unpack_R4_Rank1, Unpack_R4_Rank2, Unpack_R4_Rank3, Unpack_R4_Rank4, & - Unpack_R4_Rank5, Unpack_R8, Unpack_R8_Rank1, Unpack_R8_Rank2, & - Unpack_R8_Rank3, Unpack_R8_Rank4, Unpack_R8_Rank5 + Unpack_I4_Rank3, Unpack_I4_Rank4, Unpack_I4_Rank5, Unpack_I8, & + Unpack_I8_Rank1, Unpack_I8_Rank2, Unpack_I8_Rank3, Unpack_I8_Rank4, & + Unpack_I8_Rank5, Unpack_R4, Unpack_R4_Rank1, Unpack_R4_Rank2, & + Unpack_R4_Rank3, Unpack_R4_Rank4, Unpack_R4_Rank5, Unpack_R8, & + Unpack_R8_Rank1, Unpack_R8_Rank2, Unpack_R8_Rank3, Unpack_R8_Rank4, & + Unpack_R8_Rank5 end interface contains @@ -48,8 +51,8 @@ subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) character(ErrMsgLen), intent(out) :: ErrMsg character(*), parameter :: RoutineName = "InitPackBuffer" - integer(IntKi), parameter :: NumPointersInit = 128 - integer(IntKi), parameter :: NumBytesInit = 1024 + integer(B8Ki), parameter :: NumPointersInit = 128 + integer(B8Ki), parameter :: NumBytesInit = 1024 integer(IntKi) :: stat ErrStat = ErrID_None @@ -230,8 +233,8 @@ subroutine RegPackPointer(Buf, Ptr, Found) logical, intent(out) :: Found type(c_ptr), allocatable :: PointersTmp(:) - integer(IntKi) :: NewSize - integer(B4Ki) :: i + integer(B8Ki) :: NewSize + integer(B8Ki) :: i ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -250,7 +253,7 @@ subroutine RegPackPointer(Buf, Ptr, Found) ! If pointer index is full, grow pointer index if (Buf%NP == size(Buf%Pointers)) then - NewSize = int(1.5_R4Ki * real(Buf%NP, R4Ki), IntKi) + NewSize = int(1.5_R8Ki * real(Buf%NP, R8Ki), B8Ki) call move_alloc(Buf%Pointers, PointersTmp) allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) if (Buf%ErrStat /= ErrID_None) then @@ -274,7 +277,7 @@ subroutine RegPackPointer(Buf, Ptr, Found) subroutine RegUnpackPointer(Buf, Ptr, Idx) type(PackBuffer), intent(inout) :: Buf type(c_ptr), intent(out) :: Ptr - integer(B4Ki), intent(out) :: Idx + integer(B8Ki), intent(out) :: Idx ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -289,7 +292,8 @@ subroutine RegUnpackPointer(Buf, Ptr, Idx) subroutine RegPackBounds(Buf, R, LB, UB) type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: R, LB(:), UB(:) + integer(B4Ki), intent(in) :: R + integer(B8Ki), intent(in) :: LB(:), UB(:) ! If buffer has an error, return if (Buf%ErrStat /= ErrID_None) return @@ -303,7 +307,7 @@ subroutine RegPackBounds(Buf, R, LB, UB) subroutine RegUnpackBounds(Buf, R, LB, UB) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: R - integer(B4Ki), intent(out) :: LB(:), UB(:) + integer(B8Ki), intent(out) :: LB(:), UB(:) ! If buffer has an error, return if (Buf%ErrStat /= ErrID_None) return @@ -316,10 +320,10 @@ subroutine RegUnpackBounds(Buf, R, LB, UB) subroutine GrowBuffer(Buf, N) type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: N + integer(B8Ki), intent(in) :: N integer(B1Ki), allocatable :: BytesTmp(:) - integer(B4Ki) :: NewSize + integer(B8Ki) :: NewSize integer(IntKi) :: stat ! Return if there is a buffer error @@ -329,7 +333,7 @@ subroutine GrowBuffer(Buf, N) if (size(Buf%Bytes) > Buf%NB + N) return ! Calculate new size - NewSize = int(real(Buf%NB + N, R4Ki) * 1.8_R4Ki, IntKi) + NewSize = int(real(Buf%NB + N, R8Ki) * 1.8_R8Ki, B8Ki) ! Move allocation to temporary array and allocate buffer with new size call move_alloc(Buf%Bytes, BytesTmp) @@ -349,7 +353,7 @@ subroutine GrowBuffer(Buf, N) subroutine Pack_C1(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(in) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -370,7 +374,7 @@ subroutine Pack_C1(Buf, Data) subroutine Unpack_C1(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(out) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -394,7 +398,7 @@ subroutine Unpack_C1(Buf, Data) subroutine Pack_C1_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(in) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -415,7 +419,7 @@ subroutine Pack_C1_Rank1(Buf, Data) subroutine Unpack_C1_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(out) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -439,7 +443,7 @@ subroutine Unpack_C1_Rank1(Buf, Data) subroutine Pack_C1_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(in) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -460,7 +464,7 @@ subroutine Pack_C1_Rank2(Buf, Data) subroutine Unpack_C1_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(out) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -484,7 +488,7 @@ subroutine Unpack_C1_Rank2(Buf, Data) subroutine Pack_C1_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(in) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -505,7 +509,7 @@ subroutine Pack_C1_Rank3(Buf, Data) subroutine Unpack_C1_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(out) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -529,7 +533,7 @@ subroutine Unpack_C1_Rank3(Buf, Data) subroutine Pack_C1_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(in) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -550,7 +554,7 @@ subroutine Pack_C1_Rank4(Buf, Data) subroutine Unpack_C1_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(out) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -574,7 +578,7 @@ subroutine Unpack_C1_Rank4(Buf, Data) subroutine Pack_C1_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(in) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -595,7 +599,7 @@ subroutine Pack_C1_Rank5(Buf, Data) subroutine Unpack_C1_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf character(*), intent(out) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -619,7 +623,7 @@ subroutine Unpack_C1_Rank5(Buf, Data) subroutine Pack_L1(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(in) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -640,7 +644,7 @@ subroutine Pack_L1(Buf, Data) subroutine Unpack_L1(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(out) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -664,7 +668,7 @@ subroutine Unpack_L1(Buf, Data) subroutine Pack_L1_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(in) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -685,7 +689,7 @@ subroutine Pack_L1_Rank1(Buf, Data) subroutine Unpack_L1_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(out) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -709,7 +713,7 @@ subroutine Unpack_L1_Rank1(Buf, Data) subroutine Pack_L1_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(in) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -730,7 +734,7 @@ subroutine Pack_L1_Rank2(Buf, Data) subroutine Unpack_L1_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(out) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -754,7 +758,7 @@ subroutine Unpack_L1_Rank2(Buf, Data) subroutine Pack_L1_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(in) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -775,7 +779,7 @@ subroutine Pack_L1_Rank3(Buf, Data) subroutine Unpack_L1_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(out) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -799,7 +803,7 @@ subroutine Unpack_L1_Rank3(Buf, Data) subroutine Pack_L1_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(in) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -820,7 +824,7 @@ subroutine Pack_L1_Rank4(Buf, Data) subroutine Unpack_L1_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(out) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -844,7 +848,7 @@ subroutine Unpack_L1_Rank4(Buf, Data) subroutine Pack_L1_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(in) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -865,7 +869,7 @@ subroutine Pack_L1_Rank5(Buf, Data) subroutine Unpack_L1_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf logical, intent(out) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -889,7 +893,7 @@ subroutine Unpack_L1_Rank5(Buf, Data) subroutine Pack_I4(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -910,7 +914,7 @@ subroutine Pack_I4(Buf, Data) subroutine Unpack_I4(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(out) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -934,7 +938,7 @@ subroutine Unpack_I4(Buf, Data) subroutine Pack_I4_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -955,7 +959,7 @@ subroutine Pack_I4_Rank1(Buf, Data) subroutine Unpack_I4_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(out) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -979,7 +983,7 @@ subroutine Unpack_I4_Rank1(Buf, Data) subroutine Pack_I4_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1000,7 +1004,7 @@ subroutine Pack_I4_Rank2(Buf, Data) subroutine Unpack_I4_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(out) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1024,7 +1028,7 @@ subroutine Unpack_I4_Rank2(Buf, Data) subroutine Pack_I4_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1045,7 +1049,7 @@ subroutine Pack_I4_Rank3(Buf, Data) subroutine Unpack_I4_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(out) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1069,7 +1073,7 @@ subroutine Unpack_I4_Rank3(Buf, Data) subroutine Pack_I4_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1090,7 +1094,7 @@ subroutine Pack_I4_Rank4(Buf, Data) subroutine Unpack_I4_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(out) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1114,7 +1118,7 @@ subroutine Unpack_I4_Rank4(Buf, Data) subroutine Pack_I4_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(in) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1135,7 +1139,7 @@ subroutine Pack_I4_Rank5(Buf, Data) subroutine Unpack_I4_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf integer(B4Ki), intent(out) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1156,10 +1160,280 @@ subroutine Unpack_I4_Rank5(Buf, Data) end subroutine + subroutine Pack_I8(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(in) :: Data + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I8")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I8(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(out) :: Data + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I8: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I8_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(in) :: Data(:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I8_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I8_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(out) :: Data(:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I8_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I8_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(in) :: Data(:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I8_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I8_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(out) :: Data(:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I8_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I8_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(in) :: Data(:,:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I8_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I8_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(out) :: Data(:,:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I8_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I8_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(in) :: Data(:,:,:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I8_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I8_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(out) :: Data(:,:,:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I8_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I8_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(in) :: Data(:,:,:,:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I8_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I8_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B8Ki), intent(out) :: Data(:,:,:,:,:) + integer(B8Ki) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I8_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + subroutine Pack_R4(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(in) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1180,7 +1454,7 @@ subroutine Pack_R4(Buf, Data) subroutine Unpack_R4(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(out) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1204,7 +1478,7 @@ subroutine Unpack_R4(Buf, Data) subroutine Pack_R4_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(in) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1225,7 +1499,7 @@ subroutine Pack_R4_Rank1(Buf, Data) subroutine Unpack_R4_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(out) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1249,7 +1523,7 @@ subroutine Unpack_R4_Rank1(Buf, Data) subroutine Pack_R4_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(in) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1270,7 +1544,7 @@ subroutine Pack_R4_Rank2(Buf, Data) subroutine Unpack_R4_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(out) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1294,7 +1568,7 @@ subroutine Unpack_R4_Rank2(Buf, Data) subroutine Pack_R4_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(in) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1315,7 +1589,7 @@ subroutine Pack_R4_Rank3(Buf, Data) subroutine Unpack_R4_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(out) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1339,7 +1613,7 @@ subroutine Unpack_R4_Rank3(Buf, Data) subroutine Pack_R4_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(in) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1360,7 +1634,7 @@ subroutine Pack_R4_Rank4(Buf, Data) subroutine Unpack_R4_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(out) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1384,7 +1658,7 @@ subroutine Unpack_R4_Rank4(Buf, Data) subroutine Pack_R4_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(in) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1405,7 +1679,7 @@ subroutine Pack_R4_Rank5(Buf, Data) subroutine Unpack_R4_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R4Ki), intent(out) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1429,7 +1703,7 @@ subroutine Unpack_R4_Rank5(Buf, Data) subroutine Pack_R8(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(in) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1450,7 +1724,7 @@ subroutine Pack_R8(Buf, Data) subroutine Unpack_R8(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(out) :: Data - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1474,7 +1748,7 @@ subroutine Unpack_R8(Buf, Data) subroutine Pack_R8_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(in) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1495,7 +1769,7 @@ subroutine Pack_R8_Rank1(Buf, Data) subroutine Unpack_R8_Rank1(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(out) :: Data(:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1519,7 +1793,7 @@ subroutine Unpack_R8_Rank1(Buf, Data) subroutine Pack_R8_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(in) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1540,7 +1814,7 @@ subroutine Pack_R8_Rank2(Buf, Data) subroutine Unpack_R8_Rank2(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(out) :: Data(:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1564,7 +1838,7 @@ subroutine Unpack_R8_Rank2(Buf, Data) subroutine Pack_R8_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(in) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1585,7 +1859,7 @@ subroutine Pack_R8_Rank3(Buf, Data) subroutine Unpack_R8_Rank3(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(out) :: Data(:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1609,7 +1883,7 @@ subroutine Unpack_R8_Rank3(Buf, Data) subroutine Pack_R8_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(in) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1630,7 +1904,7 @@ subroutine Pack_R8_Rank4(Buf, Data) subroutine Unpack_R8_Rank4(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(out) :: Data(:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1654,7 +1928,7 @@ subroutine Unpack_R8_Rank4(Buf, Data) subroutine Pack_R8_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(in) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return @@ -1675,7 +1949,7 @@ subroutine Pack_R8_Rank5(Buf, Data) subroutine Unpack_R8_Rank5(Buf, Data) type(PackBuffer), intent(inout) :: Buf real(R8Ki), intent(out) :: Data(:,:,:,:,:) - integer(IntKi) :: DataSize + integer(B8Ki) :: DataSize ! If buffer error, return if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 13195434b7..83b2fd1dd0 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -140,7 +140,7 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyFASTdataType' ErrStat = ErrID_None @@ -151,8 +151,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep if (allocated(SrcFASTdataTypeData%ChanNames)) then - LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames) - UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames) + LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames, kind=B8Ki) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames, kind=B8Ki) if (.not. allocated(DstFASTdataTypeData%ChanNames)) then allocate(DstFASTdataTypeData%ChanNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -163,8 +163,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames end if if (allocated(SrcFASTdataTypeData%ChanUnits)) then - LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) - UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits) + LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits, kind=B8Ki) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits, kind=B8Ki) if (.not. allocated(DstFASTdataTypeData%ChanUnits)) then allocate(DstFASTdataTypeData%ChanUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -175,8 +175,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits end if if (allocated(SrcFASTdataTypeData%Data)) then - LB(1:2) = lbound(SrcFASTdataTypeData%Data) - UB(1:2) = ubound(SrcFASTdataTypeData%Data) + LB(1:2) = lbound(SrcFASTdataTypeData%Data, kind=B8Ki) + UB(1:2) = ubound(SrcFASTdataTypeData%Data, kind=B8Ki) if (.not. allocated(DstFASTdataTypeData%Data)) then allocate(DstFASTdataTypeData%Data(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -218,17 +218,17 @@ subroutine NWTC_Library_PackFASTdataType(Buf, Indata) call RegPack(Buf, InData%TimeStep) call RegPack(Buf, allocated(InData%ChanNames)) if (allocated(InData%ChanNames)) then - call RegPackBounds(Buf, 1, lbound(InData%ChanNames), ubound(InData%ChanNames)) + call RegPackBounds(Buf, 1, lbound(InData%ChanNames, kind=B8Ki), ubound(InData%ChanNames, kind=B8Ki)) call RegPack(Buf, InData%ChanNames) end if call RegPack(Buf, allocated(InData%ChanUnits)) if (allocated(InData%ChanUnits)) then - call RegPackBounds(Buf, 1, lbound(InData%ChanUnits), ubound(InData%ChanUnits)) + call RegPackBounds(Buf, 1, lbound(InData%ChanUnits, kind=B8Ki), ubound(InData%ChanUnits, kind=B8Ki)) call RegPack(Buf, InData%ChanUnits) end if call RegPack(Buf, allocated(InData%Data)) if (allocated(InData%Data)) then - call RegPackBounds(Buf, 2, lbound(InData%Data), ubound(InData%Data)) + call RegPackBounds(Buf, 2, lbound(InData%Data, kind=B8Ki), ubound(InData%Data, kind=B8Ki)) call RegPack(Buf, InData%Data) end if if (RegCheckErr(Buf, RoutineName)) return @@ -238,7 +238,7 @@ subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FASTdataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -353,7 +353,7 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyFileInfoType' ErrStat = ErrID_None @@ -361,8 +361,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles if (allocated(SrcFileInfoTypeData%FileLine)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileLine) - UB(1:1) = ubound(SrcFileInfoTypeData%FileLine) + LB(1:1) = lbound(SrcFileInfoTypeData%FileLine, kind=B8Ki) + UB(1:1) = ubound(SrcFileInfoTypeData%FileLine, kind=B8Ki) if (.not. allocated(DstFileInfoTypeData%FileLine)) then allocate(DstFileInfoTypeData%FileLine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -373,8 +373,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine end if if (allocated(SrcFileInfoTypeData%FileIndx)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) - UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx) + LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx, kind=B8Ki) + UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx, kind=B8Ki) if (.not. allocated(DstFileInfoTypeData%FileIndx)) then allocate(DstFileInfoTypeData%FileIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -385,8 +385,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx end if if (allocated(SrcFileInfoTypeData%FileList)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileList) - UB(1:1) = ubound(SrcFileInfoTypeData%FileList) + LB(1:1) = lbound(SrcFileInfoTypeData%FileList, kind=B8Ki) + UB(1:1) = ubound(SrcFileInfoTypeData%FileList, kind=B8Ki) if (.not. allocated(DstFileInfoTypeData%FileList)) then allocate(DstFileInfoTypeData%FileList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -397,8 +397,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList end if if (allocated(SrcFileInfoTypeData%Lines)) then - LB(1:1) = lbound(SrcFileInfoTypeData%Lines) - UB(1:1) = ubound(SrcFileInfoTypeData%Lines) + LB(1:1) = lbound(SrcFileInfoTypeData%Lines, kind=B8Ki) + UB(1:1) = ubound(SrcFileInfoTypeData%Lines, kind=B8Ki) if (.not. allocated(DstFileInfoTypeData%Lines)) then allocate(DstFileInfoTypeData%Lines(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -440,22 +440,22 @@ subroutine NWTC_Library_PackFileInfoType(Buf, Indata) call RegPack(Buf, InData%NumFiles) call RegPack(Buf, allocated(InData%FileLine)) if (allocated(InData%FileLine)) then - call RegPackBounds(Buf, 1, lbound(InData%FileLine), ubound(InData%FileLine)) + call RegPackBounds(Buf, 1, lbound(InData%FileLine, kind=B8Ki), ubound(InData%FileLine, kind=B8Ki)) call RegPack(Buf, InData%FileLine) end if call RegPack(Buf, allocated(InData%FileIndx)) if (allocated(InData%FileIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%FileIndx), ubound(InData%FileIndx)) + call RegPackBounds(Buf, 1, lbound(InData%FileIndx, kind=B8Ki), ubound(InData%FileIndx, kind=B8Ki)) call RegPack(Buf, InData%FileIndx) end if call RegPack(Buf, allocated(InData%FileList)) if (allocated(InData%FileList)) then - call RegPackBounds(Buf, 1, lbound(InData%FileList), ubound(InData%FileList)) + call RegPackBounds(Buf, 1, lbound(InData%FileList, kind=B8Ki), ubound(InData%FileList, kind=B8Ki)) call RegPack(Buf, InData%FileList) end if call RegPack(Buf, allocated(InData%Lines)) if (allocated(InData%Lines)) then - call RegPackBounds(Buf, 1, lbound(InData%Lines), ubound(InData%Lines)) + call RegPackBounds(Buf, 1, lbound(InData%Lines, kind=B8Ki), ubound(InData%Lines, kind=B8Ki)) call RegPack(Buf, InData%Lines) end if if (RegCheckErr(Buf, RoutineName)) return @@ -465,7 +465,7 @@ subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FileInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -580,7 +580,7 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' ErrStat = ErrID_None @@ -588,8 +588,8 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed if (allocated(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then - LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) - UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry, kind=B8Ki) + UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry, kind=B8Ki) if (.not. allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then allocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -623,7 +623,7 @@ subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, Indata) call RegPack(Buf, InData%RandSeed) call RegPack(Buf, allocated(InData%RandSeedAry)) if (allocated(InData%RandSeedAry)) then - call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry), ubound(InData%RandSeedAry)) + call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry, kind=B8Ki), ubound(InData%RandSeedAry, kind=B8Ki)) call RegPack(Buf, InData%RandSeedAry) end if call RegPack(Buf, InData%RNG_type) @@ -634,7 +634,7 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index a77c60c073..c90cc0224a 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -6,66 +6,76 @@ #............................................................. -usefrom NWTC_Library ProgDesc CHARACTER(99) Name -usefrom ^ ^ CHARACTER(99) Ver -usefrom ^ ^ CHARACTER(24) Date +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" -usefrom ^ FASTdataType CHARACTER(1024) File -usefrom ^ ^ CHARACTER(1024) Descr -usefrom ^ ^ IntKi NumChans -usefrom ^ ^ IntKi NumRecs -usefrom ^ ^ DbKi TimeStep -usefrom ^ ^ CHARACTER(ChanLen) ChanNames {:} -usefrom ^ ^ CHARACTER(ChanLen) ChanUnits {:} -usefrom ^ ^ ReKi Data {:}{:} +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" -usefrom NWTC_Library OutParmType IntKi Indx -usefrom ^ ^ CHARACTER(ChanLen) Name -usefrom ^ ^ CHARACTER(ChanLen) Units -usefrom ^ ^ IntKi SignM +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" -usefrom NWTC_Library FileInfoType IntKi NumLines -usefrom ^ ^ IntKi NumFiles -usefrom ^ ^ IntKi FileLine {:} -usefrom ^ ^ IntKi FileIndx {:} -usefrom ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} -usefrom ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} +typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} + +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} + +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type + +# This file defines types that may be used from the NWTC_Library +# include this into a component registry file if you wish to use these types +# the "usefrom" keyword defines the types for the registry without generating +# a NWTC_Library_Types.f90 file +# +#............................................................. -usefrom NWTC_Library Quaternion ReKi q0 -usefrom ^ ^ ReKi v {3} -usefrom NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -usefrom ^ ^ IntKi RandSeed {3} -usefrom ^ ^ IntKi RandSeedAry {:} -usefrom ^ ^ CHARACTER(6) RNG_type #BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 -usefrom NWTC_Library MapType IntKi OtherMesh_Element -usefrom ^ ^ R8Ki distance - -usefrom ^ ^ R8Ki couple_arm {3} -usefrom ^ ^ R8Ki shape_fn {2} +typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" +typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m +typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m +typedef ^ ^ R8Ki shape_fn {2} - - "shape functions: 1-D element-level location [0,1] based on closest-line projection of point" - -usefrom NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} -usefrom ^ ^ R8Ki fx_p {:}{:} -usefrom ^ ^ R8Ki tv_uD {:}{:} -usefrom ^ ^ R8Ki tv_uS {:}{:} -usefrom ^ ^ R8Ki ta_uD {:}{:} -usefrom ^ ^ R8Ki ta_uS {:}{:} -usefrom ^ ^ R8Ki ta_rv {:}{:} -usefrom ^ ^ R8Ki li {:}{:} -usefrom ^ ^ R8Ki M_u {:}{:} -usefrom ^ ^ R8Ki M_t {:}{:} -usefrom ^ ^ R8Ki M_f {:}{:} +typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" +typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" +typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" +typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" +typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" +typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" +typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" -usefrom NWTC_Library MeshMapType MapType MapLoads {:} -usefrom ^ ^ MapType MapMotions {:} -usefrom ^ ^ MapType MapSrcToAugmt {:} -usefrom ^ ^ MeshType Augmented_Ln2_Src - -usefrom ^ ^ MeshType Lumped_Points_Src - -usefrom ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} -usefrom ^ ^ R8Ki DisplacedPosition {:}{:}{:} -usefrom ^ ^ R8Ki LoadLn2_A_Mat {:}{:} -usefrom ^ ^ R8Ki LoadLn2_F {:}{:} -usefrom ^ ^ R8Ki LoadLn2_M {:}{:} -usefrom ^ ^ MeshMapLinearizationType dM +typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for load fields on the mesh" +typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motion and/or scalar fields on the mesh" +typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination" +typedef ^ ^ MeshType Augmented_Ln2_Src - - - "temporary mesh for storing augmented line2 source values" +typedef ^ ^ MeshType Lumped_Points_Src - - - "temporary mesh for lumping lines to points, stored here for efficiency" +typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorization of LoadLn2_A_Mat" +typedef ^ ^ R8Ki DisplacedPosition {:}{:}{:} - - "couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency)" m +typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" +typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ MeshMapLinearizationType dM +#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt similarity index 100% rename from modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt rename to modules/nwtc-library/src/Registry_NWTC_Library_base.txt diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt similarity index 100% rename from modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt rename to modules/nwtc-library/src/Registry_NWTC_Library_mesh.txt diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 5b39daed88..c48b7344d9 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -839,14 +839,14 @@ subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurface integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) - UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -877,7 +877,7 @@ subroutine FAST_PackVTK_BLSurfaceType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%AirfoilCoords)) if (allocated(InData%AirfoilCoords)) then - call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords, kind=B8Ki), ubound(InData%AirfoilCoords, kind=B8Ki)) call RegPack(Buf, InData%AirfoilCoords) end if if (RegCheckErr(Buf, RoutineName)) return @@ -887,7 +887,7 @@ subroutine FAST_UnPackVTK_BLSurfaceType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -913,8 +913,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' @@ -925,8 +925,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox if (allocated(SrcVTK_SurfaceTypeData%TowerRad)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad, kind=B8Ki) if (.not. allocated(DstVTK_SurfaceTypeData%TowerRad)) then allocate(DstVTK_SurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -938,8 +938,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts if (allocated(SrcVTK_SurfaceTypeData%WaveElevXY)) then - LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElevXY) - UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElevXY) + LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElevXY, kind=B8Ki) + UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElevXY, kind=B8Ki) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevXY)) then allocate(DstVTK_SurfaceTypeData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -950,8 +950,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY end if if (allocated(SrcVTK_SurfaceTypeData%WaveElev)) then - LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElev) - UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElev) + LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElev, kind=B8Ki) + UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElev, kind=B8Ki) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElev)) then allocate(DstVTK_SurfaceTypeData%WaveElev(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -962,8 +962,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev end if if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) if (.not. allocated(DstVTK_SurfaceTypeData%BladeShape)) then allocate(DstVTK_SurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -978,8 +978,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end do end if if (allocated(SrcVTK_SurfaceTypeData%MorisonVisRad)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad, kind=B8Ki) if (.not. allocated(DstVTK_SurfaceTypeData%MorisonVisRad)) then allocate(DstVTK_SurfaceTypeData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -995,8 +995,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) type(FAST_VTK_SurfaceType), intent(inout) :: VTK_SurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' @@ -1012,8 +1012,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) deallocate(VTK_SurfaceTypeData%WaveElev) end if if (allocated(VTK_SurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape) - UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape) + LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_DestroyVTK_BLSurfaceType(VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1029,8 +1029,8 @@ subroutine FAST_PackVTK_SurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_VTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumSectors) call RegPack(Buf, InData%HubRad) @@ -1038,32 +1038,32 @@ subroutine FAST_PackVTK_SurfaceType(Buf, Indata) call RegPack(Buf, InData%NacelleBox) call RegPack(Buf, allocated(InData%TowerRad)) if (allocated(InData%TowerRad)) then - call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) + call RegPackBounds(Buf, 1, lbound(InData%TowerRad, kind=B8Ki), ubound(InData%TowerRad, kind=B8Ki)) call RegPack(Buf, InData%TowerRad) end if call RegPack(Buf, InData%NWaveElevPts) call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) + call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY, kind=B8Ki), ubound(InData%WaveElevXY, kind=B8Ki)) call RegPack(Buf, InData%WaveElevXY) end if call RegPack(Buf, allocated(InData%WaveElev)) if (allocated(InData%WaveElev)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPackBounds(Buf, 2, lbound(InData%WaveElev, kind=B8Ki), ubound(InData%WaveElev, kind=B8Ki)) call RegPack(Buf, InData%WaveElev) end if call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) - LB(1:1) = lbound(InData%BladeShape) - UB(1:1) = ubound(InData%BladeShape) + call RegPackBounds(Buf, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) + LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) + UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) end do end if call RegPack(Buf, allocated(InData%MorisonVisRad)) if (allocated(InData%MorisonVisRad)) then - call RegPackBounds(Buf, 1, lbound(InData%MorisonVisRad), ubound(InData%MorisonVisRad)) + call RegPackBounds(Buf, 1, lbound(InData%MorisonVisRad, kind=B8Ki), ubound(InData%MorisonVisRad, kind=B8Ki)) call RegPack(Buf, InData%MorisonVisRad) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1073,8 +1073,8 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_VTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1167,7 +1167,7 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' ErrStat = ErrID_None @@ -1176,8 +1176,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1192,8 +1192,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1204,8 +1204,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio end if if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1216,8 +1216,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz end if if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,8 +1228,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1240,8 +1240,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase) + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1290,7 +1290,7 @@ subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) call RegPack(Buf, InData%VTKLinModes) call RegPack(Buf, allocated(InData%VTKModes)) if (allocated(InData%VTKModes)) then - call RegPackBounds(Buf, 1, lbound(InData%VTKModes), ubound(InData%VTKModes)) + call RegPackBounds(Buf, 1, lbound(InData%VTKModes, kind=B8Ki), ubound(InData%VTKModes, kind=B8Ki)) call RegPack(Buf, InData%VTKModes) end if call RegPack(Buf, InData%VTKLinTim) @@ -1299,27 +1299,27 @@ subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) call RegPack(Buf, InData%VTKLinPhase) call RegPack(Buf, allocated(InData%DampingRatio)) if (allocated(InData%DampingRatio)) then - call RegPackBounds(Buf, 1, lbound(InData%DampingRatio), ubound(InData%DampingRatio)) + call RegPackBounds(Buf, 1, lbound(InData%DampingRatio, kind=B8Ki), ubound(InData%DampingRatio, kind=B8Ki)) call RegPack(Buf, InData%DampingRatio) end if call RegPack(Buf, allocated(InData%NaturalFreq_Hz)) if (allocated(InData%NaturalFreq_Hz)) then - call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz), ubound(InData%NaturalFreq_Hz)) + call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz, kind=B8Ki), ubound(InData%NaturalFreq_Hz, kind=B8Ki)) call RegPack(Buf, InData%NaturalFreq_Hz) end if call RegPack(Buf, allocated(InData%DampedFreq_Hz)) if (allocated(InData%DampedFreq_Hz)) then - call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz), ubound(InData%DampedFreq_Hz)) + call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz, kind=B8Ki), ubound(InData%DampedFreq_Hz, kind=B8Ki)) call RegPack(Buf, InData%DampedFreq_Hz) end if call RegPack(Buf, allocated(InData%x_eig_magnitude)) if (allocated(InData%x_eig_magnitude)) then - call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude), ubound(InData%x_eig_magnitude)) + call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude, kind=B8Ki), ubound(InData%x_eig_magnitude, kind=B8Ki)) call RegPack(Buf, InData%x_eig_magnitude) end if call RegPack(Buf, allocated(InData%x_eig_phase)) if (allocated(InData%x_eig_phase)) then - call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase), ubound(InData%x_eig_phase)) + call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase, kind=B8Ki), ubound(InData%x_eig_phase, kind=B8Ki)) call RegPack(Buf, InData%x_eig_phase) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1329,7 +1329,7 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_VTK_ModeShapeType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1490,7 +1490,7 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyParam' @@ -1601,8 +1601,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindSpeedOrTSR = SrcParamData%WindSpeedOrTSR DstParamData%RotSpeedInit = SrcParamData%RotSpeedInit if (allocated(SrcParamData%RotSpeed)) then - LB(1:1) = lbound(SrcParamData%RotSpeed) - UB(1:1) = ubound(SrcParamData%RotSpeed) + LB(1:1) = lbound(SrcParamData%RotSpeed, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%RotSpeed, kind=B8Ki) if (.not. allocated(DstParamData%RotSpeed)) then allocate(DstParamData%RotSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1613,8 +1613,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotSpeed = SrcParamData%RotSpeed end if if (allocated(SrcParamData%WS_TSR)) then - LB(1:1) = lbound(SrcParamData%WS_TSR) - UB(1:1) = ubound(SrcParamData%WS_TSR) + LB(1:1) = lbound(SrcParamData%WS_TSR, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WS_TSR, kind=B8Ki) if (.not. allocated(DstParamData%WS_TSR)) then allocate(DstParamData%WS_TSR(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1625,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WS_TSR = SrcParamData%WS_TSR end if if (allocated(SrcParamData%Pitch)) then - LB(1:1) = lbound(SrcParamData%Pitch) - UB(1:1) = ubound(SrcParamData%Pitch) + LB(1:1) = lbound(SrcParamData%Pitch, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%Pitch, kind=B8Ki) if (.not. allocated(DstParamData%Pitch)) then allocate(DstParamData%Pitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1770,17 +1770,17 @@ subroutine FAST_PackParam(Buf, Indata) call RegPack(Buf, InData%RotSpeedInit) call RegPack(Buf, allocated(InData%RotSpeed)) if (allocated(InData%RotSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%RotSpeed), ubound(InData%RotSpeed)) + call RegPackBounds(Buf, 1, lbound(InData%RotSpeed, kind=B8Ki), ubound(InData%RotSpeed, kind=B8Ki)) call RegPack(Buf, InData%RotSpeed) end if call RegPack(Buf, allocated(InData%WS_TSR)) if (allocated(InData%WS_TSR)) then - call RegPackBounds(Buf, 1, lbound(InData%WS_TSR), ubound(InData%WS_TSR)) + call RegPackBounds(Buf, 1, lbound(InData%WS_TSR, kind=B8Ki), ubound(InData%WS_TSR, kind=B8Ki)) call RegPack(Buf, InData%WS_TSR) end if call RegPack(Buf, allocated(InData%Pitch)) if (allocated(InData%Pitch)) then - call RegPackBounds(Buf, 1, lbound(InData%Pitch), ubound(InData%Pitch)) + call RegPackBounds(Buf, 1, lbound(InData%Pitch, kind=B8Ki), ubound(InData%Pitch, kind=B8Ki)) call RegPack(Buf, InData%Pitch) end if call RegPack(Buf, InData%GearBox_index) @@ -1791,7 +1791,7 @@ subroutine FAST_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackParam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2045,16 +2045,16 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyLinStateSave' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLinStateSaveData%x_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%x_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%x_IceD) + LB(1:2) = lbound(SrcLinStateSaveData%x_IceD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%x_IceD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_IceD)) then allocate(DstLinStateSaveData%x_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2071,8 +2071,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD) + LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_IceD)) then allocate(DstLinStateSaveData%xd_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2089,8 +2089,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%z_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%z_IceD) + LB(1:2) = lbound(SrcLinStateSaveData%z_IceD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%z_IceD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_IceD)) then allocate(DstLinStateSaveData%z_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2107,8 +2107,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD) + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_IceD)) then allocate(DstLinStateSaveData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2125,8 +2125,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_IceD)) then - LB(1:2) = lbound(SrcLinStateSaveData%u_IceD) - UB(1:2) = ubound(SrcLinStateSaveData%u_IceD) + LB(1:2) = lbound(SrcLinStateSaveData%u_IceD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%u_IceD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_IceD)) then allocate(DstLinStateSaveData%u_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2143,8 +2143,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%x_BD) - UB(1:2) = ubound(SrcLinStateSaveData%x_BD) + LB(1:2) = lbound(SrcLinStateSaveData%x_BD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%x_BD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_BD)) then allocate(DstLinStateSaveData%x_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2161,8 +2161,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%xd_BD) - UB(1:2) = ubound(SrcLinStateSaveData%xd_BD) + LB(1:2) = lbound(SrcLinStateSaveData%xd_BD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%xd_BD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_BD)) then allocate(DstLinStateSaveData%xd_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2179,8 +2179,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%z_BD) - UB(1:2) = ubound(SrcLinStateSaveData%z_BD) + LB(1:2) = lbound(SrcLinStateSaveData%z_BD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%z_BD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_BD)) then allocate(DstLinStateSaveData%z_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2197,8 +2197,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD) + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_BD)) then allocate(DstLinStateSaveData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2215,8 +2215,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_BD)) then - LB(1:2) = lbound(SrcLinStateSaveData%u_BD) - UB(1:2) = ubound(SrcLinStateSaveData%u_BD) + LB(1:2) = lbound(SrcLinStateSaveData%u_BD, kind=B8Ki) + UB(1:2) = ubound(SrcLinStateSaveData%u_BD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_BD)) then allocate(DstLinStateSaveData%u_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2233,8 +2233,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_ED) - UB(1:1) = ubound(SrcLinStateSaveData%x_ED) + LB(1:1) = lbound(SrcLinStateSaveData%x_ED, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_ED, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_ED)) then allocate(DstLinStateSaveData%x_ED(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2249,8 +2249,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_ED) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ED) + LB(1:1) = lbound(SrcLinStateSaveData%xd_ED, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ED, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_ED)) then allocate(DstLinStateSaveData%xd_ED(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2265,8 +2265,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_ED) - UB(1:1) = ubound(SrcLinStateSaveData%z_ED) + LB(1:1) = lbound(SrcLinStateSaveData%z_ED, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_ED, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_ED)) then allocate(DstLinStateSaveData%z_ED(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2281,8 +2281,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_ED)) then allocate(DstLinStateSaveData%OtherSt_ED(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2297,8 +2297,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_ED)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_ED) - UB(1:1) = ubound(SrcLinStateSaveData%u_ED) + LB(1:1) = lbound(SrcLinStateSaveData%u_ED, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_ED, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_ED)) then allocate(DstLinStateSaveData%u_ED(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2313,8 +2313,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD) + LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_SrvD)) then allocate(DstLinStateSaveData%x_SrvD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2329,8 +2329,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD) + LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_SrvD)) then allocate(DstLinStateSaveData%xd_SrvD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2345,8 +2345,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD) + LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_SrvD)) then allocate(DstLinStateSaveData%z_SrvD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2361,8 +2361,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_SrvD)) then allocate(DstLinStateSaveData%OtherSt_SrvD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2377,8 +2377,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_SrvD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD) - UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD) + LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_SrvD)) then allocate(DstLinStateSaveData%u_SrvD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2393,8 +2393,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_AD) - UB(1:1) = ubound(SrcLinStateSaveData%x_AD) + LB(1:1) = lbound(SrcLinStateSaveData%x_AD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_AD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_AD)) then allocate(DstLinStateSaveData%x_AD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2409,8 +2409,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_AD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_AD) + LB(1:1) = lbound(SrcLinStateSaveData%xd_AD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_AD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_AD)) then allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2425,8 +2425,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_AD) - UB(1:1) = ubound(SrcLinStateSaveData%z_AD) + LB(1:1) = lbound(SrcLinStateSaveData%z_AD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_AD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_AD)) then allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2441,8 +2441,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2457,8 +2457,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_AD) - UB(1:1) = ubound(SrcLinStateSaveData%u_AD) + LB(1:1) = lbound(SrcLinStateSaveData%u_AD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_AD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_AD)) then allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2473,8 +2473,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%x_IfW) + LB(1:1) = lbound(SrcLinStateSaveData%x_IfW, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_IfW, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_IfW)) then allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2489,8 +2489,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW) + LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_IfW)) then allocate(DstLinStateSaveData%xd_IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2505,8 +2505,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%z_IfW) + LB(1:1) = lbound(SrcLinStateSaveData%z_IfW, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_IfW, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_IfW)) then allocate(DstLinStateSaveData%z_IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2521,8 +2521,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_IfW)) then allocate(DstLinStateSaveData%OtherSt_IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2537,8 +2537,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_IfW) - UB(1:1) = ubound(SrcLinStateSaveData%u_IfW) + LB(1:1) = lbound(SrcLinStateSaveData%u_IfW, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_IfW, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_IfW)) then allocate(DstLinStateSaveData%u_IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2553,8 +2553,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_SD) - UB(1:1) = ubound(SrcLinStateSaveData%x_SD) + LB(1:1) = lbound(SrcLinStateSaveData%x_SD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_SD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_SD)) then allocate(DstLinStateSaveData%x_SD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2569,8 +2569,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_SD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SD) + LB(1:1) = lbound(SrcLinStateSaveData%xd_SD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_SD)) then allocate(DstLinStateSaveData%xd_SD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2585,8 +2585,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_SD) - UB(1:1) = ubound(SrcLinStateSaveData%z_SD) + LB(1:1) = lbound(SrcLinStateSaveData%z_SD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_SD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_SD)) then allocate(DstLinStateSaveData%z_SD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2601,8 +2601,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_SD)) then allocate(DstLinStateSaveData%OtherSt_SD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2617,8 +2617,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_SD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_SD) - UB(1:1) = ubound(SrcLinStateSaveData%u_SD) + LB(1:1) = lbound(SrcLinStateSaveData%u_SD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_SD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_SD)) then allocate(DstLinStateSaveData%u_SD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2633,8 +2633,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm) + LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_ExtPtfm)) then allocate(DstLinStateSaveData%x_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2649,8 +2649,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm) + LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_ExtPtfm)) then allocate(DstLinStateSaveData%xd_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2665,8 +2665,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm) + LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_ExtPtfm)) then allocate(DstLinStateSaveData%z_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2681,8 +2681,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then allocate(DstLinStateSaveData%OtherSt_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2697,8 +2697,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm) - UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm) + LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_ExtPtfm)) then allocate(DstLinStateSaveData%u_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2713,8 +2713,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_HD) - UB(1:1) = ubound(SrcLinStateSaveData%x_HD) + LB(1:1) = lbound(SrcLinStateSaveData%x_HD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_HD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_HD)) then allocate(DstLinStateSaveData%x_HD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2729,8 +2729,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_HD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_HD) + LB(1:1) = lbound(SrcLinStateSaveData%xd_HD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_HD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_HD)) then allocate(DstLinStateSaveData%xd_HD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2745,8 +2745,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_HD) - UB(1:1) = ubound(SrcLinStateSaveData%z_HD) + LB(1:1) = lbound(SrcLinStateSaveData%z_HD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_HD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_HD)) then allocate(DstLinStateSaveData%z_HD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2761,8 +2761,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_HD)) then allocate(DstLinStateSaveData%OtherSt_HD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2777,8 +2777,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_HD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_HD) - UB(1:1) = ubound(SrcLinStateSaveData%u_HD) + LB(1:1) = lbound(SrcLinStateSaveData%u_HD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_HD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_HD)) then allocate(DstLinStateSaveData%u_HD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2793,8 +2793,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%x_IceF) + LB(1:1) = lbound(SrcLinStateSaveData%x_IceF, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_IceF, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_IceF)) then allocate(DstLinStateSaveData%x_IceF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2809,8 +2809,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF) + LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_IceF)) then allocate(DstLinStateSaveData%xd_IceF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2825,8 +2825,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%z_IceF) + LB(1:1) = lbound(SrcLinStateSaveData%z_IceF, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_IceF, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_IceF)) then allocate(DstLinStateSaveData%z_IceF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2841,8 +2841,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_IceF)) then allocate(DstLinStateSaveData%OtherSt_IceF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2857,8 +2857,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_IceF)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_IceF) - UB(1:1) = ubound(SrcLinStateSaveData%u_IceF) + LB(1:1) = lbound(SrcLinStateSaveData%u_IceF, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_IceF, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_IceF)) then allocate(DstLinStateSaveData%u_IceF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2873,8 +2873,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%x_MAP) + LB(1:1) = lbound(SrcLinStateSaveData%x_MAP, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_MAP, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_MAP)) then allocate(DstLinStateSaveData%x_MAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2889,8 +2889,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP) + LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_MAP)) then allocate(DstLinStateSaveData%xd_MAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2905,8 +2905,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%z_MAP) + LB(1:1) = lbound(SrcLinStateSaveData%z_MAP, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_MAP, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_MAP)) then allocate(DstLinStateSaveData%z_MAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2921,8 +2921,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_MAP)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_MAP) - UB(1:1) = ubound(SrcLinStateSaveData%u_MAP) + LB(1:1) = lbound(SrcLinStateSaveData%u_MAP, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_MAP, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_MAP)) then allocate(DstLinStateSaveData%u_MAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2937,8 +2937,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM) + LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_FEAM)) then allocate(DstLinStateSaveData%x_FEAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2953,8 +2953,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM) + LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_FEAM)) then allocate(DstLinStateSaveData%xd_FEAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2969,8 +2969,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM) + LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_FEAM)) then allocate(DstLinStateSaveData%z_FEAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2985,8 +2985,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_FEAM)) then allocate(DstLinStateSaveData%OtherSt_FEAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3001,8 +3001,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_FEAM)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM) - UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM) + LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_FEAM)) then allocate(DstLinStateSaveData%u_FEAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3017,8 +3017,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%x_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_MD) - UB(1:1) = ubound(SrcLinStateSaveData%x_MD) + LB(1:1) = lbound(SrcLinStateSaveData%x_MD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_MD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%x_MD)) then allocate(DstLinStateSaveData%x_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3033,8 +3033,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%xd_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_MD) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MD) + LB(1:1) = lbound(SrcLinStateSaveData%xd_MD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%xd_MD)) then allocate(DstLinStateSaveData%xd_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3049,8 +3049,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%z_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_MD) - UB(1:1) = ubound(SrcLinStateSaveData%z_MD) + LB(1:1) = lbound(SrcLinStateSaveData%z_MD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_MD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%z_MD)) then allocate(DstLinStateSaveData%z_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3065,8 +3065,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%OtherSt_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD) + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%OtherSt_MD)) then allocate(DstLinStateSaveData%OtherSt_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3081,8 +3081,8 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC end do end if if (allocated(SrcLinStateSaveData%u_MD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_MD) - UB(1:1) = ubound(SrcLinStateSaveData%u_MD) + LB(1:1) = lbound(SrcLinStateSaveData%u_MD, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_MD, kind=B8Ki) if (.not. allocated(DstLinStateSaveData%u_MD)) then allocate(DstLinStateSaveData%u_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3102,16 +3102,16 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) type(FAST_LinStateSave), intent(inout) :: LinStateSaveData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyLinStateSave' ErrStat = ErrID_None ErrMsg = '' if (allocated(LinStateSaveData%x_IceD)) then - LB(1:2) = lbound(LinStateSaveData%x_IceD) - UB(1:2) = ubound(LinStateSaveData%x_IceD) + LB(1:2) = lbound(LinStateSaveData%x_IceD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%x_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyContState(LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2) @@ -3121,8 +3121,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_IceD) end if if (allocated(LinStateSaveData%xd_IceD)) then - LB(1:2) = lbound(LinStateSaveData%xd_IceD) - UB(1:2) = ubound(LinStateSaveData%xd_IceD) + LB(1:2) = lbound(LinStateSaveData%xd_IceD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%xd_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyDiscState(LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2) @@ -3132,8 +3132,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_IceD) end if if (allocated(LinStateSaveData%z_IceD)) then - LB(1:2) = lbound(LinStateSaveData%z_IceD) - UB(1:2) = ubound(LinStateSaveData%z_IceD) + LB(1:2) = lbound(LinStateSaveData%z_IceD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%z_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyConstrState(LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2) @@ -3143,8 +3143,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_IceD) end if if (allocated(LinStateSaveData%OtherSt_IceD)) then - LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD) - UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD) + LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyOtherState(LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2) @@ -3154,8 +3154,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_IceD) end if if (allocated(LinStateSaveData%u_IceD)) then - LB(1:2) = lbound(LinStateSaveData%u_IceD) - UB(1:2) = ubound(LinStateSaveData%u_IceD) + LB(1:2) = lbound(LinStateSaveData%u_IceD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%u_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyInput(LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2) @@ -3165,8 +3165,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_IceD) end if if (allocated(LinStateSaveData%x_BD)) then - LB(1:2) = lbound(LinStateSaveData%x_BD) - UB(1:2) = ubound(LinStateSaveData%x_BD) + LB(1:2) = lbound(LinStateSaveData%x_BD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%x_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyContState(LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2) @@ -3176,8 +3176,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_BD) end if if (allocated(LinStateSaveData%xd_BD)) then - LB(1:2) = lbound(LinStateSaveData%xd_BD) - UB(1:2) = ubound(LinStateSaveData%xd_BD) + LB(1:2) = lbound(LinStateSaveData%xd_BD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%xd_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyDiscState(LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2) @@ -3187,8 +3187,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_BD) end if if (allocated(LinStateSaveData%z_BD)) then - LB(1:2) = lbound(LinStateSaveData%z_BD) - UB(1:2) = ubound(LinStateSaveData%z_BD) + LB(1:2) = lbound(LinStateSaveData%z_BD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%z_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyConstrState(LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2) @@ -3198,8 +3198,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_BD) end if if (allocated(LinStateSaveData%OtherSt_BD)) then - LB(1:2) = lbound(LinStateSaveData%OtherSt_BD) - UB(1:2) = ubound(LinStateSaveData%OtherSt_BD) + LB(1:2) = lbound(LinStateSaveData%OtherSt_BD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%OtherSt_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyOtherState(LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2) @@ -3209,8 +3209,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_BD) end if if (allocated(LinStateSaveData%u_BD)) then - LB(1:2) = lbound(LinStateSaveData%u_BD) - UB(1:2) = ubound(LinStateSaveData%u_BD) + LB(1:2) = lbound(LinStateSaveData%u_BD, kind=B8Ki) + UB(1:2) = ubound(LinStateSaveData%u_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyInput(LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2) @@ -3220,8 +3220,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_BD) end if if (allocated(LinStateSaveData%x_ED)) then - LB(1:1) = lbound(LinStateSaveData%x_ED) - UB(1:1) = ubound(LinStateSaveData%x_ED) + LB(1:1) = lbound(LinStateSaveData%x_ED, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyContState(LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3229,8 +3229,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_ED) end if if (allocated(LinStateSaveData%xd_ED)) then - LB(1:1) = lbound(LinStateSaveData%xd_ED) - UB(1:1) = ubound(LinStateSaveData%xd_ED) + LB(1:1) = lbound(LinStateSaveData%xd_ED, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyDiscState(LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3238,8 +3238,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_ED) end if if (allocated(LinStateSaveData%z_ED)) then - LB(1:1) = lbound(LinStateSaveData%z_ED) - UB(1:1) = ubound(LinStateSaveData%z_ED) + LB(1:1) = lbound(LinStateSaveData%z_ED, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyConstrState(LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3247,8 +3247,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_ED) end if if (allocated(LinStateSaveData%OtherSt_ED)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_ED) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ED) + LB(1:1) = lbound(LinStateSaveData%OtherSt_ED, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyOtherState(LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3256,8 +3256,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_ED) end if if (allocated(LinStateSaveData%u_ED)) then - LB(1:1) = lbound(LinStateSaveData%u_ED) - UB(1:1) = ubound(LinStateSaveData%u_ED) + LB(1:1) = lbound(LinStateSaveData%u_ED, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyInput(LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3265,8 +3265,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_ED) end if if (allocated(LinStateSaveData%x_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%x_SrvD) - UB(1:1) = ubound(LinStateSaveData%x_SrvD) + LB(1:1) = lbound(LinStateSaveData%x_SrvD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyContState(LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3274,8 +3274,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_SrvD) end if if (allocated(LinStateSaveData%xd_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%xd_SrvD) - UB(1:1) = ubound(LinStateSaveData%xd_SrvD) + LB(1:1) = lbound(LinStateSaveData%xd_SrvD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyDiscState(LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3283,8 +3283,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_SrvD) end if if (allocated(LinStateSaveData%z_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%z_SrvD) - UB(1:1) = ubound(LinStateSaveData%z_SrvD) + LB(1:1) = lbound(LinStateSaveData%z_SrvD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyConstrState(LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3292,8 +3292,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_SrvD) end if if (allocated(LinStateSaveData%OtherSt_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD) + LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyOtherState(LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3301,8 +3301,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_SrvD) end if if (allocated(LinStateSaveData%u_SrvD)) then - LB(1:1) = lbound(LinStateSaveData%u_SrvD) - UB(1:1) = ubound(LinStateSaveData%u_SrvD) + LB(1:1) = lbound(LinStateSaveData%u_SrvD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyInput(LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3310,8 +3310,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_SrvD) end if if (allocated(LinStateSaveData%x_AD)) then - LB(1:1) = lbound(LinStateSaveData%x_AD) - UB(1:1) = ubound(LinStateSaveData%x_AD) + LB(1:1) = lbound(LinStateSaveData%x_AD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyContState(LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3319,8 +3319,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_AD) end if if (allocated(LinStateSaveData%xd_AD)) then - LB(1:1) = lbound(LinStateSaveData%xd_AD) - UB(1:1) = ubound(LinStateSaveData%xd_AD) + LB(1:1) = lbound(LinStateSaveData%xd_AD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyDiscState(LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3328,8 +3328,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_AD) end if if (allocated(LinStateSaveData%z_AD)) then - LB(1:1) = lbound(LinStateSaveData%z_AD) - UB(1:1) = ubound(LinStateSaveData%z_AD) + LB(1:1) = lbound(LinStateSaveData%z_AD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyConstrState(LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3337,8 +3337,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_AD) end if if (allocated(LinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_AD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_AD) + LB(1:1) = lbound(LinStateSaveData%OtherSt_AD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyOtherState(LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3346,8 +3346,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_AD) end if if (allocated(LinStateSaveData%u_AD)) then - LB(1:1) = lbound(LinStateSaveData%u_AD) - UB(1:1) = ubound(LinStateSaveData%u_AD) + LB(1:1) = lbound(LinStateSaveData%u_AD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyInput(LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3355,8 +3355,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_AD) end if if (allocated(LinStateSaveData%x_IfW)) then - LB(1:1) = lbound(LinStateSaveData%x_IfW) - UB(1:1) = ubound(LinStateSaveData%x_IfW) + LB(1:1) = lbound(LinStateSaveData%x_IfW, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyContState(LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3364,8 +3364,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_IfW) end if if (allocated(LinStateSaveData%xd_IfW)) then - LB(1:1) = lbound(LinStateSaveData%xd_IfW) - UB(1:1) = ubound(LinStateSaveData%xd_IfW) + LB(1:1) = lbound(LinStateSaveData%xd_IfW, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyDiscState(LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3373,8 +3373,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_IfW) end if if (allocated(LinStateSaveData%z_IfW)) then - LB(1:1) = lbound(LinStateSaveData%z_IfW) - UB(1:1) = ubound(LinStateSaveData%z_IfW) + LB(1:1) = lbound(LinStateSaveData%z_IfW, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyConstrState(LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3382,8 +3382,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_IfW) end if if (allocated(LinStateSaveData%OtherSt_IfW)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW) + LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyOtherState(LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3391,8 +3391,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_IfW) end if if (allocated(LinStateSaveData%u_IfW)) then - LB(1:1) = lbound(LinStateSaveData%u_IfW) - UB(1:1) = ubound(LinStateSaveData%u_IfW) + LB(1:1) = lbound(LinStateSaveData%u_IfW, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyInput(LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3400,8 +3400,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_IfW) end if if (allocated(LinStateSaveData%x_SD)) then - LB(1:1) = lbound(LinStateSaveData%x_SD) - UB(1:1) = ubound(LinStateSaveData%x_SD) + LB(1:1) = lbound(LinStateSaveData%x_SD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyContState(LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3409,8 +3409,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_SD) end if if (allocated(LinStateSaveData%xd_SD)) then - LB(1:1) = lbound(LinStateSaveData%xd_SD) - UB(1:1) = ubound(LinStateSaveData%xd_SD) + LB(1:1) = lbound(LinStateSaveData%xd_SD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyDiscState(LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3418,8 +3418,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_SD) end if if (allocated(LinStateSaveData%z_SD)) then - LB(1:1) = lbound(LinStateSaveData%z_SD) - UB(1:1) = ubound(LinStateSaveData%z_SD) + LB(1:1) = lbound(LinStateSaveData%z_SD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyConstrState(LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3427,8 +3427,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_SD) end if if (allocated(LinStateSaveData%OtherSt_SD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_SD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SD) + LB(1:1) = lbound(LinStateSaveData%OtherSt_SD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyOtherState(LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3436,8 +3436,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_SD) end if if (allocated(LinStateSaveData%u_SD)) then - LB(1:1) = lbound(LinStateSaveData%u_SD) - UB(1:1) = ubound(LinStateSaveData%u_SD) + LB(1:1) = lbound(LinStateSaveData%u_SD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyInput(LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3445,8 +3445,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_SD) end if if (allocated(LinStateSaveData%x_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm) + LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyContState(LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3454,8 +3454,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_ExtPtfm) end if if (allocated(LinStateSaveData%xd_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm) + LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyDiscState(LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3463,8 +3463,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_ExtPtfm) end if if (allocated(LinStateSaveData%z_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm) + LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyConstrState(LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3472,8 +3472,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_ExtPtfm) end if if (allocated(LinStateSaveData%OtherSt_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm) + LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyOtherState(LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3481,8 +3481,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_ExtPtfm) end if if (allocated(LinStateSaveData%u_ExtPtfm)) then - LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm) - UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm) + LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyInput(LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3490,8 +3490,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_ExtPtfm) end if if (allocated(LinStateSaveData%x_HD)) then - LB(1:1) = lbound(LinStateSaveData%x_HD) - UB(1:1) = ubound(LinStateSaveData%x_HD) + LB(1:1) = lbound(LinStateSaveData%x_HD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyContState(LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3499,8 +3499,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_HD) end if if (allocated(LinStateSaveData%xd_HD)) then - LB(1:1) = lbound(LinStateSaveData%xd_HD) - UB(1:1) = ubound(LinStateSaveData%xd_HD) + LB(1:1) = lbound(LinStateSaveData%xd_HD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyDiscState(LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3508,8 +3508,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_HD) end if if (allocated(LinStateSaveData%z_HD)) then - LB(1:1) = lbound(LinStateSaveData%z_HD) - UB(1:1) = ubound(LinStateSaveData%z_HD) + LB(1:1) = lbound(LinStateSaveData%z_HD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyConstrState(LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3517,8 +3517,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_HD) end if if (allocated(LinStateSaveData%OtherSt_HD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_HD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_HD) + LB(1:1) = lbound(LinStateSaveData%OtherSt_HD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyOtherState(LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3526,8 +3526,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_HD) end if if (allocated(LinStateSaveData%u_HD)) then - LB(1:1) = lbound(LinStateSaveData%u_HD) - UB(1:1) = ubound(LinStateSaveData%u_HD) + LB(1:1) = lbound(LinStateSaveData%u_HD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyInput(LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3535,8 +3535,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_HD) end if if (allocated(LinStateSaveData%x_IceF)) then - LB(1:1) = lbound(LinStateSaveData%x_IceF) - UB(1:1) = ubound(LinStateSaveData%x_IceF) + LB(1:1) = lbound(LinStateSaveData%x_IceF, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyContState(LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3544,8 +3544,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_IceF) end if if (allocated(LinStateSaveData%xd_IceF)) then - LB(1:1) = lbound(LinStateSaveData%xd_IceF) - UB(1:1) = ubound(LinStateSaveData%xd_IceF) + LB(1:1) = lbound(LinStateSaveData%xd_IceF, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyDiscState(LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3553,8 +3553,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_IceF) end if if (allocated(LinStateSaveData%z_IceF)) then - LB(1:1) = lbound(LinStateSaveData%z_IceF) - UB(1:1) = ubound(LinStateSaveData%z_IceF) + LB(1:1) = lbound(LinStateSaveData%z_IceF, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyConstrState(LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3562,8 +3562,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_IceF) end if if (allocated(LinStateSaveData%OtherSt_IceF)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF) + LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyOtherState(LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3571,8 +3571,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_IceF) end if if (allocated(LinStateSaveData%u_IceF)) then - LB(1:1) = lbound(LinStateSaveData%u_IceF) - UB(1:1) = ubound(LinStateSaveData%u_IceF) + LB(1:1) = lbound(LinStateSaveData%u_IceF, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyInput(LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3580,8 +3580,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_IceF) end if if (allocated(LinStateSaveData%x_MAP)) then - LB(1:1) = lbound(LinStateSaveData%x_MAP) - UB(1:1) = ubound(LinStateSaveData%x_MAP) + LB(1:1) = lbound(LinStateSaveData%x_MAP, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyContState(LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3589,8 +3589,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_MAP) end if if (allocated(LinStateSaveData%xd_MAP)) then - LB(1:1) = lbound(LinStateSaveData%xd_MAP) - UB(1:1) = ubound(LinStateSaveData%xd_MAP) + LB(1:1) = lbound(LinStateSaveData%xd_MAP, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyDiscState(LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3598,8 +3598,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_MAP) end if if (allocated(LinStateSaveData%z_MAP)) then - LB(1:1) = lbound(LinStateSaveData%z_MAP) - UB(1:1) = ubound(LinStateSaveData%z_MAP) + LB(1:1) = lbound(LinStateSaveData%z_MAP, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyConstrState(LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3607,8 +3607,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_MAP) end if if (allocated(LinStateSaveData%u_MAP)) then - LB(1:1) = lbound(LinStateSaveData%u_MAP) - UB(1:1) = ubound(LinStateSaveData%u_MAP) + LB(1:1) = lbound(LinStateSaveData%u_MAP, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyInput(LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3616,8 +3616,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_MAP) end if if (allocated(LinStateSaveData%x_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%x_FEAM) - UB(1:1) = ubound(LinStateSaveData%x_FEAM) + LB(1:1) = lbound(LinStateSaveData%x_FEAM, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyContState(LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3625,8 +3625,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_FEAM) end if if (allocated(LinStateSaveData%xd_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%xd_FEAM) - UB(1:1) = ubound(LinStateSaveData%xd_FEAM) + LB(1:1) = lbound(LinStateSaveData%xd_FEAM, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyDiscState(LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3634,8 +3634,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_FEAM) end if if (allocated(LinStateSaveData%z_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%z_FEAM) - UB(1:1) = ubound(LinStateSaveData%z_FEAM) + LB(1:1) = lbound(LinStateSaveData%z_FEAM, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyConstrState(LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3643,8 +3643,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_FEAM) end if if (allocated(LinStateSaveData%OtherSt_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM) - UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM) + LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyOtherState(LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3652,8 +3652,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_FEAM) end if if (allocated(LinStateSaveData%u_FEAM)) then - LB(1:1) = lbound(LinStateSaveData%u_FEAM) - UB(1:1) = ubound(LinStateSaveData%u_FEAM) + LB(1:1) = lbound(LinStateSaveData%u_FEAM, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyInput(LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3661,8 +3661,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%u_FEAM) end if if (allocated(LinStateSaveData%x_MD)) then - LB(1:1) = lbound(LinStateSaveData%x_MD) - UB(1:1) = ubound(LinStateSaveData%x_MD) + LB(1:1) = lbound(LinStateSaveData%x_MD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyContState(LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3670,8 +3670,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%x_MD) end if if (allocated(LinStateSaveData%xd_MD)) then - LB(1:1) = lbound(LinStateSaveData%xd_MD) - UB(1:1) = ubound(LinStateSaveData%xd_MD) + LB(1:1) = lbound(LinStateSaveData%xd_MD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyDiscState(LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3679,8 +3679,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%xd_MD) end if if (allocated(LinStateSaveData%z_MD)) then - LB(1:1) = lbound(LinStateSaveData%z_MD) - UB(1:1) = ubound(LinStateSaveData%z_MD) + LB(1:1) = lbound(LinStateSaveData%z_MD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyConstrState(LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3688,8 +3688,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%z_MD) end if if (allocated(LinStateSaveData%OtherSt_MD)) then - LB(1:1) = lbound(LinStateSaveData%OtherSt_MD) - UB(1:1) = ubound(LinStateSaveData%OtherSt_MD) + LB(1:1) = lbound(LinStateSaveData%OtherSt_MD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyOtherState(LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3697,8 +3697,8 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) deallocate(LinStateSaveData%OtherSt_MD) end if if (allocated(LinStateSaveData%u_MD)) then - LB(1:1) = lbound(LinStateSaveData%u_MD) - UB(1:1) = ubound(LinStateSaveData%u_MD) + LB(1:1) = lbound(LinStateSaveData%u_MD, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyInput(LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3711,14 +3711,14 @@ subroutine FAST_PackLinStateSave(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_LinStateSave), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%x_IceD)) if (allocated(InData%x_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) - LB(1:2) = lbound(InData%x_IceD) - UB(1:2) = ubound(InData%x_IceD) + call RegPackBounds(Buf, 2, lbound(InData%x_IceD, kind=B8Ki), ubound(InData%x_IceD, kind=B8Ki)) + LB(1:2) = lbound(InData%x_IceD, kind=B8Ki) + UB(1:2) = ubound(InData%x_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackContState(Buf, InData%x_IceD(i1,i2)) @@ -3727,9 +3727,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%xd_IceD)) if (allocated(InData%xd_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) - LB(1:2) = lbound(InData%xd_IceD) - UB(1:2) = ubound(InData%xd_IceD) + call RegPackBounds(Buf, 2, lbound(InData%xd_IceD, kind=B8Ki), ubound(InData%xd_IceD, kind=B8Ki)) + LB(1:2) = lbound(InData%xd_IceD, kind=B8Ki) + UB(1:2) = ubound(InData%xd_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackDiscState(Buf, InData%xd_IceD(i1,i2)) @@ -3738,9 +3738,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%z_IceD)) if (allocated(InData%z_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) - LB(1:2) = lbound(InData%z_IceD) - UB(1:2) = ubound(InData%z_IceD) + call RegPackBounds(Buf, 2, lbound(InData%z_IceD, kind=B8Ki), ubound(InData%z_IceD, kind=B8Ki)) + LB(1:2) = lbound(InData%z_IceD, kind=B8Ki) + UB(1:2) = ubound(InData%z_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackConstrState(Buf, InData%z_IceD(i1,i2)) @@ -3749,9 +3749,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%OtherSt_IceD)) if (allocated(InData%OtherSt_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) - LB(1:2) = lbound(InData%OtherSt_IceD) - UB(1:2) = ubound(InData%OtherSt_IceD) + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD, kind=B8Ki), ubound(InData%OtherSt_IceD, kind=B8Ki)) + LB(1:2) = lbound(InData%OtherSt_IceD, kind=B8Ki) + UB(1:2) = ubound(InData%OtherSt_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackOtherState(Buf, InData%OtherSt_IceD(i1,i2)) @@ -3760,9 +3760,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%u_IceD)) if (allocated(InData%u_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) - LB(1:2) = lbound(InData%u_IceD) - UB(1:2) = ubound(InData%u_IceD) + call RegPackBounds(Buf, 2, lbound(InData%u_IceD, kind=B8Ki), ubound(InData%u_IceD, kind=B8Ki)) + LB(1:2) = lbound(InData%u_IceD, kind=B8Ki) + UB(1:2) = ubound(InData%u_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackInput(Buf, InData%u_IceD(i1,i2)) @@ -3771,9 +3771,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%x_BD)) if (allocated(InData%x_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%x_BD), ubound(InData%x_BD)) - LB(1:2) = lbound(InData%x_BD) - UB(1:2) = ubound(InData%x_BD) + call RegPackBounds(Buf, 2, lbound(InData%x_BD, kind=B8Ki), ubound(InData%x_BD, kind=B8Ki)) + LB(1:2) = lbound(InData%x_BD, kind=B8Ki) + UB(1:2) = ubound(InData%x_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackContState(Buf, InData%x_BD(i1,i2)) @@ -3782,9 +3782,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%xd_BD)) if (allocated(InData%xd_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) - LB(1:2) = lbound(InData%xd_BD) - UB(1:2) = ubound(InData%xd_BD) + call RegPackBounds(Buf, 2, lbound(InData%xd_BD, kind=B8Ki), ubound(InData%xd_BD, kind=B8Ki)) + LB(1:2) = lbound(InData%xd_BD, kind=B8Ki) + UB(1:2) = ubound(InData%xd_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackDiscState(Buf, InData%xd_BD(i1,i2)) @@ -3793,9 +3793,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%z_BD)) if (allocated(InData%z_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%z_BD), ubound(InData%z_BD)) - LB(1:2) = lbound(InData%z_BD) - UB(1:2) = ubound(InData%z_BD) + call RegPackBounds(Buf, 2, lbound(InData%z_BD, kind=B8Ki), ubound(InData%z_BD, kind=B8Ki)) + LB(1:2) = lbound(InData%z_BD, kind=B8Ki) + UB(1:2) = ubound(InData%z_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackConstrState(Buf, InData%z_BD(i1,i2)) @@ -3804,9 +3804,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%OtherSt_BD)) if (allocated(InData%OtherSt_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) - LB(1:2) = lbound(InData%OtherSt_BD) - UB(1:2) = ubound(InData%OtherSt_BD) + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD, kind=B8Ki), ubound(InData%OtherSt_BD, kind=B8Ki)) + LB(1:2) = lbound(InData%OtherSt_BD, kind=B8Ki) + UB(1:2) = ubound(InData%OtherSt_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackOtherState(Buf, InData%OtherSt_BD(i1,i2)) @@ -3815,9 +3815,9 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%u_BD)) if (allocated(InData%u_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BD), ubound(InData%u_BD)) - LB(1:2) = lbound(InData%u_BD) - UB(1:2) = ubound(InData%u_BD) + call RegPackBounds(Buf, 2, lbound(InData%u_BD, kind=B8Ki), ubound(InData%u_BD, kind=B8Ki)) + LB(1:2) = lbound(InData%u_BD, kind=B8Ki) + UB(1:2) = ubound(InData%u_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackInput(Buf, InData%u_BD(i1,i2)) @@ -3826,486 +3826,486 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end if call RegPack(Buf, allocated(InData%x_ED)) if (allocated(InData%x_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%x_ED), ubound(InData%x_ED)) - LB(1:1) = lbound(InData%x_ED) - UB(1:1) = ubound(InData%x_ED) + call RegPackBounds(Buf, 1, lbound(InData%x_ED, kind=B8Ki), ubound(InData%x_ED, kind=B8Ki)) + LB(1:1) = lbound(InData%x_ED, kind=B8Ki) + UB(1:1) = ubound(InData%x_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%x_ED(i1)) end do end if call RegPack(Buf, allocated(InData%xd_ED)) if (allocated(InData%xd_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) - LB(1:1) = lbound(InData%xd_ED) - UB(1:1) = ubound(InData%xd_ED) + call RegPackBounds(Buf, 1, lbound(InData%xd_ED, kind=B8Ki), ubound(InData%xd_ED, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_ED, kind=B8Ki) + UB(1:1) = ubound(InData%xd_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackDiscState(Buf, InData%xd_ED(i1)) end do end if call RegPack(Buf, allocated(InData%z_ED)) if (allocated(InData%z_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%z_ED), ubound(InData%z_ED)) - LB(1:1) = lbound(InData%z_ED) - UB(1:1) = ubound(InData%z_ED) + call RegPackBounds(Buf, 1, lbound(InData%z_ED, kind=B8Ki), ubound(InData%z_ED, kind=B8Ki)) + LB(1:1) = lbound(InData%z_ED, kind=B8Ki) + UB(1:1) = ubound(InData%z_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackConstrState(Buf, InData%z_ED(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_ED)) if (allocated(InData%OtherSt_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) - LB(1:1) = lbound(InData%OtherSt_ED) - UB(1:1) = ubound(InData%OtherSt_ED) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED, kind=B8Ki), ubound(InData%OtherSt_ED, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_ED, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) end do end if call RegPack(Buf, allocated(InData%u_ED)) if (allocated(InData%u_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ED), ubound(InData%u_ED)) - LB(1:1) = lbound(InData%u_ED) - UB(1:1) = ubound(InData%u_ED) + call RegPackBounds(Buf, 1, lbound(InData%u_ED, kind=B8Ki), ubound(InData%u_ED, kind=B8Ki)) + LB(1:1) = lbound(InData%u_ED, kind=B8Ki) + UB(1:1) = ubound(InData%u_ED, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackInput(Buf, InData%u_ED(i1)) end do end if call RegPack(Buf, allocated(InData%x_SrvD)) if (allocated(InData%x_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) - LB(1:1) = lbound(InData%x_SrvD) - UB(1:1) = ubound(InData%x_SrvD) + call RegPackBounds(Buf, 1, lbound(InData%x_SrvD, kind=B8Ki), ubound(InData%x_SrvD, kind=B8Ki)) + LB(1:1) = lbound(InData%x_SrvD, kind=B8Ki) + UB(1:1) = ubound(InData%x_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackContState(Buf, InData%x_SrvD(i1)) end do end if call RegPack(Buf, allocated(InData%xd_SrvD)) if (allocated(InData%xd_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) - LB(1:1) = lbound(InData%xd_SrvD) - UB(1:1) = ubound(InData%xd_SrvD) + call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD, kind=B8Ki), ubound(InData%xd_SrvD, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_SrvD, kind=B8Ki) + UB(1:1) = ubound(InData%xd_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) end do end if call RegPack(Buf, allocated(InData%z_SrvD)) if (allocated(InData%z_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) - LB(1:1) = lbound(InData%z_SrvD) - UB(1:1) = ubound(InData%z_SrvD) + call RegPackBounds(Buf, 1, lbound(InData%z_SrvD, kind=B8Ki), ubound(InData%z_SrvD, kind=B8Ki)) + LB(1:1) = lbound(InData%z_SrvD, kind=B8Ki) + UB(1:1) = ubound(InData%z_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_SrvD)) if (allocated(InData%OtherSt_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) - LB(1:1) = lbound(InData%OtherSt_SrvD) - UB(1:1) = ubound(InData%OtherSt_SrvD) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD, kind=B8Ki), ubound(InData%OtherSt_SrvD, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_SrvD, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) end do end if call RegPack(Buf, allocated(InData%u_SrvD)) if (allocated(InData%u_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) - LB(1:1) = lbound(InData%u_SrvD) - UB(1:1) = ubound(InData%u_SrvD) + call RegPackBounds(Buf, 1, lbound(InData%u_SrvD, kind=B8Ki), ubound(InData%u_SrvD, kind=B8Ki)) + LB(1:1) = lbound(InData%u_SrvD, kind=B8Ki) + UB(1:1) = ubound(InData%u_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackInput(Buf, InData%u_SrvD(i1)) end do end if call RegPack(Buf, allocated(InData%x_AD)) if (allocated(InData%x_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_AD), ubound(InData%x_AD)) - LB(1:1) = lbound(InData%x_AD) - UB(1:1) = ubound(InData%x_AD) + call RegPackBounds(Buf, 1, lbound(InData%x_AD, kind=B8Ki), ubound(InData%x_AD, kind=B8Ki)) + LB(1:1) = lbound(InData%x_AD, kind=B8Ki) + UB(1:1) = ubound(InData%x_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackContState(Buf, InData%x_AD(i1)) end do end if call RegPack(Buf, allocated(InData%xd_AD)) if (allocated(InData%xd_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) - LB(1:1) = lbound(InData%xd_AD) - UB(1:1) = ubound(InData%xd_AD) + call RegPackBounds(Buf, 1, lbound(InData%xd_AD, kind=B8Ki), ubound(InData%xd_AD, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_AD, kind=B8Ki) + UB(1:1) = ubound(InData%xd_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackDiscState(Buf, InData%xd_AD(i1)) end do end if call RegPack(Buf, allocated(InData%z_AD)) if (allocated(InData%z_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_AD), ubound(InData%z_AD)) - LB(1:1) = lbound(InData%z_AD) - UB(1:1) = ubound(InData%z_AD) + call RegPackBounds(Buf, 1, lbound(InData%z_AD, kind=B8Ki), ubound(InData%z_AD, kind=B8Ki)) + LB(1:1) = lbound(InData%z_AD, kind=B8Ki) + UB(1:1) = ubound(InData%z_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackConstrState(Buf, InData%z_AD(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_AD)) if (allocated(InData%OtherSt_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) - LB(1:1) = lbound(InData%OtherSt_AD) - UB(1:1) = ubound(InData%OtherSt_AD) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD, kind=B8Ki), ubound(InData%OtherSt_AD, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_AD, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) end do end if call RegPack(Buf, allocated(InData%u_AD)) if (allocated(InData%u_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_AD), ubound(InData%u_AD)) - LB(1:1) = lbound(InData%u_AD) - UB(1:1) = ubound(InData%u_AD) + call RegPackBounds(Buf, 1, lbound(InData%u_AD, kind=B8Ki), ubound(InData%u_AD, kind=B8Ki)) + LB(1:1) = lbound(InData%u_AD, kind=B8Ki) + UB(1:1) = ubound(InData%u_AD, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackInput(Buf, InData%u_AD(i1)) end do end if call RegPack(Buf, allocated(InData%x_IfW)) if (allocated(InData%x_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) - LB(1:1) = lbound(InData%x_IfW) - UB(1:1) = ubound(InData%x_IfW) + call RegPackBounds(Buf, 1, lbound(InData%x_IfW, kind=B8Ki), ubound(InData%x_IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%x_IfW, kind=B8Ki) + UB(1:1) = ubound(InData%x_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackContState(Buf, InData%x_IfW(i1)) end do end if call RegPack(Buf, allocated(InData%xd_IfW)) if (allocated(InData%xd_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) - LB(1:1) = lbound(InData%xd_IfW) - UB(1:1) = ubound(InData%xd_IfW) + call RegPackBounds(Buf, 1, lbound(InData%xd_IfW, kind=B8Ki), ubound(InData%xd_IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_IfW, kind=B8Ki) + UB(1:1) = ubound(InData%xd_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) end do end if call RegPack(Buf, allocated(InData%z_IfW)) if (allocated(InData%z_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) - LB(1:1) = lbound(InData%z_IfW) - UB(1:1) = ubound(InData%z_IfW) + call RegPackBounds(Buf, 1, lbound(InData%z_IfW, kind=B8Ki), ubound(InData%z_IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%z_IfW, kind=B8Ki) + UB(1:1) = ubound(InData%z_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_IfW)) if (allocated(InData%OtherSt_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) - LB(1:1) = lbound(InData%OtherSt_IfW) - UB(1:1) = ubound(InData%OtherSt_IfW) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW, kind=B8Ki), ubound(InData%OtherSt_IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_IfW, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) end do end if call RegPack(Buf, allocated(InData%u_IfW)) if (allocated(InData%u_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) - LB(1:1) = lbound(InData%u_IfW) - UB(1:1) = ubound(InData%u_IfW) + call RegPackBounds(Buf, 1, lbound(InData%u_IfW, kind=B8Ki), ubound(InData%u_IfW, kind=B8Ki)) + LB(1:1) = lbound(InData%u_IfW, kind=B8Ki) + UB(1:1) = ubound(InData%u_IfW, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackInput(Buf, InData%u_IfW(i1)) end do end if call RegPack(Buf, allocated(InData%x_SD)) if (allocated(InData%x_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_SD), ubound(InData%x_SD)) - LB(1:1) = lbound(InData%x_SD) - UB(1:1) = ubound(InData%x_SD) + call RegPackBounds(Buf, 1, lbound(InData%x_SD, kind=B8Ki), ubound(InData%x_SD, kind=B8Ki)) + LB(1:1) = lbound(InData%x_SD, kind=B8Ki) + UB(1:1) = ubound(InData%x_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackContState(Buf, InData%x_SD(i1)) end do end if call RegPack(Buf, allocated(InData%xd_SD)) if (allocated(InData%xd_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) - LB(1:1) = lbound(InData%xd_SD) - UB(1:1) = ubound(InData%xd_SD) + call RegPackBounds(Buf, 1, lbound(InData%xd_SD, kind=B8Ki), ubound(InData%xd_SD, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_SD, kind=B8Ki) + UB(1:1) = ubound(InData%xd_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackDiscState(Buf, InData%xd_SD(i1)) end do end if call RegPack(Buf, allocated(InData%z_SD)) if (allocated(InData%z_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_SD), ubound(InData%z_SD)) - LB(1:1) = lbound(InData%z_SD) - UB(1:1) = ubound(InData%z_SD) + call RegPackBounds(Buf, 1, lbound(InData%z_SD, kind=B8Ki), ubound(InData%z_SD, kind=B8Ki)) + LB(1:1) = lbound(InData%z_SD, kind=B8Ki) + UB(1:1) = ubound(InData%z_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackConstrState(Buf, InData%z_SD(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_SD)) if (allocated(InData%OtherSt_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) - LB(1:1) = lbound(InData%OtherSt_SD) - UB(1:1) = ubound(InData%OtherSt_SD) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD, kind=B8Ki), ubound(InData%OtherSt_SD, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_SD, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) end do end if call RegPack(Buf, allocated(InData%u_SD)) if (allocated(InData%u_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SD), ubound(InData%u_SD)) - LB(1:1) = lbound(InData%u_SD) - UB(1:1) = ubound(InData%u_SD) + call RegPackBounds(Buf, 1, lbound(InData%u_SD, kind=B8Ki), ubound(InData%u_SD, kind=B8Ki)) + LB(1:1) = lbound(InData%u_SD, kind=B8Ki) + UB(1:1) = ubound(InData%u_SD, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackInput(Buf, InData%u_SD(i1)) end do end if call RegPack(Buf, allocated(InData%x_ExtPtfm)) if (allocated(InData%x_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) - LB(1:1) = lbound(InData%x_ExtPtfm) - UB(1:1) = ubound(InData%x_ExtPtfm) + call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm, kind=B8Ki), ubound(InData%x_ExtPtfm, kind=B8Ki)) + LB(1:1) = lbound(InData%x_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(InData%x_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) end do end if call RegPack(Buf, allocated(InData%xd_ExtPtfm)) if (allocated(InData%xd_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) - LB(1:1) = lbound(InData%xd_ExtPtfm) - UB(1:1) = ubound(InData%xd_ExtPtfm) + call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm, kind=B8Ki), ubound(InData%xd_ExtPtfm, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(InData%xd_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) end do end if call RegPack(Buf, allocated(InData%z_ExtPtfm)) if (allocated(InData%z_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) - LB(1:1) = lbound(InData%z_ExtPtfm) - UB(1:1) = ubound(InData%z_ExtPtfm) + call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm, kind=B8Ki), ubound(InData%z_ExtPtfm, kind=B8Ki)) + LB(1:1) = lbound(InData%z_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(InData%z_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) if (allocated(InData%OtherSt_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) - LB(1:1) = lbound(InData%OtherSt_ExtPtfm) - UB(1:1) = ubound(InData%OtherSt_ExtPtfm) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm, kind=B8Ki), ubound(InData%OtherSt_ExtPtfm, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) end do end if call RegPack(Buf, allocated(InData%u_ExtPtfm)) if (allocated(InData%u_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) - LB(1:1) = lbound(InData%u_ExtPtfm) - UB(1:1) = ubound(InData%u_ExtPtfm) + call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm, kind=B8Ki), ubound(InData%u_ExtPtfm, kind=B8Ki)) + LB(1:1) = lbound(InData%u_ExtPtfm, kind=B8Ki) + UB(1:1) = ubound(InData%u_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) end do end if call RegPack(Buf, allocated(InData%x_HD)) if (allocated(InData%x_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_HD), ubound(InData%x_HD)) - LB(1:1) = lbound(InData%x_HD) - UB(1:1) = ubound(InData%x_HD) + call RegPackBounds(Buf, 1, lbound(InData%x_HD, kind=B8Ki), ubound(InData%x_HD, kind=B8Ki)) + LB(1:1) = lbound(InData%x_HD, kind=B8Ki) + UB(1:1) = ubound(InData%x_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackContState(Buf, InData%x_HD(i1)) end do end if call RegPack(Buf, allocated(InData%xd_HD)) if (allocated(InData%xd_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) - LB(1:1) = lbound(InData%xd_HD) - UB(1:1) = ubound(InData%xd_HD) + call RegPackBounds(Buf, 1, lbound(InData%xd_HD, kind=B8Ki), ubound(InData%xd_HD, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_HD, kind=B8Ki) + UB(1:1) = ubound(InData%xd_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) end do end if call RegPack(Buf, allocated(InData%z_HD)) if (allocated(InData%z_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_HD), ubound(InData%z_HD)) - LB(1:1) = lbound(InData%z_HD) - UB(1:1) = ubound(InData%z_HD) + call RegPackBounds(Buf, 1, lbound(InData%z_HD, kind=B8Ki), ubound(InData%z_HD, kind=B8Ki)) + LB(1:1) = lbound(InData%z_HD, kind=B8Ki) + UB(1:1) = ubound(InData%z_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_HD)) if (allocated(InData%OtherSt_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) - LB(1:1) = lbound(InData%OtherSt_HD) - UB(1:1) = ubound(InData%OtherSt_HD) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD, kind=B8Ki), ubound(InData%OtherSt_HD, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_HD, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) end do end if call RegPack(Buf, allocated(InData%u_HD)) if (allocated(InData%u_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_HD), ubound(InData%u_HD)) - LB(1:1) = lbound(InData%u_HD) - UB(1:1) = ubound(InData%u_HD) + call RegPackBounds(Buf, 1, lbound(InData%u_HD, kind=B8Ki), ubound(InData%u_HD, kind=B8Ki)) + LB(1:1) = lbound(InData%u_HD, kind=B8Ki) + UB(1:1) = ubound(InData%u_HD, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackInput(Buf, InData%u_HD(i1)) end do end if call RegPack(Buf, allocated(InData%x_IceF)) if (allocated(InData%x_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) - LB(1:1) = lbound(InData%x_IceF) - UB(1:1) = ubound(InData%x_IceF) + call RegPackBounds(Buf, 1, lbound(InData%x_IceF, kind=B8Ki), ubound(InData%x_IceF, kind=B8Ki)) + LB(1:1) = lbound(InData%x_IceF, kind=B8Ki) + UB(1:1) = ubound(InData%x_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackContState(Buf, InData%x_IceF(i1)) end do end if call RegPack(Buf, allocated(InData%xd_IceF)) if (allocated(InData%xd_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) - LB(1:1) = lbound(InData%xd_IceF) - UB(1:1) = ubound(InData%xd_IceF) + call RegPackBounds(Buf, 1, lbound(InData%xd_IceF, kind=B8Ki), ubound(InData%xd_IceF, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_IceF, kind=B8Ki) + UB(1:1) = ubound(InData%xd_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) end do end if call RegPack(Buf, allocated(InData%z_IceF)) if (allocated(InData%z_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) - LB(1:1) = lbound(InData%z_IceF) - UB(1:1) = ubound(InData%z_IceF) + call RegPackBounds(Buf, 1, lbound(InData%z_IceF, kind=B8Ki), ubound(InData%z_IceF, kind=B8Ki)) + LB(1:1) = lbound(InData%z_IceF, kind=B8Ki) + UB(1:1) = ubound(InData%z_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_IceF)) if (allocated(InData%OtherSt_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) - LB(1:1) = lbound(InData%OtherSt_IceF) - UB(1:1) = ubound(InData%OtherSt_IceF) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF, kind=B8Ki), ubound(InData%OtherSt_IceF, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_IceF, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) end do end if call RegPack(Buf, allocated(InData%u_IceF)) if (allocated(InData%u_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) - LB(1:1) = lbound(InData%u_IceF) - UB(1:1) = ubound(InData%u_IceF) + call RegPackBounds(Buf, 1, lbound(InData%u_IceF, kind=B8Ki), ubound(InData%u_IceF, kind=B8Ki)) + LB(1:1) = lbound(InData%u_IceF, kind=B8Ki) + UB(1:1) = ubound(InData%u_IceF, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackInput(Buf, InData%u_IceF(i1)) end do end if call RegPack(Buf, allocated(InData%x_MAP)) if (allocated(InData%x_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) - LB(1:1) = lbound(InData%x_MAP) - UB(1:1) = ubound(InData%x_MAP) + call RegPackBounds(Buf, 1, lbound(InData%x_MAP, kind=B8Ki), ubound(InData%x_MAP, kind=B8Ki)) + LB(1:1) = lbound(InData%x_MAP, kind=B8Ki) + UB(1:1) = ubound(InData%x_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackContState(Buf, InData%x_MAP(i1)) end do end if call RegPack(Buf, allocated(InData%xd_MAP)) if (allocated(InData%xd_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) - LB(1:1) = lbound(InData%xd_MAP) - UB(1:1) = ubound(InData%xd_MAP) + call RegPackBounds(Buf, 1, lbound(InData%xd_MAP, kind=B8Ki), ubound(InData%xd_MAP, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_MAP, kind=B8Ki) + UB(1:1) = ubound(InData%xd_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) end do end if call RegPack(Buf, allocated(InData%z_MAP)) if (allocated(InData%z_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) - LB(1:1) = lbound(InData%z_MAP) - UB(1:1) = ubound(InData%z_MAP) + call RegPackBounds(Buf, 1, lbound(InData%z_MAP, kind=B8Ki), ubound(InData%z_MAP, kind=B8Ki)) + LB(1:1) = lbound(InData%z_MAP, kind=B8Ki) + UB(1:1) = ubound(InData%z_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackConstrState(Buf, InData%z_MAP(i1)) end do end if call RegPack(Buf, allocated(InData%u_MAP)) if (allocated(InData%u_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) - LB(1:1) = lbound(InData%u_MAP) - UB(1:1) = ubound(InData%u_MAP) + call RegPackBounds(Buf, 1, lbound(InData%u_MAP, kind=B8Ki), ubound(InData%u_MAP, kind=B8Ki)) + LB(1:1) = lbound(InData%u_MAP, kind=B8Ki) + UB(1:1) = ubound(InData%u_MAP, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackInput(Buf, InData%u_MAP(i1)) end do end if call RegPack(Buf, allocated(InData%x_FEAM)) if (allocated(InData%x_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) - LB(1:1) = lbound(InData%x_FEAM) - UB(1:1) = ubound(InData%x_FEAM) + call RegPackBounds(Buf, 1, lbound(InData%x_FEAM, kind=B8Ki), ubound(InData%x_FEAM, kind=B8Ki)) + LB(1:1) = lbound(InData%x_FEAM, kind=B8Ki) + UB(1:1) = ubound(InData%x_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackContState(Buf, InData%x_FEAM(i1)) end do end if call RegPack(Buf, allocated(InData%xd_FEAM)) if (allocated(InData%xd_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) - LB(1:1) = lbound(InData%xd_FEAM) - UB(1:1) = ubound(InData%xd_FEAM) + call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM, kind=B8Ki), ubound(InData%xd_FEAM, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_FEAM, kind=B8Ki) + UB(1:1) = ubound(InData%xd_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) end do end if call RegPack(Buf, allocated(InData%z_FEAM)) if (allocated(InData%z_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) - LB(1:1) = lbound(InData%z_FEAM) - UB(1:1) = ubound(InData%z_FEAM) + call RegPackBounds(Buf, 1, lbound(InData%z_FEAM, kind=B8Ki), ubound(InData%z_FEAM, kind=B8Ki)) + LB(1:1) = lbound(InData%z_FEAM, kind=B8Ki) + UB(1:1) = ubound(InData%z_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_FEAM)) if (allocated(InData%OtherSt_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) - LB(1:1) = lbound(InData%OtherSt_FEAM) - UB(1:1) = ubound(InData%OtherSt_FEAM) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM, kind=B8Ki), ubound(InData%OtherSt_FEAM, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_FEAM, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) end do end if call RegPack(Buf, allocated(InData%u_FEAM)) if (allocated(InData%u_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) - LB(1:1) = lbound(InData%u_FEAM) - UB(1:1) = ubound(InData%u_FEAM) + call RegPackBounds(Buf, 1, lbound(InData%u_FEAM, kind=B8Ki), ubound(InData%u_FEAM, kind=B8Ki)) + LB(1:1) = lbound(InData%u_FEAM, kind=B8Ki) + UB(1:1) = ubound(InData%u_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackInput(Buf, InData%u_FEAM(i1)) end do end if call RegPack(Buf, allocated(InData%x_MD)) if (allocated(InData%x_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_MD), ubound(InData%x_MD)) - LB(1:1) = lbound(InData%x_MD) - UB(1:1) = ubound(InData%x_MD) + call RegPackBounds(Buf, 1, lbound(InData%x_MD, kind=B8Ki), ubound(InData%x_MD, kind=B8Ki)) + LB(1:1) = lbound(InData%x_MD, kind=B8Ki) + UB(1:1) = ubound(InData%x_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackContState(Buf, InData%x_MD(i1)) end do end if call RegPack(Buf, allocated(InData%xd_MD)) if (allocated(InData%xd_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) - LB(1:1) = lbound(InData%xd_MD) - UB(1:1) = ubound(InData%xd_MD) + call RegPackBounds(Buf, 1, lbound(InData%xd_MD, kind=B8Ki), ubound(InData%xd_MD, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_MD, kind=B8Ki) + UB(1:1) = ubound(InData%xd_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackDiscState(Buf, InData%xd_MD(i1)) end do end if call RegPack(Buf, allocated(InData%z_MD)) if (allocated(InData%z_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_MD), ubound(InData%z_MD)) - LB(1:1) = lbound(InData%z_MD) - UB(1:1) = ubound(InData%z_MD) + call RegPackBounds(Buf, 1, lbound(InData%z_MD, kind=B8Ki), ubound(InData%z_MD, kind=B8Ki)) + LB(1:1) = lbound(InData%z_MD, kind=B8Ki) + UB(1:1) = ubound(InData%z_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackConstrState(Buf, InData%z_MD(i1)) end do end if call RegPack(Buf, allocated(InData%OtherSt_MD)) if (allocated(InData%OtherSt_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) - LB(1:1) = lbound(InData%OtherSt_MD) - UB(1:1) = ubound(InData%OtherSt_MD) + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD, kind=B8Ki), ubound(InData%OtherSt_MD, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_MD, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) end do end if call RegPack(Buf, allocated(InData%u_MD)) if (allocated(InData%u_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_MD), ubound(InData%u_MD)) - LB(1:1) = lbound(InData%u_MD) - UB(1:1) = ubound(InData%u_MD) + call RegPackBounds(Buf, 1, lbound(InData%u_MD, kind=B8Ki), ubound(InData%u_MD, kind=B8Ki)) + LB(1:1) = lbound(InData%u_MD, kind=B8Ki) + UB(1:1) = ubound(InData%u_MD, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackInput(Buf, InData%u_MD(i1)) end do @@ -4317,8 +4317,8 @@ subroutine FAST_UnPackLinStateSave(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_LinStateSave), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5310,14 +5310,14 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLinTypeData%Names_u)) then - LB(1:1) = lbound(SrcLinTypeData%Names_u) - UB(1:1) = ubound(SrcLinTypeData%Names_u) + LB(1:1) = lbound(SrcLinTypeData%Names_u, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Names_u, kind=B8Ki) if (.not. allocated(DstLinTypeData%Names_u)) then allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5328,8 +5328,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_u = SrcLinTypeData%Names_u end if if (allocated(SrcLinTypeData%Names_y)) then - LB(1:1) = lbound(SrcLinTypeData%Names_y) - UB(1:1) = ubound(SrcLinTypeData%Names_y) + LB(1:1) = lbound(SrcLinTypeData%Names_y, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Names_y, kind=B8Ki) if (.not. allocated(DstLinTypeData%Names_y)) then allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5340,8 +5340,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_y = SrcLinTypeData%Names_y end if if (allocated(SrcLinTypeData%Names_x)) then - LB(1:1) = lbound(SrcLinTypeData%Names_x) - UB(1:1) = ubound(SrcLinTypeData%Names_x) + LB(1:1) = lbound(SrcLinTypeData%Names_x, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Names_x, kind=B8Ki) if (.not. allocated(DstLinTypeData%Names_x)) then allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5352,8 +5352,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_x = SrcLinTypeData%Names_x end if if (allocated(SrcLinTypeData%Names_xd)) then - LB(1:1) = lbound(SrcLinTypeData%Names_xd) - UB(1:1) = ubound(SrcLinTypeData%Names_xd) + LB(1:1) = lbound(SrcLinTypeData%Names_xd, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Names_xd, kind=B8Ki) if (.not. allocated(DstLinTypeData%Names_xd)) then allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5364,8 +5364,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd end if if (allocated(SrcLinTypeData%Names_z)) then - LB(1:1) = lbound(SrcLinTypeData%Names_z) - UB(1:1) = ubound(SrcLinTypeData%Names_z) + LB(1:1) = lbound(SrcLinTypeData%Names_z, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Names_z, kind=B8Ki) if (.not. allocated(DstLinTypeData%Names_z)) then allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5376,8 +5376,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Names_z = SrcLinTypeData%Names_z end if if (allocated(SrcLinTypeData%op_u)) then - LB(1:1) = lbound(SrcLinTypeData%op_u) - UB(1:1) = ubound(SrcLinTypeData%op_u) + LB(1:1) = lbound(SrcLinTypeData%op_u, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_u, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_u)) then allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5388,8 +5388,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_u = SrcLinTypeData%op_u end if if (allocated(SrcLinTypeData%op_y)) then - LB(1:1) = lbound(SrcLinTypeData%op_y) - UB(1:1) = ubound(SrcLinTypeData%op_y) + LB(1:1) = lbound(SrcLinTypeData%op_y, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_y, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_y)) then allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5400,8 +5400,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_y = SrcLinTypeData%op_y end if if (allocated(SrcLinTypeData%op_x)) then - LB(1:1) = lbound(SrcLinTypeData%op_x) - UB(1:1) = ubound(SrcLinTypeData%op_x) + LB(1:1) = lbound(SrcLinTypeData%op_x, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_x, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_x)) then allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5412,8 +5412,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_x = SrcLinTypeData%op_x end if if (allocated(SrcLinTypeData%op_dx)) then - LB(1:1) = lbound(SrcLinTypeData%op_dx) - UB(1:1) = ubound(SrcLinTypeData%op_dx) + LB(1:1) = lbound(SrcLinTypeData%op_dx, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_dx, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_dx)) then allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5424,8 +5424,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_dx = SrcLinTypeData%op_dx end if if (allocated(SrcLinTypeData%op_xd)) then - LB(1:1) = lbound(SrcLinTypeData%op_xd) - UB(1:1) = ubound(SrcLinTypeData%op_xd) + LB(1:1) = lbound(SrcLinTypeData%op_xd, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_xd, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_xd)) then allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5436,8 +5436,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_xd = SrcLinTypeData%op_xd end if if (allocated(SrcLinTypeData%op_z)) then - LB(1:1) = lbound(SrcLinTypeData%op_z) - UB(1:1) = ubound(SrcLinTypeData%op_z) + LB(1:1) = lbound(SrcLinTypeData%op_z, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_z, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_z)) then allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5448,8 +5448,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_z = SrcLinTypeData%op_z end if if (allocated(SrcLinTypeData%op_x_eig_mag)) then - LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5460,8 +5460,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag end if if (allocated(SrcLinTypeData%op_x_eig_phase)) then - LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase, kind=B8Ki) if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5472,8 +5472,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase end if if (allocated(SrcLinTypeData%Use_u)) then - LB(1:1) = lbound(SrcLinTypeData%Use_u) - UB(1:1) = ubound(SrcLinTypeData%Use_u) + LB(1:1) = lbound(SrcLinTypeData%Use_u, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Use_u, kind=B8Ki) if (.not. allocated(DstLinTypeData%Use_u)) then allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5484,8 +5484,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Use_u = SrcLinTypeData%Use_u end if if (allocated(SrcLinTypeData%Use_y)) then - LB(1:1) = lbound(SrcLinTypeData%Use_y) - UB(1:1) = ubound(SrcLinTypeData%Use_y) + LB(1:1) = lbound(SrcLinTypeData%Use_y, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%Use_y, kind=B8Ki) if (.not. allocated(DstLinTypeData%Use_y)) then allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5496,8 +5496,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%Use_y = SrcLinTypeData%Use_y end if if (allocated(SrcLinTypeData%A)) then - LB(1:2) = lbound(SrcLinTypeData%A) - UB(1:2) = ubound(SrcLinTypeData%A) + LB(1:2) = lbound(SrcLinTypeData%A, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%A, kind=B8Ki) if (.not. allocated(DstLinTypeData%A)) then allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5508,8 +5508,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%A = SrcLinTypeData%A end if if (allocated(SrcLinTypeData%B)) then - LB(1:2) = lbound(SrcLinTypeData%B) - UB(1:2) = ubound(SrcLinTypeData%B) + LB(1:2) = lbound(SrcLinTypeData%B, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%B, kind=B8Ki) if (.not. allocated(DstLinTypeData%B)) then allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5520,8 +5520,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%B = SrcLinTypeData%B end if if (allocated(SrcLinTypeData%C)) then - LB(1:2) = lbound(SrcLinTypeData%C) - UB(1:2) = ubound(SrcLinTypeData%C) + LB(1:2) = lbound(SrcLinTypeData%C, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%C, kind=B8Ki) if (.not. allocated(DstLinTypeData%C)) then allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5532,8 +5532,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%C = SrcLinTypeData%C end if if (allocated(SrcLinTypeData%D)) then - LB(1:2) = lbound(SrcLinTypeData%D) - UB(1:2) = ubound(SrcLinTypeData%D) + LB(1:2) = lbound(SrcLinTypeData%D, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%D, kind=B8Ki) if (.not. allocated(DstLinTypeData%D)) then allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5544,8 +5544,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%D = SrcLinTypeData%D end if if (allocated(SrcLinTypeData%StateRotation)) then - LB(1:2) = lbound(SrcLinTypeData%StateRotation) - UB(1:2) = ubound(SrcLinTypeData%StateRotation) + LB(1:2) = lbound(SrcLinTypeData%StateRotation, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%StateRotation, kind=B8Ki) if (.not. allocated(DstLinTypeData%StateRotation)) then allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5556,8 +5556,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation end if if (allocated(SrcLinTypeData%StateRel_x)) then - LB(1:2) = lbound(SrcLinTypeData%StateRel_x) - UB(1:2) = ubound(SrcLinTypeData%StateRel_x) + LB(1:2) = lbound(SrcLinTypeData%StateRel_x, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%StateRel_x, kind=B8Ki) if (.not. allocated(DstLinTypeData%StateRel_x)) then allocate(DstLinTypeData%StateRel_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5568,8 +5568,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x end if if (allocated(SrcLinTypeData%StateRel_xdot)) then - LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot) - UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot) + LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot, kind=B8Ki) + UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot, kind=B8Ki) if (.not. allocated(DstLinTypeData%StateRel_xdot)) then allocate(DstLinTypeData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5580,8 +5580,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot end if if (allocated(SrcLinTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) - UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) + LB(1:1) = lbound(SrcLinTypeData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstLinTypeData%IsLoad_u)) then allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5592,8 +5592,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u end if if (allocated(SrcLinTypeData%RotFrame_u)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_u) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstLinTypeData%RotFrame_u)) then allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5604,8 +5604,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u end if if (allocated(SrcLinTypeData%RotFrame_y)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_y) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstLinTypeData%RotFrame_y)) then allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5616,8 +5616,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y end if if (allocated(SrcLinTypeData%RotFrame_x)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_x) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstLinTypeData%RotFrame_x)) then allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5628,8 +5628,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x end if if (allocated(SrcLinTypeData%RotFrame_z)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_z) + LB(1:1) = lbound(SrcLinTypeData%RotFrame_z, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_z, kind=B8Ki) if (.not. allocated(DstLinTypeData%RotFrame_z)) then allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5640,8 +5640,8 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z end if if (allocated(SrcLinTypeData%DerivOrder_x)) then - LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) - UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x) + LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstLinTypeData%DerivOrder_x)) then allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5756,142 +5756,142 @@ subroutine FAST_PackLinType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Names_u)) if (allocated(InData%Names_u)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_u), ubound(InData%Names_u)) + call RegPackBounds(Buf, 1, lbound(InData%Names_u, kind=B8Ki), ubound(InData%Names_u, kind=B8Ki)) call RegPack(Buf, InData%Names_u) end if call RegPack(Buf, allocated(InData%Names_y)) if (allocated(InData%Names_y)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_y), ubound(InData%Names_y)) + call RegPackBounds(Buf, 1, lbound(InData%Names_y, kind=B8Ki), ubound(InData%Names_y, kind=B8Ki)) call RegPack(Buf, InData%Names_y) end if call RegPack(Buf, allocated(InData%Names_x)) if (allocated(InData%Names_x)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_x), ubound(InData%Names_x)) + call RegPackBounds(Buf, 1, lbound(InData%Names_x, kind=B8Ki), ubound(InData%Names_x, kind=B8Ki)) call RegPack(Buf, InData%Names_x) end if call RegPack(Buf, allocated(InData%Names_xd)) if (allocated(InData%Names_xd)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_xd), ubound(InData%Names_xd)) + call RegPackBounds(Buf, 1, lbound(InData%Names_xd, kind=B8Ki), ubound(InData%Names_xd, kind=B8Ki)) call RegPack(Buf, InData%Names_xd) end if call RegPack(Buf, allocated(InData%Names_z)) if (allocated(InData%Names_z)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_z), ubound(InData%Names_z)) + call RegPackBounds(Buf, 1, lbound(InData%Names_z, kind=B8Ki), ubound(InData%Names_z, kind=B8Ki)) call RegPack(Buf, InData%Names_z) end if call RegPack(Buf, allocated(InData%op_u)) if (allocated(InData%op_u)) then - call RegPackBounds(Buf, 1, lbound(InData%op_u), ubound(InData%op_u)) + call RegPackBounds(Buf, 1, lbound(InData%op_u, kind=B8Ki), ubound(InData%op_u, kind=B8Ki)) call RegPack(Buf, InData%op_u) end if call RegPack(Buf, allocated(InData%op_y)) if (allocated(InData%op_y)) then - call RegPackBounds(Buf, 1, lbound(InData%op_y), ubound(InData%op_y)) + call RegPackBounds(Buf, 1, lbound(InData%op_y, kind=B8Ki), ubound(InData%op_y, kind=B8Ki)) call RegPack(Buf, InData%op_y) end if call RegPack(Buf, allocated(InData%op_x)) if (allocated(InData%op_x)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x), ubound(InData%op_x)) + call RegPackBounds(Buf, 1, lbound(InData%op_x, kind=B8Ki), ubound(InData%op_x, kind=B8Ki)) call RegPack(Buf, InData%op_x) end if call RegPack(Buf, allocated(InData%op_dx)) if (allocated(InData%op_dx)) then - call RegPackBounds(Buf, 1, lbound(InData%op_dx), ubound(InData%op_dx)) + call RegPackBounds(Buf, 1, lbound(InData%op_dx, kind=B8Ki), ubound(InData%op_dx, kind=B8Ki)) call RegPack(Buf, InData%op_dx) end if call RegPack(Buf, allocated(InData%op_xd)) if (allocated(InData%op_xd)) then - call RegPackBounds(Buf, 1, lbound(InData%op_xd), ubound(InData%op_xd)) + call RegPackBounds(Buf, 1, lbound(InData%op_xd, kind=B8Ki), ubound(InData%op_xd, kind=B8Ki)) call RegPack(Buf, InData%op_xd) end if call RegPack(Buf, allocated(InData%op_z)) if (allocated(InData%op_z)) then - call RegPackBounds(Buf, 1, lbound(InData%op_z), ubound(InData%op_z)) + call RegPackBounds(Buf, 1, lbound(InData%op_z, kind=B8Ki), ubound(InData%op_z, kind=B8Ki)) call RegPack(Buf, InData%op_z) end if call RegPack(Buf, allocated(InData%op_x_eig_mag)) if (allocated(InData%op_x_eig_mag)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag), ubound(InData%op_x_eig_mag)) + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag, kind=B8Ki), ubound(InData%op_x_eig_mag, kind=B8Ki)) call RegPack(Buf, InData%op_x_eig_mag) end if call RegPack(Buf, allocated(InData%op_x_eig_phase)) if (allocated(InData%op_x_eig_phase)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase), ubound(InData%op_x_eig_phase)) + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase, kind=B8Ki), ubound(InData%op_x_eig_phase, kind=B8Ki)) call RegPack(Buf, InData%op_x_eig_phase) end if call RegPack(Buf, allocated(InData%Use_u)) if (allocated(InData%Use_u)) then - call RegPackBounds(Buf, 1, lbound(InData%Use_u), ubound(InData%Use_u)) + call RegPackBounds(Buf, 1, lbound(InData%Use_u, kind=B8Ki), ubound(InData%Use_u, kind=B8Ki)) call RegPack(Buf, InData%Use_u) end if call RegPack(Buf, allocated(InData%Use_y)) if (allocated(InData%Use_y)) then - call RegPackBounds(Buf, 1, lbound(InData%Use_y), ubound(InData%Use_y)) + call RegPackBounds(Buf, 1, lbound(InData%Use_y, kind=B8Ki), ubound(InData%Use_y, kind=B8Ki)) call RegPack(Buf, InData%Use_y) end if call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) call RegPack(Buf, InData%A) end if call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) call RegPack(Buf, InData%B) end if call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPackBounds(Buf, 2, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) call RegPack(Buf, InData%C) end if call RegPack(Buf, allocated(InData%D)) if (allocated(InData%D)) then - call RegPackBounds(Buf, 2, lbound(InData%D), ubound(InData%D)) + call RegPackBounds(Buf, 2, lbound(InData%D, kind=B8Ki), ubound(InData%D, kind=B8Ki)) call RegPack(Buf, InData%D) end if call RegPack(Buf, allocated(InData%StateRotation)) if (allocated(InData%StateRotation)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRotation), ubound(InData%StateRotation)) + call RegPackBounds(Buf, 2, lbound(InData%StateRotation, kind=B8Ki), ubound(InData%StateRotation, kind=B8Ki)) call RegPack(Buf, InData%StateRotation) end if call RegPack(Buf, allocated(InData%StateRel_x)) if (allocated(InData%StateRel_x)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRel_x), ubound(InData%StateRel_x)) + call RegPackBounds(Buf, 2, lbound(InData%StateRel_x, kind=B8Ki), ubound(InData%StateRel_x, kind=B8Ki)) call RegPack(Buf, InData%StateRel_x) end if call RegPack(Buf, allocated(InData%StateRel_xdot)) if (allocated(InData%StateRel_xdot)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot), ubound(InData%StateRel_xdot)) + call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot, kind=B8Ki), ubound(InData%StateRel_xdot, kind=B8Ki)) call RegPack(Buf, InData%StateRel_xdot) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_z)) if (allocated(InData%RotFrame_z)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z), ubound(InData%RotFrame_z)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z, kind=B8Ki), ubound(InData%RotFrame_z, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_z) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if call RegPack(Buf, InData%SizeLin) @@ -5904,7 +5904,7 @@ subroutine FAST_UnPackLinType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_LinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6314,16 +6314,16 @@ subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModLinTypeData%Instance)) then - LB(1:1) = lbound(SrcModLinTypeData%Instance) - UB(1:1) = ubound(SrcModLinTypeData%Instance) + LB(1:1) = lbound(SrcModLinTypeData%Instance, kind=B8Ki) + UB(1:1) = ubound(SrcModLinTypeData%Instance, kind=B8Ki) if (.not. allocated(DstModLinTypeData%Instance)) then allocate(DstModLinTypeData%Instance(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6343,16 +6343,16 @@ subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) type(FAST_ModLinType), intent(inout) :: ModLinTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModLinTypeData%Instance)) then - LB(1:1) = lbound(ModLinTypeData%Instance) - UB(1:1) = ubound(ModLinTypeData%Instance) + LB(1:1) = lbound(ModLinTypeData%Instance, kind=B8Ki) + UB(1:1) = ubound(ModLinTypeData%Instance, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_DestroyLinType(ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6365,14 +6365,14 @@ subroutine FAST_PackModLinType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_ModLinType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModLinType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Instance)) if (allocated(InData%Instance)) then - call RegPackBounds(Buf, 1, lbound(InData%Instance), ubound(InData%Instance)) - LB(1:1) = lbound(InData%Instance) - UB(1:1) = ubound(InData%Instance) + call RegPackBounds(Buf, 1, lbound(InData%Instance, kind=B8Ki), ubound(InData%Instance, kind=B8Ki)) + LB(1:1) = lbound(InData%Instance, kind=B8Ki) + UB(1:1) = ubound(InData%Instance, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_PackLinType(Buf, InData%Instance(i1)) end do @@ -6384,8 +6384,8 @@ subroutine FAST_UnPackModLinType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_ModLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6412,15 +6412,15 @@ subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcLinFileTypeData%Modules) - UB(1:1) = ubound(SrcLinFileTypeData%Modules) + LB(1:1) = lbound(SrcLinFileTypeData%Modules, kind=B8Ki) + UB(1:1) = ubound(SrcLinFileTypeData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6438,15 +6438,15 @@ subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) type(FAST_LinFileType), intent(inout) :: LinFileTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(LinFileTypeData%Modules) - UB(1:1) = ubound(LinFileTypeData%Modules) + LB(1:1) = lbound(LinFileTypeData%Modules, kind=B8Ki) + UB(1:1) = ubound(LinFileTypeData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_DestroyModLinType(LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6459,11 +6459,11 @@ subroutine FAST_PackLinFileType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_LinFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinFileType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%Modules) - UB(1:1) = ubound(InData%Modules) + LB(1:1) = lbound(InData%Modules, kind=B8Ki) + UB(1:1) = ubound(InData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_PackModLinType(Buf, InData%Modules(i1)) end do @@ -6478,11 +6478,11 @@ subroutine FAST_UnPackLinFileType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_LinFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%Modules) - UB(1:1) = ubound(OutData%Modules) + LB(1:1) = lbound(OutData%Modules, kind=B8Ki) + UB(1:1) = ubound(OutData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) call FAST_UnpackModLinType(Buf, OutData%Modules(i1)) ! Modules end do @@ -6501,14 +6501,14 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyMiscLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscLinTypeData%LinTimes)) then - LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes) - UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes) + LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes, kind=B8Ki) + UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes, kind=B8Ki) if (.not. allocated(DstMiscLinTypeData%LinTimes)) then allocate(DstMiscLinTypeData%LinTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6520,8 +6520,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode if (allocated(SrcMiscLinTypeData%AzimTarget)) then - LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget) - UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget) + LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget, kind=B8Ki) + UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget, kind=B8Ki) if (.not. allocated(DstMiscLinTypeData%AzimTarget)) then allocate(DstMiscLinTypeData%AzimTarget(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6538,8 +6538,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx if (allocated(SrcMiscLinTypeData%Psi)) then - LB(1:1) = lbound(SrcMiscLinTypeData%Psi) - UB(1:1) = ubound(SrcMiscLinTypeData%Psi) + LB(1:1) = lbound(SrcMiscLinTypeData%Psi, kind=B8Ki) + UB(1:1) = ubound(SrcMiscLinTypeData%Psi, kind=B8Ki) if (.not. allocated(DstMiscLinTypeData%Psi)) then allocate(DstMiscLinTypeData%Psi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6550,8 +6550,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi end if if (allocated(SrcMiscLinTypeData%y_interp)) then - LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) - UB(1:1) = ubound(SrcMiscLinTypeData%y_interp) + LB(1:1) = lbound(SrcMiscLinTypeData%y_interp, kind=B8Ki) + UB(1:1) = ubound(SrcMiscLinTypeData%y_interp, kind=B8Ki) if (.not. allocated(DstMiscLinTypeData%y_interp)) then allocate(DstMiscLinTypeData%y_interp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6562,8 +6562,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp end if if (allocated(SrcMiscLinTypeData%y_ref)) then - LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) - UB(1:1) = ubound(SrcMiscLinTypeData%y_ref) + LB(1:1) = lbound(SrcMiscLinTypeData%y_ref, kind=B8Ki) + UB(1:1) = ubound(SrcMiscLinTypeData%y_ref, kind=B8Ki) if (.not. allocated(DstMiscLinTypeData%y_ref)) then allocate(DstMiscLinTypeData%y_ref(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6574,8 +6574,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref end if if (allocated(SrcMiscLinTypeData%Y_prevRot)) then - LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) - UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot) + LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot, kind=B8Ki) + UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot, kind=B8Ki) if (.not. allocated(DstMiscLinTypeData%Y_prevRot)) then allocate(DstMiscLinTypeData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6621,13 +6621,13 @@ subroutine FAST_PackMiscLinType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%LinTimes)) if (allocated(InData%LinTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%LinTimes), ubound(InData%LinTimes)) + call RegPackBounds(Buf, 1, lbound(InData%LinTimes, kind=B8Ki), ubound(InData%LinTimes, kind=B8Ki)) call RegPack(Buf, InData%LinTimes) end if call RegPack(Buf, InData%CopyOP_CtrlCode) call RegPack(Buf, allocated(InData%AzimTarget)) if (allocated(InData%AzimTarget)) then - call RegPackBounds(Buf, 1, lbound(InData%AzimTarget), ubound(InData%AzimTarget)) + call RegPackBounds(Buf, 1, lbound(InData%AzimTarget, kind=B8Ki), ubound(InData%AzimTarget, kind=B8Ki)) call RegPack(Buf, InData%AzimTarget) end if call RegPack(Buf, InData%IsConverged) @@ -6638,22 +6638,22 @@ subroutine FAST_PackMiscLinType(Buf, Indata) call RegPack(Buf, InData%NextLinTimeIndx) call RegPack(Buf, allocated(InData%Psi)) if (allocated(InData%Psi)) then - call RegPackBounds(Buf, 1, lbound(InData%Psi), ubound(InData%Psi)) + call RegPackBounds(Buf, 1, lbound(InData%Psi, kind=B8Ki), ubound(InData%Psi, kind=B8Ki)) call RegPack(Buf, InData%Psi) end if call RegPack(Buf, allocated(InData%y_interp)) if (allocated(InData%y_interp)) then - call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + call RegPackBounds(Buf, 1, lbound(InData%y_interp, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) call RegPack(Buf, InData%y_interp) end if call RegPack(Buf, allocated(InData%y_ref)) if (allocated(InData%y_ref)) then - call RegPackBounds(Buf, 1, lbound(InData%y_ref), ubound(InData%y_ref)) + call RegPackBounds(Buf, 1, lbound(InData%y_ref, kind=B8Ki), ubound(InData%y_ref, kind=B8Ki)) call RegPack(Buf, InData%y_ref) end if call RegPack(Buf, allocated(InData%Y_prevRot)) if (allocated(InData%Y_prevRot)) then - call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot), ubound(InData%Y_prevRot)) + call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot, kind=B8Ki), ubound(InData%Y_prevRot, kind=B8Ki)) call RegPack(Buf, InData%Y_prevRot) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6663,7 +6663,7 @@ subroutine FAST_UnPackMiscLinType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_MiscLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6773,16 +6773,16 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyOutputFileType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputFileTypeData%TimeData)) then - LB(1:1) = lbound(SrcOutputFileTypeData%TimeData) - UB(1:1) = ubound(SrcOutputFileTypeData%TimeData) + LB(1:1) = lbound(SrcOutputFileTypeData%TimeData, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%TimeData, kind=B8Ki) if (.not. allocated(DstOutputFileTypeData%TimeData)) then allocate(DstOutputFileTypeData%TimeData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6793,8 +6793,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData end if if (allocated(SrcOutputFileTypeData%AllOutData)) then - LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) - UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData) + LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData, kind=B8Ki) + UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData, kind=B8Ki) if (.not. allocated(DstOutputFileTypeData%AllOutData)) then allocate(DstOutputFileTypeData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6812,8 +6812,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines if (allocated(SrcOutputFileTypeData%ChannelNames)) then - LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames) - UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames) + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames, kind=B8Ki) if (.not. allocated(DstOutputFileTypeData%ChannelNames)) then allocate(DstOutputFileTypeData%ChannelNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6824,8 +6824,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames end if if (allocated(SrcOutputFileTypeData%ChannelUnits)) then - LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) - UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits) + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits, kind=B8Ki) if (.not. allocated(DstOutputFileTypeData%ChannelUnits)) then allocate(DstOutputFileTypeData%ChannelUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6835,8 +6835,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits end if - LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) - UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) + LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6860,8 +6860,8 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) type(FAST_OutputFileType), intent(inout) :: OutputFileTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyOutputFileType' @@ -6879,8 +6879,8 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) if (allocated(OutputFileTypeData%ChannelUnits)) then deallocate(OutputFileTypeData%ChannelUnits) end if - LB(1:1) = lbound(OutputFileTypeData%Module_Ver) - UB(1:1) = ubound(OutputFileTypeData%Module_Ver) + LB(1:1) = lbound(OutputFileTypeData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(OutputFileTypeData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyProgDesc(OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6895,17 +6895,17 @@ subroutine FAST_PackOutputFileType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_OutputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%TimeData)) if (allocated(InData%TimeData)) then - call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPackBounds(Buf, 1, lbound(InData%TimeData, kind=B8Ki), ubound(InData%TimeData, kind=B8Ki)) call RegPack(Buf, InData%TimeData) end if call RegPack(Buf, allocated(InData%AllOutData)) if (allocated(InData%AllOutData)) then - call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPackBounds(Buf, 2, lbound(InData%AllOutData, kind=B8Ki), ubound(InData%AllOutData, kind=B8Ki)) call RegPack(Buf, InData%AllOutData) end if call RegPack(Buf, InData%n_Out) @@ -6917,16 +6917,16 @@ subroutine FAST_PackOutputFileType(Buf, Indata) call RegPack(Buf, InData%FileDescLines) call RegPack(Buf, allocated(InData%ChannelNames)) if (allocated(InData%ChannelNames)) then - call RegPackBounds(Buf, 1, lbound(InData%ChannelNames), ubound(InData%ChannelNames)) + call RegPackBounds(Buf, 1, lbound(InData%ChannelNames, kind=B8Ki), ubound(InData%ChannelNames, kind=B8Ki)) call RegPack(Buf, InData%ChannelNames) end if call RegPack(Buf, allocated(InData%ChannelUnits)) if (allocated(InData%ChannelUnits)) then - call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits), ubound(InData%ChannelUnits)) + call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits, kind=B8Ki), ubound(InData%ChannelUnits, kind=B8Ki)) call RegPack(Buf, InData%ChannelUnits) end if - LB(1:1) = lbound(InData%Module_Ver) - UB(1:1) = ubound(InData%Module_Ver) + LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) end do @@ -6945,8 +6945,8 @@ subroutine FAST_UnPackOutputFileType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_OutputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7020,8 +7020,8 @@ subroutine FAST_UnPackOutputFileType(Buf, OutData) call RegUnpack(Buf, OutData%ChannelUnits) if (RegCheckErr(Buf, RoutineName)) return end if - LB(1:1) = lbound(OutData%Module_Ver) - UB(1:1) = ubound(OutData%Module_Ver) + LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) + UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver end do @@ -7047,16 +7047,16 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyIceDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIceDyn_DataData%x)) then - LB(1:2) = lbound(SrcIceDyn_DataData%x) - UB(1:2) = ubound(SrcIceDyn_DataData%x) + LB(1:2) = lbound(SrcIceDyn_DataData%x, kind=B8Ki) + UB(1:2) = ubound(SrcIceDyn_DataData%x, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%x)) then allocate(DstIceDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7073,8 +7073,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%xd)) then - LB(1:2) = lbound(SrcIceDyn_DataData%xd) - UB(1:2) = ubound(SrcIceDyn_DataData%xd) + LB(1:2) = lbound(SrcIceDyn_DataData%xd, kind=B8Ki) + UB(1:2) = ubound(SrcIceDyn_DataData%xd, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%xd)) then allocate(DstIceDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7091,8 +7091,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%z)) then - LB(1:2) = lbound(SrcIceDyn_DataData%z) - UB(1:2) = ubound(SrcIceDyn_DataData%z) + LB(1:2) = lbound(SrcIceDyn_DataData%z, kind=B8Ki) + UB(1:2) = ubound(SrcIceDyn_DataData%z, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%z)) then allocate(DstIceDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7109,8 +7109,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%OtherSt)) then - LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) - UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt) + LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%OtherSt)) then allocate(DstIceDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7127,8 +7127,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%p)) then - LB(1:1) = lbound(SrcIceDyn_DataData%p) - UB(1:1) = ubound(SrcIceDyn_DataData%p) + LB(1:1) = lbound(SrcIceDyn_DataData%p, kind=B8Ki) + UB(1:1) = ubound(SrcIceDyn_DataData%p, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%p)) then allocate(DstIceDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7143,8 +7143,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%u)) then - LB(1:1) = lbound(SrcIceDyn_DataData%u) - UB(1:1) = ubound(SrcIceDyn_DataData%u) + LB(1:1) = lbound(SrcIceDyn_DataData%u, kind=B8Ki) + UB(1:1) = ubound(SrcIceDyn_DataData%u, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%u)) then allocate(DstIceDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7159,8 +7159,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%y)) then - LB(1:1) = lbound(SrcIceDyn_DataData%y) - UB(1:1) = ubound(SrcIceDyn_DataData%y) + LB(1:1) = lbound(SrcIceDyn_DataData%y, kind=B8Ki) + UB(1:1) = ubound(SrcIceDyn_DataData%y, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%y)) then allocate(DstIceDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7175,8 +7175,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%m)) then - LB(1:1) = lbound(SrcIceDyn_DataData%m) - UB(1:1) = ubound(SrcIceDyn_DataData%m) + LB(1:1) = lbound(SrcIceDyn_DataData%m, kind=B8Ki) + UB(1:1) = ubound(SrcIceDyn_DataData%m, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%m)) then allocate(DstIceDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7191,8 +7191,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%Input)) then - LB(1:2) = lbound(SrcIceDyn_DataData%Input) - UB(1:2) = ubound(SrcIceDyn_DataData%Input) + LB(1:2) = lbound(SrcIceDyn_DataData%Input, kind=B8Ki) + UB(1:2) = ubound(SrcIceDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%Input)) then allocate(DstIceDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7209,8 +7209,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%InputTimes)) then - LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) - UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstIceDyn_DataData%InputTimes)) then allocate(DstIceDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7226,16 +7226,16 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) type(IceDyn_Data), intent(inout) :: IceDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyIceDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(IceDyn_DataData%x)) then - LB(1:2) = lbound(IceDyn_DataData%x) - UB(1:2) = ubound(IceDyn_DataData%x) + LB(1:2) = lbound(IceDyn_DataData%x, kind=B8Ki) + UB(1:2) = ubound(IceDyn_DataData%x, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyContState(IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) @@ -7245,8 +7245,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%x) end if if (allocated(IceDyn_DataData%xd)) then - LB(1:2) = lbound(IceDyn_DataData%xd) - UB(1:2) = ubound(IceDyn_DataData%xd) + LB(1:2) = lbound(IceDyn_DataData%xd, kind=B8Ki) + UB(1:2) = ubound(IceDyn_DataData%xd, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyDiscState(IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) @@ -7256,8 +7256,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%xd) end if if (allocated(IceDyn_DataData%z)) then - LB(1:2) = lbound(IceDyn_DataData%z) - UB(1:2) = ubound(IceDyn_DataData%z) + LB(1:2) = lbound(IceDyn_DataData%z, kind=B8Ki) + UB(1:2) = ubound(IceDyn_DataData%z, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyConstrState(IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) @@ -7267,8 +7267,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%z) end if if (allocated(IceDyn_DataData%OtherSt)) then - LB(1:2) = lbound(IceDyn_DataData%OtherSt) - UB(1:2) = ubound(IceDyn_DataData%OtherSt) + LB(1:2) = lbound(IceDyn_DataData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(IceDyn_DataData%OtherSt, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyOtherState(IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) @@ -7278,8 +7278,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%OtherSt) end if if (allocated(IceDyn_DataData%p)) then - LB(1:1) = lbound(IceDyn_DataData%p) - UB(1:1) = ubound(IceDyn_DataData%p) + LB(1:1) = lbound(IceDyn_DataData%p, kind=B8Ki) + UB(1:1) = ubound(IceDyn_DataData%p, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_DestroyParam(IceDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7287,8 +7287,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%p) end if if (allocated(IceDyn_DataData%u)) then - LB(1:1) = lbound(IceDyn_DataData%u) - UB(1:1) = ubound(IceDyn_DataData%u) + LB(1:1) = lbound(IceDyn_DataData%u, kind=B8Ki) + UB(1:1) = ubound(IceDyn_DataData%u, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_DestroyInput(IceDyn_DataData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7296,8 +7296,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%u) end if if (allocated(IceDyn_DataData%y)) then - LB(1:1) = lbound(IceDyn_DataData%y) - UB(1:1) = ubound(IceDyn_DataData%y) + LB(1:1) = lbound(IceDyn_DataData%y, kind=B8Ki) + UB(1:1) = ubound(IceDyn_DataData%y, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_DestroyOutput(IceDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7305,8 +7305,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%y) end if if (allocated(IceDyn_DataData%m)) then - LB(1:1) = lbound(IceDyn_DataData%m) - UB(1:1) = ubound(IceDyn_DataData%m) + LB(1:1) = lbound(IceDyn_DataData%m, kind=B8Ki) + UB(1:1) = ubound(IceDyn_DataData%m, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_DestroyMisc(IceDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7314,8 +7314,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%m) end if if (allocated(IceDyn_DataData%Input)) then - LB(1:2) = lbound(IceDyn_DataData%Input) - UB(1:2) = ubound(IceDyn_DataData%Input) + LB(1:2) = lbound(IceDyn_DataData%Input, kind=B8Ki) + UB(1:2) = ubound(IceDyn_DataData%Input, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyInput(IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) @@ -7333,14 +7333,14 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) - LB(1:2) = lbound(InData%x) - UB(1:2) = ubound(InData%x) + call RegPackBounds(Buf, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:2) = lbound(InData%x, kind=B8Ki) + UB(1:2) = ubound(InData%x, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackContState(Buf, InData%x(i1,i2)) @@ -7349,9 +7349,9 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) - LB(1:2) = lbound(InData%xd) - UB(1:2) = ubound(InData%xd) + call RegPackBounds(Buf, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:2) = lbound(InData%xd, kind=B8Ki) + UB(1:2) = ubound(InData%xd, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackDiscState(Buf, InData%xd(i1,i2)) @@ -7360,9 +7360,9 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) - LB(1:2) = lbound(InData%z) - UB(1:2) = ubound(InData%z) + call RegPackBounds(Buf, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:2) = lbound(InData%z, kind=B8Ki) + UB(1:2) = ubound(InData%z, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackConstrState(Buf, InData%z(i1,i2)) @@ -7371,9 +7371,9 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) - LB(1:2) = lbound(InData%OtherSt) - UB(1:2) = ubound(InData%OtherSt) + call RegPackBounds(Buf, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackOtherState(Buf, InData%OtherSt(i1,i2)) @@ -7382,45 +7382,45 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) - LB(1:1) = lbound(InData%p) - UB(1:1) = ubound(InData%p) + call RegPackBounds(Buf, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) + LB(1:1) = lbound(InData%p, kind=B8Ki) + UB(1:1) = ubound(InData%p, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_PackParam(Buf, InData%p(i1)) end do end if call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) - LB(1:1) = lbound(InData%u) - UB(1:1) = ubound(InData%u) + call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + LB(1:1) = lbound(InData%u, kind=B8Ki) + UB(1:1) = ubound(InData%u, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_PackInput(Buf, InData%u(i1)) end do end if call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) - LB(1:1) = lbound(InData%y) - UB(1:1) = ubound(InData%y) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + LB(1:1) = lbound(InData%y, kind=B8Ki) + UB(1:1) = ubound(InData%y, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_PackOutput(Buf, InData%y(i1)) end do end if call RegPack(Buf, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) - LB(1:1) = lbound(InData%m) - UB(1:1) = ubound(InData%m) + call RegPackBounds(Buf, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) + LB(1:1) = lbound(InData%m, kind=B8Ki) + UB(1:1) = ubound(InData%m, kind=B8Ki) do i1 = LB(1), UB(1) call IceD_PackMisc(Buf, InData%m(i1)) end do end if call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) - LB(1:2) = lbound(InData%Input) - UB(1:2) = ubound(InData%Input) + call RegPackBounds(Buf, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:2) = lbound(InData%Input, kind=B8Ki) + UB(1:2) = ubound(InData%Input, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_PackInput(Buf, InData%Input(i1,i2)) @@ -7429,7 +7429,7 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 2, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -7439,8 +7439,8 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7611,16 +7611,16 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyBeamDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBeamDyn_DataData%x)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%x) - UB(1:2) = ubound(SrcBeamDyn_DataData%x) + LB(1:2) = lbound(SrcBeamDyn_DataData%x, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%x, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%x)) then allocate(DstBeamDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7637,8 +7637,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%xd)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%xd) - UB(1:2) = ubound(SrcBeamDyn_DataData%xd) + LB(1:2) = lbound(SrcBeamDyn_DataData%xd, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%xd, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%xd)) then allocate(DstBeamDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7655,8 +7655,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%z)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%z) - UB(1:2) = ubound(SrcBeamDyn_DataData%z) + LB(1:2) = lbound(SrcBeamDyn_DataData%z, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%z, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%z)) then allocate(DstBeamDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7673,8 +7673,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%OtherSt)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) - UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt) + LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%OtherSt)) then allocate(DstBeamDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7691,8 +7691,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%p)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%p) - UB(1:1) = ubound(SrcBeamDyn_DataData%p) + LB(1:1) = lbound(SrcBeamDyn_DataData%p, kind=B8Ki) + UB(1:1) = ubound(SrcBeamDyn_DataData%p, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%p)) then allocate(DstBeamDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7707,8 +7707,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%u)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%u) - UB(1:1) = ubound(SrcBeamDyn_DataData%u) + LB(1:1) = lbound(SrcBeamDyn_DataData%u, kind=B8Ki) + UB(1:1) = ubound(SrcBeamDyn_DataData%u, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%u)) then allocate(DstBeamDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7723,8 +7723,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%y)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%y) - UB(1:1) = ubound(SrcBeamDyn_DataData%y) + LB(1:1) = lbound(SrcBeamDyn_DataData%y, kind=B8Ki) + UB(1:1) = ubound(SrcBeamDyn_DataData%y, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%y)) then allocate(DstBeamDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7739,8 +7739,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%m)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%m) - UB(1:1) = ubound(SrcBeamDyn_DataData%m) + LB(1:1) = lbound(SrcBeamDyn_DataData%m, kind=B8Ki) + UB(1:1) = ubound(SrcBeamDyn_DataData%m, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%m)) then allocate(DstBeamDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7755,8 +7755,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%Output)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Output) - UB(1:2) = ubound(SrcBeamDyn_DataData%Output) + LB(1:2) = lbound(SrcBeamDyn_DataData%Output, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%Output)) then allocate(DstBeamDyn_DataData%Output(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7773,8 +7773,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%y_interp)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp) - UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp) + LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp, kind=B8Ki) + UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%y_interp)) then allocate(DstBeamDyn_DataData%y_interp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7789,8 +7789,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%Input)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%Input) - UB(1:2) = ubound(SrcBeamDyn_DataData%Input) + LB(1:2) = lbound(SrcBeamDyn_DataData%Input, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%Input)) then allocate(DstBeamDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7807,8 +7807,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%InputTimes)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) - UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstBeamDyn_DataData%InputTimes)) then allocate(DstBeamDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7824,16 +7824,16 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) type(BeamDyn_Data), intent(inout) :: BeamDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyBeamDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(BeamDyn_DataData%x)) then - LB(1:2) = lbound(BeamDyn_DataData%x) - UB(1:2) = ubound(BeamDyn_DataData%x) + LB(1:2) = lbound(BeamDyn_DataData%x, kind=B8Ki) + UB(1:2) = ubound(BeamDyn_DataData%x, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyContState(BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) @@ -7843,8 +7843,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%x) end if if (allocated(BeamDyn_DataData%xd)) then - LB(1:2) = lbound(BeamDyn_DataData%xd) - UB(1:2) = ubound(BeamDyn_DataData%xd) + LB(1:2) = lbound(BeamDyn_DataData%xd, kind=B8Ki) + UB(1:2) = ubound(BeamDyn_DataData%xd, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyDiscState(BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) @@ -7854,8 +7854,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%xd) end if if (allocated(BeamDyn_DataData%z)) then - LB(1:2) = lbound(BeamDyn_DataData%z) - UB(1:2) = ubound(BeamDyn_DataData%z) + LB(1:2) = lbound(BeamDyn_DataData%z, kind=B8Ki) + UB(1:2) = ubound(BeamDyn_DataData%z, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyConstrState(BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) @@ -7865,8 +7865,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%z) end if if (allocated(BeamDyn_DataData%OtherSt)) then - LB(1:2) = lbound(BeamDyn_DataData%OtherSt) - UB(1:2) = ubound(BeamDyn_DataData%OtherSt) + LB(1:2) = lbound(BeamDyn_DataData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(BeamDyn_DataData%OtherSt, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyOtherState(BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) @@ -7876,8 +7876,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%OtherSt) end if if (allocated(BeamDyn_DataData%p)) then - LB(1:1) = lbound(BeamDyn_DataData%p) - UB(1:1) = ubound(BeamDyn_DataData%p) + LB(1:1) = lbound(BeamDyn_DataData%p, kind=B8Ki) + UB(1:1) = ubound(BeamDyn_DataData%p, kind=B8Ki) do i1 = LB(1), UB(1) call BD_DestroyParam(BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7885,8 +7885,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%p) end if if (allocated(BeamDyn_DataData%u)) then - LB(1:1) = lbound(BeamDyn_DataData%u) - UB(1:1) = ubound(BeamDyn_DataData%u) + LB(1:1) = lbound(BeamDyn_DataData%u, kind=B8Ki) + UB(1:1) = ubound(BeamDyn_DataData%u, kind=B8Ki) do i1 = LB(1), UB(1) call BD_DestroyInput(BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7894,8 +7894,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%u) end if if (allocated(BeamDyn_DataData%y)) then - LB(1:1) = lbound(BeamDyn_DataData%y) - UB(1:1) = ubound(BeamDyn_DataData%y) + LB(1:1) = lbound(BeamDyn_DataData%y, kind=B8Ki) + UB(1:1) = ubound(BeamDyn_DataData%y, kind=B8Ki) do i1 = LB(1), UB(1) call BD_DestroyOutput(BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7903,8 +7903,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%y) end if if (allocated(BeamDyn_DataData%m)) then - LB(1:1) = lbound(BeamDyn_DataData%m) - UB(1:1) = ubound(BeamDyn_DataData%m) + LB(1:1) = lbound(BeamDyn_DataData%m, kind=B8Ki) + UB(1:1) = ubound(BeamDyn_DataData%m, kind=B8Ki) do i1 = LB(1), UB(1) call BD_DestroyMisc(BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7912,8 +7912,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%m) end if if (allocated(BeamDyn_DataData%Output)) then - LB(1:2) = lbound(BeamDyn_DataData%Output) - UB(1:2) = ubound(BeamDyn_DataData%Output) + LB(1:2) = lbound(BeamDyn_DataData%Output, kind=B8Ki) + UB(1:2) = ubound(BeamDyn_DataData%Output, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyOutput(BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2) @@ -7923,8 +7923,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%Output) end if if (allocated(BeamDyn_DataData%y_interp)) then - LB(1:1) = lbound(BeamDyn_DataData%y_interp) - UB(1:1) = ubound(BeamDyn_DataData%y_interp) + LB(1:1) = lbound(BeamDyn_DataData%y_interp, kind=B8Ki) + UB(1:1) = ubound(BeamDyn_DataData%y_interp, kind=B8Ki) do i1 = LB(1), UB(1) call BD_DestroyOutput(BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7932,8 +7932,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%y_interp) end if if (allocated(BeamDyn_DataData%Input)) then - LB(1:2) = lbound(BeamDyn_DataData%Input) - UB(1:2) = ubound(BeamDyn_DataData%Input) + LB(1:2) = lbound(BeamDyn_DataData%Input, kind=B8Ki) + UB(1:2) = ubound(BeamDyn_DataData%Input, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyInput(BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) @@ -7951,14 +7951,14 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BeamDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) - LB(1:2) = lbound(InData%x) - UB(1:2) = ubound(InData%x) + call RegPackBounds(Buf, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:2) = lbound(InData%x, kind=B8Ki) + UB(1:2) = ubound(InData%x, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackContState(Buf, InData%x(i1,i2)) @@ -7967,9 +7967,9 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) - LB(1:2) = lbound(InData%xd) - UB(1:2) = ubound(InData%xd) + call RegPackBounds(Buf, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + LB(1:2) = lbound(InData%xd, kind=B8Ki) + UB(1:2) = ubound(InData%xd, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackDiscState(Buf, InData%xd(i1,i2)) @@ -7978,9 +7978,9 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) - LB(1:2) = lbound(InData%z) - UB(1:2) = ubound(InData%z) + call RegPackBounds(Buf, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + LB(1:2) = lbound(InData%z, kind=B8Ki) + UB(1:2) = ubound(InData%z, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackConstrState(Buf, InData%z(i1,i2)) @@ -7989,9 +7989,9 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) - LB(1:2) = lbound(InData%OtherSt) - UB(1:2) = ubound(InData%OtherSt) + call RegPackBounds(Buf, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackOtherState(Buf, InData%OtherSt(i1,i2)) @@ -8000,45 +8000,45 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) - LB(1:1) = lbound(InData%p) - UB(1:1) = ubound(InData%p) + call RegPackBounds(Buf, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) + LB(1:1) = lbound(InData%p, kind=B8Ki) + UB(1:1) = ubound(InData%p, kind=B8Ki) do i1 = LB(1), UB(1) call BD_PackParam(Buf, InData%p(i1)) end do end if call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) - LB(1:1) = lbound(InData%u) - UB(1:1) = ubound(InData%u) + call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + LB(1:1) = lbound(InData%u, kind=B8Ki) + UB(1:1) = ubound(InData%u, kind=B8Ki) do i1 = LB(1), UB(1) call BD_PackInput(Buf, InData%u(i1)) end do end if call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) - LB(1:1) = lbound(InData%y) - UB(1:1) = ubound(InData%y) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + LB(1:1) = lbound(InData%y, kind=B8Ki) + UB(1:1) = ubound(InData%y, kind=B8Ki) do i1 = LB(1), UB(1) call BD_PackOutput(Buf, InData%y(i1)) end do end if call RegPack(Buf, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) - LB(1:1) = lbound(InData%m) - UB(1:1) = ubound(InData%m) + call RegPackBounds(Buf, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) + LB(1:1) = lbound(InData%m, kind=B8Ki) + UB(1:1) = ubound(InData%m, kind=B8Ki) do i1 = LB(1), UB(1) call BD_PackMisc(Buf, InData%m(i1)) end do end if call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 2, lbound(InData%Output), ubound(InData%Output)) - LB(1:2) = lbound(InData%Output) - UB(1:2) = ubound(InData%Output) + call RegPackBounds(Buf, 2, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:2) = lbound(InData%Output, kind=B8Ki) + UB(1:2) = ubound(InData%Output, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackOutput(Buf, InData%Output(i1,i2)) @@ -8047,18 +8047,18 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%y_interp)) if (allocated(InData%y_interp)) then - call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) - LB(1:1) = lbound(InData%y_interp) - UB(1:1) = ubound(InData%y_interp) + call RegPackBounds(Buf, 1, lbound(InData%y_interp, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) + LB(1:1) = lbound(InData%y_interp, kind=B8Ki) + UB(1:1) = ubound(InData%y_interp, kind=B8Ki) do i1 = LB(1), UB(1) call BD_PackOutput(Buf, InData%y_interp(i1)) end do end if call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) - LB(1:2) = lbound(InData%Input) - UB(1:2) = ubound(InData%Input) + call RegPackBounds(Buf, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:2) = lbound(InData%Input, kind=B8Ki) + UB(1:2) = ubound(InData%Input, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_PackInput(Buf, InData%Input(i1,i2)) @@ -8067,7 +8067,7 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 2, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -8077,8 +8077,8 @@ subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BeamDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -8281,36 +8281,36 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcElastoDyn_DataData%x) - UB(1:1) = ubound(SrcElastoDyn_DataData%x) + LB(1:1) = lbound(SrcElastoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcElastoDyn_DataData%xd) - UB(1:1) = ubound(SrcElastoDyn_DataData%xd) + LB(1:1) = lbound(SrcElastoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcElastoDyn_DataData%z) - UB(1:1) = ubound(SrcElastoDyn_DataData%z) + LB(1:1) = lbound(SrcElastoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8329,8 +8329,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcElastoDyn_DataData%Output)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Output) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output) + LB(1:1) = lbound(SrcElastoDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstElastoDyn_DataData%Output)) then allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8348,8 +8348,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcElastoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input) + LB(1:1) = lbound(SrcElastoDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstElastoDyn_DataData%Input)) then allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8364,8 +8364,8 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end do end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8381,33 +8381,33 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ElastoDyn_DataData%x) - UB(1:1) = ubound(ElastoDyn_DataData%x) + LB(1:1) = lbound(ElastoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ElastoDyn_DataData%xd) - UB(1:1) = ubound(ElastoDyn_DataData%xd) + LB(1:1) = lbound(ElastoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ElastoDyn_DataData%z) - UB(1:1) = ubound(ElastoDyn_DataData%z) + LB(1:1) = lbound(ElastoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) - UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8421,8 +8421,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%Output)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output) - UB(1:1) = ubound(ElastoDyn_DataData%Output) + LB(1:1) = lbound(ElastoDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8432,8 +8432,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) call ED_DestroyOutput(ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%Input)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input) - UB(1:1) = ubound(ElastoDyn_DataData%Input) + LB(1:1) = lbound(ElastoDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(ElastoDyn_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8449,26 +8449,26 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ElastoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -8478,9 +8478,9 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) call ED_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackOutput(Buf, InData%Output(i1)) end do @@ -8488,16 +8488,16 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) call ED_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call ED_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -8507,28 +8507,28 @@ subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ElastoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ED_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ED_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ED_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ED_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -8589,36 +8589,36 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcServoDyn_DataData%x) - UB(1:1) = ubound(SrcServoDyn_DataData%x) + LB(1:1) = lbound(SrcServoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcServoDyn_DataData%xd) - UB(1:1) = ubound(SrcServoDyn_DataData%xd) + LB(1:1) = lbound(SrcServoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcServoDyn_DataData%z) - UB(1:1) = ubound(SrcServoDyn_DataData%z) + LB(1:1) = lbound(SrcServoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8637,8 +8637,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcServoDyn_DataData%Output)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Output) - UB(1:1) = ubound(SrcServoDyn_DataData%Output) + LB(1:1) = lbound(SrcServoDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstServoDyn_DataData%Output)) then allocate(DstServoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8656,8 +8656,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcServoDyn_DataData%Input)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Input) - UB(1:1) = ubound(SrcServoDyn_DataData%Input) + LB(1:1) = lbound(SrcServoDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstServoDyn_DataData%Input)) then allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8672,8 +8672,8 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end do end if if (allocated(SrcServoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes) + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstServoDyn_DataData%InputTimes)) then allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8689,33 +8689,33 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) type(ServoDyn_Data), intent(inout) :: ServoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ServoDyn_DataData%x) - UB(1:1) = ubound(ServoDyn_DataData%x) + LB(1:1) = lbound(ServoDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ServoDyn_DataData%xd) - UB(1:1) = ubound(ServoDyn_DataData%xd) + LB(1:1) = lbound(ServoDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ServoDyn_DataData%z) - UB(1:1) = ubound(ServoDyn_DataData%z) + LB(1:1) = lbound(ServoDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ServoDyn_DataData%OtherSt) - UB(1:1) = ubound(ServoDyn_DataData%OtherSt) + LB(1:1) = lbound(ServoDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8729,8 +8729,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Output)) then - LB(1:1) = lbound(ServoDyn_DataData%Output) - UB(1:1) = ubound(ServoDyn_DataData%Output) + LB(1:1) = lbound(ServoDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyOutput(ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8740,8 +8740,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) call SrvD_DestroyOutput(ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Input)) then - LB(1:1) = lbound(ServoDyn_DataData%Input) - UB(1:1) = ubound(ServoDyn_DataData%Input) + LB(1:1) = lbound(ServoDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(ServoDyn_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_DestroyInput(ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8757,26 +8757,26 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ServoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -8786,9 +8786,9 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) call SrvD_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackOutput(Buf, InData%Output(i1)) end do @@ -8796,16 +8796,16 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) call SrvD_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -8815,28 +8815,28 @@ subroutine FAST_UnPackServoDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ServoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SrvD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -8897,36 +8897,36 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn14_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDyn14_DataData%x) - UB(1:1) = ubound(SrcAeroDyn14_DataData%x) + LB(1:1) = lbound(SrcAeroDyn14_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%x, kind=B8Ki) do i1 = LB(1), UB(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 end do - LB(1:1) = lbound(SrcAeroDyn14_DataData%xd) - UB(1:1) = ubound(SrcAeroDyn14_DataData%xd) + LB(1:1) = lbound(SrcAeroDyn14_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(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 end do - LB(1:1) = lbound(SrcAeroDyn14_DataData%z) - UB(1:1) = ubound(SrcAeroDyn14_DataData%z) + LB(1:1) = lbound(SrcAeroDyn14_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%z, kind=B8Ki) do i1 = LB(1), UB(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 end do - LB(1:1) = lbound(SrcAeroDyn14_DataData%OtherSt) - UB(1:1) = ubound(SrcAeroDyn14_DataData%OtherSt) + LB(1:1) = lbound(SrcAeroDyn14_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_CopyOtherState(SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8945,8 +8945,8 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDyn14_DataData%Input)) then - LB(1:1) = lbound(SrcAeroDyn14_DataData%Input) - UB(1:1) = ubound(SrcAeroDyn14_DataData%Input) + LB(1:1) = lbound(SrcAeroDyn14_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%Input, kind=B8Ki) if (.not. allocated(DstAeroDyn14_DataData%Input)) then allocate(DstAeroDyn14_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8961,8 +8961,8 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, end do end if if (allocated(SrcAeroDyn14_DataData%InputTimes)) then - LB(1:1) = lbound(SrcAeroDyn14_DataData%InputTimes) - UB(1:1) = ubound(SrcAeroDyn14_DataData%InputTimes) + LB(1:1) = lbound(SrcAeroDyn14_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn14_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstAeroDyn14_DataData%InputTimes)) then allocate(DstAeroDyn14_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8978,33 +8978,33 @@ subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) type(AeroDyn14_Data), intent(inout) :: AeroDyn14_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn14_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDyn14_DataData%x) - UB(1:1) = ubound(AeroDyn14_DataData%x) + LB(1:1) = lbound(AeroDyn14_DataData%x, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_DestroyContState(AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(AeroDyn14_DataData%xd) - UB(1:1) = ubound(AeroDyn14_DataData%xd) + LB(1:1) = lbound(AeroDyn14_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_DestroyDiscState(AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(AeroDyn14_DataData%z) - UB(1:1) = ubound(AeroDyn14_DataData%z) + LB(1:1) = lbound(AeroDyn14_DataData%z, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_DestroyConstrState(AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(AeroDyn14_DataData%OtherSt) - UB(1:1) = ubound(AeroDyn14_DataData%OtherSt) + LB(1:1) = lbound(AeroDyn14_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_DestroyOtherState(AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9018,8 +9018,8 @@ subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) call AD14_DestroyMisc(AeroDyn14_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn14_DataData%Input)) then - LB(1:1) = lbound(AeroDyn14_DataData%Input) - UB(1:1) = ubound(AeroDyn14_DataData%Input) + LB(1:1) = lbound(AeroDyn14_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(AeroDyn14_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_DestroyInput(AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9035,26 +9035,26 @@ subroutine FAST_PackAeroDyn14_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AeroDyn14_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDyn14_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -9064,16 +9064,16 @@ subroutine FAST_PackAeroDyn14_Data(Buf, Indata) call AD14_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -9083,28 +9083,28 @@ subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AeroDyn14_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn14_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD14_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -9149,36 +9149,36 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDyn_DataData%x) - UB(1:1) = ubound(SrcAeroDyn_DataData%x) + LB(1:1) = lbound(SrcAeroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcAeroDyn_DataData%xd) - UB(1:1) = ubound(SrcAeroDyn_DataData%xd) + LB(1:1) = lbound(SrcAeroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcAeroDyn_DataData%z) - UB(1:1) = ubound(SrcAeroDyn_DataData%z) + LB(1:1) = lbound(SrcAeroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9197,8 +9197,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDyn_DataData%Output)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Output) - UB(1:1) = ubound(SrcAeroDyn_DataData%Output) + LB(1:1) = lbound(SrcAeroDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstAeroDyn_DataData%Output)) then allocate(DstAeroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9216,8 +9216,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAeroDyn_DataData%Input)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Input) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input) + LB(1:1) = lbound(SrcAeroDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstAeroDyn_DataData%Input)) then allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9232,8 +9232,8 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end do end if if (allocated(SrcAeroDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes) + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9249,33 +9249,33 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) type(AeroDyn_Data), intent(inout) :: AeroDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDyn_DataData%x) - UB(1:1) = ubound(AeroDyn_DataData%x) + LB(1:1) = lbound(AeroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(AeroDyn_DataData%xd) - UB(1:1) = ubound(AeroDyn_DataData%xd) + LB(1:1) = lbound(AeroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(AeroDyn_DataData%z) - UB(1:1) = ubound(AeroDyn_DataData%z) + LB(1:1) = lbound(AeroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(AeroDyn_DataData%OtherSt) - UB(1:1) = ubound(AeroDyn_DataData%OtherSt) + LB(1:1) = lbound(AeroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9289,8 +9289,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Output)) then - LB(1:1) = lbound(AeroDyn_DataData%Output) - UB(1:1) = ubound(AeroDyn_DataData%Output) + LB(1:1) = lbound(AeroDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyOutput(AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9300,8 +9300,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) call AD_DestroyOutput(AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Input)) then - LB(1:1) = lbound(AeroDyn_DataData%Input) - UB(1:1) = ubound(AeroDyn_DataData%Input) + LB(1:1) = lbound(AeroDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(AeroDyn_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call AD_DestroyInput(AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9317,26 +9317,26 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AeroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -9346,9 +9346,9 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) call AD_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackOutput(Buf, InData%Output(i1)) end do @@ -9356,16 +9356,16 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) call AD_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call AD_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -9375,28 +9375,28 @@ subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(AeroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call AD_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call AD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call AD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call AD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -9457,36 +9457,36 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcInflowWind_DataData%x) - UB(1:1) = ubound(SrcInflowWind_DataData%x) + LB(1:1) = lbound(SrcInflowWind_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcInflowWind_DataData%xd) - UB(1:1) = ubound(SrcInflowWind_DataData%xd) + LB(1:1) = lbound(SrcInflowWind_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcInflowWind_DataData%z) - UB(1:1) = ubound(SrcInflowWind_DataData%z) + LB(1:1) = lbound(SrcInflowWind_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) - UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9505,8 +9505,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInflowWind_DataData%Output)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Output) - UB(1:1) = ubound(SrcInflowWind_DataData%Output) + LB(1:1) = lbound(SrcInflowWind_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%Output, kind=B8Ki) if (.not. allocated(DstInflowWind_DataData%Output)) then allocate(DstInflowWind_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9524,8 +9524,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInflowWind_DataData%Input)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Input) - UB(1:1) = ubound(SrcInflowWind_DataData%Input) + LB(1:1) = lbound(SrcInflowWind_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%Input, kind=B8Ki) if (.not. allocated(DstInflowWind_DataData%Input)) then allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9540,8 +9540,8 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end do end if if (allocated(SrcInflowWind_DataData%InputTimes)) then - LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) - UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes) + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstInflowWind_DataData%InputTimes)) then allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9557,33 +9557,33 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) type(InflowWind_Data), intent(inout) :: InflowWind_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(InflowWind_DataData%x) - UB(1:1) = ubound(InflowWind_DataData%x) + LB(1:1) = lbound(InflowWind_DataData%x, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(InflowWind_DataData%xd) - UB(1:1) = ubound(InflowWind_DataData%xd) + LB(1:1) = lbound(InflowWind_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(InflowWind_DataData%z) - UB(1:1) = ubound(InflowWind_DataData%z) + LB(1:1) = lbound(InflowWind_DataData%z, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(InflowWind_DataData%OtherSt) - UB(1:1) = ubound(InflowWind_DataData%OtherSt) + LB(1:1) = lbound(InflowWind_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9597,8 +9597,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Output)) then - LB(1:1) = lbound(InflowWind_DataData%Output) - UB(1:1) = ubound(InflowWind_DataData%Output) + LB(1:1) = lbound(InflowWind_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9608,8 +9608,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) call InflowWind_DestroyOutput(InflowWind_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Input)) then - LB(1:1) = lbound(InflowWind_DataData%Input) - UB(1:1) = ubound(InflowWind_DataData%Input) + LB(1:1) = lbound(InflowWind_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(InflowWind_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9625,26 +9625,26 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -9654,9 +9654,9 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) call InflowWind_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackOutput(Buf, InData%Output(i1)) end do @@ -9664,16 +9664,16 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) call InflowWind_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -9683,28 +9683,28 @@ subroutine FAST_UnPackInflowWind_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(InflowWind_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call InflowWind_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -9892,36 +9892,36 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSubDyn_DataData%x) - UB(1:1) = ubound(SrcSubDyn_DataData%x) + LB(1:1) = lbound(SrcSubDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcSubDyn_DataData%xd) - UB(1:1) = ubound(SrcSubDyn_DataData%xd) + LB(1:1) = lbound(SrcSubDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcSubDyn_DataData%z) - UB(1:1) = ubound(SrcSubDyn_DataData%z) + LB(1:1) = lbound(SrcSubDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9940,8 +9940,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSubDyn_DataData%Input)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Input) - UB(1:1) = ubound(SrcSubDyn_DataData%Input) + LB(1:1) = lbound(SrcSubDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstSubDyn_DataData%Input)) then allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9956,8 +9956,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end do end if if (allocated(SrcSubDyn_DataData%Output)) then - LB(1:1) = lbound(SrcSubDyn_DataData%Output) - UB(1:1) = ubound(SrcSubDyn_DataData%Output) + LB(1:1) = lbound(SrcSubDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstSubDyn_DataData%Output)) then allocate(DstSubDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9975,8 +9975,8 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSubDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstSubDyn_DataData%InputTimes)) then allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9992,33 +9992,33 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) type(SubDyn_Data), intent(inout) :: SubDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SubDyn_DataData%x) - UB(1:1) = ubound(SubDyn_DataData%x) + LB(1:1) = lbound(SubDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(SubDyn_DataData%xd) - UB(1:1) = ubound(SubDyn_DataData%xd) + LB(1:1) = lbound(SubDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(SubDyn_DataData%z) - UB(1:1) = ubound(SubDyn_DataData%z) + LB(1:1) = lbound(SubDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(SubDyn_DataData%OtherSt) - UB(1:1) = ubound(SubDyn_DataData%OtherSt) + LB(1:1) = lbound(SubDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10032,8 +10032,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%Input)) then - LB(1:1) = lbound(SubDyn_DataData%Input) - UB(1:1) = ubound(SubDyn_DataData%Input) + LB(1:1) = lbound(SubDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10041,8 +10041,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) deallocate(SubDyn_DataData%Input) end if if (allocated(SubDyn_DataData%Output)) then - LB(1:1) = lbound(SubDyn_DataData%Output) - UB(1:1) = ubound(SubDyn_DataData%Output) + LB(1:1) = lbound(SubDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SubDyn_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10060,26 +10060,26 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SubDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -10089,18 +10089,18 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) call SD_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackOutput(Buf, InData%Output(i1)) end do @@ -10108,7 +10108,7 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) call SD_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -10118,28 +10118,28 @@ subroutine FAST_UnPackSubDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SubDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SD_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -10200,36 +10200,36 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcExtPtfm_DataData%x) - UB(1:1) = ubound(SrcExtPtfm_DataData%x) + LB(1:1) = lbound(SrcExtPtfm_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtPtfm_DataData%xd) - UB(1:1) = ubound(SrcExtPtfm_DataData%xd) + LB(1:1) = lbound(SrcExtPtfm_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtPtfm_DataData%z) - UB(1:1) = ubound(SrcExtPtfm_DataData%z) + LB(1:1) = lbound(SrcExtPtfm_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) - UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10248,8 +10248,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcExtPtfm_DataData%Input)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%Input) - UB(1:1) = ubound(SrcExtPtfm_DataData%Input) + LB(1:1) = lbound(SrcExtPtfm_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input, kind=B8Ki) if (.not. allocated(DstExtPtfm_DataData%Input)) then allocate(DstExtPtfm_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10264,8 +10264,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end do end if if (allocated(SrcExtPtfm_DataData%InputTimes)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) - UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstExtPtfm_DataData%InputTimes)) then allocate(DstExtPtfm_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10281,33 +10281,33 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) type(ExtPtfm_Data), intent(inout) :: ExtPtfm_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ExtPtfm_DataData%x) - UB(1:1) = ubound(ExtPtfm_DataData%x) + LB(1:1) = lbound(ExtPtfm_DataData%x, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtPtfm_DataData%xd) - UB(1:1) = ubound(ExtPtfm_DataData%xd) + LB(1:1) = lbound(ExtPtfm_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtPtfm_DataData%z) - UB(1:1) = ubound(ExtPtfm_DataData%z) + LB(1:1) = lbound(ExtPtfm_DataData%z, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) - UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10321,8 +10321,8 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ExtPtfm_DataData%Input)) then - LB(1:1) = lbound(ExtPtfm_DataData%Input) - UB(1:1) = ubound(ExtPtfm_DataData%Input) + LB(1:1) = lbound(ExtPtfm_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(ExtPtfm_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10338,26 +10338,26 @@ subroutine FAST_PackExtPtfm_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -10367,16 +10367,16 @@ subroutine FAST_PackExtPtfm_Data(Buf, Indata) call ExtPtfm_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -10386,28 +10386,28 @@ subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -10452,36 +10452,36 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSeaState_DataData%x) - UB(1:1) = ubound(SrcSeaState_DataData%x) + LB(1:1) = lbound(SrcSeaState_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcSeaState_DataData%xd) - UB(1:1) = ubound(SrcSeaState_DataData%xd) + LB(1:1) = lbound(SrcSeaState_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcSeaState_DataData%z) - UB(1:1) = ubound(SrcSeaState_DataData%z) + LB(1:1) = lbound(SrcSeaState_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) - UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10500,8 +10500,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSeaState_DataData%Input)) then - LB(1:1) = lbound(SrcSeaState_DataData%Input) - UB(1:1) = ubound(SrcSeaState_DataData%Input) + LB(1:1) = lbound(SrcSeaState_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%Input, kind=B8Ki) if (.not. allocated(DstSeaState_DataData%Input)) then allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10516,8 +10516,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end do end if if (allocated(SrcSeaState_DataData%Output)) then - LB(1:1) = lbound(SrcSeaState_DataData%Output) - UB(1:1) = ubound(SrcSeaState_DataData%Output) + LB(1:1) = lbound(SrcSeaState_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%Output, kind=B8Ki) if (.not. allocated(DstSeaState_DataData%Output)) then allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10535,8 +10535,8 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcSeaState_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) - UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstSeaState_DataData%InputTimes)) then allocate(DstSeaState_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10552,33 +10552,33 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) type(SeaState_Data), intent(inout) :: SeaState_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SeaState_DataData%x) - UB(1:1) = ubound(SeaState_DataData%x) + LB(1:1) = lbound(SeaState_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(SeaState_DataData%xd) - UB(1:1) = ubound(SeaState_DataData%xd) + LB(1:1) = lbound(SeaState_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(SeaState_DataData%z) - UB(1:1) = ubound(SeaState_DataData%z) + LB(1:1) = lbound(SeaState_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(SeaState_DataData%OtherSt) - UB(1:1) = ubound(SeaState_DataData%OtherSt) + LB(1:1) = lbound(SeaState_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10592,8 +10592,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaState_DataData%Input)) then - LB(1:1) = lbound(SeaState_DataData%Input) - UB(1:1) = ubound(SeaState_DataData%Input) + LB(1:1) = lbound(SeaState_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10601,8 +10601,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) deallocate(SeaState_DataData%Input) end if if (allocated(SeaState_DataData%Output)) then - LB(1:1) = lbound(SeaState_DataData%Output) - UB(1:1) = ubound(SeaState_DataData%Output) + LB(1:1) = lbound(SeaState_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SeaState_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10620,26 +10620,26 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaState_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -10649,18 +10649,18 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) call SeaSt_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_PackOutput(Buf, InData%Output(i1)) end do @@ -10668,7 +10668,7 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) call SeaSt_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -10678,28 +10678,28 @@ subroutine FAST_UnPackSeaState_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaState_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call SeaSt_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -10760,36 +10760,36 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcHydroDyn_DataData%x) - UB(1:1) = ubound(SrcHydroDyn_DataData%x) + LB(1:1) = lbound(SrcHydroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcHydroDyn_DataData%xd) - UB(1:1) = ubound(SrcHydroDyn_DataData%xd) + LB(1:1) = lbound(SrcHydroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcHydroDyn_DataData%z) - UB(1:1) = ubound(SrcHydroDyn_DataData%z) + LB(1:1) = lbound(SrcHydroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10808,8 +10808,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcHydroDyn_DataData%Output)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Output) - UB(1:1) = ubound(SrcHydroDyn_DataData%Output) + LB(1:1) = lbound(SrcHydroDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstHydroDyn_DataData%Output)) then allocate(DstHydroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10827,8 +10827,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcHydroDyn_DataData%Input)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Input) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input) + LB(1:1) = lbound(SrcHydroDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstHydroDyn_DataData%Input)) then allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10843,8 +10843,8 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end do end if if (allocated(SrcHydroDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes) + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10860,33 +10860,33 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) type(HydroDyn_Data), intent(inout) :: HydroDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(HydroDyn_DataData%x) - UB(1:1) = ubound(HydroDyn_DataData%x) + LB(1:1) = lbound(HydroDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(HydroDyn_DataData%xd) - UB(1:1) = ubound(HydroDyn_DataData%xd) + LB(1:1) = lbound(HydroDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(HydroDyn_DataData%z) - UB(1:1) = ubound(HydroDyn_DataData%z) + LB(1:1) = lbound(HydroDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(HydroDyn_DataData%OtherSt) - UB(1:1) = ubound(HydroDyn_DataData%OtherSt) + LB(1:1) = lbound(HydroDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10900,8 +10900,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Output)) then - LB(1:1) = lbound(HydroDyn_DataData%Output) - UB(1:1) = ubound(HydroDyn_DataData%Output) + LB(1:1) = lbound(HydroDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10911,8 +10911,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Input)) then - LB(1:1) = lbound(HydroDyn_DataData%Input) - UB(1:1) = ubound(HydroDyn_DataData%Input) + LB(1:1) = lbound(HydroDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(HydroDyn_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10928,26 +10928,26 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -10957,9 +10957,9 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) call HydroDyn_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackOutput(Buf, InData%Output(i1)) end do @@ -10967,16 +10967,16 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) call HydroDyn_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -10986,28 +10986,28 @@ subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -11068,36 +11068,36 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcIceFloe_DataData%x) - UB(1:1) = ubound(SrcIceFloe_DataData%x) + LB(1:1) = lbound(SrcIceFloe_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcIceFloe_DataData%xd) - UB(1:1) = ubound(SrcIceFloe_DataData%xd) + LB(1:1) = lbound(SrcIceFloe_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcIceFloe_DataData%z) - UB(1:1) = ubound(SrcIceFloe_DataData%z) + LB(1:1) = lbound(SrcIceFloe_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) - UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11116,8 +11116,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcIceFloe_DataData%Input)) then - LB(1:1) = lbound(SrcIceFloe_DataData%Input) - UB(1:1) = ubound(SrcIceFloe_DataData%Input) + LB(1:1) = lbound(SrcIceFloe_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%Input, kind=B8Ki) if (.not. allocated(DstIceFloe_DataData%Input)) then allocate(DstIceFloe_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11132,8 +11132,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end do end if if (allocated(SrcIceFloe_DataData%InputTimes)) then - LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) - UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstIceFloe_DataData%InputTimes)) then allocate(DstIceFloe_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11149,33 +11149,33 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) type(IceFloe_Data), intent(inout) :: IceFloe_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(IceFloe_DataData%x) - UB(1:1) = ubound(IceFloe_DataData%x) + LB(1:1) = lbound(IceFloe_DataData%x, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(IceFloe_DataData%xd) - UB(1:1) = ubound(IceFloe_DataData%xd) + LB(1:1) = lbound(IceFloe_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(IceFloe_DataData%z) - UB(1:1) = ubound(IceFloe_DataData%z) + LB(1:1) = lbound(IceFloe_DataData%z, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(IceFloe_DataData%OtherSt) - UB(1:1) = ubound(IceFloe_DataData%OtherSt) + LB(1:1) = lbound(IceFloe_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11189,8 +11189,8 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(IceFloe_DataData%Input)) then - LB(1:1) = lbound(IceFloe_DataData%Input) - UB(1:1) = ubound(IceFloe_DataData%Input) + LB(1:1) = lbound(IceFloe_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(IceFloe_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_DestroyInput(IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11206,26 +11206,26 @@ subroutine FAST_PackIceFloe_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -11235,16 +11235,16 @@ subroutine FAST_PackIceFloe_Data(Buf, Indata) call IceFloe_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -11254,28 +11254,28 @@ subroutine FAST_UnPackIceFloe_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IceFloe_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call IceFloe_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -11320,29 +11320,29 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMAP_DataData%x) - UB(1:1) = ubound(SrcMAP_DataData%x) + LB(1:1) = lbound(SrcMAP_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMAP_DataData%xd) - UB(1:1) = ubound(SrcMAP_DataData%xd) + LB(1:1) = lbound(SrcMAP_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMAP_DataData%z) - UB(1:1) = ubound(SrcMAP_DataData%z) + LB(1:1) = lbound(SrcMAP_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11364,8 +11364,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMAP_DataData%Output)) then - LB(1:1) = lbound(SrcMAP_DataData%Output) - UB(1:1) = ubound(SrcMAP_DataData%Output) + LB(1:1) = lbound(SrcMAP_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%Output, kind=B8Ki) if (.not. allocated(DstMAP_DataData%Output)) then allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11383,8 +11383,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMAP_DataData%Input)) then - LB(1:1) = lbound(SrcMAP_DataData%Input) - UB(1:1) = ubound(SrcMAP_DataData%Input) + LB(1:1) = lbound(SrcMAP_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%Input, kind=B8Ki) if (.not. allocated(DstMAP_DataData%Input)) then allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11399,8 +11399,8 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcMAP_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMAP_DataData%InputTimes) - UB(1:1) = ubound(SrcMAP_DataData%InputTimes) + LB(1:1) = lbound(SrcMAP_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstMAP_DataData%InputTimes)) then allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11416,27 +11416,27 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) type(MAP_Data), intent(inout) :: MAP_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MAP_DataData%x) - UB(1:1) = ubound(MAP_DataData%x) + LB(1:1) = lbound(MAP_DataData%x, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MAP_DataData%xd) - UB(1:1) = ubound(MAP_DataData%xd) + LB(1:1) = lbound(MAP_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MAP_DataData%z) - UB(1:1) = ubound(MAP_DataData%z) + LB(1:1) = lbound(MAP_DataData%z, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11452,8 +11452,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Output)) then - LB(1:1) = lbound(MAP_DataData%Output) - UB(1:1) = ubound(MAP_DataData%Output) + LB(1:1) = lbound(MAP_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyOutput(MAP_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11463,8 +11463,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) call MAP_DestroyOutput(MAP_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Input)) then - LB(1:1) = lbound(MAP_DataData%Input) - UB(1:1) = ubound(MAP_DataData%Input) + LB(1:1) = lbound(MAP_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(MAP_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_DestroyInput(MAP_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11480,21 +11480,21 @@ subroutine FAST_PackMAP_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MAP_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackConstrState(Buf, InData%z(i1)) end do @@ -11505,9 +11505,9 @@ subroutine FAST_PackMAP_Data(Buf, Indata) call MAP_PackOtherState(Buf, InData%OtherSt_old) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackOutput(Buf, InData%Output(i1)) end do @@ -11515,16 +11515,16 @@ subroutine FAST_PackMAP_Data(Buf, Indata) call MAP_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -11534,23 +11534,23 @@ subroutine FAST_UnPackMAP_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MAP_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MAP_UnpackConstrState(Buf, OutData%z(i1)) ! z end do @@ -11612,36 +11612,36 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcFEAMooring_DataData%x) - UB(1:1) = ubound(SrcFEAMooring_DataData%x) + LB(1:1) = lbound(SrcFEAMooring_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcFEAMooring_DataData%xd) - UB(1:1) = ubound(SrcFEAMooring_DataData%xd) + LB(1:1) = lbound(SrcFEAMooring_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcFEAMooring_DataData%z) - UB(1:1) = ubound(SrcFEAMooring_DataData%z) + LB(1:1) = lbound(SrcFEAMooring_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) - UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11660,8 +11660,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcFEAMooring_DataData%Input)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%Input) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input) + LB(1:1) = lbound(SrcFEAMooring_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input, kind=B8Ki) if (.not. allocated(DstFEAMooring_DataData%Input)) then allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11676,8 +11676,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end do end if if (allocated(SrcFEAMooring_DataData%InputTimes)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) - UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstFEAMooring_DataData%InputTimes)) then allocate(DstFEAMooring_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11693,33 +11693,33 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(FEAMooring_DataData%x) - UB(1:1) = ubound(FEAMooring_DataData%x) + LB(1:1) = lbound(FEAMooring_DataData%x, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(FEAMooring_DataData%xd) - UB(1:1) = ubound(FEAMooring_DataData%xd) + LB(1:1) = lbound(FEAMooring_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(FEAMooring_DataData%z) - UB(1:1) = ubound(FEAMooring_DataData%z) + LB(1:1) = lbound(FEAMooring_DataData%z, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(FEAMooring_DataData%OtherSt) - UB(1:1) = ubound(FEAMooring_DataData%OtherSt) + LB(1:1) = lbound(FEAMooring_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11733,8 +11733,8 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(FEAMooring_DataData%Input)) then - LB(1:1) = lbound(FEAMooring_DataData%Input) - UB(1:1) = ubound(FEAMooring_DataData%Input) + LB(1:1) = lbound(FEAMooring_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(FEAMooring_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_DestroyInput(FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11750,26 +11750,26 @@ subroutine FAST_PackFEAMooring_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAMooring_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -11779,16 +11779,16 @@ subroutine FAST_PackFEAMooring_Data(Buf, Indata) call FEAM_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -11798,28 +11798,28 @@ subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FEAMooring_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call FEAM_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -11864,36 +11864,36 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMoorDyn_DataData%x) - UB(1:1) = ubound(SrcMoorDyn_DataData%x) + LB(1:1) = lbound(SrcMoorDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMoorDyn_DataData%xd) - UB(1:1) = ubound(SrcMoorDyn_DataData%xd) + LB(1:1) = lbound(SrcMoorDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMoorDyn_DataData%z) - UB(1:1) = ubound(SrcMoorDyn_DataData%z) + LB(1:1) = lbound(SrcMoorDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) - UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11912,8 +11912,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMoorDyn_DataData%Output)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Output) - UB(1:1) = ubound(SrcMoorDyn_DataData%Output) + LB(1:1) = lbound(SrcMoorDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%Output, kind=B8Ki) if (.not. allocated(DstMoorDyn_DataData%Output)) then allocate(DstMoorDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11931,8 +11931,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMoorDyn_DataData%Input)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Input) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input) + LB(1:1) = lbound(SrcMoorDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input, kind=B8Ki) if (.not. allocated(DstMoorDyn_DataData%Input)) then allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11947,8 +11947,8 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end do end if if (allocated(SrcMoorDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) - UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes) + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11964,33 +11964,33 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) type(MoorDyn_Data), intent(inout) :: MoorDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MoorDyn_DataData%x) - UB(1:1) = ubound(MoorDyn_DataData%x) + LB(1:1) = lbound(MoorDyn_DataData%x, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MoorDyn_DataData%xd) - UB(1:1) = ubound(MoorDyn_DataData%xd) + LB(1:1) = lbound(MoorDyn_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MoorDyn_DataData%z) - UB(1:1) = ubound(MoorDyn_DataData%z) + LB(1:1) = lbound(MoorDyn_DataData%z, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MoorDyn_DataData%OtherSt) - UB(1:1) = ubound(MoorDyn_DataData%OtherSt) + LB(1:1) = lbound(MoorDyn_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12004,8 +12004,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Output)) then - LB(1:1) = lbound(MoorDyn_DataData%Output) - UB(1:1) = ubound(MoorDyn_DataData%Output) + LB(1:1) = lbound(MoorDyn_DataData%Output, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyOutput(MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12015,8 +12015,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) call MD_DestroyOutput(MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Input)) then - LB(1:1) = lbound(MoorDyn_DataData%Input) - UB(1:1) = ubound(MoorDyn_DataData%Input) + LB(1:1) = lbound(MoorDyn_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(MoorDyn_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call MD_DestroyInput(MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12032,26 +12032,26 @@ subroutine FAST_PackMoorDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MoorDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -12061,9 +12061,9 @@ subroutine FAST_PackMoorDyn_Data(Buf, Indata) call MD_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) + call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + LB(1:1) = lbound(InData%Output, kind=B8Ki) + UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackOutput(Buf, InData%Output(i1)) end do @@ -12071,16 +12071,16 @@ subroutine FAST_PackMoorDyn_Data(Buf, Indata) call MD_PackOutput(Buf, InData%y_interp) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call MD_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -12090,28 +12090,28 @@ subroutine FAST_UnPackMoorDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MoorDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call MD_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call MD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call MD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call MD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -12172,36 +12172,36 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcOrcaFlex_DataData%x) - UB(1:1) = ubound(SrcOrcaFlex_DataData%x) + LB(1:1) = lbound(SrcOrcaFlex_DataData%x, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) - UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%z) - UB(1:1) = ubound(SrcOrcaFlex_DataData%z) + LB(1:1) = lbound(SrcOrcaFlex_DataData%z, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) - UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12220,8 +12220,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOrcaFlex_DataData%Input)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%Input) - UB(1:1) = ubound(SrcOrcaFlex_DataData%Input) + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input, kind=B8Ki) if (.not. allocated(DstOrcaFlex_DataData%Input)) then allocate(DstOrcaFlex_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12236,8 +12236,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end do end if if (allocated(SrcOrcaFlex_DataData%InputTimes)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) - UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) if (.not. allocated(DstOrcaFlex_DataData%InputTimes)) then allocate(DstOrcaFlex_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12253,33 +12253,33 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) type(OrcaFlex_Data), intent(inout) :: OrcaFlex_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OrcaFlex_DataData%x) - UB(1:1) = ubound(OrcaFlex_DataData%x) + LB(1:1) = lbound(OrcaFlex_DataData%x, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%x, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(OrcaFlex_DataData%xd) - UB(1:1) = ubound(OrcaFlex_DataData%xd) + LB(1:1) = lbound(OrcaFlex_DataData%xd, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(OrcaFlex_DataData%z) - UB(1:1) = ubound(OrcaFlex_DataData%z) + LB(1:1) = lbound(OrcaFlex_DataData%z, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%z, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) - UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12293,8 +12293,8 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OrcaFlex_DataData%Input)) then - LB(1:1) = lbound(OrcaFlex_DataData%Input) - UB(1:1) = ubound(OrcaFlex_DataData%Input) + LB(1:1) = lbound(OrcaFlex_DataData%Input, kind=B8Ki) + UB(1:1) = ubound(OrcaFlex_DataData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_DestroyInput(OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12310,26 +12310,26 @@ subroutine FAST_PackOrcaFlex_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(OrcaFlex_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_PackContState(Buf, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) + LB(1:1) = lbound(InData%xd, kind=B8Ki) + UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_PackDiscState(Buf, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) + LB(1:1) = lbound(InData%z, kind=B8Ki) + UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_PackConstrState(Buf, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_PackOtherState(Buf, InData%OtherSt(i1)) end do @@ -12339,16 +12339,16 @@ subroutine FAST_PackOrcaFlex_Data(Buf, Indata) call Orca_PackMisc(Buf, InData%m) call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + LB(1:1) = lbound(InData%Input, kind=B8Ki) + UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_PackInput(Buf, InData%Input(i1)) end do end if call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return @@ -12358,28 +12358,28 @@ subroutine FAST_UnPackOrcaFlex_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(OrcaFlex_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) + LB(1:1) = lbound(OutData%x, kind=B8Ki) + UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_UnpackContState(Buf, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) + LB(1:1) = lbound(OutData%xd, kind=B8Ki) + UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) + LB(1:1) = lbound(OutData%z, kind=B8Ki) + UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) + LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) + UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) call Orca_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do @@ -12424,16 +12424,16 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then allocate(DstModuleMapTypeData%ED_P_2_BD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12448,8 +12448,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) - UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P) + LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then allocate(DstModuleMapTypeData%BD_P_2_ED_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12464,8 +12464,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then allocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12507,8 +12507,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then allocate(DstModuleMapTypeData%ED_P_2_NStC_P_N(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12523,8 +12523,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then - LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) - UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then allocate(DstModuleMapTypeData%NStC_P_2_ED_P_N(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12539,8 +12539,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then allocate(DstModuleMapTypeData%ED_L_2_TStC_P_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12555,8 +12555,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then - LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) - UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then allocate(DstModuleMapTypeData%TStC_P_2_ED_P_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12571,8 +12571,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) - UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then allocate(DstModuleMapTypeData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12589,8 +12589,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then allocate(DstModuleMapTypeData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12607,8 +12607,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) - UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then allocate(DstModuleMapTypeData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12625,8 +12625,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then allocate(DstModuleMapTypeData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12643,8 +12643,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) - UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then allocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12659,8 +12659,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) - UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then allocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12678,8 +12678,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) - UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then allocate(DstModuleMapTypeData%BDED_L_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12694,8 +12694,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then allocate(DstModuleMapTypeData%AD_L_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12710,8 +12710,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) - UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L) + LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then allocate(DstModuleMapTypeData%BD_L_2_BD_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12744,8 +12744,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then allocate(DstModuleMapTypeData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12772,8 +12772,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%IceD_P_2_SD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P) - UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P) + LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then allocate(DstModuleMapTypeData%IceD_P_2_SD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12788,8 +12788,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) - UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then allocate(DstModuleMapTypeData%SDy3_P_2_IceD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12804,8 +12804,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then - LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) - UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1) + LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%Jacobian_Opt1)) then allocate(DstModuleMapTypeData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12816,8 +12816,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 end if if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then - LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) - UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot) + LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%Jacobian_pivot)) then allocate(DstModuleMapTypeData%Jacobian_pivot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12828,8 +12828,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot end if if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) - UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx) + LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%Jac_u_indx)) then allocate(DstModuleMapTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12861,8 +12861,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%u_ED_BladePtLoads)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads) - UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads) + LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then allocate(DstModuleMapTypeData%u_ED_BladePtLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12892,8 +12892,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%u_BD_RootMotion)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion) - UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion) + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_BD_RootMotion)) then allocate(DstModuleMapTypeData%u_BD_RootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12908,8 +12908,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then - LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) - UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then allocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12924,8 +12924,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) - UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload) + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_BD_Distrload)) then allocate(DstModuleMapTypeData%u_BD_Distrload(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12946,8 +12946,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%HubOrient)) then - LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient) - UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient) + LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient, kind=B8Ki) + UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%HubOrient)) then allocate(DstModuleMapTypeData%HubOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12963,16 +12963,16 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) type(FAST_ModuleMapType), intent(inout) :: ModuleMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModuleMapTypeData%ED_P_2_BD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12980,8 +12980,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_P_2_BD_P) end if if (allocated(ModuleMapTypeData%BD_P_2_ED_P)) then - LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P) - UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P) + LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12989,8 +12989,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_P_2_ED_P) end if if (allocated(ModuleMapTypeData%ED_P_2_BD_P_Hub)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13016,8 +13016,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_NStC_P_N)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13025,8 +13025,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_P_2_NStC_P_N) end if if (allocated(ModuleMapTypeData%NStC_P_2_ED_P_N)) then - LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N) - UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N) + LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13034,8 +13034,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%NStC_P_2_ED_P_N) end if if (allocated(ModuleMapTypeData%ED_L_2_TStC_P_T)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T) - UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T) + LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13043,8 +13043,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_L_2_TStC_P_T) end if if (allocated(ModuleMapTypeData%TStC_P_2_ED_P_T)) then - LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T) - UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T) + LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13052,8 +13052,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%TStC_P_2_ED_P_T) end if if (allocated(ModuleMapTypeData%ED_L_2_BStC_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B) - UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B) + LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) + UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13063,8 +13063,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_L_2_BStC_P_B) end if if (allocated(ModuleMapTypeData%BStC_P_2_ED_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B) - UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B) + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13074,8 +13074,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_P_2_ED_P_B) end if if (allocated(ModuleMapTypeData%BD_L_2_BStC_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B) - UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B) + LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) + UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13085,8 +13085,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_L_2_BStC_P_B) end if if (allocated(ModuleMapTypeData%BStC_P_2_BD_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B) - UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B) + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13096,8 +13096,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_P_2_BD_P_B) end if if (allocated(ModuleMapTypeData%SStC_P_P_2_SubStructure)) then - LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure) - UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13105,8 +13105,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SStC_P_P_2_SubStructure) end if if (allocated(ModuleMapTypeData%SubStructure_2_SStC_P_P)) then - LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P) - UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13116,8 +13116,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%BDED_L_2_AD_L_B)) then - LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) - UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13125,8 +13125,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BDED_L_2_AD_L_B) end if if (allocated(ModuleMapTypeData%AD_L_2_BDED_B)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13134,8 +13134,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%AD_L_2_BDED_B) end if if (allocated(ModuleMapTypeData%BD_L_2_BD_L)) then - LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L) - UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L) + LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13155,8 +13155,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13172,8 +13172,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) - UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) + LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13181,8 +13181,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%IceD_P_2_SD_P) end if if (allocated(ModuleMapTypeData%SDy3_P_2_IceD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P) - UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P) + LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13213,8 +13213,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then - LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) - UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) + LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13232,8 +13232,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then - LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) - UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) + LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13241,8 +13241,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_BD_RootMotion) end if if (allocated(ModuleMapTypeData%y_BD_BldMotion_4Loads)) then - LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads) - UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13250,8 +13250,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%y_BD_BldMotion_4Loads) end if if (allocated(ModuleMapTypeData%u_BD_Distrload)) then - LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload) - UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload) + LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13271,32 +13271,32 @@ subroutine FAST_PackModuleMapType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%ED_P_2_BD_P)) if (allocated(InData%ED_P_2_BD_P)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) - LB(1:1) = lbound(InData%ED_P_2_BD_P) - UB(1:1) = ubound(InData%ED_P_2_BD_P) + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P, kind=B8Ki), ubound(InData%ED_P_2_BD_P, kind=B8Ki)) + LB(1:1) = lbound(InData%ED_P_2_BD_P, kind=B8Ki) + UB(1:1) = ubound(InData%ED_P_2_BD_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P(i1)) end do end if call RegPack(Buf, allocated(InData%BD_P_2_ED_P)) if (allocated(InData%BD_P_2_ED_P)) then - call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) - LB(1:1) = lbound(InData%BD_P_2_ED_P) - UB(1:1) = ubound(InData%BD_P_2_ED_P) + call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P, kind=B8Ki), ubound(InData%BD_P_2_ED_P, kind=B8Ki)) + LB(1:1) = lbound(InData%BD_P_2_ED_P, kind=B8Ki) + UB(1:1) = ubound(InData%BD_P_2_ED_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BD_P_2_ED_P(i1)) end do end if call RegPack(Buf, allocated(InData%ED_P_2_BD_P_Hub)) if (allocated(InData%ED_P_2_BD_P_Hub)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) - LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub) - UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub) + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki), ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki)) + LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) + UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P_Hub(i1)) end do @@ -13312,45 +13312,45 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%SD_TP_2_ED_P) call RegPack(Buf, allocated(InData%ED_P_2_NStC_P_N)) if (allocated(InData%ED_P_2_NStC_P_N)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) - LB(1:1) = lbound(InData%ED_P_2_NStC_P_N) - UB(1:1) = ubound(InData%ED_P_2_NStC_P_N) + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki), ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki)) + LB(1:1) = lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki) + UB(1:1) = ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_NStC_P_N(i1)) end do end if call RegPack(Buf, allocated(InData%NStC_P_2_ED_P_N)) if (allocated(InData%NStC_P_2_ED_P_N)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) - LB(1:1) = lbound(InData%NStC_P_2_ED_P_N) - UB(1:1) = ubound(InData%NStC_P_2_ED_P_N) + call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki), ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki) + UB(1:1) = ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%NStC_P_2_ED_P_N(i1)) end do end if call RegPack(Buf, allocated(InData%ED_L_2_TStC_P_T)) if (allocated(InData%ED_L_2_TStC_P_T)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) - LB(1:1) = lbound(InData%ED_L_2_TStC_P_T) - UB(1:1) = ubound(InData%ED_L_2_TStC_P_T) + call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki), ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki)) + LB(1:1) = lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki) + UB(1:1) = ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_TStC_P_T(i1)) end do end if call RegPack(Buf, allocated(InData%TStC_P_2_ED_P_T)) if (allocated(InData%TStC_P_2_ED_P_T)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) - LB(1:1) = lbound(InData%TStC_P_2_ED_P_T) - UB(1:1) = ubound(InData%TStC_P_2_ED_P_T) + call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki), ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki) + UB(1:1) = ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%TStC_P_2_ED_P_T(i1)) end do end if call RegPack(Buf, allocated(InData%ED_L_2_BStC_P_B)) if (allocated(InData%ED_L_2_BStC_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) - LB(1:2) = lbound(InData%ED_L_2_BStC_P_B) - UB(1:2) = ubound(InData%ED_L_2_BStC_P_B) + call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki), ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki)) + LB(1:2) = lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki) + UB(1:2) = ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_BStC_P_B(i1,i2)) @@ -13359,9 +13359,9 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end if call RegPack(Buf, allocated(InData%BStC_P_2_ED_P_B)) if (allocated(InData%BStC_P_2_ED_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) - LB(1:2) = lbound(InData%BStC_P_2_ED_P_B) - UB(1:2) = ubound(InData%BStC_P_2_ED_P_B) + call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki), ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki)) + LB(1:2) = lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki) + UB(1:2) = ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_ED_P_B(i1,i2)) @@ -13370,9 +13370,9 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end if call RegPack(Buf, allocated(InData%BD_L_2_BStC_P_B)) if (allocated(InData%BD_L_2_BStC_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) - LB(1:2) = lbound(InData%BD_L_2_BStC_P_B) - UB(1:2) = ubound(InData%BD_L_2_BStC_P_B) + call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki), ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki)) + LB(1:2) = lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki) + UB(1:2) = ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BStC_P_B(i1,i2)) @@ -13381,9 +13381,9 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end if call RegPack(Buf, allocated(InData%BStC_P_2_BD_P_B)) if (allocated(InData%BStC_P_2_BD_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) - LB(1:2) = lbound(InData%BStC_P_2_BD_P_B) - UB(1:2) = ubound(InData%BStC_P_2_BD_P_B) + call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki), ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki)) + LB(1:2) = lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki) + UB(1:2) = ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_BD_P_B(i1,i2)) @@ -13392,18 +13392,18 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end if call RegPack(Buf, allocated(InData%SStC_P_P_2_SubStructure)) if (allocated(InData%SStC_P_P_2_SubStructure)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) - LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure) - UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure) + call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki), ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) + UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%SStC_P_P_2_SubStructure(i1)) end do end if call RegPack(Buf, allocated(InData%SubStructure_2_SStC_P_P)) if (allocated(InData%SubStructure_2_SStC_P_P)) then - call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) - LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P) - UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P) + call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki), ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki)) + LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) + UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_SStC_P_P(i1)) end do @@ -13411,27 +13411,27 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SrvD_P_P) call RegPack(Buf, allocated(InData%BDED_L_2_AD_L_B)) if (allocated(InData%BDED_L_2_AD_L_B)) then - call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) - LB(1:1) = lbound(InData%BDED_L_2_AD_L_B) - UB(1:1) = ubound(InData%BDED_L_2_AD_L_B) + call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki), ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki)) + LB(1:1) = lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki) + UB(1:1) = ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BDED_L_2_AD_L_B(i1)) end do end if call RegPack(Buf, allocated(InData%AD_L_2_BDED_B)) if (allocated(InData%AD_L_2_BDED_B)) then - call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) - LB(1:1) = lbound(InData%AD_L_2_BDED_B) - UB(1:1) = ubound(InData%AD_L_2_BDED_B) + call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B, kind=B8Ki), ubound(InData%AD_L_2_BDED_B, kind=B8Ki)) + LB(1:1) = lbound(InData%AD_L_2_BDED_B, kind=B8Ki) + UB(1:1) = ubound(InData%AD_L_2_BDED_B, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_BDED_B(i1)) end do end if call RegPack(Buf, allocated(InData%BD_L_2_BD_L)) if (allocated(InData%BD_L_2_BD_L)) then - call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) - LB(1:1) = lbound(InData%BD_L_2_BD_L) - UB(1:1) = ubound(InData%BD_L_2_BD_L) + call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L, kind=B8Ki), ubound(InData%BD_L_2_BD_L, kind=B8Ki)) + LB(1:1) = lbound(InData%BD_L_2_BD_L, kind=B8Ki) + UB(1:1) = ubound(InData%BD_L_2_BD_L, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BD_L(i1)) end do @@ -13444,9 +13444,9 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_ED_P_T) call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) - LB(1:1) = lbound(InData%ED_P_2_AD_P_R) - UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) end do @@ -13457,35 +13457,35 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceF_P) call RegPack(Buf, allocated(InData%IceD_P_2_SD_P)) if (allocated(InData%IceD_P_2_SD_P)) then - call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) - LB(1:1) = lbound(InData%IceD_P_2_SD_P) - UB(1:1) = ubound(InData%IceD_P_2_SD_P) + call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P, kind=B8Ki), ubound(InData%IceD_P_2_SD_P, kind=B8Ki)) + LB(1:1) = lbound(InData%IceD_P_2_SD_P, kind=B8Ki) + UB(1:1) = ubound(InData%IceD_P_2_SD_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%IceD_P_2_SD_P(i1)) end do end if call RegPack(Buf, allocated(InData%SDy3_P_2_IceD_P)) if (allocated(InData%SDy3_P_2_IceD_P)) then - call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) - LB(1:1) = lbound(InData%SDy3_P_2_IceD_P) - UB(1:1) = ubound(InData%SDy3_P_2_IceD_P) + call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki), ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki)) + LB(1:1) = lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki) + UB(1:1) = ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceD_P(i1)) end do end if call RegPack(Buf, allocated(InData%Jacobian_Opt1)) if (allocated(InData%Jacobian_Opt1)) then - call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1), ubound(InData%Jacobian_Opt1)) + call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1, kind=B8Ki), ubound(InData%Jacobian_Opt1, kind=B8Ki)) call RegPack(Buf, InData%Jacobian_Opt1) end if call RegPack(Buf, allocated(InData%Jacobian_pivot)) if (allocated(InData%Jacobian_pivot)) then - call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot), ubound(InData%Jacobian_pivot)) + call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot, kind=B8Ki), ubound(InData%Jacobian_pivot, kind=B8Ki)) call RegPack(Buf, InData%Jacobian_pivot) end if call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call MeshPack(Buf, InData%u_ED_NacelleLoads) @@ -13497,9 +13497,9 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%u_ED_TowerPtloads) call RegPack(Buf, allocated(InData%u_ED_BladePtLoads)) if (allocated(InData%u_ED_BladePtLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) - LB(1:1) = lbound(InData%u_ED_BladePtLoads) - UB(1:1) = ubound(InData%u_ED_BladePtLoads) + call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads, kind=B8Ki), ubound(InData%u_ED_BladePtLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%u_ED_BladePtLoads, kind=B8Ki) + UB(1:1) = ubound(InData%u_ED_BladePtLoads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%u_ED_BladePtLoads(i1)) end do @@ -13511,27 +13511,27 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%u_ED_HubPtLoad_2) call RegPack(Buf, allocated(InData%u_BD_RootMotion)) if (allocated(InData%u_BD_RootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) - LB(1:1) = lbound(InData%u_BD_RootMotion) - UB(1:1) = ubound(InData%u_BD_RootMotion) + call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion, kind=B8Ki), ubound(InData%u_BD_RootMotion, kind=B8Ki)) + LB(1:1) = lbound(InData%u_BD_RootMotion, kind=B8Ki) + UB(1:1) = ubound(InData%u_BD_RootMotion, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%u_BD_RootMotion(i1)) end do end if call RegPack(Buf, allocated(InData%y_BD_BldMotion_4Loads)) if (allocated(InData%y_BD_BldMotion_4Loads)) then - call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) - LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads) - UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads) + call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki), ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki)) + LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) + UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%y_BD_BldMotion_4Loads(i1)) end do end if call RegPack(Buf, allocated(InData%u_BD_Distrload)) if (allocated(InData%u_BD_Distrload)) then - call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) - LB(1:1) = lbound(InData%u_BD_Distrload) - UB(1:1) = ubound(InData%u_BD_Distrload) + call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload, kind=B8Ki), ubound(InData%u_BD_Distrload, kind=B8Ki)) + LB(1:1) = lbound(InData%u_BD_Distrload, kind=B8Ki) + UB(1:1) = ubound(InData%u_BD_Distrload, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%u_BD_Distrload(i1)) end do @@ -13540,7 +13540,7 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%u_ExtPtfm_PtfmMesh) call RegPack(Buf, allocated(InData%HubOrient)) if (allocated(InData%HubOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%HubOrient), ubound(InData%HubOrient)) + call RegPackBounds(Buf, 3, lbound(InData%HubOrient, kind=B8Ki), ubound(InData%HubOrient, kind=B8Ki)) call RegPack(Buf, InData%HubOrient) end if if (RegCheckErr(Buf, RoutineName)) return @@ -13550,8 +13550,8 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -14170,8 +14170,8 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyInitData' @@ -14187,8 +14187,8 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitDataData%OutData_BD)) then - LB(1:1) = lbound(SrcInitDataData%OutData_BD) - UB(1:1) = ubound(SrcInitDataData%OutData_BD) + LB(1:1) = lbound(SrcInitDataData%OutData_BD, kind=B8Ki) + UB(1:1) = ubound(SrcInitDataData%OutData_BD, kind=B8Ki) if (.not. allocated(DstInitDataData%OutData_BD)) then allocate(DstInitDataData%OutData_BD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -14298,8 +14298,8 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) type(FAST_InitData), intent(inout) :: InitDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyInitData' @@ -14312,8 +14312,8 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) call BD_DestroyInitInput(InitDataData%InData_BD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitDataData%OutData_BD)) then - LB(1:1) = lbound(InitDataData%OutData_BD) - UB(1:1) = ubound(InitDataData%OutData_BD) + LB(1:1) = lbound(InitDataData%OutData_BD, kind=B8Ki) + UB(1:1) = ubound(InitDataData%OutData_BD, kind=B8Ki) do i1 = LB(1), UB(1) call BD_DestroyInitOutput(InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -14386,17 +14386,17 @@ subroutine FAST_PackInitData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_InitData), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInitData' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call ED_PackInitInput(Buf, InData%InData_ED) call ED_PackInitOutput(Buf, InData%OutData_ED) call BD_PackInitInput(Buf, InData%InData_BD) call RegPack(Buf, allocated(InData%OutData_BD)) if (allocated(InData%OutData_BD)) then - call RegPackBounds(Buf, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) - LB(1:1) = lbound(InData%OutData_BD) - UB(1:1) = ubound(InData%OutData_BD) + call RegPackBounds(Buf, 1, lbound(InData%OutData_BD, kind=B8Ki), ubound(InData%OutData_BD, kind=B8Ki)) + LB(1:1) = lbound(InData%OutData_BD, kind=B8Ki) + UB(1:1) = ubound(InData%OutData_BD, kind=B8Ki) do i1 = LB(1), UB(1) call BD_PackInitOutput(Buf, InData%OutData_BD(i1)) end do @@ -14438,8 +14438,8 @@ subroutine FAST_UnPackInitData(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_InitData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInitData' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -14499,7 +14499,7 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyExternInitType' ErrStat = ErrID_None @@ -14514,8 +14514,8 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC if (allocated(SrcExternInitTypeData%fromSCGlob)) then - LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob) - UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob) + LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob, kind=B8Ki) + UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob, kind=B8Ki) if (.not. allocated(DstExternInitTypeData%fromSCGlob)) then allocate(DstExternInitTypeData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -14526,8 +14526,8 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob end if if (allocated(SrcExternInitTypeData%fromSC)) then - LB(1:1) = lbound(SrcExternInitTypeData%fromSC) - UB(1:1) = ubound(SrcExternInitTypeData%fromSC) + LB(1:1) = lbound(SrcExternInitTypeData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcExternInitTypeData%fromSC, kind=B8Ki) if (.not. allocated(DstExternInitTypeData%fromSC)) then allocate(DstExternInitTypeData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -14581,12 +14581,12 @@ subroutine FAST_PackExternInitType(Buf, Indata) call RegPack(Buf, InData%NumCtrl2SC) call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob, kind=B8Ki), ubound(InData%fromSCGlob, kind=B8Ki)) call RegPack(Buf, InData%fromSCGlob) end if call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPack(Buf, InData%fromSC) end if call RegPack(Buf, InData%FarmIntegration) @@ -14595,7 +14595,7 @@ subroutine FAST_PackExternInitType(Buf, Indata) call RegPack(Buf, InData%windGrid_pZero) call RegPack(Buf, associated(InData%windGrid_data)) if (associated(InData%windGrid_data)) then - call RegPackBounds(Buf, 5, lbound(InData%windGrid_data), ubound(InData%windGrid_data)) + call RegPackBounds(Buf, 5, lbound(InData%windGrid_data, kind=B8Ki), ubound(InData%windGrid_data, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%windGrid_data), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%windGrid_data) @@ -14612,10 +14612,10 @@ subroutine FAST_UnPackExternInitType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(FAST_ExternInitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%Tmax) diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 58fb7582f3..8444173d83 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -337,13 +337,13 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "character(*), intent( out) :: ErrMsg"; if (has_ddt_arr) { - w << indent << "integer(IntKi) :: "; + w << indent << "integer(B8Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } if (has_ddt_arr || has_alloc) - w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; if (has_ddt || has_alloc) w << indent << "integer(IntKi) :: ErrStat2"; if (has_ddt) @@ -378,8 +378,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, std::string dims(""); if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ", kind=B8Ki)"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ", kind=B8Ki)"; for (int d = 1; d <= field.rank; d++) dims += ",LB(" + std::to_string(d) + "):UB(" + std::to_string(d) + ")"; dims = "(" + dims.substr(1) + ")"; @@ -420,8 +420,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, // Get bounds for non-allocated field if (field.rank > 0 && !field.is_allocatable) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ", kind=B8Ki)"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ", kind=B8Ki)"; } for (int d = field.rank; d >= 1; d--) @@ -505,10 +505,10 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd w << indent << "character(*), intent( out) :: ErrMsg"; if (has_ddt_arr) { - w << indent << "integer(IntKi) :: "; + w << indent << "integer(B8Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ddt) { @@ -548,8 +548,8 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; } for (int d = field.rank; d >= 1; d--) { @@ -628,10 +628,10 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) { - w << indent << "integer(IntKi) :: "; + w << indent << "integer(B8Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ptr) { @@ -663,7 +663,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, indent += " "; if (field.rank > 0) { - w << indent << "call RegPackBounds(Buf, " << field.rank << ", lbound(" << var << "), ubound(" << var << "))"; + w << indent << "call RegPackBounds(Buf, " << field.rank << ", lbound(" << var << ", kind=B8Ki), ubound(" << var << ", kind=B8Ki))"; } } if (field.is_pointer) @@ -680,8 +680,8 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; } for (int d = field.rank; d >= 1; d--) @@ -756,14 +756,14 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) { - w << indent << "integer(IntKi) :: "; + w << indent << "integer(B8Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } if (has_ddt_arr || has_alloc) { - w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_alloc) { @@ -772,7 +772,7 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } if (has_ptr) { - w << indent << "integer(IntKi) :: PtrIdx"; + w << indent << "integer(B8Ki) :: PtrIdx"; w << indent << "type(c_ptr) :: Ptr"; } w << indent << "if (Buf%ErrStat /= ErrID_None) return"; @@ -862,8 +862,8 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt // Get bounds for non-allocated field if (field.rank > 0 && !field.is_allocatable) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; } for (int d = field.rank; d >= 1; d--) @@ -978,7 +978,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var << "," << j << "),UBOUND(" << uy << "_out" << field_var << "," << j << ")"; + w << indent << "DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var << "," << j << ", kind=B8Ki),UBOUND(" << uy << "_out" << field_var << "," << j << ", kind=B8Ki)"; indent += " "; } @@ -1007,7 +1007,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," << j << ")"; + w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << ", kind=B8Ki),UBOUND(" << vout << "," << j << ", kind=B8Ki)"; indent += " "; } @@ -1074,7 +1074,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," << j << ")"; + w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << ", kind=B8Ki),UBOUND(" << vout << "," << j << ", kind=B8Ki)"; indent += " "; } } @@ -1539,7 +1539,7 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d { std::string dims; for (int d = 1; d <= field.rank; d++) - dims += std::string(d > 1 ? "," : "") + "LBOUND(" + var_f + "," + std::to_string(d) + ")"; + dims += std::string(d > 1 ? "," : "") + "LBOUND(" + var_f + "," + std::to_string(d) + ", kind=B8Ki)"; w << indent; w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; w << indent << "IF (.NOT. SkipPointers_local ) THEN"; diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index f2c1cc1ea3..0252be5e3f 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -161,7 +161,7 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyInitOutput' @@ -171,8 +171,8 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -183,8 +183,8 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -223,12 +223,12 @@ subroutine Orca_PackInitOutput(Buf, Indata) call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -238,7 +238,7 @@ subroutine Orca_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Orca_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -373,7 +373,7 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Orca_CopyMisc' ErrStat = ErrID_None @@ -382,8 +382,8 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PtfmFt = SrcMiscData%PtfmFt DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -418,7 +418,7 @@ subroutine Orca_PackMisc(Buf, Indata) call RegPack(Buf, InData%F_PtfmAM) call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, InData%LastTimeStep) @@ -429,7 +429,7 @@ subroutine Orca_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Orca_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackMisc' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -463,8 +463,8 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyParam' @@ -476,8 +476,8 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -497,8 +497,8 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) type(Orca_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_DestroyParam' @@ -507,8 +507,8 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -521,8 +521,8 @@ subroutine Orca_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call DLLTypePack(Buf, InData%DLL_Orca) @@ -531,9 +531,9 @@ subroutine Orca_PackParam(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -545,8 +545,8 @@ subroutine Orca_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Orca_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -628,7 +628,7 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyOutput' @@ -638,8 +638,8 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -675,7 +675,7 @@ subroutine Orca_PackOutput(Buf, Indata) call MeshPack(Buf, InData%PtfmMesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -685,7 +685,7 @@ subroutine Orca_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Orca_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index e0893fc9ac..02e3286938 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -66,7 +66,7 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Current_CopyInitInput' ErrStat = ErrID_None @@ -82,8 +82,8 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%CurrMod = SrcInitInputData%CurrMod DstInitInputData%EffWtrDpth = SrcInitInputData%EffWtrDpth if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -126,7 +126,7 @@ subroutine Current_PackInitInput(Buf, Indata) call RegPack(Buf, InData%EffWtrDpth) call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi, kind=B8Ki), ubound(InData%WaveKinGridzi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridzi) end if call RegPack(Buf, InData%NGridPts) @@ -138,7 +138,7 @@ subroutine Current_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Current_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -188,14 +188,14 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Current_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%CurrVxi)) then - LB(1:1) = lbound(SrcInitOutputData%CurrVxi) - UB(1:1) = ubound(SrcInitOutputData%CurrVxi) + LB(1:1) = lbound(SrcInitOutputData%CurrVxi, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%CurrVxi, kind=B8Ki) if (.not. allocated(DstInitOutputData%CurrVxi)) then allocate(DstInitOutputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -206,8 +206,8 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi end if if (allocated(SrcInitOutputData%CurrVyi)) then - LB(1:1) = lbound(SrcInitOutputData%CurrVyi) - UB(1:1) = ubound(SrcInitOutputData%CurrVyi) + LB(1:1) = lbound(SrcInitOutputData%CurrVyi, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%CurrVyi, kind=B8Ki) if (.not. allocated(DstInitOutputData%CurrVyi)) then allocate(DstInitOutputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -243,12 +243,12 @@ subroutine Current_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%CurrVxi)) if (allocated(InData%CurrVxi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) + call RegPackBounds(Buf, 1, lbound(InData%CurrVxi, kind=B8Ki), ubound(InData%CurrVxi, kind=B8Ki)) call RegPack(Buf, InData%CurrVxi) end if call RegPack(Buf, allocated(InData%CurrVyi)) if (allocated(InData%CurrVyi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) + call RegPackBounds(Buf, 1, lbound(InData%CurrVyi, kind=B8Ki), ubound(InData%CurrVyi, kind=B8Ki)) call RegPack(Buf, InData%CurrVyi) end if call RegPack(Buf, InData%PCurrVxiPz0) @@ -260,7 +260,7 @@ subroutine Current_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Current_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index a6d6262c06..10331b864d 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -94,15 +94,15 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcSeaSt_WaveFieldTypeData%WaveTime)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime, kind=B8Ki) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then allocate(DstSeaSt_WaveFieldTypeData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -113,8 +113,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP, kind=B8Ki) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then allocate(DstSeaSt_WaveFieldTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -125,8 +125,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc, kind=B8Ki) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then allocate(DstSeaSt_WaveFieldTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -137,8 +137,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF, kind=B8Ki) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then allocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -149,8 +149,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel, kind=B8Ki) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then allocate(DstSeaSt_WaveFieldTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -161,8 +161,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0, kind=B8Ki) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -173,8 +173,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0, kind=B8Ki) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -185,8 +185,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0, kind=B8Ki) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -197,8 +197,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0, kind=B8Ki) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -209,8 +209,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0, kind=B8Ki) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -221,8 +221,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1, kind=B8Ki) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -233,8 +233,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2, kind=B8Ki) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -251,8 +251,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC, kind=B8Ki) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -263,8 +263,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then - LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) - UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0, kind=B8Ki) + UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -275,8 +275,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr, kind=B8Ki) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr, kind=B8Ki) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then allocate(DstSeaSt_WaveFieldTypeData%WaveDirArr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -371,62 +371,62 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackBounds(Buf, 1, lbound(InData%WaveTime, kind=B8Ki), ubound(InData%WaveTime, kind=B8Ki)) call RegPack(Buf, InData%WaveTime) end if call RegPack(Buf, allocated(InData%WaveDynP)) if (allocated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP, kind=B8Ki), ubound(InData%WaveDynP, kind=B8Ki)) call RegPack(Buf, InData%WaveDynP) end if call RegPack(Buf, allocated(InData%WaveAcc)) if (allocated(InData%WaveAcc)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc, kind=B8Ki), ubound(InData%WaveAcc, kind=B8Ki)) call RegPack(Buf, InData%WaveAcc) end if call RegPack(Buf, allocated(InData%WaveAccMCF)) if (allocated(InData%WaveAccMCF)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF, kind=B8Ki), ubound(InData%WaveAccMCF, kind=B8Ki)) call RegPack(Buf, InData%WaveAccMCF) end if call RegPack(Buf, allocated(InData%WaveVel)) if (allocated(InData%WaveVel)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackBounds(Buf, 5, lbound(InData%WaveVel, kind=B8Ki), ubound(InData%WaveVel, kind=B8Ki)) call RegPack(Buf, InData%WaveVel) end if call RegPack(Buf, allocated(InData%PWaveDynP0)) if (allocated(InData%PWaveDynP0)) then - call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0, kind=B8Ki), ubound(InData%PWaveDynP0, kind=B8Ki)) call RegPack(Buf, InData%PWaveDynP0) end if call RegPack(Buf, allocated(InData%PWaveAcc0)) if (allocated(InData%PWaveAcc0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0, kind=B8Ki), ubound(InData%PWaveAcc0, kind=B8Ki)) call RegPack(Buf, InData%PWaveAcc0) end if call RegPack(Buf, allocated(InData%PWaveAccMCF0)) if (allocated(InData%PWaveAccMCF0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0, kind=B8Ki), ubound(InData%PWaveAccMCF0, kind=B8Ki)) call RegPack(Buf, InData%PWaveAccMCF0) end if call RegPack(Buf, allocated(InData%PWaveVel0)) if (allocated(InData%PWaveVel0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0, kind=B8Ki), ubound(InData%PWaveVel0, kind=B8Ki)) call RegPack(Buf, InData%PWaveVel0) end if call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0, kind=B8Ki), ubound(InData%WaveElev0, kind=B8Ki)) call RegPack(Buf, InData%WaveElev0) end if call RegPack(Buf, allocated(InData%WaveElev1)) if (allocated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1, kind=B8Ki), ubound(InData%WaveElev1, kind=B8Ki)) call RegPack(Buf, InData%WaveElev1) end if call RegPack(Buf, allocated(InData%WaveElev2)) if (allocated(InData%WaveElev2)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2, kind=B8Ki), ubound(InData%WaveElev2, kind=B8Ki)) call RegPack(Buf, InData%WaveElev2) end if call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) @@ -435,17 +435,17 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPack(Buf, InData%MSL2SWL) call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC, kind=B8Ki), ubound(InData%WaveElevC, kind=B8Ki)) call RegPack(Buf, InData%WaveElevC) end if call RegPack(Buf, allocated(InData%WaveElevC0)) if (allocated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0, kind=B8Ki), ubound(InData%WaveElevC0, kind=B8Ki)) call RegPack(Buf, InData%WaveElevC0) end if call RegPack(Buf, allocated(InData%WaveDirArr)) if (allocated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr, kind=B8Ki), ubound(InData%WaveDirArr, kind=B8Ki)) call RegPack(Buf, InData%WaveDirArr) end if call RegPack(Buf, InData%WtrDpth) @@ -473,7 +473,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_WaveFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f0a1d2bf70..78b2a16e84 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -183,7 +183,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInputFile' @@ -209,8 +209,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%Echo = SrcInputFileData%Echo DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev if (allocated(SrcInputFileData%WaveElevxi)) then - LB(1:1) = lbound(SrcInputFileData%WaveElevxi) - UB(1:1) = ubound(SrcInputFileData%WaveElevxi) + LB(1:1) = lbound(SrcInputFileData%WaveElevxi, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WaveElevxi, kind=B8Ki) if (.not. allocated(DstInputFileData%WaveElevxi)) then allocate(DstInputFileData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -221,8 +221,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi end if if (allocated(SrcInputFileData%WaveElevyi)) then - LB(1:1) = lbound(SrcInputFileData%WaveElevyi) - UB(1:1) = ubound(SrcInputFileData%WaveElevyi) + LB(1:1) = lbound(SrcInputFileData%WaveElevyi, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WaveElevyi, kind=B8Ki) if (.not. allocated(DstInputFileData%WaveElevyi)) then allocate(DstInputFileData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -234,8 +234,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin if (allocated(SrcInputFileData%WaveKinxi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinxi) - UB(1:1) = ubound(SrcInputFileData%WaveKinxi) + LB(1:1) = lbound(SrcInputFileData%WaveKinxi, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WaveKinxi, kind=B8Ki) if (.not. allocated(DstInputFileData%WaveKinxi)) then allocate(DstInputFileData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -246,8 +246,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi end if if (allocated(SrcInputFileData%WaveKinyi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinyi) - UB(1:1) = ubound(SrcInputFileData%WaveKinyi) + LB(1:1) = lbound(SrcInputFileData%WaveKinyi, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WaveKinyi, kind=B8Ki) if (.not. allocated(DstInputFileData%WaveKinyi)) then allocate(DstInputFileData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -258,8 +258,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi end if if (allocated(SrcInputFileData%WaveKinzi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinzi) - UB(1:1) = ubound(SrcInputFileData%WaveKinzi) + LB(1:1) = lbound(SrcInputFileData%WaveKinzi, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%WaveKinzi, kind=B8Ki) if (.not. allocated(DstInputFileData%WaveKinzi)) then allocate(DstInputFileData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -273,8 +273,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutAll = SrcInputFileData%OutAll DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -359,28 +359,28 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NWaveElev) call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi, kind=B8Ki), ubound(InData%WaveElevxi, kind=B8Ki)) call RegPack(Buf, InData%WaveElevxi) end if call RegPack(Buf, allocated(InData%WaveElevyi)) if (allocated(InData%WaveElevyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi, kind=B8Ki), ubound(InData%WaveElevyi, kind=B8Ki)) call RegPack(Buf, InData%WaveElevyi) end if call RegPack(Buf, InData%NWaveKin) call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi, kind=B8Ki), ubound(InData%WaveKinxi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinxi) end if call RegPack(Buf, allocated(InData%WaveKinyi)) if (allocated(InData%WaveKinyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi, kind=B8Ki), ubound(InData%WaveKinyi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinyi) end if call RegPack(Buf, allocated(InData%WaveKinzi)) if (allocated(InData%WaveKinzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi, kind=B8Ki), ubound(InData%WaveKinzi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinzi) end if call RegPack(Buf, InData%OutSwtch) @@ -388,7 +388,7 @@ subroutine SeaSt_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%SeaStSum) @@ -416,7 +416,7 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -579,7 +579,7 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitInput' @@ -597,8 +597,8 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL DstInitInputData%TMax = SrcInitInputData%TMax if (allocated(SrcInitInputData%WaveElevXY)) then - LB(1:2) = lbound(SrcInitInputData%WaveElevXY) - UB(1:2) = ubound(SrcInitInputData%WaveElevXY) + LB(1:2) = lbound(SrcInitInputData%WaveElevXY, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%WaveElevXY, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveElevXY)) then allocate(DstInitInputData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -648,7 +648,7 @@ subroutine SeaSt_PackInitInput(Buf, Indata) call RegPack(Buf, InData%TMax) call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) + call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY, kind=B8Ki), ubound(InData%WaveElevXY, kind=B8Ki)) call RegPack(Buf, InData%WaveElevXY) end if call RegPack(Buf, InData%WaveFieldMod) @@ -664,7 +664,7 @@ subroutine SeaSt_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -719,15 +719,15 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -738,8 +738,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -754,8 +754,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn if (allocated(SrcInitOutputData%WaveElevSeries)) then - LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) - UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries) + LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries, kind=B8Ki) + UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveElevSeries)) then allocate(DstInitOutputData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -799,19 +799,19 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, InData%InvalidWithSSExctn) call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) + call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries, kind=B8Ki), ubound(InData%WaveElevSeries, kind=B8Ki)) call RegPack(Buf, InData%WaveElevSeries) end if call RegPack(Buf, associated(InData%WaveField)) @@ -828,10 +828,10 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) @@ -1121,8 +1121,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyParam' @@ -1134,8 +1134,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%deltaGrid = SrcParamData%deltaGrid DstParamData%NWaveElev = SrcParamData%NWaveElev if (allocated(SrcParamData%WaveElevxi)) then - LB(1:1) = lbound(SrcParamData%WaveElevxi) - UB(1:1) = ubound(SrcParamData%WaveElevxi) + LB(1:1) = lbound(SrcParamData%WaveElevxi, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WaveElevxi, kind=B8Ki) if (.not. allocated(DstParamData%WaveElevxi)) then allocate(DstParamData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1146,8 +1146,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveElevxi = SrcParamData%WaveElevxi end if if (allocated(SrcParamData%WaveElevyi)) then - LB(1:1) = lbound(SrcParamData%WaveElevyi) - UB(1:1) = ubound(SrcParamData%WaveElevyi) + LB(1:1) = lbound(SrcParamData%WaveElevyi, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WaveElevyi, kind=B8Ki) if (.not. allocated(DstParamData%WaveElevyi)) then allocate(DstParamData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1159,8 +1159,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then - LB(1:1) = lbound(SrcParamData%WaveKinxi) - UB(1:1) = ubound(SrcParamData%WaveKinxi) + LB(1:1) = lbound(SrcParamData%WaveKinxi, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WaveKinxi, kind=B8Ki) if (.not. allocated(DstParamData%WaveKinxi)) then allocate(DstParamData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1171,8 +1171,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinxi = SrcParamData%WaveKinxi end if if (allocated(SrcParamData%WaveKinyi)) then - LB(1:1) = lbound(SrcParamData%WaveKinyi) - UB(1:1) = ubound(SrcParamData%WaveKinyi) + LB(1:1) = lbound(SrcParamData%WaveKinyi, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WaveKinyi, kind=B8Ki) if (.not. allocated(DstParamData%WaveKinyi)) then allocate(DstParamData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1183,8 +1183,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinyi = SrcParamData%WaveKinyi end if if (allocated(SrcParamData%WaveKinzi)) then - LB(1:1) = lbound(SrcParamData%WaveKinzi) - UB(1:1) = ubound(SrcParamData%WaveKinzi) + LB(1:1) = lbound(SrcParamData%WaveKinzi, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%WaveKinzi, kind=B8Ki) if (.not. allocated(DstParamData%WaveKinzi)) then allocate(DstParamData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1195,8 +1195,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinzi = SrcParamData%WaveKinzi end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1235,8 +1235,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) type(SeaSt_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' @@ -1258,8 +1258,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveKinzi) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1278,8 +1278,8 @@ subroutine SeaSt_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WaveDT) @@ -1289,35 +1289,35 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%NWaveElev) call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi, kind=B8Ki), ubound(InData%WaveElevxi, kind=B8Ki)) call RegPack(Buf, InData%WaveElevxi) end if call RegPack(Buf, allocated(InData%WaveElevyi)) if (allocated(InData%WaveElevyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi, kind=B8Ki), ubound(InData%WaveElevyi, kind=B8Ki)) call RegPack(Buf, InData%WaveElevyi) end if call RegPack(Buf, InData%NWaveKin) call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi, kind=B8Ki), ubound(InData%WaveKinxi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinxi) end if call RegPack(Buf, allocated(InData%WaveKinyi)) if (allocated(InData%WaveKinyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi, kind=B8Ki), ubound(InData%WaveKinyi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinyi) end if call RegPack(Buf, allocated(InData%WaveKinzi)) if (allocated(InData%WaveKinzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi, kind=B8Ki), ubound(InData%WaveKinzi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinzi) end if call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -1343,11 +1343,11 @@ subroutine SeaSt_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%WaveDT) @@ -1528,14 +1528,14 @@ subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SeaSt_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1566,7 +1566,7 @@ subroutine SeaSt_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1576,7 +1576,7 @@ subroutine SeaSt_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SeaSt_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index ee5d2ba6c1..0fdde7f505 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -64,7 +64,7 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' ErrStat = ErrID_None @@ -74,8 +74,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridxi)) then allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -86,8 +86,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi end if if (allocated(SrcInitInputData%WaveKinGridyi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridyi)) then allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -98,8 +98,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi end if if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -142,17 +142,17 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NWaveKinGrid) call RegPack(Buf, allocated(InData%WaveKinGridxi)) if (allocated(InData%WaveKinGridxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi, kind=B8Ki), ubound(InData%WaveKinGridxi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridxi) end if call RegPack(Buf, allocated(InData%WaveKinGridyi)) if (allocated(InData%WaveKinGridyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi, kind=B8Ki), ubound(InData%WaveKinGridyi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridyi) end if call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi, kind=B8Ki), ubound(InData%WaveKinGridzi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridzi) end if call RegPack(Buf, InData%WvDiffQTFF) @@ -164,7 +164,7 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Waves2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -230,14 +230,14 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WaveAcc2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D, kind=B8Ki) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveAcc2D)) then allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -248,8 +248,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D end if if (allocated(SrcInitOutputData%WaveDynP2D)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D, kind=B8Ki) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveDynP2D)) then allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -260,8 +260,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D end if if (allocated(SrcInitOutputData%WaveAcc2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S, kind=B8Ki) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveAcc2S)) then allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -272,8 +272,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S end if if (allocated(SrcInitOutputData%WaveDynP2S)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S, kind=B8Ki) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveDynP2S)) then allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -284,8 +284,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S end if if (allocated(SrcInitOutputData%WaveVel2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) + LB(1:5) = lbound(SrcInitOutputData%WaveVel2D, kind=B8Ki) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2D, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveVel2D)) then allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -296,8 +296,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D end if if (allocated(SrcInitOutputData%WaveVel2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) + LB(1:5) = lbound(SrcInitOutputData%WaveVel2S, kind=B8Ki) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2S, kind=B8Ki) if (.not. allocated(DstInitOutputData%WaveVel2S)) then allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -343,32 +343,32 @@ subroutine Waves2_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WaveAcc2D)) if (allocated(InData%WaveAcc2D)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D), ubound(InData%WaveAcc2D)) + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D, kind=B8Ki), ubound(InData%WaveAcc2D, kind=B8Ki)) call RegPack(Buf, InData%WaveAcc2D) end if call RegPack(Buf, allocated(InData%WaveDynP2D)) if (allocated(InData%WaveDynP2D)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D), ubound(InData%WaveDynP2D)) + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D, kind=B8Ki), ubound(InData%WaveDynP2D, kind=B8Ki)) call RegPack(Buf, InData%WaveDynP2D) end if call RegPack(Buf, allocated(InData%WaveAcc2S)) if (allocated(InData%WaveAcc2S)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S), ubound(InData%WaveAcc2S)) + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S, kind=B8Ki), ubound(InData%WaveAcc2S, kind=B8Ki)) call RegPack(Buf, InData%WaveAcc2S) end if call RegPack(Buf, allocated(InData%WaveDynP2S)) if (allocated(InData%WaveDynP2S)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S), ubound(InData%WaveDynP2S)) + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S, kind=B8Ki), ubound(InData%WaveDynP2S, kind=B8Ki)) call RegPack(Buf, InData%WaveDynP2S) end if call RegPack(Buf, allocated(InData%WaveVel2D)) if (allocated(InData%WaveVel2D)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D), ubound(InData%WaveVel2D)) + call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D, kind=B8Ki), ubound(InData%WaveVel2D, kind=B8Ki)) call RegPack(Buf, InData%WaveVel2D) end if call RegPack(Buf, allocated(InData%WaveVel2S)) if (allocated(InData%WaveVel2S)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S), ubound(InData%WaveVel2S)) + call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S, kind=B8Ki), ubound(InData%WaveVel2S, kind=B8Ki)) call RegPack(Buf, InData%WaveVel2S) end if if (RegCheckErr(Buf, RoutineName)) return @@ -378,7 +378,7 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Waves2_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' - integer(IntKi) :: LB(5), UB(5) + integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 00cfd710db..4b465fc3a9 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -84,7 +84,7 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Waves_CopyInitInput' @@ -108,8 +108,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridxi)) then allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -120,8 +120,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi end if if (allocated(SrcInitInputData%WaveKinGridyi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridyi)) then allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -132,8 +132,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi end if if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -144,8 +144,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi end if if (allocated(SrcInitInputData%CurrVxi)) then - LB(1:1) = lbound(SrcInitInputData%CurrVxi) - UB(1:1) = ubound(SrcInitInputData%CurrVxi) + LB(1:1) = lbound(SrcInitInputData%CurrVxi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%CurrVxi, kind=B8Ki) if (.not. allocated(DstInitInputData%CurrVxi)) then allocate(DstInitInputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -156,8 +156,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi end if if (allocated(SrcInitInputData%CurrVyi)) then - LB(1:1) = lbound(SrcInitInputData%CurrVyi) - UB(1:1) = ubound(SrcInitInputData%CurrVyi) + LB(1:1) = lbound(SrcInitInputData%CurrVyi, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%CurrVyi, kind=B8Ki) if (.not. allocated(DstInitInputData%CurrVyi)) then allocate(DstInitInputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -234,27 +234,27 @@ subroutine Waves_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NWaveKinGrid) call RegPack(Buf, allocated(InData%WaveKinGridxi)) if (allocated(InData%WaveKinGridxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi, kind=B8Ki), ubound(InData%WaveKinGridxi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridxi) end if call RegPack(Buf, allocated(InData%WaveKinGridyi)) if (allocated(InData%WaveKinGridyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi, kind=B8Ki), ubound(InData%WaveKinGridyi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridyi) end if call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi, kind=B8Ki), ubound(InData%WaveKinGridzi, kind=B8Ki)) call RegPack(Buf, InData%WaveKinGridzi) end if call RegPack(Buf, allocated(InData%CurrVxi)) if (allocated(InData%CurrVxi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) + call RegPackBounds(Buf, 1, lbound(InData%CurrVxi, kind=B8Ki), ubound(InData%CurrVxi, kind=B8Ki)) call RegPack(Buf, InData%CurrVxi) end if call RegPack(Buf, allocated(InData%CurrVyi)) if (allocated(InData%CurrVyi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) + call RegPackBounds(Buf, 1, lbound(InData%CurrVyi, kind=B8Ki), ubound(InData%CurrVyi, kind=B8Ki)) call RegPack(Buf, InData%CurrVyi) end if call RegPack(Buf, InData%PCurrVxiPz0) @@ -275,7 +275,7 @@ subroutine Waves_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(Waves_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 59e61da949..cc7445e5d0 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -584,7 +584,7 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInitInput' @@ -595,8 +595,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%NumBl = SrcInitInputData%NumBl DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%BlPitchInit)) then - LB(1:1) = lbound(SrcInitInputData%BlPitchInit) - UB(1:1) = ubound(SrcInitInputData%BlPitchInit) + LB(1:1) = lbound(SrcInitInputData%BlPitchInit, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%BlPitchInit, kind=B8Ki) if (.not. allocated(DstInitInputData%BlPitchInit)) then allocate(DstInitInputData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -629,8 +629,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%TrimGain = SrcInitInputData%TrimGain DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef if (allocated(SrcInitInputData%BladeRootRefPos)) then - LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos) - UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos) + LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos, kind=B8Ki) if (.not. allocated(DstInitInputData%BladeRootRefPos)) then allocate(DstInitInputData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -641,8 +641,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos end if if (allocated(SrcInitInputData%BladeRootTransDisp)) then - LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) - UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp) + LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp, kind=B8Ki) if (.not. allocated(DstInitInputData%BladeRootTransDisp)) then allocate(DstInitInputData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -653,8 +653,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp end if if (allocated(SrcInitInputData%BladeRootOrient)) then - LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) - UB(1:3) = ubound(SrcInitInputData%BladeRootOrient) + LB(1:3) = lbound(SrcInitInputData%BladeRootOrient, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%BladeRootOrient, kind=B8Ki) if (.not. allocated(DstInitInputData%BladeRootOrient)) then allocate(DstInitInputData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -665,8 +665,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient end if if (allocated(SrcInitInputData%BladeRootRefOrient)) then - LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) - UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient) + LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient, kind=B8Ki) if (.not. allocated(DstInitInputData%BladeRootRefOrient)) then allocate(DstInitInputData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -682,8 +682,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS if (ErrStat >= AbortErrLev) return DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl if (allocated(SrcInitInputData%CableControlRequestor)) then - LB(1:1) = lbound(SrcInitInputData%CableControlRequestor) - UB(1:1) = ubound(SrcInitInputData%CableControlRequestor) + LB(1:1) = lbound(SrcInitInputData%CableControlRequestor, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%CableControlRequestor, kind=B8Ki) if (.not. allocated(DstInitInputData%CableControlRequestor)) then allocate(DstInitInputData%CableControlRequestor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -695,8 +695,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder if (allocated(SrcInitInputData%fromSCGlob)) then - LB(1:1) = lbound(SrcInitInputData%fromSCGlob) - UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + LB(1:1) = lbound(SrcInitInputData%fromSCGlob, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob, kind=B8Ki) if (.not. allocated(DstInitInputData%fromSCGlob)) then allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -707,8 +707,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob end if if (allocated(SrcInitInputData%fromSC)) then - LB(1:1) = lbound(SrcInitInputData%fromSC) - UB(1:1) = ubound(SrcInitInputData%fromSC) + LB(1:1) = lbound(SrcInitInputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%fromSC, kind=B8Ki) if (.not. allocated(DstInitInputData%fromSC)) then allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -719,8 +719,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%fromSC = SrcInitInputData%fromSC end if if (allocated(SrcInitInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInitInputData%LidSpeed) - UB(1:1) = ubound(SrcInitInputData%LidSpeed) + LB(1:1) = lbound(SrcInitInputData%LidSpeed, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%LidSpeed, kind=B8Ki) if (.not. allocated(DstInitInputData%LidSpeed)) then allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -731,8 +731,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed end if if (allocated(SrcInitInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsX) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsX, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsX, kind=B8Ki) if (.not. allocated(DstInitInputData%MsrPositionsX)) then allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -743,8 +743,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX end if if (allocated(SrcInitInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsY) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsY, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsY, kind=B8Ki) if (.not. allocated(DstInitInputData%MsrPositionsY)) then allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -755,8 +755,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY end if if (allocated(SrcInitInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) if (.not. allocated(DstInitInputData%MsrPositionsZ)) then allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -833,7 +833,7 @@ subroutine SrvD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%BlPitchInit)) if (allocated(InData%BlPitchInit)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit, kind=B8Ki), ubound(InData%BlPitchInit, kind=B8Ki)) call RegPack(Buf, InData%BlPitchInit) end if call RegPack(Buf, InData%Gravity) @@ -860,22 +860,22 @@ subroutine SrvD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%RotSpeedRef) call RegPack(Buf, allocated(InData%BladeRootRefPos)) if (allocated(InData%BladeRootRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos), ubound(InData%BladeRootRefPos)) + call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos, kind=B8Ki), ubound(InData%BladeRootRefPos, kind=B8Ki)) call RegPack(Buf, InData%BladeRootRefPos) end if call RegPack(Buf, allocated(InData%BladeRootTransDisp)) if (allocated(InData%BladeRootTransDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp), ubound(InData%BladeRootTransDisp)) + call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp, kind=B8Ki), ubound(InData%BladeRootTransDisp, kind=B8Ki)) call RegPack(Buf, InData%BladeRootTransDisp) end if call RegPack(Buf, allocated(InData%BladeRootOrient)) if (allocated(InData%BladeRootOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient), ubound(InData%BladeRootOrient)) + call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient, kind=B8Ki), ubound(InData%BladeRootOrient, kind=B8Ki)) call RegPack(Buf, InData%BladeRootOrient) end if call RegPack(Buf, allocated(InData%BladeRootRefOrient)) if (allocated(InData%BladeRootRefOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient), ubound(InData%BladeRootRefOrient)) + call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient, kind=B8Ki), ubound(InData%BladeRootRefOrient, kind=B8Ki)) call RegPack(Buf, InData%BladeRootRefOrient) end if call RegPack(Buf, InData%UseInputFile) @@ -883,38 +883,38 @@ subroutine SrvD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NumCableControl) call RegPack(Buf, allocated(InData%CableControlRequestor)) if (allocated(InData%CableControlRequestor)) then - call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor), ubound(InData%CableControlRequestor)) + call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor, kind=B8Ki), ubound(InData%CableControlRequestor, kind=B8Ki)) call RegPack(Buf, InData%CableControlRequestor) end if call RegPack(Buf, InData%InterpOrder) call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob, kind=B8Ki), ubound(InData%fromSCGlob, kind=B8Ki)) call RegPack(Buf, InData%fromSCGlob) end if call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPack(Buf, InData%fromSC) end if call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) call RegPack(Buf, InData%LidSpeed) end if call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsX) end if call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsY) end if call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsZ) end if call RegPack(Buf, InData%SensorType) @@ -929,7 +929,7 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1178,15 +1178,15 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1197,8 +1197,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1214,8 +1214,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1226,8 +1226,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1238,8 +1238,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1250,8 +1250,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1262,8 +1262,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1274,8 +1274,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1286,8 +1286,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1298,8 +1298,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1361,12 +1361,12 @@ subroutine SrvD_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) @@ -1374,42 +1374,42 @@ subroutine SrvD_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%UseHSSBrake) call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1419,7 +1419,7 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1576,7 +1576,7 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SrvD_CopyInputFile' ErrStat = ErrID_None @@ -1631,8 +1631,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList) - UB(1:1) = ubound(SrcInputFileData%OutList) + LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1663,8 +1663,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq if (allocated(SrcInputFileData%GenSpd_TLU)) then - LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU) - UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU) + LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU, kind=B8Ki) if (.not. allocated(DstInputFileData%GenSpd_TLU)) then allocate(DstInputFileData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1675,8 +1675,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU end if if (allocated(SrcInputFileData%GenTrq_TLU)) then - LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) - UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU) + LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU, kind=B8Ki) if (.not. allocated(DstInputFileData%GenTrq_TLU)) then allocate(DstInputFileData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1689,8 +1689,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%NumBStC = SrcInputFileData%NumBStC if (allocated(SrcInputFileData%BStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%BStCfiles) - UB(1:1) = ubound(SrcInputFileData%BStCfiles) + LB(1:1) = lbound(SrcInputFileData%BStCfiles, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%BStCfiles, kind=B8Ki) if (.not. allocated(DstInputFileData%BStCfiles)) then allocate(DstInputFileData%BStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1702,8 +1702,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumNStC = SrcInputFileData%NumNStC if (allocated(SrcInputFileData%NStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%NStCfiles) - UB(1:1) = ubound(SrcInputFileData%NStCfiles) + LB(1:1) = lbound(SrcInputFileData%NStCfiles, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%NStCfiles, kind=B8Ki) if (.not. allocated(DstInputFileData%NStCfiles)) then allocate(DstInputFileData%NStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1715,8 +1715,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumTStC = SrcInputFileData%NumTStC if (allocated(SrcInputFileData%TStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%TStCfiles) - UB(1:1) = ubound(SrcInputFileData%TStCfiles) + LB(1:1) = lbound(SrcInputFileData%TStCfiles, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%TStCfiles, kind=B8Ki) if (.not. allocated(DstInputFileData%TStCfiles)) then allocate(DstInputFileData%TStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1728,8 +1728,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumSStC = SrcInputFileData%NumSStC if (allocated(SrcInputFileData%SStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%SStCfiles) - UB(1:1) = ubound(SrcInputFileData%SStCfiles) + LB(1:1) = lbound(SrcInputFileData%SStCfiles, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%SStCfiles, kind=B8Ki) if (.not. allocated(DstInputFileData%SStCfiles)) then allocate(DstInputFileData%SStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1833,7 +1833,7 @@ subroutine SrvD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%NumOuts) call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) call RegPack(Buf, InData%OutList) end if call RegPack(Buf, InData%DLL_FileName) @@ -1858,37 +1858,37 @@ subroutine SrvD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%DLL_NumTrq) call RegPack(Buf, allocated(InData%GenSpd_TLU)) if (allocated(InData%GenSpd_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) + call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU, kind=B8Ki), ubound(InData%GenSpd_TLU, kind=B8Ki)) call RegPack(Buf, InData%GenSpd_TLU) end if call RegPack(Buf, allocated(InData%GenTrq_TLU)) if (allocated(InData%GenTrq_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) + call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU, kind=B8Ki), ubound(InData%GenTrq_TLU, kind=B8Ki)) call RegPack(Buf, InData%GenTrq_TLU) end if call RegPack(Buf, InData%UseLegacyInterface) call RegPack(Buf, InData%NumBStC) call RegPack(Buf, allocated(InData%BStCfiles)) if (allocated(InData%BStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%BStCfiles), ubound(InData%BStCfiles)) + call RegPackBounds(Buf, 1, lbound(InData%BStCfiles, kind=B8Ki), ubound(InData%BStCfiles, kind=B8Ki)) call RegPack(Buf, InData%BStCfiles) end if call RegPack(Buf, InData%NumNStC) call RegPack(Buf, allocated(InData%NStCfiles)) if (allocated(InData%NStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%NStCfiles), ubound(InData%NStCfiles)) + call RegPackBounds(Buf, 1, lbound(InData%NStCfiles, kind=B8Ki), ubound(InData%NStCfiles, kind=B8Ki)) call RegPack(Buf, InData%NStCfiles) end if call RegPack(Buf, InData%NumTStC) call RegPack(Buf, allocated(InData%TStCfiles)) if (allocated(InData%TStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%TStCfiles), ubound(InData%TStCfiles)) + call RegPackBounds(Buf, 1, lbound(InData%TStCfiles, kind=B8Ki), ubound(InData%TStCfiles, kind=B8Ki)) call RegPack(Buf, InData%TStCfiles) end if call RegPack(Buf, InData%NumSStC) call RegPack(Buf, allocated(InData%SStCfiles)) if (allocated(InData%SStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%SStCfiles), ubound(InData%SStCfiles)) + call RegPackBounds(Buf, 1, lbound(InData%SStCfiles, kind=B8Ki), ubound(InData%SStCfiles, kind=B8Ki)) call RegPack(Buf, InData%SStCfiles) end if call RegPack(Buf, InData%AfCmode) @@ -1904,7 +1904,7 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2174,16 +2174,16 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyBladedDLLType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladedDLLTypeData%avrSWAP)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP) - UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP) + LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%avrSWAP)) then allocate(DstBladedDLLTypeData%avrSWAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2204,8 +2204,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev if (allocated(SrcBladedDLLTypeData%toSC)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%toSC) - UB(1:1) = ubound(SrcBladedDLLTypeData%toSC) + LB(1:1) = lbound(SrcBladedDLLTypeData%toSC, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%toSC, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%toSC)) then allocate(DstBladedDLLTypeData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2218,8 +2218,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels if (allocated(SrcBladedDLLTypeData%LogChannels_OutParam)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam) - UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam) + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then allocate(DstBladedDLLTypeData%LogChannels_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2234,8 +2234,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end do end if if (allocated(SrcBladedDLLTypeData%LogChannels)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) - UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels) + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%LogChannels)) then allocate(DstBladedDLLTypeData%LogChannels(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2256,8 +2256,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand if (allocated(SrcBladedDLLTypeData%BlPitchInput)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput) - UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput) + LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%BlPitchInput)) then allocate(DstBladedDLLTypeData%BlPitchInput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2294,8 +2294,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs if (allocated(SrcBladedDLLTypeData%LidSpeed)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed) - UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed) + LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%LidSpeed)) then allocate(DstBladedDLLTypeData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2306,8 +2306,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed end if if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsX)) then allocate(DstBladedDLLTypeData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2318,8 +2318,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX end if if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsY)) then allocate(DstBladedDLLTypeData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2330,8 +2330,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY end if if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsZ)) then allocate(DstBladedDLLTypeData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2363,8 +2363,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq if (allocated(SrcBladedDLLTypeData%GenSpd_TLU)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU) - UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU) + LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%GenSpd_TLU)) then allocate(DstBladedDLLTypeData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2375,8 +2375,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU end if if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) - UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU) + LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%GenTrq_TLU)) then allocate(DstBladedDLLTypeData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2388,8 +2388,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL) - UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL) + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then allocate(DstBladedDLLTypeData%PrevCableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2400,8 +2400,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL end if if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) - UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then allocate(DstBladedDLLTypeData%PrevCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2412,8 +2412,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot end if if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) - UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL) + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%CableDeltaL)) then allocate(DstBladedDLLTypeData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2424,8 +2424,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL end if if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) - UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot) + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%CableDeltaLdot)) then allocate(DstBladedDLLTypeData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2436,8 +2436,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then allocate(DstBladedDLLTypeData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2448,8 +2448,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then allocate(DstBladedDLLTypeData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2460,8 +2460,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then allocate(DstBladedDLLTypeData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2472,8 +2472,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then allocate(DstBladedDLLTypeData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2484,8 +2484,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce end if if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%StCCmdStiff)) then allocate(DstBladedDLLTypeData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2496,8 +2496,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff end if if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%StCCmdDamp)) then allocate(DstBladedDLLTypeData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2508,8 +2508,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp end if if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%StCCmdBrake)) then allocate(DstBladedDLLTypeData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2520,8 +2520,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake end if if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%StCCmdForce)) then allocate(DstBladedDLLTypeData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2532,8 +2532,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce end if if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%StCMeasDisp)) then allocate(DstBladedDLLTypeData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2544,8 +2544,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp end if if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel, kind=B8Ki) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel, kind=B8Ki) if (.not. allocated(DstBladedDLLTypeData%StCMeasVel)) then allocate(DstBladedDLLTypeData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2561,8 +2561,8 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) type(BladedDLLType), intent(inout) :: BladedDLLTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyBladedDLLType' @@ -2575,8 +2575,8 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) deallocate(BladedDLLTypeData%toSC) end if if (allocated(BladedDLLTypeData%LogChannels_OutParam)) then - LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam) - UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam) + LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) + UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2655,12 +2655,12 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BladedDLLType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%avrSWAP)) if (allocated(InData%avrSWAP)) then - call RegPackBounds(Buf, 1, lbound(InData%avrSWAP), ubound(InData%avrSWAP)) + call RegPackBounds(Buf, 1, lbound(InData%avrSWAP, kind=B8Ki), ubound(InData%avrSWAP, kind=B8Ki)) call RegPack(Buf, InData%avrSWAP) end if call RegPack(Buf, InData%HSSBrTrqDemand) @@ -2675,23 +2675,23 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) call RegPack(Buf, InData%GenTrq_prev) call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) call RegPack(Buf, InData%toSC) end if call RegPack(Buf, InData%initialized) call RegPack(Buf, InData%NumLogChannels) call RegPack(Buf, allocated(InData%LogChannels_OutParam)) if (allocated(InData%LogChannels_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) - LB(1:1) = lbound(InData%LogChannels_OutParam) - UB(1:1) = ubound(InData%LogChannels_OutParam) + call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam, kind=B8Ki), ubound(InData%LogChannels_OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%LogChannels_OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%LogChannels_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%LogChannels_OutParam(i1)) end do end if call RegPack(Buf, allocated(InData%LogChannels)) if (allocated(InData%LogChannels)) then - call RegPackBounds(Buf, 1, lbound(InData%LogChannels), ubound(InData%LogChannels)) + call RegPackBounds(Buf, 1, lbound(InData%LogChannels, kind=B8Ki), ubound(InData%LogChannels, kind=B8Ki)) call RegPack(Buf, InData%LogChannels) end if call RegPack(Buf, InData%ErrStat) @@ -2706,7 +2706,7 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) call RegPack(Buf, InData%YawTorqueDemand) call RegPack(Buf, allocated(InData%BlPitchInput)) if (allocated(InData%BlPitchInput)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput), ubound(InData%BlPitchInput)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput, kind=B8Ki), ubound(InData%BlPitchInput, kind=B8Ki)) call RegPack(Buf, InData%BlPitchInput) end if call RegPack(Buf, InData%YawAngleFromNorth) @@ -2737,22 +2737,22 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) call RegPack(Buf, InData%LSShftFzs) call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) call RegPack(Buf, InData%LidSpeed) end if call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsX) end if call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsY) end if call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsZ) end if call RegPack(Buf, InData%SensorType) @@ -2778,83 +2778,83 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) call RegPack(Buf, InData%DLL_NumTrq) call RegPack(Buf, allocated(InData%GenSpd_TLU)) if (allocated(InData%GenSpd_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) + call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU, kind=B8Ki), ubound(InData%GenSpd_TLU, kind=B8Ki)) call RegPack(Buf, InData%GenSpd_TLU) end if call RegPack(Buf, allocated(InData%GenTrq_TLU)) if (allocated(InData%GenTrq_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) + call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU, kind=B8Ki), ubound(InData%GenTrq_TLU, kind=B8Ki)) call RegPack(Buf, InData%GenTrq_TLU) end if call RegPack(Buf, InData%Yaw_Cntrl) call RegPack(Buf, allocated(InData%PrevCableDeltaL)) if (allocated(InData%PrevCableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL), ubound(InData%PrevCableDeltaL)) + call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL, kind=B8Ki), ubound(InData%PrevCableDeltaL, kind=B8Ki)) call RegPack(Buf, InData%PrevCableDeltaL) end if call RegPack(Buf, allocated(InData%PrevCableDeltaLdot)) if (allocated(InData%PrevCableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot), ubound(InData%PrevCableDeltaLdot)) + call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot, kind=B8Ki), ubound(InData%PrevCableDeltaLdot, kind=B8Ki)) call RegPack(Buf, InData%PrevCableDeltaLdot) end if call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL, kind=B8Ki), ubound(InData%CableDeltaL, kind=B8Ki)) call RegPack(Buf, InData%CableDeltaL) end if call RegPack(Buf, allocated(InData%CableDeltaLdot)) if (allocated(InData%CableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot, kind=B8Ki), ubound(InData%CableDeltaLdot, kind=B8Ki)) call RegPack(Buf, InData%CableDeltaLdot) end if call RegPack(Buf, allocated(InData%PrevStCCmdStiff)) if (allocated(InData%PrevStCCmdStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff), ubound(InData%PrevStCCmdStiff)) + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff, kind=B8Ki), ubound(InData%PrevStCCmdStiff, kind=B8Ki)) call RegPack(Buf, InData%PrevStCCmdStiff) end if call RegPack(Buf, allocated(InData%PrevStCCmdDamp)) if (allocated(InData%PrevStCCmdDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp), ubound(InData%PrevStCCmdDamp)) + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp, kind=B8Ki), ubound(InData%PrevStCCmdDamp, kind=B8Ki)) call RegPack(Buf, InData%PrevStCCmdDamp) end if call RegPack(Buf, allocated(InData%PrevStCCmdBrake)) if (allocated(InData%PrevStCCmdBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake), ubound(InData%PrevStCCmdBrake)) + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake, kind=B8Ki), ubound(InData%PrevStCCmdBrake, kind=B8Ki)) call RegPack(Buf, InData%PrevStCCmdBrake) end if call RegPack(Buf, allocated(InData%PrevStCCmdForce)) if (allocated(InData%PrevStCCmdForce)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce), ubound(InData%PrevStCCmdForce)) + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce, kind=B8Ki), ubound(InData%PrevStCCmdForce, kind=B8Ki)) call RegPack(Buf, InData%PrevStCCmdForce) end if call RegPack(Buf, allocated(InData%StCCmdStiff)) if (allocated(InData%StCCmdStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff), ubound(InData%StCCmdStiff)) + call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff, kind=B8Ki), ubound(InData%StCCmdStiff, kind=B8Ki)) call RegPack(Buf, InData%StCCmdStiff) end if call RegPack(Buf, allocated(InData%StCCmdDamp)) if (allocated(InData%StCCmdDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp), ubound(InData%StCCmdDamp)) + call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp, kind=B8Ki), ubound(InData%StCCmdDamp, kind=B8Ki)) call RegPack(Buf, InData%StCCmdDamp) end if call RegPack(Buf, allocated(InData%StCCmdBrake)) if (allocated(InData%StCCmdBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake), ubound(InData%StCCmdBrake)) + call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake, kind=B8Ki), ubound(InData%StCCmdBrake, kind=B8Ki)) call RegPack(Buf, InData%StCCmdBrake) end if call RegPack(Buf, allocated(InData%StCCmdForce)) if (allocated(InData%StCCmdForce)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce), ubound(InData%StCCmdForce)) + call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce, kind=B8Ki), ubound(InData%StCCmdForce, kind=B8Ki)) call RegPack(Buf, InData%StCCmdForce) end if call RegPack(Buf, allocated(InData%StCMeasDisp)) if (allocated(InData%StCMeasDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp), ubound(InData%StCMeasDisp)) + call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp, kind=B8Ki), ubound(InData%StCMeasDisp, kind=B8Ki)) call RegPack(Buf, InData%StCMeasDisp) end if call RegPack(Buf, allocated(InData%StCMeasVel)) if (allocated(InData%StCMeasVel)) then - call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel), ubound(InData%StCMeasVel)) + call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel, kind=B8Ki), ubound(InData%StCMeasVel, kind=B8Ki)) call RegPack(Buf, InData%StCMeasVel) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2864,8 +2864,8 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(BladedDLLType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3368,8 +3368,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyContState' @@ -3377,8 +3377,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS ErrMsg = '' DstContStateData%DummyContState = SrcContStateData%DummyContState if (allocated(SrcContStateData%BStC)) then - LB(1:1) = lbound(SrcContStateData%BStC) - UB(1:1) = ubound(SrcContStateData%BStC) + LB(1:1) = lbound(SrcContStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%BStC, kind=B8Ki) if (.not. allocated(DstContStateData%BStC)) then allocate(DstContStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3393,8 +3393,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%NStC)) then - LB(1:1) = lbound(SrcContStateData%NStC) - UB(1:1) = ubound(SrcContStateData%NStC) + LB(1:1) = lbound(SrcContStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%NStC, kind=B8Ki) if (.not. allocated(DstContStateData%NStC)) then allocate(DstContStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3409,8 +3409,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%TStC)) then - LB(1:1) = lbound(SrcContStateData%TStC) - UB(1:1) = ubound(SrcContStateData%TStC) + LB(1:1) = lbound(SrcContStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%TStC, kind=B8Ki) if (.not. allocated(DstContStateData%TStC)) then allocate(DstContStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3425,8 +3425,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%SStC)) then - LB(1:1) = lbound(SrcContStateData%SStC) - UB(1:1) = ubound(SrcContStateData%SStC) + LB(1:1) = lbound(SrcContStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%SStC, kind=B8Ki) if (.not. allocated(DstContStateData%SStC)) then allocate(DstContStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3446,16 +3446,16 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) type(SrvD_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%BStC)) then - LB(1:1) = lbound(ContStateData%BStC) - UB(1:1) = ubound(ContStateData%BStC) + LB(1:1) = lbound(ContStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(ContStateData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3463,8 +3463,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%BStC) end if if (allocated(ContStateData%NStC)) then - LB(1:1) = lbound(ContStateData%NStC) - UB(1:1) = ubound(ContStateData%NStC) + LB(1:1) = lbound(ContStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(ContStateData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3472,8 +3472,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%NStC) end if if (allocated(ContStateData%TStC)) then - LB(1:1) = lbound(ContStateData%TStC) - UB(1:1) = ubound(ContStateData%TStC) + LB(1:1) = lbound(ContStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(ContStateData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3481,8 +3481,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%TStC) end if if (allocated(ContStateData%SStC)) then - LB(1:1) = lbound(ContStateData%SStC) - UB(1:1) = ubound(ContStateData%SStC) + LB(1:1) = lbound(ContStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(ContStateData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3495,42 +3495,42 @@ subroutine SrvD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DummyContState) call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackContState(Buf, InData%BStC(i1)) end do end if call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackContState(Buf, InData%NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackContState(Buf, InData%TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackContState(Buf, InData%SStC(i1)) end do @@ -3542,8 +3542,8 @@ subroutine SrvD_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackContState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3617,8 +3617,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyDiscState' @@ -3626,8 +3626,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS ErrMsg = '' DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset if (allocated(SrcDiscStateData%BStC)) then - LB(1:1) = lbound(SrcDiscStateData%BStC) - UB(1:1) = ubound(SrcDiscStateData%BStC) + LB(1:1) = lbound(SrcDiscStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%BStC, kind=B8Ki) if (.not. allocated(DstDiscStateData%BStC)) then allocate(DstDiscStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3642,8 +3642,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%NStC)) then - LB(1:1) = lbound(SrcDiscStateData%NStC) - UB(1:1) = ubound(SrcDiscStateData%NStC) + LB(1:1) = lbound(SrcDiscStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%NStC, kind=B8Ki) if (.not. allocated(DstDiscStateData%NStC)) then allocate(DstDiscStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3658,8 +3658,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%TStC)) then - LB(1:1) = lbound(SrcDiscStateData%TStC) - UB(1:1) = ubound(SrcDiscStateData%TStC) + LB(1:1) = lbound(SrcDiscStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%TStC, kind=B8Ki) if (.not. allocated(DstDiscStateData%TStC)) then allocate(DstDiscStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3674,8 +3674,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%SStC)) then - LB(1:1) = lbound(SrcDiscStateData%SStC) - UB(1:1) = ubound(SrcDiscStateData%SStC) + LB(1:1) = lbound(SrcDiscStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%SStC, kind=B8Ki) if (.not. allocated(DstDiscStateData%SStC)) then allocate(DstDiscStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3695,16 +3695,16 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(SrvD_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%BStC)) then - LB(1:1) = lbound(DiscStateData%BStC) - UB(1:1) = ubound(DiscStateData%BStC) + LB(1:1) = lbound(DiscStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3712,8 +3712,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%BStC) end if if (allocated(DiscStateData%NStC)) then - LB(1:1) = lbound(DiscStateData%NStC) - UB(1:1) = ubound(DiscStateData%NStC) + LB(1:1) = lbound(DiscStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3721,8 +3721,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%NStC) end if if (allocated(DiscStateData%TStC)) then - LB(1:1) = lbound(DiscStateData%TStC) - UB(1:1) = ubound(DiscStateData%TStC) + LB(1:1) = lbound(DiscStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3730,8 +3730,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%TStC) end if if (allocated(DiscStateData%SStC)) then - LB(1:1) = lbound(DiscStateData%SStC) - UB(1:1) = ubound(DiscStateData%SStC) + LB(1:1) = lbound(DiscStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(DiscStateData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3744,42 +3744,42 @@ subroutine SrvD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%CtrlOffset) call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackDiscState(Buf, InData%BStC(i1)) end do end if call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackDiscState(Buf, InData%NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackDiscState(Buf, InData%TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackDiscState(Buf, InData%SStC(i1)) end do @@ -3791,8 +3791,8 @@ subroutine SrvD_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3866,8 +3866,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyConstrState' @@ -3875,8 +3875,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode ErrMsg = '' DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState if (allocated(SrcConstrStateData%BStC)) then - LB(1:1) = lbound(SrcConstrStateData%BStC) - UB(1:1) = ubound(SrcConstrStateData%BStC) + LB(1:1) = lbound(SrcConstrStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%BStC, kind=B8Ki) if (.not. allocated(DstConstrStateData%BStC)) then allocate(DstConstrStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3891,8 +3891,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%NStC)) then - LB(1:1) = lbound(SrcConstrStateData%NStC) - UB(1:1) = ubound(SrcConstrStateData%NStC) + LB(1:1) = lbound(SrcConstrStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%NStC, kind=B8Ki) if (.not. allocated(DstConstrStateData%NStC)) then allocate(DstConstrStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3907,8 +3907,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%TStC)) then - LB(1:1) = lbound(SrcConstrStateData%TStC) - UB(1:1) = ubound(SrcConstrStateData%TStC) + LB(1:1) = lbound(SrcConstrStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%TStC, kind=B8Ki) if (.not. allocated(DstConstrStateData%TStC)) then allocate(DstConstrStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3923,8 +3923,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%SStC)) then - LB(1:1) = lbound(SrcConstrStateData%SStC) - UB(1:1) = ubound(SrcConstrStateData%SStC) + LB(1:1) = lbound(SrcConstrStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcConstrStateData%SStC, kind=B8Ki) if (.not. allocated(DstConstrStateData%SStC)) then allocate(DstConstrStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3944,16 +3944,16 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(SrvD_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%BStC)) then - LB(1:1) = lbound(ConstrStateData%BStC) - UB(1:1) = ubound(ConstrStateData%BStC) + LB(1:1) = lbound(ConstrStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3961,8 +3961,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%BStC) end if if (allocated(ConstrStateData%NStC)) then - LB(1:1) = lbound(ConstrStateData%NStC) - UB(1:1) = ubound(ConstrStateData%NStC) + LB(1:1) = lbound(ConstrStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3970,8 +3970,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%NStC) end if if (allocated(ConstrStateData%TStC)) then - LB(1:1) = lbound(ConstrStateData%TStC) - UB(1:1) = ubound(ConstrStateData%TStC) + LB(1:1) = lbound(ConstrStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3979,8 +3979,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%TStC) end if if (allocated(ConstrStateData%SStC)) then - LB(1:1) = lbound(ConstrStateData%SStC) - UB(1:1) = ubound(ConstrStateData%SStC) + LB(1:1) = lbound(ConstrStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(ConstrStateData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3993,42 +3993,42 @@ subroutine SrvD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DummyConstrState) call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackConstrState(Buf, InData%BStC(i1)) end do end if call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackConstrState(Buf, InData%NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackConstrState(Buf, InData%TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackConstrState(Buf, InData%SStC(i1)) end do @@ -4040,8 +4040,8 @@ subroutine SrvD_UnPackConstrState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4115,16 +4115,16 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%BegPitMan)) then - LB(1:1) = lbound(SrcOtherStateData%BegPitMan) - UB(1:1) = ubound(SrcOtherStateData%BegPitMan) + LB(1:1) = lbound(SrcOtherStateData%BegPitMan, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%BegPitMan, kind=B8Ki) if (.not. allocated(DstOtherStateData%BegPitMan)) then allocate(DstOtherStateData%BegPitMan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4135,8 +4135,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan end if if (allocated(SrcOtherStateData%BlPitchI)) then - LB(1:1) = lbound(SrcOtherStateData%BlPitchI) - UB(1:1) = ubound(SrcOtherStateData%BlPitchI) + LB(1:1) = lbound(SrcOtherStateData%BlPitchI, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%BlPitchI, kind=B8Ki) if (.not. allocated(DstOtherStateData%BlPitchI)) then allocate(DstOtherStateData%BlPitchI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4147,8 +4147,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI end if if (allocated(SrcOtherStateData%TPitManE)) then - LB(1:1) = lbound(SrcOtherStateData%TPitManE) - UB(1:1) = ubound(SrcOtherStateData%TPitManE) + LB(1:1) = lbound(SrcOtherStateData%TPitManE, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%TPitManE, kind=B8Ki) if (.not. allocated(DstOtherStateData%TPitManE)) then allocate(DstOtherStateData%TPitManE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4163,8 +4163,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt if (allocated(SrcOtherStateData%BegTpBr)) then - LB(1:1) = lbound(SrcOtherStateData%BegTpBr) - UB(1:1) = ubound(SrcOtherStateData%BegTpBr) + LB(1:1) = lbound(SrcOtherStateData%BegTpBr, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%BegTpBr, kind=B8Ki) if (.not. allocated(DstOtherStateData%BegTpBr)) then allocate(DstOtherStateData%BegTpBr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4175,8 +4175,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr end if if (allocated(SrcOtherStateData%TTpBrDp)) then - LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) - UB(1:1) = ubound(SrcOtherStateData%TTpBrDp) + LB(1:1) = lbound(SrcOtherStateData%TTpBrDp, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%TTpBrDp, kind=B8Ki) if (.not. allocated(DstOtherStateData%TTpBrDp)) then allocate(DstOtherStateData%TTpBrDp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4187,8 +4187,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp end if if (allocated(SrcOtherStateData%TTpBrFl)) then - LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) - UB(1:1) = ubound(SrcOtherStateData%TTpBrFl) + LB(1:1) = lbound(SrcOtherStateData%TTpBrFl, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%TTpBrFl, kind=B8Ki) if (.not. allocated(DstOtherStateData%TTpBrFl)) then allocate(DstOtherStateData%TTpBrFl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4201,8 +4201,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine if (allocated(SrcOtherStateData%BStC)) then - LB(1:1) = lbound(SrcOtherStateData%BStC) - UB(1:1) = ubound(SrcOtherStateData%BStC) + LB(1:1) = lbound(SrcOtherStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%BStC, kind=B8Ki) if (.not. allocated(DstOtherStateData%BStC)) then allocate(DstOtherStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4217,8 +4217,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%NStC)) then - LB(1:1) = lbound(SrcOtherStateData%NStC) - UB(1:1) = ubound(SrcOtherStateData%NStC) + LB(1:1) = lbound(SrcOtherStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%NStC, kind=B8Ki) if (.not. allocated(DstOtherStateData%NStC)) then allocate(DstOtherStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4233,8 +4233,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%TStC)) then - LB(1:1) = lbound(SrcOtherStateData%TStC) - UB(1:1) = ubound(SrcOtherStateData%TStC) + LB(1:1) = lbound(SrcOtherStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%TStC, kind=B8Ki) if (.not. allocated(DstOtherStateData%TStC)) then allocate(DstOtherStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4249,8 +4249,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%SStC)) then - LB(1:1) = lbound(SrcOtherStateData%SStC) - UB(1:1) = ubound(SrcOtherStateData%SStC) + LB(1:1) = lbound(SrcOtherStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%SStC, kind=B8Ki) if (.not. allocated(DstOtherStateData%SStC)) then allocate(DstOtherStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4270,8 +4270,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SrvD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyOtherState' @@ -4296,8 +4296,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%TTpBrFl) end if if (allocated(OtherStateData%BStC)) then - LB(1:1) = lbound(OtherStateData%BStC) - UB(1:1) = ubound(OtherStateData%BStC) + LB(1:1) = lbound(OtherStateData%BStC, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4305,8 +4305,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%BStC) end if if (allocated(OtherStateData%NStC)) then - LB(1:1) = lbound(OtherStateData%NStC) - UB(1:1) = ubound(OtherStateData%NStC) + LB(1:1) = lbound(OtherStateData%NStC, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4314,8 +4314,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%NStC) end if if (allocated(OtherStateData%TStC)) then - LB(1:1) = lbound(OtherStateData%TStC) - UB(1:1) = ubound(OtherStateData%TStC) + LB(1:1) = lbound(OtherStateData%TStC, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4323,8 +4323,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%TStC) end if if (allocated(OtherStateData%SStC)) then - LB(1:1) = lbound(OtherStateData%SStC) - UB(1:1) = ubound(OtherStateData%SStC) + LB(1:1) = lbound(OtherStateData%SStC, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4337,22 +4337,22 @@ subroutine SrvD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%BegPitMan)) if (allocated(InData%BegPitMan)) then - call RegPackBounds(Buf, 1, lbound(InData%BegPitMan), ubound(InData%BegPitMan)) + call RegPackBounds(Buf, 1, lbound(InData%BegPitMan, kind=B8Ki), ubound(InData%BegPitMan, kind=B8Ki)) call RegPack(Buf, InData%BegPitMan) end if call RegPack(Buf, allocated(InData%BlPitchI)) if (allocated(InData%BlPitchI)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchI), ubound(InData%BlPitchI)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchI, kind=B8Ki), ubound(InData%BlPitchI, kind=B8Ki)) call RegPack(Buf, InData%BlPitchI) end if call RegPack(Buf, allocated(InData%TPitManE)) if (allocated(InData%TPitManE)) then - call RegPackBounds(Buf, 1, lbound(InData%TPitManE), ubound(InData%TPitManE)) + call RegPackBounds(Buf, 1, lbound(InData%TPitManE, kind=B8Ki), ubound(InData%TPitManE, kind=B8Ki)) call RegPack(Buf, InData%TPitManE) end if call RegPack(Buf, InData%BegYawMan) @@ -4361,53 +4361,53 @@ subroutine SrvD_PackOtherState(Buf, Indata) call RegPack(Buf, InData%YawPosComInt) call RegPack(Buf, allocated(InData%BegTpBr)) if (allocated(InData%BegTpBr)) then - call RegPackBounds(Buf, 1, lbound(InData%BegTpBr), ubound(InData%BegTpBr)) + call RegPackBounds(Buf, 1, lbound(InData%BegTpBr, kind=B8Ki), ubound(InData%BegTpBr, kind=B8Ki)) call RegPack(Buf, InData%BegTpBr) end if call RegPack(Buf, allocated(InData%TTpBrDp)) if (allocated(InData%TTpBrDp)) then - call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp), ubound(InData%TTpBrDp)) + call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp, kind=B8Ki), ubound(InData%TTpBrDp, kind=B8Ki)) call RegPack(Buf, InData%TTpBrDp) end if call RegPack(Buf, allocated(InData%TTpBrFl)) if (allocated(InData%TTpBrFl)) then - call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl), ubound(InData%TTpBrFl)) + call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl, kind=B8Ki), ubound(InData%TTpBrFl, kind=B8Ki)) call RegPack(Buf, InData%TTpBrFl) end if call RegPack(Buf, InData%Off4Good) call RegPack(Buf, InData%GenOnLine) call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOtherState(Buf, InData%BStC(i1)) end do end if call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOtherState(Buf, InData%NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOtherState(Buf, InData%TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOtherState(Buf, InData%SStC(i1)) end do @@ -4419,8 +4419,8 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -4588,16 +4588,16 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) then - LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) - UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then allocate(DstModuleMapTypeData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4614,8 +4614,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) - UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then allocate(DstModuleMapTypeData%u_NStC_Mot2_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4630,8 +4630,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) - UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then allocate(DstModuleMapTypeData%u_TStC_Mot2_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4646,8 +4646,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) - UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then allocate(DstModuleMapTypeData%u_SStC_Mot2_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4662,8 +4662,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then allocate(DstModuleMapTypeData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4680,8 +4680,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) - UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then allocate(DstModuleMapTypeData%NStC_Frc2_y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4696,8 +4696,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) - UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then allocate(DstModuleMapTypeData%TStC_Frc2_y_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4712,8 +4712,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) - UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) if (.not. allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then allocate(DstModuleMapTypeData%SStC_Frc2_y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4733,16 +4733,16 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) type(SrvD_ModuleMapType), intent(inout) :: ModuleMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModuleMapTypeData%u_BStC_Mot2_BStC)) then - LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC) - UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC) + LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) + UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -4752,8 +4752,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_BStC_Mot2_BStC) end if if (allocated(ModuleMapTypeData%u_NStC_Mot2_NStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC) - UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC) + LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4761,8 +4761,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_NStC_Mot2_NStC) end if if (allocated(ModuleMapTypeData%u_TStC_Mot2_TStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC) - UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC) + LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4770,8 +4770,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_TStC_Mot2_TStC) end if if (allocated(ModuleMapTypeData%u_SStC_Mot2_SStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC) - UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC) + LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4779,8 +4779,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_SStC_Mot2_SStC) end if if (allocated(ModuleMapTypeData%BStC_Frc2_y_BStC)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC) - UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC) + LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) + UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -4790,8 +4790,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_Frc2_y_BStC) end if if (allocated(ModuleMapTypeData%NStC_Frc2_y_NStC)) then - LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC) - UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC) + LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4799,8 +4799,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%NStC_Frc2_y_NStC) end if if (allocated(ModuleMapTypeData%TStC_Frc2_y_TStC)) then - LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC) - UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC) + LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4808,8 +4808,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%TStC_Frc2_y_TStC) end if if (allocated(ModuleMapTypeData%SStC_Frc2_y_SStC)) then - LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC) - UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC) + LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) + UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4822,14 +4822,14 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%u_BStC_Mot2_BStC)) if (allocated(InData%u_BStC_Mot2_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) - LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) - UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) + call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki), ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%u_BStC_Mot2_BStC(i1,i2)) @@ -4838,36 +4838,36 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end if call RegPack(Buf, allocated(InData%u_NStC_Mot2_NStC)) if (allocated(InData%u_NStC_Mot2_NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) - LB(1:1) = lbound(InData%u_NStC_Mot2_NStC) - UB(1:1) = ubound(InData%u_NStC_Mot2_NStC) + call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki), ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki) + UB(1:1) = ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%u_NStC_Mot2_NStC(i1)) end do end if call RegPack(Buf, allocated(InData%u_TStC_Mot2_TStC)) if (allocated(InData%u_TStC_Mot2_TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) - LB(1:1) = lbound(InData%u_TStC_Mot2_TStC) - UB(1:1) = ubound(InData%u_TStC_Mot2_TStC) + call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki), ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki) + UB(1:1) = ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%u_TStC_Mot2_TStC(i1)) end do end if call RegPack(Buf, allocated(InData%u_SStC_Mot2_SStC)) if (allocated(InData%u_SStC_Mot2_SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) - LB(1:1) = lbound(InData%u_SStC_Mot2_SStC) - UB(1:1) = ubound(InData%u_SStC_Mot2_SStC) + call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki), ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki) + UB(1:1) = ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%u_SStC_Mot2_SStC(i1)) end do end if call RegPack(Buf, allocated(InData%BStC_Frc2_y_BStC)) if (allocated(InData%BStC_Frc2_y_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) - LB(1:2) = lbound(InData%BStC_Frc2_y_BStC) - UB(1:2) = ubound(InData%BStC_Frc2_y_BStC) + call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki), ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki)) + LB(1:2) = lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki) + UB(1:2) = ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%BStC_Frc2_y_BStC(i1,i2)) @@ -4876,27 +4876,27 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end if call RegPack(Buf, allocated(InData%NStC_Frc2_y_NStC)) if (allocated(InData%NStC_Frc2_y_NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) - LB(1:1) = lbound(InData%NStC_Frc2_y_NStC) - UB(1:1) = ubound(InData%NStC_Frc2_y_NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki), ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%NStC_Frc2_y_NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC_Frc2_y_TStC)) if (allocated(InData%TStC_Frc2_y_TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) - LB(1:1) = lbound(InData%TStC_Frc2_y_TStC) - UB(1:1) = ubound(InData%TStC_Frc2_y_TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki), ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%TStC_Frc2_y_TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC_Frc2_y_SStC)) if (allocated(InData%SStC_Frc2_y_SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) - LB(1:1) = lbound(InData%SStC_Frc2_y_SStC) - UB(1:1) = ubound(InData%SStC_Frc2_y_SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki), ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%SStC_Frc2_y_SStC(i1)) end do @@ -4908,8 +4908,8 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5045,8 +5045,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyMisc' @@ -5059,8 +5059,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstWarn = SrcMiscData%FirstWarn DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered if (allocated(SrcMiscData%xd_BlPitchFilter)) then - LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) - UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5071,8 +5071,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter end if if (allocated(SrcMiscData%BStC)) then - LB(1:1) = lbound(SrcMiscData%BStC) - UB(1:1) = ubound(SrcMiscData%BStC) + LB(1:1) = lbound(SrcMiscData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%BStC, kind=B8Ki) if (.not. allocated(DstMiscData%BStC)) then allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5087,8 +5087,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%NStC)) then - LB(1:1) = lbound(SrcMiscData%NStC) - UB(1:1) = ubound(SrcMiscData%NStC) + LB(1:1) = lbound(SrcMiscData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%NStC, kind=B8Ki) if (.not. allocated(DstMiscData%NStC)) then allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5103,8 +5103,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%TStC)) then - LB(1:1) = lbound(SrcMiscData%TStC) - UB(1:1) = ubound(SrcMiscData%TStC) + LB(1:1) = lbound(SrcMiscData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%TStC, kind=B8Ki) if (.not. allocated(DstMiscData%TStC)) then allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5119,8 +5119,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%SStC)) then - LB(1:1) = lbound(SrcMiscData%SStC) - UB(1:1) = ubound(SrcMiscData%SStC) + LB(1:1) = lbound(SrcMiscData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SStC, kind=B8Ki) if (.not. allocated(DstMiscData%SStC)) then allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5135,8 +5135,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_BStC)) then - LB(1:2) = lbound(SrcMiscData%u_BStC) - UB(1:2) = ubound(SrcMiscData%u_BStC) + LB(1:2) = lbound(SrcMiscData%u_BStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_BStC, kind=B8Ki) if (.not. allocated(DstMiscData%u_BStC)) then allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5153,8 +5153,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_NStC)) then - LB(1:2) = lbound(SrcMiscData%u_NStC) - UB(1:2) = ubound(SrcMiscData%u_NStC) + LB(1:2) = lbound(SrcMiscData%u_NStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_NStC, kind=B8Ki) if (.not. allocated(DstMiscData%u_NStC)) then allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5171,8 +5171,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_TStC)) then - LB(1:2) = lbound(SrcMiscData%u_TStC) - UB(1:2) = ubound(SrcMiscData%u_TStC) + LB(1:2) = lbound(SrcMiscData%u_TStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_TStC, kind=B8Ki) if (.not. allocated(DstMiscData%u_TStC)) then allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5189,8 +5189,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%u_SStC)) then - LB(1:2) = lbound(SrcMiscData%u_SStC) - UB(1:2) = ubound(SrcMiscData%u_SStC) + LB(1:2) = lbound(SrcMiscData%u_SStC, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%u_SStC, kind=B8Ki) if (.not. allocated(DstMiscData%u_SStC)) then allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5207,8 +5207,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_BStC)) then - LB(1:1) = lbound(SrcMiscData%y_BStC) - UB(1:1) = ubound(SrcMiscData%y_BStC) + LB(1:1) = lbound(SrcMiscData%y_BStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_BStC, kind=B8Ki) if (.not. allocated(DstMiscData%y_BStC)) then allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5223,8 +5223,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_NStC)) then - LB(1:1) = lbound(SrcMiscData%y_NStC) - UB(1:1) = ubound(SrcMiscData%y_NStC) + LB(1:1) = lbound(SrcMiscData%y_NStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_NStC, kind=B8Ki) if (.not. allocated(DstMiscData%y_NStC)) then allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5239,8 +5239,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_TStC)) then - LB(1:1) = lbound(SrcMiscData%y_TStC) - UB(1:1) = ubound(SrcMiscData%y_TStC) + LB(1:1) = lbound(SrcMiscData%y_TStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_TStC, kind=B8Ki) if (.not. allocated(DstMiscData%y_TStC)) then allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5255,8 +5255,8 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%y_SStC)) then - LB(1:1) = lbound(SrcMiscData%y_SStC) - UB(1:1) = ubound(SrcMiscData%y_SStC) + LB(1:1) = lbound(SrcMiscData%y_SStC, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%y_SStC, kind=B8Ki) if (.not. allocated(DstMiscData%y_SStC)) then allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5280,8 +5280,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) type(SrvD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' @@ -5293,8 +5293,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%xd_BlPitchFilter) end if if (allocated(MiscData%BStC)) then - LB(1:1) = lbound(MiscData%BStC) - UB(1:1) = ubound(MiscData%BStC) + LB(1:1) = lbound(MiscData%BStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5302,8 +5302,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%BStC) end if if (allocated(MiscData%NStC)) then - LB(1:1) = lbound(MiscData%NStC) - UB(1:1) = ubound(MiscData%NStC) + LB(1:1) = lbound(MiscData%NStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5311,8 +5311,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%NStC) end if if (allocated(MiscData%TStC)) then - LB(1:1) = lbound(MiscData%TStC) - UB(1:1) = ubound(MiscData%TStC) + LB(1:1) = lbound(MiscData%TStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5320,8 +5320,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TStC) end if if (allocated(MiscData%SStC)) then - LB(1:1) = lbound(MiscData%SStC) - UB(1:1) = ubound(MiscData%SStC) + LB(1:1) = lbound(MiscData%SStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5329,8 +5329,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%SStC) end if if (allocated(MiscData%u_BStC)) then - LB(1:2) = lbound(MiscData%u_BStC) - UB(1:2) = ubound(MiscData%u_BStC) + LB(1:2) = lbound(MiscData%u_BStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -5340,8 +5340,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_BStC) end if if (allocated(MiscData%u_NStC)) then - LB(1:2) = lbound(MiscData%u_NStC) - UB(1:2) = ubound(MiscData%u_NStC) + LB(1:2) = lbound(MiscData%u_NStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_NStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) @@ -5351,8 +5351,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_NStC) end if if (allocated(MiscData%u_TStC)) then - LB(1:2) = lbound(MiscData%u_TStC) - UB(1:2) = ubound(MiscData%u_TStC) + LB(1:2) = lbound(MiscData%u_TStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_TStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) @@ -5362,8 +5362,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_TStC) end if if (allocated(MiscData%u_SStC)) then - LB(1:2) = lbound(MiscData%u_SStC) - UB(1:2) = ubound(MiscData%u_SStC) + LB(1:2) = lbound(MiscData%u_SStC, kind=B8Ki) + UB(1:2) = ubound(MiscData%u_SStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) @@ -5373,8 +5373,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%u_SStC) end if if (allocated(MiscData%y_BStC)) then - LB(1:1) = lbound(MiscData%y_BStC) - UB(1:1) = ubound(MiscData%y_BStC) + LB(1:1) = lbound(MiscData%y_BStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5382,8 +5382,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%y_BStC) end if if (allocated(MiscData%y_NStC)) then - LB(1:1) = lbound(MiscData%y_NStC) - UB(1:1) = ubound(MiscData%y_NStC) + LB(1:1) = lbound(MiscData%y_NStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5391,8 +5391,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%y_NStC) end if if (allocated(MiscData%y_TStC)) then - LB(1:1) = lbound(MiscData%y_TStC) - UB(1:1) = ubound(MiscData%y_TStC) + LB(1:1) = lbound(MiscData%y_TStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5400,8 +5400,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%y_TStC) end if if (allocated(MiscData%y_SStC)) then - LB(1:1) = lbound(MiscData%y_SStC) - UB(1:1) = ubound(MiscData%y_SStC) + LB(1:1) = lbound(MiscData%y_SStC, kind=B8Ki) + UB(1:1) = ubound(MiscData%y_SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5416,8 +5416,8 @@ subroutine SrvD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%LastTimeCalled) call SrvD_PackBladedDLLType(Buf, InData%dll_data) @@ -5425,50 +5425,50 @@ subroutine SrvD_PackMisc(Buf, Indata) call RegPack(Buf, InData%LastTimeFiltered) call RegPack(Buf, allocated(InData%xd_BlPitchFilter)) if (allocated(InData%xd_BlPitchFilter)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter), ubound(InData%xd_BlPitchFilter)) + call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter, kind=B8Ki), ubound(InData%xd_BlPitchFilter, kind=B8Ki)) call RegPack(Buf, InData%xd_BlPitchFilter) end if call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackMisc(Buf, InData%BStC(i1)) end do end if call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackMisc(Buf, InData%NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackMisc(Buf, InData%TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackMisc(Buf, InData%SStC(i1)) end do end if call RegPack(Buf, allocated(InData%u_BStC)) if (allocated(InData%u_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) - LB(1:2) = lbound(InData%u_BStC) - UB(1:2) = ubound(InData%u_BStC) + call RegPackBounds(Buf, 2, lbound(InData%u_BStC, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_BStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(Buf, InData%u_BStC(i1,i2)) @@ -5477,9 +5477,9 @@ subroutine SrvD_PackMisc(Buf, Indata) end if call RegPack(Buf, allocated(InData%u_NStC)) if (allocated(InData%u_NStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) - LB(1:2) = lbound(InData%u_NStC) - UB(1:2) = ubound(InData%u_NStC) + call RegPackBounds(Buf, 2, lbound(InData%u_NStC, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_NStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_NStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(Buf, InData%u_NStC(i1,i2)) @@ -5488,9 +5488,9 @@ subroutine SrvD_PackMisc(Buf, Indata) end if call RegPack(Buf, allocated(InData%u_TStC)) if (allocated(InData%u_TStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) - LB(1:2) = lbound(InData%u_TStC) - UB(1:2) = ubound(InData%u_TStC) + call RegPackBounds(Buf, 2, lbound(InData%u_TStC, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_TStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_TStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(Buf, InData%u_TStC(i1,i2)) @@ -5499,9 +5499,9 @@ subroutine SrvD_PackMisc(Buf, Indata) end if call RegPack(Buf, allocated(InData%u_SStC)) if (allocated(InData%u_SStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) - LB(1:2) = lbound(InData%u_SStC) - UB(1:2) = ubound(InData%u_SStC) + call RegPackBounds(Buf, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) + LB(1:2) = lbound(InData%u_SStC, kind=B8Ki) + UB(1:2) = ubound(InData%u_SStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call StC_PackInput(Buf, InData%u_SStC(i1,i2)) @@ -5510,36 +5510,36 @@ subroutine SrvD_PackMisc(Buf, Indata) end if call RegPack(Buf, allocated(InData%y_BStC)) if (allocated(InData%y_BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) - LB(1:1) = lbound(InData%y_BStC) - UB(1:1) = ubound(InData%y_BStC) + call RegPackBounds(Buf, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_BStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOutput(Buf, InData%y_BStC(i1)) end do end if call RegPack(Buf, allocated(InData%y_NStC)) if (allocated(InData%y_NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) - LB(1:1) = lbound(InData%y_NStC) - UB(1:1) = ubound(InData%y_NStC) + call RegPackBounds(Buf, 1, lbound(InData%y_NStC, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_NStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOutput(Buf, InData%y_NStC(i1)) end do end if call RegPack(Buf, allocated(InData%y_TStC)) if (allocated(InData%y_TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) - LB(1:1) = lbound(InData%y_TStC) - UB(1:1) = ubound(InData%y_TStC) + call RegPackBounds(Buf, 1, lbound(InData%y_TStC, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_TStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOutput(Buf, InData%y_TStC(i1)) end do end if call RegPack(Buf, allocated(InData%y_SStC)) if (allocated(InData%y_SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) - LB(1:1) = lbound(InData%y_SStC) - UB(1:1) = ubound(InData%y_SStC) + call RegPackBounds(Buf, 1, lbound(InData%y_SStC, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%y_SStC, kind=B8Ki) + UB(1:1) = ubound(InData%y_SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackOutput(Buf, InData%y_SStC(i1)) end do @@ -5553,8 +5553,8 @@ subroutine SrvD_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -5778,8 +5778,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyParam' @@ -5809,8 +5809,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 DstParamData%GenEff = SrcParamData%GenEff if (allocated(SrcParamData%BlPitchInit)) then - LB(1:1) = lbound(SrcParamData%BlPitchInit) - UB(1:1) = ubound(SrcParamData%BlPitchInit) + LB(1:1) = lbound(SrcParamData%BlPitchInit, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BlPitchInit, kind=B8Ki) if (.not. allocated(DstParamData%BlPitchInit)) then allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5821,8 +5821,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlPitchInit = SrcParamData%BlPitchInit end if if (allocated(SrcParamData%BlPitchF)) then - LB(1:1) = lbound(SrcParamData%BlPitchF) - UB(1:1) = ubound(SrcParamData%BlPitchF) + LB(1:1) = lbound(SrcParamData%BlPitchF, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BlPitchF, kind=B8Ki) if (.not. allocated(DstParamData%BlPitchF)) then allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5833,8 +5833,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlPitchF = SrcParamData%BlPitchF end if if (allocated(SrcParamData%PitManRat)) then - LB(1:1) = lbound(SrcParamData%PitManRat) - UB(1:1) = ubound(SrcParamData%PitManRat) + LB(1:1) = lbound(SrcParamData%PitManRat, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%PitManRat, kind=B8Ki) if (.not. allocated(DstParamData%PitManRat)) then allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5853,8 +5853,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TimGenOn = SrcParamData%TimGenOn DstParamData%TPCOn = SrcParamData%TPCOn if (allocated(SrcParamData%TPitManS)) then - LB(1:1) = lbound(SrcParamData%TPitManS) - UB(1:1) = ubound(SrcParamData%TPitManS) + LB(1:1) = lbound(SrcParamData%TPitManS, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TPitManS, kind=B8Ki) if (.not. allocated(DstParamData%TPitManS)) then allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5887,8 +5887,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%YawDamp = SrcParamData%YawDamp DstParamData%TpBrDT = SrcParamData%TpBrDT if (allocated(SrcParamData%TBDepISp)) then - LB(1:1) = lbound(SrcParamData%TBDepISp) - UB(1:1) = ubound(SrcParamData%TBDepISp) + LB(1:1) = lbound(SrcParamData%TBDepISp, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TBDepISp, kind=B8Ki) if (.not. allocated(DstParamData%TBDepISp)) then allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5915,8 +5915,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5945,8 +5945,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TrimGain = SrcParamData%TrimGain DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef if (allocated(SrcParamData%BStC)) then - LB(1:1) = lbound(SrcParamData%BStC) - UB(1:1) = ubound(SrcParamData%BStC) + LB(1:1) = lbound(SrcParamData%BStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%BStC, kind=B8Ki) if (.not. allocated(DstParamData%BStC)) then allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5961,8 +5961,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%NStC)) then - LB(1:1) = lbound(SrcParamData%NStC) - UB(1:1) = ubound(SrcParamData%NStC) + LB(1:1) = lbound(SrcParamData%NStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NStC, kind=B8Ki) if (.not. allocated(DstParamData%NStC)) then allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5977,8 +5977,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%TStC)) then - LB(1:1) = lbound(SrcParamData%TStC) - UB(1:1) = ubound(SrcParamData%TStC) + LB(1:1) = lbound(SrcParamData%TStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%TStC, kind=B8Ki) if (.not. allocated(DstParamData%TStC)) then allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5993,8 +5993,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%SStC)) then - LB(1:1) = lbound(SrcParamData%SStC) - UB(1:1) = ubound(SrcParamData%SStC) + LB(1:1) = lbound(SrcParamData%SStC, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%SStC, kind=B8Ki) if (.not. allocated(DstParamData%SStC)) then allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6013,8 +6013,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumCableControl = SrcParamData%NumCableControl DstParamData%NumStC_Control = SrcParamData%NumStC_Control if (allocated(SrcParamData%StCMeasNumPerChan)) then - LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) - UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) if (.not. allocated(DstParamData%StCMeasNumPerChan)) then allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6026,8 +6026,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%UseSC = SrcParamData%UseSC if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6038,8 +6038,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%Jac_x_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_x_indx) - UB(1:2) = ubound(SrcParamData%Jac_x_indx) + LB(1:2) = lbound(SrcParamData%Jac_x_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_x_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_x_indx)) then allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6050,8 +6050,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6062,8 +6062,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx) - UB(1:1) = ubound(SrcParamData%dx) + LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) if (.not. allocated(DstParamData%dx)) then allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6077,8 +6077,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%Jac_nx = SrcParamData%Jac_nx if (allocated(SrcParamData%Jac_Idx_BStC_u)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6089,8 +6089,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u end if if (allocated(SrcParamData%Jac_Idx_NStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6101,8 +6101,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u end if if (allocated(SrcParamData%Jac_Idx_TStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6113,8 +6113,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u end if if (allocated(SrcParamData%Jac_Idx_SStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6125,8 +6125,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u end if if (allocated(SrcParamData%Jac_Idx_BStC_x)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6137,8 +6137,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x end if if (allocated(SrcParamData%Jac_Idx_NStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6149,8 +6149,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x end if if (allocated(SrcParamData%Jac_Idx_TStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6161,8 +6161,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x end if if (allocated(SrcParamData%Jac_Idx_SStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6173,8 +6173,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x end if if (allocated(SrcParamData%Jac_Idx_BStC_y)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6185,8 +6185,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y end if if (allocated(SrcParamData%Jac_Idx_NStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6197,8 +6197,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y end if if (allocated(SrcParamData%Jac_Idx_TStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6209,8 +6209,8 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y end if if (allocated(SrcParamData%Jac_Idx_SStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6231,8 +6231,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) type(SrvD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyParam' @@ -6254,8 +6254,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TBDepISp) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6265,8 +6265,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BStC)) then - LB(1:1) = lbound(ParamData%BStC) - UB(1:1) = ubound(ParamData%BStC) + LB(1:1) = lbound(ParamData%BStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6274,8 +6274,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BStC) end if if (allocated(ParamData%NStC)) then - LB(1:1) = lbound(ParamData%NStC) - UB(1:1) = ubound(ParamData%NStC) + LB(1:1) = lbound(ParamData%NStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6283,8 +6283,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%NStC) end if if (allocated(ParamData%TStC)) then - LB(1:1) = lbound(ParamData%TStC) - UB(1:1) = ubound(ParamData%TStC) + LB(1:1) = lbound(ParamData%TStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6292,8 +6292,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TStC) end if if (allocated(ParamData%SStC)) then - LB(1:1) = lbound(ParamData%SStC) - UB(1:1) = ubound(ParamData%SStC) + LB(1:1) = lbound(ParamData%SStC, kind=B8Ki) + UB(1:1) = ubound(ParamData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6357,8 +6357,8 @@ subroutine SrvD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) call RegPack(Buf, InData%HSSBrDT) @@ -6385,17 +6385,17 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%GenEff) call RegPack(Buf, allocated(InData%BlPitchInit)) if (allocated(InData%BlPitchInit)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit, kind=B8Ki), ubound(InData%BlPitchInit, kind=B8Ki)) call RegPack(Buf, InData%BlPitchInit) end if call RegPack(Buf, allocated(InData%BlPitchF)) if (allocated(InData%BlPitchF)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchF), ubound(InData%BlPitchF)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchF, kind=B8Ki), ubound(InData%BlPitchF, kind=B8Ki)) call RegPack(Buf, InData%BlPitchF) end if call RegPack(Buf, allocated(InData%PitManRat)) if (allocated(InData%PitManRat)) then - call RegPackBounds(Buf, 1, lbound(InData%PitManRat), ubound(InData%PitManRat)) + call RegPackBounds(Buf, 1, lbound(InData%PitManRat, kind=B8Ki), ubound(InData%PitManRat, kind=B8Ki)) call RegPack(Buf, InData%PitManRat) end if call RegPack(Buf, InData%YawManRat) @@ -6408,7 +6408,7 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%TPCOn) call RegPack(Buf, allocated(InData%TPitManS)) if (allocated(InData%TPitManS)) then - call RegPackBounds(Buf, 1, lbound(InData%TPitManS), ubound(InData%TPitManS)) + call RegPackBounds(Buf, 1, lbound(InData%TPitManS, kind=B8Ki), ubound(InData%TPitManS, kind=B8Ki)) call RegPack(Buf, InData%TPitManS) end if call RegPack(Buf, InData%TYawManS) @@ -6435,7 +6435,7 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%TpBrDT) call RegPack(Buf, allocated(InData%TBDepISp)) if (allocated(InData%TBDepISp)) then - call RegPackBounds(Buf, 1, lbound(InData%TBDepISp), ubound(InData%TBDepISp)) + call RegPackBounds(Buf, 1, lbound(InData%TBDepISp, kind=B8Ki), ubound(InData%TBDepISp, kind=B8Ki)) call RegPack(Buf, InData%TBDepISp) end if call RegPack(Buf, InData%TBDrConN) @@ -6456,9 +6456,9 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%RootName) call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -6479,36 +6479,36 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%RotSpeedRef) call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) - LB(1:1) = lbound(InData%BStC) - UB(1:1) = ubound(InData%BStC) + call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + LB(1:1) = lbound(InData%BStC, kind=B8Ki) + UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackParam(Buf, InData%BStC(i1)) end do end if call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) - LB(1:1) = lbound(InData%NStC) - UB(1:1) = ubound(InData%NStC) + call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + LB(1:1) = lbound(InData%NStC, kind=B8Ki) + UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackParam(Buf, InData%NStC(i1)) end do end if call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) - LB(1:1) = lbound(InData%TStC) - UB(1:1) = ubound(InData%TStC) + call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + LB(1:1) = lbound(InData%TStC, kind=B8Ki) + UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackParam(Buf, InData%TStC(i1)) end do end if call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) - LB(1:1) = lbound(InData%SStC) - UB(1:1) = ubound(InData%SStC) + call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + LB(1:1) = lbound(InData%SStC, kind=B8Ki) + UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) call StC_PackParam(Buf, InData%SStC(i1)) end do @@ -6519,28 +6519,28 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%NumStC_Control) call RegPack(Buf, allocated(InData%StCMeasNumPerChan)) if (allocated(InData%StCMeasNumPerChan)) then - call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan), ubound(InData%StCMeasNumPerChan)) + call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan, kind=B8Ki), ubound(InData%StCMeasNumPerChan, kind=B8Ki)) call RegPack(Buf, InData%StCMeasNumPerChan) end if call RegPack(Buf, InData%UseSC) call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%Jac_x_indx)) if (allocated(InData%Jac_x_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx), ubound(InData%Jac_x_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx, kind=B8Ki), ubound(InData%Jac_x_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_x_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) call RegPack(Buf, InData%dx) end if call RegPack(Buf, InData%Jac_nu) @@ -6548,62 +6548,62 @@ subroutine SrvD_PackParam(Buf, Indata) call RegPack(Buf, InData%Jac_nx) call RegPack(Buf, allocated(InData%Jac_Idx_BStC_u)) if (allocated(InData%Jac_Idx_BStC_u)) then - call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u), ubound(InData%Jac_Idx_BStC_u)) + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u, kind=B8Ki), ubound(InData%Jac_Idx_BStC_u, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_BStC_u) end if call RegPack(Buf, allocated(InData%Jac_Idx_NStC_u)) if (allocated(InData%Jac_Idx_NStC_u)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u), ubound(InData%Jac_Idx_NStC_u)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u, kind=B8Ki), ubound(InData%Jac_Idx_NStC_u, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_NStC_u) end if call RegPack(Buf, allocated(InData%Jac_Idx_TStC_u)) if (allocated(InData%Jac_Idx_TStC_u)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u), ubound(InData%Jac_Idx_TStC_u)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u, kind=B8Ki), ubound(InData%Jac_Idx_TStC_u, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_TStC_u) end if call RegPack(Buf, allocated(InData%Jac_Idx_SStC_u)) if (allocated(InData%Jac_Idx_SStC_u)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u), ubound(InData%Jac_Idx_SStC_u)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u, kind=B8Ki), ubound(InData%Jac_Idx_SStC_u, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_SStC_u) end if call RegPack(Buf, allocated(InData%Jac_Idx_BStC_x)) if (allocated(InData%Jac_Idx_BStC_x)) then - call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x), ubound(InData%Jac_Idx_BStC_x)) + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x, kind=B8Ki), ubound(InData%Jac_Idx_BStC_x, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_BStC_x) end if call RegPack(Buf, allocated(InData%Jac_Idx_NStC_x)) if (allocated(InData%Jac_Idx_NStC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x), ubound(InData%Jac_Idx_NStC_x)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x, kind=B8Ki), ubound(InData%Jac_Idx_NStC_x, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_NStC_x) end if call RegPack(Buf, allocated(InData%Jac_Idx_TStC_x)) if (allocated(InData%Jac_Idx_TStC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x), ubound(InData%Jac_Idx_TStC_x)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x, kind=B8Ki), ubound(InData%Jac_Idx_TStC_x, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_TStC_x) end if call RegPack(Buf, allocated(InData%Jac_Idx_SStC_x)) if (allocated(InData%Jac_Idx_SStC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x), ubound(InData%Jac_Idx_SStC_x)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x, kind=B8Ki), ubound(InData%Jac_Idx_SStC_x, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_SStC_x) end if call RegPack(Buf, allocated(InData%Jac_Idx_BStC_y)) if (allocated(InData%Jac_Idx_BStC_y)) then - call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y), ubound(InData%Jac_Idx_BStC_y)) + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y, kind=B8Ki), ubound(InData%Jac_Idx_BStC_y, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_BStC_y) end if call RegPack(Buf, allocated(InData%Jac_Idx_NStC_y)) if (allocated(InData%Jac_Idx_NStC_y)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y), ubound(InData%Jac_Idx_NStC_y)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y, kind=B8Ki), ubound(InData%Jac_Idx_NStC_y, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_NStC_y) end if call RegPack(Buf, allocated(InData%Jac_Idx_TStC_y)) if (allocated(InData%Jac_Idx_TStC_y)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y), ubound(InData%Jac_Idx_TStC_y)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y, kind=B8Ki), ubound(InData%Jac_Idx_TStC_y, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_TStC_y) end if call RegPack(Buf, allocated(InData%Jac_Idx_SStC_y)) if (allocated(InData%Jac_Idx_SStC_y)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y), ubound(InData%Jac_Idx_SStC_y)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y, kind=B8Ki), ubound(InData%Jac_Idx_SStC_y, kind=B8Ki)) call RegPack(Buf, InData%Jac_Idx_SStC_y) end if call RegPack(Buf, InData%SensorType) @@ -6618,8 +6618,8 @@ subroutine SrvD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackParam' - integer(IntKi) :: i1, i2, i3 - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -7205,16 +7205,16 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%BlPitch)) then - LB(1:1) = lbound(SrcInputData%BlPitch) - UB(1:1) = ubound(SrcInputData%BlPitch) + LB(1:1) = lbound(SrcInputData%BlPitch, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%BlPitch, kind=B8Ki) if (.not. allocated(DstInputData%BlPitch)) then allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7232,8 +7232,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom if (allocated(SrcInputData%ExternalBlPitchCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) - UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) if (.not. allocated(DstInputData%ExternalBlPitchCom)) then allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7247,8 +7247,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac if (allocated(SrcInputData%ExternalBlAirfoilCom)) then - LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) - UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7259,8 +7259,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom end if if (allocated(SrcInputData%ExternalCableDeltaL)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) if (.not. allocated(DstInputData%ExternalCableDeltaL)) then allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7271,8 +7271,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL end if if (allocated(SrcInputData%ExternalCableDeltaLdot)) then - LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7307,8 +7307,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%LSShftFys = SrcInputData%LSShftFys DstInputData%LSShftFzs = SrcInputData%LSShftFzs if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC) - UB(1:1) = ubound(SrcInputData%fromSC) + LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) if (.not. allocated(DstInputData%fromSC)) then allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7319,8 +7319,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%fromSC = SrcInputData%fromSC end if if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob) - UB(1:1) = ubound(SrcInputData%fromSCglob) + LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) if (.not. allocated(DstInputData%fromSCglob)) then allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7331,8 +7331,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%fromSCglob = SrcInputData%fromSCglob end if if (allocated(SrcInputData%Lidar)) then - LB(1:1) = lbound(SrcInputData%Lidar) - UB(1:1) = ubound(SrcInputData%Lidar) + LB(1:1) = lbound(SrcInputData%Lidar, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%Lidar, kind=B8Ki) if (.not. allocated(DstInputData%Lidar)) then allocate(DstInputData%Lidar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7346,8 +7346,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%BStCMotionMesh)) then - LB(1:2) = lbound(SrcInputData%BStCMotionMesh) - UB(1:2) = ubound(SrcInputData%BStCMotionMesh) + LB(1:2) = lbound(SrcInputData%BStCMotionMesh, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh, kind=B8Ki) if (.not. allocated(DstInputData%BStCMotionMesh)) then allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7364,8 +7364,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%NStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%NStCMotionMesh) - UB(1:1) = ubound(SrcInputData%NStCMotionMesh) + LB(1:1) = lbound(SrcInputData%NStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh, kind=B8Ki) if (.not. allocated(DstInputData%NStCMotionMesh)) then allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7380,8 +7380,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%TStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%TStCMotionMesh) - UB(1:1) = ubound(SrcInputData%TStCMotionMesh) + LB(1:1) = lbound(SrcInputData%TStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh, kind=B8Ki) if (.not. allocated(DstInputData%TStCMotionMesh)) then allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7396,8 +7396,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%SStCMotionMesh)) then - LB(1:1) = lbound(SrcInputData%SStCMotionMesh) - UB(1:1) = ubound(SrcInputData%SStCMotionMesh) + LB(1:1) = lbound(SrcInputData%SStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh, kind=B8Ki) if (.not. allocated(DstInputData%SStCMotionMesh)) then allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7412,8 +7412,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInputData%LidSpeed) - UB(1:1) = ubound(SrcInputData%LidSpeed) + LB(1:1) = lbound(SrcInputData%LidSpeed, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%LidSpeed, kind=B8Ki) if (.not. allocated(DstInputData%LidSpeed)) then allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7424,8 +7424,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%LidSpeed = SrcInputData%LidSpeed end if if (allocated(SrcInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsX) - UB(1:1) = ubound(SrcInputData%MsrPositionsX) + LB(1:1) = lbound(SrcInputData%MsrPositionsX, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%MsrPositionsX, kind=B8Ki) if (.not. allocated(DstInputData%MsrPositionsX)) then allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7436,8 +7436,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX end if if (allocated(SrcInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsY) - UB(1:1) = ubound(SrcInputData%MsrPositionsY) + LB(1:1) = lbound(SrcInputData%MsrPositionsY, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%MsrPositionsY, kind=B8Ki) if (.not. allocated(DstInputData%MsrPositionsY)) then allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7448,8 +7448,8 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY end if if (allocated(SrcInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInputData%MsrPositionsZ) - UB(1:1) = ubound(SrcInputData%MsrPositionsZ) + LB(1:1) = lbound(SrcInputData%MsrPositionsZ, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ, kind=B8Ki) if (.not. allocated(DstInputData%MsrPositionsZ)) then allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7465,8 +7465,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) type(SrvD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyInput' @@ -7499,8 +7499,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%BStCMotionMesh)) then - LB(1:2) = lbound(InputData%BStCMotionMesh) - UB(1:2) = ubound(InputData%BStCMotionMesh) + LB(1:2) = lbound(InputData%BStCMotionMesh, kind=B8Ki) + UB(1:2) = ubound(InputData%BStCMotionMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) @@ -7510,8 +7510,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%BStCMotionMesh) end if if (allocated(InputData%NStCMotionMesh)) then - LB(1:1) = lbound(InputData%NStCMotionMesh) - UB(1:1) = ubound(InputData%NStCMotionMesh) + LB(1:1) = lbound(InputData%NStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%NStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7519,8 +7519,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%NStCMotionMesh) end if if (allocated(InputData%TStCMotionMesh)) then - LB(1:1) = lbound(InputData%TStCMotionMesh) - UB(1:1) = ubound(InputData%TStCMotionMesh) + LB(1:1) = lbound(InputData%TStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%TStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7528,8 +7528,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%TStCMotionMesh) end if if (allocated(InputData%SStCMotionMesh)) then - LB(1:1) = lbound(InputData%SStCMotionMesh) - UB(1:1) = ubound(InputData%SStCMotionMesh) + LB(1:1) = lbound(InputData%SStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InputData%SStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7554,12 +7554,12 @@ subroutine SrvD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) call RegPack(Buf, InData%BlPitch) end if call RegPack(Buf, InData%Yaw) @@ -7571,7 +7571,7 @@ subroutine SrvD_PackInput(Buf, Indata) call RegPack(Buf, InData%ExternalYawRateCom) call RegPack(Buf, allocated(InData%ExternalBlPitchCom)) if (allocated(InData%ExternalBlPitchCom)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom), ubound(InData%ExternalBlPitchCom)) + call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom, kind=B8Ki), ubound(InData%ExternalBlPitchCom, kind=B8Ki)) call RegPack(Buf, InData%ExternalBlPitchCom) end if call RegPack(Buf, InData%ExternalGenTrq) @@ -7579,17 +7579,17 @@ subroutine SrvD_PackInput(Buf, Indata) call RegPack(Buf, InData%ExternalHSSBrFrac) call RegPack(Buf, allocated(InData%ExternalBlAirfoilCom)) if (allocated(InData%ExternalBlAirfoilCom)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom), ubound(InData%ExternalBlAirfoilCom)) + call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom, kind=B8Ki), ubound(InData%ExternalBlAirfoilCom, kind=B8Ki)) call RegPack(Buf, InData%ExternalBlAirfoilCom) end if call RegPack(Buf, allocated(InData%ExternalCableDeltaL)) if (allocated(InData%ExternalCableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL), ubound(InData%ExternalCableDeltaL)) + call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL, kind=B8Ki), ubound(InData%ExternalCableDeltaL, kind=B8Ki)) call RegPack(Buf, InData%ExternalCableDeltaL) end if call RegPack(Buf, allocated(InData%ExternalCableDeltaLdot)) if (allocated(InData%ExternalCableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot), ubound(InData%ExternalCableDeltaLdot)) + call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot, kind=B8Ki), ubound(InData%ExternalCableDeltaLdot, kind=B8Ki)) call RegPack(Buf, InData%ExternalCableDeltaLdot) end if call RegPack(Buf, InData%TwrAccel) @@ -7618,25 +7618,25 @@ subroutine SrvD_PackInput(Buf, Indata) call RegPack(Buf, InData%LSShftFzs) call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPack(Buf, InData%fromSC) end if call RegPack(Buf, allocated(InData%fromSCglob)) if (allocated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) call RegPack(Buf, InData%fromSCglob) end if call RegPack(Buf, allocated(InData%Lidar)) if (allocated(InData%Lidar)) then - call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) + call RegPackBounds(Buf, 1, lbound(InData%Lidar, kind=B8Ki), ubound(InData%Lidar, kind=B8Ki)) call RegPack(Buf, InData%Lidar) end if call MeshPack(Buf, InData%PtfmMotionMesh) call RegPack(Buf, allocated(InData%BStCMotionMesh)) if (allocated(InData%BStCMotionMesh)) then - call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) - LB(1:2) = lbound(InData%BStCMotionMesh) - UB(1:2) = ubound(InData%BStCMotionMesh) + call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) + LB(1:2) = lbound(InData%BStCMotionMesh, kind=B8Ki) + UB(1:2) = ubound(InData%BStCMotionMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BStCMotionMesh(i1,i2)) @@ -7645,49 +7645,49 @@ subroutine SrvD_PackInput(Buf, Indata) end if call RegPack(Buf, allocated(InData%NStCMotionMesh)) if (allocated(InData%NStCMotionMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) - LB(1:1) = lbound(InData%NStCMotionMesh) - UB(1:1) = ubound(InData%NStCMotionMesh) + call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%NStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InData%NStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%NStCMotionMesh(i1)) end do end if call RegPack(Buf, allocated(InData%TStCMotionMesh)) if (allocated(InData%TStCMotionMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) - LB(1:1) = lbound(InData%TStCMotionMesh) - UB(1:1) = ubound(InData%TStCMotionMesh) + call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%TStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InData%TStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%TStCMotionMesh(i1)) end do end if call RegPack(Buf, allocated(InData%SStCMotionMesh)) if (allocated(InData%SStCMotionMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) - LB(1:1) = lbound(InData%SStCMotionMesh) - UB(1:1) = ubound(InData%SStCMotionMesh) + call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%SStCMotionMesh, kind=B8Ki) + UB(1:1) = ubound(InData%SStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%SStCMotionMesh(i1)) end do end if call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) call RegPack(Buf, InData%LidSpeed) end if call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsX) end if call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsY) end if call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) call RegPack(Buf, InData%MsrPositionsZ) end if if (RegCheckErr(Buf, RoutineName)) return @@ -7697,8 +7697,8 @@ subroutine SrvD_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -8009,16 +8009,16 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8029,8 +8029,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%BlPitchCom)) then - LB(1:1) = lbound(SrcOutputData%BlPitchCom) - UB(1:1) = ubound(SrcOutputData%BlPitchCom) + LB(1:1) = lbound(SrcOutputData%BlPitchCom, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BlPitchCom, kind=B8Ki) if (.not. allocated(DstOutputData%BlPitchCom)) then allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8041,8 +8041,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom end if if (allocated(SrcOutputData%BlAirfoilCom)) then - LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) - UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom, kind=B8Ki) if (.not. allocated(DstOutputData%BlAirfoilCom)) then allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8057,8 +8057,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC DstOutputData%ElecPwr = SrcOutputData%ElecPwr if (allocated(SrcOutputData%TBDrCon)) then - LB(1:1) = lbound(SrcOutputData%TBDrCon) - UB(1:1) = ubound(SrcOutputData%TBDrCon) + LB(1:1) = lbound(SrcOutputData%TBDrCon, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%TBDrCon, kind=B8Ki) if (.not. allocated(DstOutputData%TBDrCon)) then allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8069,8 +8069,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%TBDrCon = SrcOutputData%TBDrCon end if if (allocated(SrcOutputData%Lidar)) then - LB(1:1) = lbound(SrcOutputData%Lidar) - UB(1:1) = ubound(SrcOutputData%Lidar) + LB(1:1) = lbound(SrcOutputData%Lidar, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Lidar, kind=B8Ki) if (.not. allocated(DstOutputData%Lidar)) then allocate(DstOutputData%Lidar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8081,8 +8081,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Lidar = SrcOutputData%Lidar end if if (allocated(SrcOutputData%CableDeltaL)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaL) - UB(1:1) = ubound(SrcOutputData%CableDeltaL) + LB(1:1) = lbound(SrcOutputData%CableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%CableDeltaL, kind=B8Ki) if (.not. allocated(DstOutputData%CableDeltaL)) then allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8093,8 +8093,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL end if if (allocated(SrcOutputData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) - UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot, kind=B8Ki) if (.not. allocated(DstOutputData%CableDeltaLdot)) then allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8105,8 +8105,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot end if if (allocated(SrcOutputData%BStCLoadMesh)) then - LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) - UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh, kind=B8Ki) if (.not. allocated(DstOutputData%BStCLoadMesh)) then allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8123,8 +8123,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%NStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) - UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh, kind=B8Ki) if (.not. allocated(DstOutputData%NStCLoadMesh)) then allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8139,8 +8139,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%TStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) - UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh, kind=B8Ki) if (.not. allocated(DstOutputData%TStCLoadMesh)) then allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8155,8 +8155,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%SStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) - UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh, kind=B8Ki) if (.not. allocated(DstOutputData%SStCLoadMesh)) then allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8171,8 +8171,8 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC) - UB(1:1) = ubound(SrcOutputData%toSC) + LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) if (.not. allocated(DstOutputData%toSC)) then allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8188,8 +8188,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) type(SrvD_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' @@ -8217,8 +8217,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%CableDeltaLdot) end if if (allocated(OutputData%BStCLoadMesh)) then - LB(1:2) = lbound(OutputData%BStCLoadMesh) - UB(1:2) = ubound(OutputData%BStCLoadMesh) + LB(1:2) = lbound(OutputData%BStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(OutputData%BStCLoadMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) @@ -8228,8 +8228,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%BStCLoadMesh) end if if (allocated(OutputData%NStCLoadMesh)) then - LB(1:1) = lbound(OutputData%NStCLoadMesh) - UB(1:1) = ubound(OutputData%NStCLoadMesh) + LB(1:1) = lbound(OutputData%NStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%NStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8237,8 +8237,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%NStCLoadMesh) end if if (allocated(OutputData%TStCLoadMesh)) then - LB(1:1) = lbound(OutputData%TStCLoadMesh) - UB(1:1) = ubound(OutputData%TStCLoadMesh) + LB(1:1) = lbound(OutputData%TStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%TStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8246,8 +8246,8 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%TStCLoadMesh) end if if (allocated(OutputData%SStCLoadMesh)) then - LB(1:1) = lbound(OutputData%SStCLoadMesh) - UB(1:1) = ubound(OutputData%SStCLoadMesh) + LB(1:1) = lbound(OutputData%SStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%SStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8263,22 +8263,22 @@ subroutine SrvD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOutput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if call RegPack(Buf, allocated(InData%BlPitchCom)) if (allocated(InData%BlPitchCom)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) + call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom, kind=B8Ki), ubound(InData%BlPitchCom, kind=B8Ki)) call RegPack(Buf, InData%BlPitchCom) end if call RegPack(Buf, allocated(InData%BlAirfoilCom)) if (allocated(InData%BlAirfoilCom)) then - call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom), ubound(InData%BlAirfoilCom)) + call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom, kind=B8Ki), ubound(InData%BlAirfoilCom, kind=B8Ki)) call RegPack(Buf, InData%BlAirfoilCom) end if call RegPack(Buf, InData%YawMom) @@ -8287,29 +8287,29 @@ subroutine SrvD_PackOutput(Buf, Indata) call RegPack(Buf, InData%ElecPwr) call RegPack(Buf, allocated(InData%TBDrCon)) if (allocated(InData%TBDrCon)) then - call RegPackBounds(Buf, 1, lbound(InData%TBDrCon), ubound(InData%TBDrCon)) + call RegPackBounds(Buf, 1, lbound(InData%TBDrCon, kind=B8Ki), ubound(InData%TBDrCon, kind=B8Ki)) call RegPack(Buf, InData%TBDrCon) end if call RegPack(Buf, allocated(InData%Lidar)) if (allocated(InData%Lidar)) then - call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) + call RegPackBounds(Buf, 1, lbound(InData%Lidar, kind=B8Ki), ubound(InData%Lidar, kind=B8Ki)) call RegPack(Buf, InData%Lidar) end if call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL, kind=B8Ki), ubound(InData%CableDeltaL, kind=B8Ki)) call RegPack(Buf, InData%CableDeltaL) end if call RegPack(Buf, allocated(InData%CableDeltaLdot)) if (allocated(InData%CableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot, kind=B8Ki), ubound(InData%CableDeltaLdot, kind=B8Ki)) call RegPack(Buf, InData%CableDeltaLdot) end if call RegPack(Buf, allocated(InData%BStCLoadMesh)) if (allocated(InData%BStCLoadMesh)) then - call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) - LB(1:2) = lbound(InData%BStCLoadMesh) - UB(1:2) = ubound(InData%BStCLoadMesh) + call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) + LB(1:2) = lbound(InData%BStCLoadMesh, kind=B8Ki) + UB(1:2) = ubound(InData%BStCLoadMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%BStCLoadMesh(i1,i2)) @@ -8318,34 +8318,34 @@ subroutine SrvD_PackOutput(Buf, Indata) end if call RegPack(Buf, allocated(InData%NStCLoadMesh)) if (allocated(InData%NStCLoadMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) - LB(1:1) = lbound(InData%NStCLoadMesh) - UB(1:1) = ubound(InData%NStCLoadMesh) + call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%NStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(InData%NStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%NStCLoadMesh(i1)) end do end if call RegPack(Buf, allocated(InData%TStCLoadMesh)) if (allocated(InData%TStCLoadMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) - LB(1:1) = lbound(InData%TStCLoadMesh) - UB(1:1) = ubound(InData%TStCLoadMesh) + call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%TStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(InData%TStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%TStCLoadMesh(i1)) end do end if call RegPack(Buf, allocated(InData%SStCLoadMesh)) if (allocated(InData%SStCLoadMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) - LB(1:1) = lbound(InData%SStCLoadMesh) - UB(1:1) = ubound(InData%SStCLoadMesh) + call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) + LB(1:1) = lbound(InData%SStCLoadMesh, kind=B8Ki) + UB(1:1) = ubound(InData%SStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%SStCLoadMesh(i1)) end do end if call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) call RegPack(Buf, InData%toSC) end if if (RegCheckErr(Buf, RoutineName)) return @@ -8355,8 +8355,8 @@ subroutine SrvD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SrvD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -8644,7 +8644,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + DO i1 = LBOUND(u_out%BlPitch,1, kind=B8Ki),UBOUND(u_out%BlPitch,1, kind=B8Ki) CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -8656,7 +8656,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki),UBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki) CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -8708,27 +8708,27 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) + DO i2 = LBOUND(u_out%BStCMotionMesh,2, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,2, kind=B8Ki) + DO i1 = LBOUND(u_out%BStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) + DO i1 = LBOUND(u_out%NStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%NStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) + DO i1 = LBOUND(u_out%TStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%TStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) + DO i1 = LBOUND(u_out%SStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%SStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -8805,7 +8805,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + DO i1 = LBOUND(u_out%BlPitch,1, kind=B8Ki),UBOUND(u_out%BlPitch,1, kind=B8Ki) 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 @@ -8817,7 +8817,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + a3*u3%ExternalYawRateCom IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki),UBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki) 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 @@ -8869,27 +8869,27 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) + DO i2 = LBOUND(u_out%BStCMotionMesh,2, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,2, kind=B8Ki) + DO i1 = LBOUND(u_out%BStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) + DO i1 = LBOUND(u_out%NStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%NStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) + DO i1 = LBOUND(u_out%TStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%TStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) + DO i1 = LBOUND(u_out%SStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%SStCMotionMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -9011,7 +9011,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + DO i1 = LBOUND(y_out%BlPitchCom,1, kind=B8Ki),UBOUND(y_out%BlPitchCom,1, kind=B8Ki) CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -9035,27 +9035,27 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot END IF ! check if allocated IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) + DO i2 = LBOUND(y_out%BStCLoadMesh,2, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,2, kind=B8Ki) + DO i1 = LBOUND(y_out%BStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) + DO i1 = LBOUND(y_out%NStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%NStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) + DO i1 = LBOUND(y_out%TStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%TStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) + DO i1 = LBOUND(y_out%SStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%SStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -9126,7 +9126,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + DO i1 = LBOUND(y_out%BlPitchCom,1, kind=B8Ki),UBOUND(y_out%BlPitchCom,1, kind=B8Ki) 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 @@ -9150,27 +9150,27 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + a3*y3%CableDeltaLdot END IF ! check if allocated IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) + DO i2 = LBOUND(y_out%BStCLoadMesh,2, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,2, kind=B8Ki) + DO i1 = LBOUND(y_out%BStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) + DO i1 = LBOUND(y_out%NStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%NStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) + DO i1 = LBOUND(y_out%TStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%TStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) + DO i1 = LBOUND(y_out%SStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%SStCLoadMesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index ccff3fa523..61c5b1aa1c 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -256,7 +256,7 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyInputFile' ErrStat = ErrID_None @@ -323,8 +323,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE if (allocated(SrcInputFileData%F_TBL)) then - LB(1:2) = lbound(SrcInputFileData%F_TBL) - UB(1:2) = ubound(SrcInputFileData%F_TBL) + LB(1:2) = lbound(SrcInputFileData%F_TBL, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileData%F_TBL, kind=B8Ki) if (.not. allocated(DstInputFileData%F_TBL)) then allocate(DstInputFileData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -337,8 +337,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile if (allocated(SrcInputFileData%StC_PrescribedForce)) then - LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce) - UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce) + LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce, kind=B8Ki) + UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce, kind=B8Ki) if (.not. allocated(DstInputFileData%StC_PrescribedForce)) then allocate(DstInputFileData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -349,8 +349,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce end if if (allocated(SrcInputFileData%StC_CChan)) then - LB(1:1) = lbound(SrcInputFileData%StC_CChan) - UB(1:1) = ubound(SrcInputFileData%StC_CChan) + LB(1:1) = lbound(SrcInputFileData%StC_CChan, kind=B8Ki) + UB(1:1) = ubound(SrcInputFileData%StC_CChan, kind=B8Ki) if (.not. allocated(DstInputFileData%StC_CChan)) then allocate(DstInputFileData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -448,19 +448,19 @@ subroutine StC_PackInputFile(Buf, Indata) call RegPack(Buf, InData%StC_F_TBL_FILE) call RegPack(Buf, allocated(InData%F_TBL)) if (allocated(InData%F_TBL)) then - call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) + call RegPackBounds(Buf, 2, lbound(InData%F_TBL, kind=B8Ki), ubound(InData%F_TBL, kind=B8Ki)) call RegPack(Buf, InData%F_TBL) end if call RegPack(Buf, InData%PrescribedForcesCoordSys) call RegPack(Buf, InData%PrescribedForcesFile) call RegPack(Buf, allocated(InData%StC_PrescribedForce)) if (allocated(InData%StC_PrescribedForce)) then - call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) + call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce, kind=B8Ki), ubound(InData%StC_PrescribedForce, kind=B8Ki)) call RegPack(Buf, InData%StC_PrescribedForce) end if call RegPack(Buf, allocated(InData%StC_CChan)) if (allocated(InData%StC_CChan)) then - call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) + call RegPackBounds(Buf, 1, lbound(InData%StC_CChan, kind=B8Ki), ubound(InData%StC_CChan, kind=B8Ki)) call RegPack(Buf, InData%StC_CChan) end if if (RegCheckErr(Buf, RoutineName)) return @@ -470,7 +470,7 @@ subroutine StC_UnPackInputFile(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInputFile' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -650,7 +650,7 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyInitInput' @@ -661,8 +661,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts if (allocated(SrcInitInputData%InitRefPos)) then - LB(1:2) = lbound(SrcInitInputData%InitRefPos) - UB(1:2) = ubound(SrcInitInputData%InitRefPos) + LB(1:2) = lbound(SrcInitInputData%InitRefPos, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%InitRefPos, kind=B8Ki) if (.not. allocated(DstInitInputData%InitRefPos)) then allocate(DstInitInputData%InitRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -673,8 +673,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos end if if (allocated(SrcInitInputData%InitTransDisp)) then - LB(1:2) = lbound(SrcInitInputData%InitTransDisp) - UB(1:2) = ubound(SrcInitInputData%InitTransDisp) + LB(1:2) = lbound(SrcInitInputData%InitTransDisp, kind=B8Ki) + UB(1:2) = ubound(SrcInitInputData%InitTransDisp, kind=B8Ki) if (.not. allocated(DstInitInputData%InitTransDisp)) then allocate(DstInitInputData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -685,8 +685,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp end if if (allocated(SrcInitInputData%InitOrient)) then - LB(1:3) = lbound(SrcInitInputData%InitOrient) - UB(1:3) = ubound(SrcInitInputData%InitOrient) + LB(1:3) = lbound(SrcInitInputData%InitOrient, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%InitOrient, kind=B8Ki) if (.not. allocated(DstInitInputData%InitOrient)) then allocate(DstInitInputData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -697,8 +697,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitOrient = SrcInitInputData%InitOrient end if if (allocated(SrcInitInputData%InitRefOrient)) then - LB(1:3) = lbound(SrcInitInputData%InitRefOrient) - UB(1:3) = ubound(SrcInitInputData%InitRefOrient) + LB(1:3) = lbound(SrcInitInputData%InitRefOrient, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%InitRefOrient, kind=B8Ki) if (.not. allocated(DstInitInputData%InitRefOrient)) then allocate(DstInitInputData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -756,22 +756,22 @@ subroutine StC_PackInitInput(Buf, Indata) call RegPack(Buf, InData%NumMeshPts) call RegPack(Buf, allocated(InData%InitRefPos)) if (allocated(InData%InitRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%InitRefPos), ubound(InData%InitRefPos)) + call RegPackBounds(Buf, 2, lbound(InData%InitRefPos, kind=B8Ki), ubound(InData%InitRefPos, kind=B8Ki)) call RegPack(Buf, InData%InitRefPos) end if call RegPack(Buf, allocated(InData%InitTransDisp)) if (allocated(InData%InitTransDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp), ubound(InData%InitTransDisp)) + call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp, kind=B8Ki), ubound(InData%InitTransDisp, kind=B8Ki)) call RegPack(Buf, InData%InitTransDisp) end if call RegPack(Buf, allocated(InData%InitOrient)) if (allocated(InData%InitOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%InitOrient), ubound(InData%InitOrient)) + call RegPackBounds(Buf, 3, lbound(InData%InitOrient, kind=B8Ki), ubound(InData%InitOrient, kind=B8Ki)) call RegPack(Buf, InData%InitOrient) end if call RegPack(Buf, allocated(InData%InitRefOrient)) if (allocated(InData%InitRefOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient), ubound(InData%InitRefOrient)) + call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient, kind=B8Ki), ubound(InData%InitRefOrient, kind=B8Ki)) call RegPack(Buf, InData%InitRefOrient) end if call RegPack(Buf, InData%UseInputFile) @@ -785,7 +785,7 @@ subroutine StC_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -867,14 +867,14 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyCtrlChanInitInfoType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCtrlChanInitInfoTypeData%Requestor)) then - LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor) - UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor) + LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor, kind=B8Ki) + UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%Requestor)) then allocate(DstCtrlChanInitInfoTypeData%Requestor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -885,8 +885,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor end if if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff, kind=B8Ki) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then allocate(DstCtrlChanInitInfoTypeData%InitStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -897,8 +897,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff end if if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp, kind=B8Ki) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then allocate(DstCtrlChanInitInfoTypeData%InitDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -909,8 +909,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp end if if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake, kind=B8Ki) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then allocate(DstCtrlChanInitInfoTypeData%InitBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -921,8 +921,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake end if if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce, kind=B8Ki) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitForce)) then allocate(DstCtrlChanInitInfoTypeData%InitForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -933,8 +933,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp, kind=B8Ki) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then allocate(DstCtrlChanInitInfoTypeData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -945,8 +945,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel, kind=B8Ki) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel, kind=B8Ki) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then allocate(DstCtrlChanInitInfoTypeData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -995,37 +995,37 @@ subroutine StC_PackCtrlChanInitInfoType(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Requestor)) if (allocated(InData%Requestor)) then - call RegPackBounds(Buf, 1, lbound(InData%Requestor), ubound(InData%Requestor)) + call RegPackBounds(Buf, 1, lbound(InData%Requestor, kind=B8Ki), ubound(InData%Requestor, kind=B8Ki)) call RegPack(Buf, InData%Requestor) end if call RegPack(Buf, allocated(InData%InitStiff)) if (allocated(InData%InitStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%InitStiff), ubound(InData%InitStiff)) + call RegPackBounds(Buf, 2, lbound(InData%InitStiff, kind=B8Ki), ubound(InData%InitStiff, kind=B8Ki)) call RegPack(Buf, InData%InitStiff) end if call RegPack(Buf, allocated(InData%InitDamp)) if (allocated(InData%InitDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%InitDamp), ubound(InData%InitDamp)) + call RegPackBounds(Buf, 2, lbound(InData%InitDamp, kind=B8Ki), ubound(InData%InitDamp, kind=B8Ki)) call RegPack(Buf, InData%InitDamp) end if call RegPack(Buf, allocated(InData%InitBrake)) if (allocated(InData%InitBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%InitBrake), ubound(InData%InitBrake)) + call RegPackBounds(Buf, 2, lbound(InData%InitBrake, kind=B8Ki), ubound(InData%InitBrake, kind=B8Ki)) call RegPack(Buf, InData%InitBrake) end if call RegPack(Buf, allocated(InData%InitForce)) if (allocated(InData%InitForce)) then - call RegPackBounds(Buf, 2, lbound(InData%InitForce), ubound(InData%InitForce)) + call RegPackBounds(Buf, 2, lbound(InData%InitForce, kind=B8Ki), ubound(InData%InitForce, kind=B8Ki)) call RegPack(Buf, InData%InitForce) end if call RegPack(Buf, allocated(InData%InitMeasDisp)) if (allocated(InData%InitMeasDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp), ubound(InData%InitMeasDisp)) + call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp, kind=B8Ki), ubound(InData%InitMeasDisp, kind=B8Ki)) call RegPack(Buf, InData%InitMeasDisp) end if call RegPack(Buf, allocated(InData%InitMeasVel)) if (allocated(InData%InitMeasVel)) then - call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel), ubound(InData%InitMeasVel)) + call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel, kind=B8Ki), ubound(InData%InitMeasVel, kind=B8Ki)) call RegPack(Buf, InData%InitMeasVel) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1035,7 +1035,7 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_CtrlChanInitInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1145,14 +1145,14 @@ subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%RelPosition)) then - LB(1:2) = lbound(SrcInitOutputData%RelPosition) - UB(1:2) = ubound(SrcInitOutputData%RelPosition) + LB(1:2) = lbound(SrcInitOutputData%RelPosition, kind=B8Ki) + UB(1:2) = ubound(SrcInitOutputData%RelPosition, kind=B8Ki) if (.not. allocated(DstInitOutputData%RelPosition)) then allocate(DstInitOutputData%RelPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1183,7 +1183,7 @@ subroutine StC_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%RelPosition)) if (allocated(InData%RelPosition)) then - call RegPackBounds(Buf, 2, lbound(InData%RelPosition), ubound(InData%RelPosition)) + call RegPackBounds(Buf, 2, lbound(InData%RelPosition, kind=B8Ki), ubound(InData%RelPosition, kind=B8Ki)) call RegPack(Buf, InData%RelPosition) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1193,7 +1193,7 @@ subroutine StC_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1219,14 +1219,14 @@ subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%StC_x)) then - LB(1:2) = lbound(SrcContStateData%StC_x) - UB(1:2) = ubound(SrcContStateData%StC_x) + LB(1:2) = lbound(SrcContStateData%StC_x, kind=B8Ki) + UB(1:2) = ubound(SrcContStateData%StC_x, kind=B8Ki) if (.not. allocated(DstContStateData%StC_x)) then allocate(DstContStateData%StC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1257,7 +1257,7 @@ subroutine StC_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%StC_x)) if (allocated(InData%StC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%StC_x), ubound(InData%StC_x)) + call RegPackBounds(Buf, 2, lbound(InData%StC_x, kind=B8Ki), ubound(InData%StC_x, kind=B8Ki)) call RegPack(Buf, InData%StC_x) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1267,7 +1267,7 @@ subroutine StC_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackContState' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1410,14 +1410,14 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%F_stop)) then - LB(1:2) = lbound(SrcMiscData%F_stop) - UB(1:2) = ubound(SrcMiscData%F_stop) + LB(1:2) = lbound(SrcMiscData%F_stop, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_stop, kind=B8Ki) if (.not. allocated(DstMiscData%F_stop)) then allocate(DstMiscData%F_stop(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1428,8 +1428,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_stop = SrcMiscData%F_stop end if if (allocated(SrcMiscData%F_ext)) then - LB(1:2) = lbound(SrcMiscData%F_ext) - UB(1:2) = ubound(SrcMiscData%F_ext) + LB(1:2) = lbound(SrcMiscData%F_ext, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_ext, kind=B8Ki) if (.not. allocated(DstMiscData%F_ext)) then allocate(DstMiscData%F_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1440,8 +1440,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_ext = SrcMiscData%F_ext end if if (allocated(SrcMiscData%F_fr)) then - LB(1:2) = lbound(SrcMiscData%F_fr) - UB(1:2) = ubound(SrcMiscData%F_fr) + LB(1:2) = lbound(SrcMiscData%F_fr, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_fr, kind=B8Ki) if (.not. allocated(DstMiscData%F_fr)) then allocate(DstMiscData%F_fr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1452,8 +1452,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_fr = SrcMiscData%F_fr end if if (allocated(SrcMiscData%K)) then - LB(1:2) = lbound(SrcMiscData%K) - UB(1:2) = ubound(SrcMiscData%K) + LB(1:2) = lbound(SrcMiscData%K, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%K, kind=B8Ki) if (.not. allocated(DstMiscData%K)) then allocate(DstMiscData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1464,8 +1464,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%K = SrcMiscData%K end if if (allocated(SrcMiscData%C_ctrl)) then - LB(1:2) = lbound(SrcMiscData%C_ctrl) - UB(1:2) = ubound(SrcMiscData%C_ctrl) + LB(1:2) = lbound(SrcMiscData%C_ctrl, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%C_ctrl, kind=B8Ki) if (.not. allocated(DstMiscData%C_ctrl)) then allocate(DstMiscData%C_ctrl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1476,8 +1476,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%C_ctrl = SrcMiscData%C_ctrl end if if (allocated(SrcMiscData%C_Brake)) then - LB(1:2) = lbound(SrcMiscData%C_Brake) - UB(1:2) = ubound(SrcMiscData%C_Brake) + LB(1:2) = lbound(SrcMiscData%C_Brake, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%C_Brake, kind=B8Ki) if (.not. allocated(DstMiscData%C_Brake)) then allocate(DstMiscData%C_Brake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1488,8 +1488,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%C_Brake = SrcMiscData%C_Brake end if if (allocated(SrcMiscData%F_table)) then - LB(1:2) = lbound(SrcMiscData%F_table) - UB(1:2) = ubound(SrcMiscData%F_table) + LB(1:2) = lbound(SrcMiscData%F_table, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_table, kind=B8Ki) if (.not. allocated(DstMiscData%F_table)) then allocate(DstMiscData%F_table(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1500,8 +1500,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_table = SrcMiscData%F_table end if if (allocated(SrcMiscData%F_k)) then - LB(1:2) = lbound(SrcMiscData%F_k) - UB(1:2) = ubound(SrcMiscData%F_k) + LB(1:2) = lbound(SrcMiscData%F_k, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_k, kind=B8Ki) if (.not. allocated(DstMiscData%F_k)) then allocate(DstMiscData%F_k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1512,8 +1512,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_k = SrcMiscData%F_k end if if (allocated(SrcMiscData%a_G)) then - LB(1:2) = lbound(SrcMiscData%a_G) - UB(1:2) = ubound(SrcMiscData%a_G) + LB(1:2) = lbound(SrcMiscData%a_G, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%a_G, kind=B8Ki) if (.not. allocated(DstMiscData%a_G)) then allocate(DstMiscData%a_G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1524,8 +1524,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%a_G = SrcMiscData%a_G end if if (allocated(SrcMiscData%rdisp_P)) then - LB(1:2) = lbound(SrcMiscData%rdisp_P) - UB(1:2) = ubound(SrcMiscData%rdisp_P) + LB(1:2) = lbound(SrcMiscData%rdisp_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%rdisp_P, kind=B8Ki) if (.not. allocated(DstMiscData%rdisp_P)) then allocate(DstMiscData%rdisp_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1536,8 +1536,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rdisp_P = SrcMiscData%rdisp_P end if if (allocated(SrcMiscData%rdot_P)) then - LB(1:2) = lbound(SrcMiscData%rdot_P) - UB(1:2) = ubound(SrcMiscData%rdot_P) + LB(1:2) = lbound(SrcMiscData%rdot_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%rdot_P, kind=B8Ki) if (.not. allocated(DstMiscData%rdot_P)) then allocate(DstMiscData%rdot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1548,8 +1548,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rdot_P = SrcMiscData%rdot_P end if if (allocated(SrcMiscData%rddot_P)) then - LB(1:2) = lbound(SrcMiscData%rddot_P) - UB(1:2) = ubound(SrcMiscData%rddot_P) + LB(1:2) = lbound(SrcMiscData%rddot_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%rddot_P, kind=B8Ki) if (.not. allocated(DstMiscData%rddot_P)) then allocate(DstMiscData%rddot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1560,8 +1560,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rddot_P = SrcMiscData%rddot_P end if if (allocated(SrcMiscData%omega_P)) then - LB(1:2) = lbound(SrcMiscData%omega_P) - UB(1:2) = ubound(SrcMiscData%omega_P) + LB(1:2) = lbound(SrcMiscData%omega_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%omega_P, kind=B8Ki) if (.not. allocated(DstMiscData%omega_P)) then allocate(DstMiscData%omega_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1572,8 +1572,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%omega_P = SrcMiscData%omega_P end if if (allocated(SrcMiscData%alpha_P)) then - LB(1:2) = lbound(SrcMiscData%alpha_P) - UB(1:2) = ubound(SrcMiscData%alpha_P) + LB(1:2) = lbound(SrcMiscData%alpha_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%alpha_P, kind=B8Ki) if (.not. allocated(DstMiscData%alpha_P)) then allocate(DstMiscData%alpha_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1584,8 +1584,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%alpha_P = SrcMiscData%alpha_P end if if (allocated(SrcMiscData%F_P)) then - LB(1:2) = lbound(SrcMiscData%F_P) - UB(1:2) = ubound(SrcMiscData%F_P) + LB(1:2) = lbound(SrcMiscData%F_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%F_P, kind=B8Ki) if (.not. allocated(DstMiscData%F_P)) then allocate(DstMiscData%F_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1596,8 +1596,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_P = SrcMiscData%F_P end if if (allocated(SrcMiscData%M_P)) then - LB(1:2) = lbound(SrcMiscData%M_P) - UB(1:2) = ubound(SrcMiscData%M_P) + LB(1:2) = lbound(SrcMiscData%M_P, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%M_P, kind=B8Ki) if (.not. allocated(DstMiscData%M_P)) then allocate(DstMiscData%M_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1608,8 +1608,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%M_P = SrcMiscData%M_P end if if (allocated(SrcMiscData%Acc)) then - LB(1:2) = lbound(SrcMiscData%Acc) - UB(1:2) = ubound(SrcMiscData%Acc) + LB(1:2) = lbound(SrcMiscData%Acc, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%Acc, kind=B8Ki) if (.not. allocated(DstMiscData%Acc)) then allocate(DstMiscData%Acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1689,87 +1689,87 @@ subroutine StC_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%F_stop)) if (allocated(InData%F_stop)) then - call RegPackBounds(Buf, 2, lbound(InData%F_stop), ubound(InData%F_stop)) + call RegPackBounds(Buf, 2, lbound(InData%F_stop, kind=B8Ki), ubound(InData%F_stop, kind=B8Ki)) call RegPack(Buf, InData%F_stop) end if call RegPack(Buf, allocated(InData%F_ext)) if (allocated(InData%F_ext)) then - call RegPackBounds(Buf, 2, lbound(InData%F_ext), ubound(InData%F_ext)) + call RegPackBounds(Buf, 2, lbound(InData%F_ext, kind=B8Ki), ubound(InData%F_ext, kind=B8Ki)) call RegPack(Buf, InData%F_ext) end if call RegPack(Buf, allocated(InData%F_fr)) if (allocated(InData%F_fr)) then - call RegPackBounds(Buf, 2, lbound(InData%F_fr), ubound(InData%F_fr)) + call RegPackBounds(Buf, 2, lbound(InData%F_fr, kind=B8Ki), ubound(InData%F_fr, kind=B8Ki)) call RegPack(Buf, InData%F_fr) end if call RegPack(Buf, allocated(InData%K)) if (allocated(InData%K)) then - call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) + call RegPackBounds(Buf, 2, lbound(InData%K, kind=B8Ki), ubound(InData%K, kind=B8Ki)) call RegPack(Buf, InData%K) end if call RegPack(Buf, allocated(InData%C_ctrl)) if (allocated(InData%C_ctrl)) then - call RegPackBounds(Buf, 2, lbound(InData%C_ctrl), ubound(InData%C_ctrl)) + call RegPackBounds(Buf, 2, lbound(InData%C_ctrl, kind=B8Ki), ubound(InData%C_ctrl, kind=B8Ki)) call RegPack(Buf, InData%C_ctrl) end if call RegPack(Buf, allocated(InData%C_Brake)) if (allocated(InData%C_Brake)) then - call RegPackBounds(Buf, 2, lbound(InData%C_Brake), ubound(InData%C_Brake)) + call RegPackBounds(Buf, 2, lbound(InData%C_Brake, kind=B8Ki), ubound(InData%C_Brake, kind=B8Ki)) call RegPack(Buf, InData%C_Brake) end if call RegPack(Buf, allocated(InData%F_table)) if (allocated(InData%F_table)) then - call RegPackBounds(Buf, 2, lbound(InData%F_table), ubound(InData%F_table)) + call RegPackBounds(Buf, 2, lbound(InData%F_table, kind=B8Ki), ubound(InData%F_table, kind=B8Ki)) call RegPack(Buf, InData%F_table) end if call RegPack(Buf, allocated(InData%F_k)) if (allocated(InData%F_k)) then - call RegPackBounds(Buf, 2, lbound(InData%F_k), ubound(InData%F_k)) + call RegPackBounds(Buf, 2, lbound(InData%F_k, kind=B8Ki), ubound(InData%F_k, kind=B8Ki)) call RegPack(Buf, InData%F_k) end if call RegPack(Buf, allocated(InData%a_G)) if (allocated(InData%a_G)) then - call RegPackBounds(Buf, 2, lbound(InData%a_G), ubound(InData%a_G)) + call RegPackBounds(Buf, 2, lbound(InData%a_G, kind=B8Ki), ubound(InData%a_G, kind=B8Ki)) call RegPack(Buf, InData%a_G) end if call RegPack(Buf, allocated(InData%rdisp_P)) if (allocated(InData%rdisp_P)) then - call RegPackBounds(Buf, 2, lbound(InData%rdisp_P), ubound(InData%rdisp_P)) + call RegPackBounds(Buf, 2, lbound(InData%rdisp_P, kind=B8Ki), ubound(InData%rdisp_P, kind=B8Ki)) call RegPack(Buf, InData%rdisp_P) end if call RegPack(Buf, allocated(InData%rdot_P)) if (allocated(InData%rdot_P)) then - call RegPackBounds(Buf, 2, lbound(InData%rdot_P), ubound(InData%rdot_P)) + call RegPackBounds(Buf, 2, lbound(InData%rdot_P, kind=B8Ki), ubound(InData%rdot_P, kind=B8Ki)) call RegPack(Buf, InData%rdot_P) end if call RegPack(Buf, allocated(InData%rddot_P)) if (allocated(InData%rddot_P)) then - call RegPackBounds(Buf, 2, lbound(InData%rddot_P), ubound(InData%rddot_P)) + call RegPackBounds(Buf, 2, lbound(InData%rddot_P, kind=B8Ki), ubound(InData%rddot_P, kind=B8Ki)) call RegPack(Buf, InData%rddot_P) end if call RegPack(Buf, allocated(InData%omega_P)) if (allocated(InData%omega_P)) then - call RegPackBounds(Buf, 2, lbound(InData%omega_P), ubound(InData%omega_P)) + call RegPackBounds(Buf, 2, lbound(InData%omega_P, kind=B8Ki), ubound(InData%omega_P, kind=B8Ki)) call RegPack(Buf, InData%omega_P) end if call RegPack(Buf, allocated(InData%alpha_P)) if (allocated(InData%alpha_P)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_P), ubound(InData%alpha_P)) + call RegPackBounds(Buf, 2, lbound(InData%alpha_P, kind=B8Ki), ubound(InData%alpha_P, kind=B8Ki)) call RegPack(Buf, InData%alpha_P) end if call RegPack(Buf, allocated(InData%F_P)) if (allocated(InData%F_P)) then - call RegPackBounds(Buf, 2, lbound(InData%F_P), ubound(InData%F_P)) + call RegPackBounds(Buf, 2, lbound(InData%F_P, kind=B8Ki), ubound(InData%F_P, kind=B8Ki)) call RegPack(Buf, InData%F_P) end if call RegPack(Buf, allocated(InData%M_P)) if (allocated(InData%M_P)) then - call RegPackBounds(Buf, 2, lbound(InData%M_P), ubound(InData%M_P)) + call RegPackBounds(Buf, 2, lbound(InData%M_P, kind=B8Ki), ubound(InData%M_P, kind=B8Ki)) call RegPack(Buf, InData%M_P) end if call RegPack(Buf, allocated(InData%Acc)) if (allocated(InData%Acc)) then - call RegPackBounds(Buf, 2, lbound(InData%Acc), ubound(InData%Acc)) + call RegPackBounds(Buf, 2, lbound(InData%Acc, kind=B8Ki), ubound(InData%Acc, kind=B8Ki)) call RegPack(Buf, InData%Acc) end if call RegPack(Buf, InData%PrescribedInterpIdx) @@ -1780,7 +1780,7 @@ subroutine StC_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackMisc' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2032,7 +2032,7 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyParam' ErrStat = ErrID_None @@ -2084,8 +2084,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rho_Y = SrcParamData%rho_Y DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL if (allocated(SrcParamData%F_TBL)) then - LB(1:2) = lbound(SrcParamData%F_TBL) - UB(1:2) = ubound(SrcParamData%F_TBL) + LB(1:2) = lbound(SrcParamData%F_TBL, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%F_TBL, kind=B8Ki) if (.not. allocated(DstParamData%F_TBL)) then allocate(DstParamData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2098,8 +2098,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumMeshPts = SrcParamData%NumMeshPts DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys if (allocated(SrcParamData%StC_PrescribedForce)) then - LB(1:2) = lbound(SrcParamData%StC_PrescribedForce) - UB(1:2) = ubound(SrcParamData%StC_PrescribedForce) + LB(1:2) = lbound(SrcParamData%StC_PrescribedForce, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%StC_PrescribedForce, kind=B8Ki) if (.not. allocated(DstParamData%StC_PrescribedForce)) then allocate(DstParamData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2110,8 +2110,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce end if if (allocated(SrcParamData%StC_CChan)) then - LB(1:1) = lbound(SrcParamData%StC_CChan) - UB(1:1) = ubound(SrcParamData%StC_CChan) + LB(1:1) = lbound(SrcParamData%StC_CChan, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%StC_CChan, kind=B8Ki) if (.not. allocated(DstParamData%StC_CChan)) then allocate(DstParamData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2194,19 +2194,19 @@ subroutine StC_PackParam(Buf, Indata) call RegPack(Buf, InData%Use_F_TBL) call RegPack(Buf, allocated(InData%F_TBL)) if (allocated(InData%F_TBL)) then - call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) + call RegPackBounds(Buf, 2, lbound(InData%F_TBL, kind=B8Ki), ubound(InData%F_TBL, kind=B8Ki)) call RegPack(Buf, InData%F_TBL) end if call RegPack(Buf, InData%NumMeshPts) call RegPack(Buf, InData%PrescribedForcesCoordSys) call RegPack(Buf, allocated(InData%StC_PrescribedForce)) if (allocated(InData%StC_PrescribedForce)) then - call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) + call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce, kind=B8Ki), ubound(InData%StC_PrescribedForce, kind=B8Ki)) call RegPack(Buf, InData%StC_PrescribedForce) end if call RegPack(Buf, allocated(InData%StC_CChan)) if (allocated(InData%StC_CChan)) then - call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) + call RegPackBounds(Buf, 1, lbound(InData%StC_CChan, kind=B8Ki), ubound(InData%StC_CChan, kind=B8Ki)) call RegPack(Buf, InData%StC_CChan) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2216,7 +2216,7 @@ subroutine StC_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackParam' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2366,16 +2366,16 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Mesh)) then - LB(1:1) = lbound(SrcInputData%Mesh) - UB(1:1) = ubound(SrcInputData%Mesh) + LB(1:1) = lbound(SrcInputData%Mesh, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%Mesh, kind=B8Ki) if (.not. allocated(DstInputData%Mesh)) then allocate(DstInputData%Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2390,8 +2390,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%CmdStiff)) then - LB(1:2) = lbound(SrcInputData%CmdStiff) - UB(1:2) = ubound(SrcInputData%CmdStiff) + LB(1:2) = lbound(SrcInputData%CmdStiff, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%CmdStiff, kind=B8Ki) if (.not. allocated(DstInputData%CmdStiff)) then allocate(DstInputData%CmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2402,8 +2402,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdStiff = SrcInputData%CmdStiff end if if (allocated(SrcInputData%CmdDamp)) then - LB(1:2) = lbound(SrcInputData%CmdDamp) - UB(1:2) = ubound(SrcInputData%CmdDamp) + LB(1:2) = lbound(SrcInputData%CmdDamp, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%CmdDamp, kind=B8Ki) if (.not. allocated(DstInputData%CmdDamp)) then allocate(DstInputData%CmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2414,8 +2414,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdDamp = SrcInputData%CmdDamp end if if (allocated(SrcInputData%CmdBrake)) then - LB(1:2) = lbound(SrcInputData%CmdBrake) - UB(1:2) = ubound(SrcInputData%CmdBrake) + LB(1:2) = lbound(SrcInputData%CmdBrake, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%CmdBrake, kind=B8Ki) if (.not. allocated(DstInputData%CmdBrake)) then allocate(DstInputData%CmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2426,8 +2426,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdBrake = SrcInputData%CmdBrake end if if (allocated(SrcInputData%CmdForce)) then - LB(1:2) = lbound(SrcInputData%CmdForce) - UB(1:2) = ubound(SrcInputData%CmdForce) + LB(1:2) = lbound(SrcInputData%CmdForce, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%CmdForce, kind=B8Ki) if (.not. allocated(DstInputData%CmdForce)) then allocate(DstInputData%CmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2443,16 +2443,16 @@ subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) type(StC_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%Mesh)) then - LB(1:1) = lbound(InputData%Mesh) - UB(1:1) = ubound(InputData%Mesh) + LB(1:1) = lbound(InputData%Mesh, kind=B8Ki) + UB(1:1) = ubound(InputData%Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2477,36 +2477,36 @@ subroutine StC_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) - LB(1:1) = lbound(InData%Mesh) - UB(1:1) = ubound(InData%Mesh) + call RegPackBounds(Buf, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) + LB(1:1) = lbound(InData%Mesh, kind=B8Ki) + UB(1:1) = ubound(InData%Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%Mesh(i1)) end do end if call RegPack(Buf, allocated(InData%CmdStiff)) if (allocated(InData%CmdStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdStiff), ubound(InData%CmdStiff)) + call RegPackBounds(Buf, 2, lbound(InData%CmdStiff, kind=B8Ki), ubound(InData%CmdStiff, kind=B8Ki)) call RegPack(Buf, InData%CmdStiff) end if call RegPack(Buf, allocated(InData%CmdDamp)) if (allocated(InData%CmdDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdDamp), ubound(InData%CmdDamp)) + call RegPackBounds(Buf, 2, lbound(InData%CmdDamp, kind=B8Ki), ubound(InData%CmdDamp, kind=B8Ki)) call RegPack(Buf, InData%CmdDamp) end if call RegPack(Buf, allocated(InData%CmdBrake)) if (allocated(InData%CmdBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdBrake), ubound(InData%CmdBrake)) + call RegPackBounds(Buf, 2, lbound(InData%CmdBrake, kind=B8Ki), ubound(InData%CmdBrake, kind=B8Ki)) call RegPack(Buf, InData%CmdBrake) end if call RegPack(Buf, allocated(InData%CmdForce)) if (allocated(InData%CmdForce)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdForce), ubound(InData%CmdForce)) + call RegPackBounds(Buf, 2, lbound(InData%CmdForce, kind=B8Ki), ubound(InData%CmdForce, kind=B8Ki)) call RegPack(Buf, InData%CmdForce) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2516,8 +2516,8 @@ subroutine StC_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2600,16 +2600,16 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Mesh)) then - LB(1:1) = lbound(SrcOutputData%Mesh) - UB(1:1) = ubound(SrcOutputData%Mesh) + LB(1:1) = lbound(SrcOutputData%Mesh, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%Mesh, kind=B8Ki) if (.not. allocated(DstOutputData%Mesh)) then allocate(DstOutputData%Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2624,8 +2624,8 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end do end if if (allocated(SrcOutputData%MeasDisp)) then - LB(1:2) = lbound(SrcOutputData%MeasDisp) - UB(1:2) = ubound(SrcOutputData%MeasDisp) + LB(1:2) = lbound(SrcOutputData%MeasDisp, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%MeasDisp, kind=B8Ki) if (.not. allocated(DstOutputData%MeasDisp)) then allocate(DstOutputData%MeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2636,8 +2636,8 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%MeasDisp = SrcOutputData%MeasDisp end if if (allocated(SrcOutputData%MeasVel)) then - LB(1:2) = lbound(SrcOutputData%MeasVel) - UB(1:2) = ubound(SrcOutputData%MeasVel) + LB(1:2) = lbound(SrcOutputData%MeasVel, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%MeasVel, kind=B8Ki) if (.not. allocated(DstOutputData%MeasVel)) then allocate(DstOutputData%MeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2653,16 +2653,16 @@ subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) type(StC_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%Mesh)) then - LB(1:1) = lbound(OutputData%Mesh) - UB(1:1) = ubound(OutputData%Mesh) + LB(1:1) = lbound(OutputData%Mesh, kind=B8Ki) + UB(1:1) = ubound(OutputData%Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2681,26 +2681,26 @@ subroutine StC_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackOutput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) - LB(1:1) = lbound(InData%Mesh) - UB(1:1) = ubound(InData%Mesh) + call RegPackBounds(Buf, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) + LB(1:1) = lbound(InData%Mesh, kind=B8Ki) + UB(1:1) = ubound(InData%Mesh, kind=B8Ki) do i1 = LB(1), UB(1) call MeshPack(Buf, InData%Mesh(i1)) end do end if call RegPack(Buf, allocated(InData%MeasDisp)) if (allocated(InData%MeasDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%MeasDisp), ubound(InData%MeasDisp)) + call RegPackBounds(Buf, 2, lbound(InData%MeasDisp, kind=B8Ki), ubound(InData%MeasDisp, kind=B8Ki)) call RegPack(Buf, InData%MeasDisp) end if call RegPack(Buf, allocated(InData%MeasVel)) if (allocated(InData%MeasVel)) then - call RegPackBounds(Buf, 2, lbound(InData%MeasVel), ubound(InData%MeasVel)) + call RegPackBounds(Buf, 2, lbound(InData%MeasVel, kind=B8Ki), ubound(InData%MeasVel, kind=B8Ki)) call RegPack(Buf, InData%MeasVel) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2710,8 +2710,8 @@ subroutine StC_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(StC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackOutput' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2860,7 +2860,7 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) + DO i1 = LBOUND(u_out%Mesh,1, kind=B8Ki),UBOUND(u_out%Mesh,1, kind=B8Ki) CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2937,7 +2937,7 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) + DO i1 = LBOUND(u_out%Mesh,1, kind=B8Ki),UBOUND(u_out%Mesh,1, kind=B8Ki) CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -3056,7 +3056,7 @@ SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) + DO i1 = LBOUND(y_out%Mesh,1, kind=B8Ki),UBOUND(y_out%Mesh,1, kind=B8Ki) CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -3127,7 +3127,7 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) + DO i1 = LBOUND(y_out%Mesh,1, kind=B8Ki),UBOUND(y_out%Mesh,1, kind=B8Ki) CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 96a79aae0c..f8f683f430 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -349,14 +349,14 @@ subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyIList' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIListData%List)) then - LB(1:1) = lbound(SrcIListData%List) - UB(1:1) = ubound(SrcIListData%List) + LB(1:1) = lbound(SrcIListData%List, kind=B8Ki) + UB(1:1) = ubound(SrcIListData%List, kind=B8Ki) if (.not. allocated(DstIListData%List)) then allocate(DstIListData%List(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -387,7 +387,7 @@ subroutine SD_PackIList(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%List)) if (allocated(InData%List)) then - call RegPackBounds(Buf, 1, lbound(InData%List), ubound(InData%List)) + call RegPackBounds(Buf, 1, lbound(InData%List, kind=B8Ki), ubound(InData%List, kind=B8Ki)) call RegPack(Buf, InData%List) end if if (RegCheckErr(Buf, RoutineName)) return @@ -397,7 +397,7 @@ subroutine SD_UnPackIList(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(IList), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackIList' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -423,7 +423,7 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyMeshAuxDataType' ErrStat = ErrID_None @@ -431,8 +431,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt if (allocated(SrcMeshAuxDataTypeData%NodeCnt)) then - LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt) - UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt) + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt, kind=B8Ki) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%NodeCnt)) then allocate(DstMeshAuxDataTypeData%NodeCnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -443,8 +443,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt end if if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then - LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) - UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs) + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs, kind=B8Ki) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%NodeIDs)) then allocate(DstMeshAuxDataTypeData%NodeIDs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -455,8 +455,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs end if if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then - LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) - UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs) + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs, kind=B8Ki) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%ElmIDs)) then allocate(DstMeshAuxDataTypeData%ElmIDs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -467,8 +467,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs end if if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then - LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) - UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds) + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds, kind=B8Ki) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%ElmNds)) then allocate(DstMeshAuxDataTypeData%ElmNds(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -479,8 +479,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds end if if (allocated(SrcMeshAuxDataTypeData%Me)) then - LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) - UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me) + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me, kind=B8Ki) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%Me)) then allocate(DstMeshAuxDataTypeData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -491,8 +491,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me end if if (allocated(SrcMeshAuxDataTypeData%Ke)) then - LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) - UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke) + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke, kind=B8Ki) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%Ke)) then allocate(DstMeshAuxDataTypeData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -503,8 +503,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke end if if (allocated(SrcMeshAuxDataTypeData%Fg)) then - LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) - UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg) + LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg, kind=B8Ki) + UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg, kind=B8Ki) if (.not. allocated(DstMeshAuxDataTypeData%Fg)) then allocate(DstMeshAuxDataTypeData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -555,37 +555,37 @@ subroutine SD_PackMeshAuxDataType(Buf, Indata) call RegPack(Buf, InData%NOutCnt) call RegPack(Buf, allocated(InData%NodeCnt)) if (allocated(InData%NodeCnt)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeCnt), ubound(InData%NodeCnt)) + call RegPackBounds(Buf, 1, lbound(InData%NodeCnt, kind=B8Ki), ubound(InData%NodeCnt, kind=B8Ki)) call RegPack(Buf, InData%NodeCnt) end if call RegPack(Buf, allocated(InData%NodeIDs)) if (allocated(InData%NodeIDs)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeIDs), ubound(InData%NodeIDs)) + call RegPackBounds(Buf, 1, lbound(InData%NodeIDs, kind=B8Ki), ubound(InData%NodeIDs, kind=B8Ki)) call RegPack(Buf, InData%NodeIDs) end if call RegPack(Buf, allocated(InData%ElmIDs)) if (allocated(InData%ElmIDs)) then - call RegPackBounds(Buf, 2, lbound(InData%ElmIDs), ubound(InData%ElmIDs)) + call RegPackBounds(Buf, 2, lbound(InData%ElmIDs, kind=B8Ki), ubound(InData%ElmIDs, kind=B8Ki)) call RegPack(Buf, InData%ElmIDs) end if call RegPack(Buf, allocated(InData%ElmNds)) if (allocated(InData%ElmNds)) then - call RegPackBounds(Buf, 2, lbound(InData%ElmNds), ubound(InData%ElmNds)) + call RegPackBounds(Buf, 2, lbound(InData%ElmNds, kind=B8Ki), ubound(InData%ElmNds, kind=B8Ki)) call RegPack(Buf, InData%ElmNds) end if call RegPack(Buf, allocated(InData%Me)) if (allocated(InData%Me)) then - call RegPackBounds(Buf, 4, lbound(InData%Me), ubound(InData%Me)) + call RegPackBounds(Buf, 4, lbound(InData%Me, kind=B8Ki), ubound(InData%Me, kind=B8Ki)) call RegPack(Buf, InData%Me) end if call RegPack(Buf, allocated(InData%Ke)) if (allocated(InData%Ke)) then - call RegPackBounds(Buf, 4, lbound(InData%Ke), ubound(InData%Ke)) + call RegPackBounds(Buf, 4, lbound(InData%Ke, kind=B8Ki), ubound(InData%Ke, kind=B8Ki)) call RegPack(Buf, InData%Ke) end if call RegPack(Buf, allocated(InData%Fg)) if (allocated(InData%Fg)) then - call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) + call RegPackBounds(Buf, 3, lbound(InData%Fg, kind=B8Ki), ubound(InData%Fg, kind=B8Ki)) call RegPack(Buf, InData%Fg) end if if (RegCheckErr(Buf, RoutineName)) return @@ -595,7 +595,7 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(MeshAuxDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' - integer(IntKi) :: LB(4), UB(4) + integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -709,14 +709,14 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyCB_MatArrays' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCB_MatArraysData%MBB)) then - LB(1:2) = lbound(SrcCB_MatArraysData%MBB) - UB(1:2) = ubound(SrcCB_MatArraysData%MBB) + LB(1:2) = lbound(SrcCB_MatArraysData%MBB, kind=B8Ki) + UB(1:2) = ubound(SrcCB_MatArraysData%MBB, kind=B8Ki) if (.not. allocated(DstCB_MatArraysData%MBB)) then allocate(DstCB_MatArraysData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -727,8 +727,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB end if if (allocated(SrcCB_MatArraysData%MBM)) then - LB(1:2) = lbound(SrcCB_MatArraysData%MBM) - UB(1:2) = ubound(SrcCB_MatArraysData%MBM) + LB(1:2) = lbound(SrcCB_MatArraysData%MBM, kind=B8Ki) + UB(1:2) = ubound(SrcCB_MatArraysData%MBM, kind=B8Ki) if (.not. allocated(DstCB_MatArraysData%MBM)) then allocate(DstCB_MatArraysData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -739,8 +739,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM end if if (allocated(SrcCB_MatArraysData%KBB)) then - LB(1:2) = lbound(SrcCB_MatArraysData%KBB) - UB(1:2) = ubound(SrcCB_MatArraysData%KBB) + LB(1:2) = lbound(SrcCB_MatArraysData%KBB, kind=B8Ki) + UB(1:2) = ubound(SrcCB_MatArraysData%KBB, kind=B8Ki) if (.not. allocated(DstCB_MatArraysData%KBB)) then allocate(DstCB_MatArraysData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -751,8 +751,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB end if if (allocated(SrcCB_MatArraysData%PhiL)) then - LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) - UB(1:2) = ubound(SrcCB_MatArraysData%PhiL) + LB(1:2) = lbound(SrcCB_MatArraysData%PhiL, kind=B8Ki) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiL, kind=B8Ki) if (.not. allocated(DstCB_MatArraysData%PhiL)) then allocate(DstCB_MatArraysData%PhiL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -763,8 +763,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL end if if (allocated(SrcCB_MatArraysData%PhiR)) then - LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) - UB(1:2) = ubound(SrcCB_MatArraysData%PhiR) + LB(1:2) = lbound(SrcCB_MatArraysData%PhiR, kind=B8Ki) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiR, kind=B8Ki) if (.not. allocated(DstCB_MatArraysData%PhiR)) then allocate(DstCB_MatArraysData%PhiR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -775,8 +775,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR end if if (allocated(SrcCB_MatArraysData%OmegaL)) then - LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) - UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL) + LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL, kind=B8Ki) + UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL, kind=B8Ki) if (.not. allocated(DstCB_MatArraysData%OmegaL)) then allocate(DstCB_MatArraysData%OmegaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -822,32 +822,32 @@ subroutine SD_PackCB_MatArrays(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%MBB)) if (allocated(InData%MBB)) then - call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) + call RegPackBounds(Buf, 2, lbound(InData%MBB, kind=B8Ki), ubound(InData%MBB, kind=B8Ki)) call RegPack(Buf, InData%MBB) end if call RegPack(Buf, allocated(InData%MBM)) if (allocated(InData%MBM)) then - call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) + call RegPackBounds(Buf, 2, lbound(InData%MBM, kind=B8Ki), ubound(InData%MBM, kind=B8Ki)) call RegPack(Buf, InData%MBM) end if call RegPack(Buf, allocated(InData%KBB)) if (allocated(InData%KBB)) then - call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) + call RegPackBounds(Buf, 2, lbound(InData%KBB, kind=B8Ki), ubound(InData%KBB, kind=B8Ki)) call RegPack(Buf, InData%KBB) end if call RegPack(Buf, allocated(InData%PhiL)) if (allocated(InData%PhiL)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiL), ubound(InData%PhiL)) + call RegPackBounds(Buf, 2, lbound(InData%PhiL, kind=B8Ki), ubound(InData%PhiL, kind=B8Ki)) call RegPack(Buf, InData%PhiL) end if call RegPack(Buf, allocated(InData%PhiR)) if (allocated(InData%PhiR)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiR), ubound(InData%PhiR)) + call RegPackBounds(Buf, 2, lbound(InData%PhiR, kind=B8Ki), ubound(InData%PhiR, kind=B8Ki)) call RegPack(Buf, InData%PhiR) end if call RegPack(Buf, allocated(InData%OmegaL)) if (allocated(InData%OmegaL)) then - call RegPackBounds(Buf, 1, lbound(InData%OmegaL), ubound(InData%OmegaL)) + call RegPackBounds(Buf, 1, lbound(InData%OmegaL, kind=B8Ki), ubound(InData%OmegaL, kind=B8Ki)) call RegPack(Buf, InData%OmegaL) end if if (RegCheckErr(Buf, RoutineName)) return @@ -857,7 +857,7 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(CB_MatArrays), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1048,7 +1048,7 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInitInput' @@ -1061,8 +1061,8 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ if (allocated(SrcInitInputData%SoilStiffness)) then - LB(1:3) = lbound(SrcInitInputData%SoilStiffness) - UB(1:3) = ubound(SrcInitInputData%SoilStiffness) + LB(1:3) = lbound(SrcInitInputData%SoilStiffness, kind=B8Ki) + UB(1:3) = ubound(SrcInitInputData%SoilStiffness, kind=B8Ki) if (.not. allocated(DstInitInputData%SoilStiffness)) then allocate(DstInitInputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1107,7 +1107,7 @@ subroutine SD_PackInitInput(Buf, Indata) call RegPack(Buf, InData%SubRotateZ) call RegPack(Buf, allocated(InData%SoilStiffness)) if (allocated(InData%SoilStiffness)) then - call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness), ubound(InData%SoilStiffness)) + call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness, kind=B8Ki), ubound(InData%SoilStiffness, kind=B8Ki)) call RegPack(Buf, InData%SoilStiffness) end if call MeshPack(Buf, InData%SoilMesh) @@ -1119,7 +1119,7 @@ subroutine SD_UnPackInitInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitInput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1160,15 +1160,15 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1179,8 +1179,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1194,8 +1194,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_y)) then allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1206,8 +1206,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1218,8 +1218,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%LinNames_u)) then allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1230,8 +1230,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_y)) then allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1242,8 +1242,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1254,8 +1254,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%RotFrame_u)) then allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1266,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) if (.not. allocated(DstInitOutputData%IsLoad_u)) then allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1278,8 +1278,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1290,8 +1290,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%CableCChanRqst)) then - LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) - UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) if (.not. allocated(DstInitOutputData%CableCChanRqst)) then allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1356,58 +1356,58 @@ subroutine SD_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) call RegPack(Buf, InData%LinNames_y) end if call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) call RegPack(Buf, InData%LinNames_x) end if call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) call RegPack(Buf, InData%LinNames_u) end if call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_y) end if call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_x) end if call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) call RegPack(Buf, InData%RotFrame_u) end if call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) call RegPack(Buf, InData%IsLoad_u) end if call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) call RegPack(Buf, InData%DerivOrder_x) end if call RegPack(Buf, allocated(InData%CableCChanRqst)) if (allocated(InData%CableCChanRqst)) then - call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) + call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst, kind=B8Ki), ubound(InData%CableCChanRqst, kind=B8Ki)) call RegPack(Buf, InData%CableCChanRqst) end if if (RegCheckErr(Buf, RoutineName)) return @@ -1417,7 +1417,7 @@ subroutine SD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1584,7 +1584,7 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyInitType' ErrStat = ErrID_None @@ -1605,8 +1605,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NDiv = SrcInitTypeData%NDiv DstInitTypeData%CBMod = SrcInitTypeData%CBMod if (allocated(SrcInitTypeData%Joints)) then - LB(1:2) = lbound(SrcInitTypeData%Joints) - UB(1:2) = ubound(SrcInitTypeData%Joints) + LB(1:2) = lbound(SrcInitTypeData%Joints, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%Joints, kind=B8Ki) if (.not. allocated(DstInitTypeData%Joints)) then allocate(DstInitTypeData%Joints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1617,8 +1617,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Joints = SrcInitTypeData%Joints end if if (allocated(SrcInitTypeData%PropSetsB)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsB) - UB(1:2) = ubound(SrcInitTypeData%PropSetsB) + LB(1:2) = lbound(SrcInitTypeData%PropSetsB, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropSetsB, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropSetsB)) then allocate(DstInitTypeData%PropSetsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1629,8 +1629,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB end if if (allocated(SrcInitTypeData%PropSetsC)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsC) - UB(1:2) = ubound(SrcInitTypeData%PropSetsC) + LB(1:2) = lbound(SrcInitTypeData%PropSetsC, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropSetsC, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropSetsC)) then allocate(DstInitTypeData%PropSetsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1641,8 +1641,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC end if if (allocated(SrcInitTypeData%PropSetsR)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsR) - UB(1:2) = ubound(SrcInitTypeData%PropSetsR) + LB(1:2) = lbound(SrcInitTypeData%PropSetsR, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropSetsR, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropSetsR)) then allocate(DstInitTypeData%PropSetsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1653,8 +1653,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR end if if (allocated(SrcInitTypeData%PropSetsX)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsX) - UB(1:2) = ubound(SrcInitTypeData%PropSetsX) + LB(1:2) = lbound(SrcInitTypeData%PropSetsX, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropSetsX, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropSetsX)) then allocate(DstInitTypeData%PropSetsX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1665,8 +1665,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX end if if (allocated(SrcInitTypeData%COSMs)) then - LB(1:2) = lbound(SrcInitTypeData%COSMs) - UB(1:2) = ubound(SrcInitTypeData%COSMs) + LB(1:2) = lbound(SrcInitTypeData%COSMs, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%COSMs, kind=B8Ki) if (.not. allocated(DstInitTypeData%COSMs)) then allocate(DstInitTypeData%COSMs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1677,8 +1677,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%COSMs = SrcInitTypeData%COSMs end if if (allocated(SrcInitTypeData%CMass)) then - LB(1:2) = lbound(SrcInitTypeData%CMass) - UB(1:2) = ubound(SrcInitTypeData%CMass) + LB(1:2) = lbound(SrcInitTypeData%CMass, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%CMass, kind=B8Ki) if (.not. allocated(DstInitTypeData%CMass)) then allocate(DstInitTypeData%CMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1689,8 +1689,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%CMass = SrcInitTypeData%CMass end if if (allocated(SrcInitTypeData%JDampings)) then - LB(1:1) = lbound(SrcInitTypeData%JDampings) - UB(1:1) = ubound(SrcInitTypeData%JDampings) + LB(1:1) = lbound(SrcInitTypeData%JDampings, kind=B8Ki) + UB(1:1) = ubound(SrcInitTypeData%JDampings, kind=B8Ki) if (.not. allocated(DstInitTypeData%JDampings)) then allocate(DstInitTypeData%JDampings(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1704,8 +1704,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat if (allocated(SrcInitTypeData%Members)) then - LB(1:2) = lbound(SrcInitTypeData%Members) - UB(1:2) = ubound(SrcInitTypeData%Members) + LB(1:2) = lbound(SrcInitTypeData%Members, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%Members, kind=B8Ki) if (.not. allocated(DstInitTypeData%Members)) then allocate(DstInitTypeData%Members(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1716,8 +1716,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Members = SrcInitTypeData%Members end if if (allocated(SrcInitTypeData%SSOutList)) then - LB(1:1) = lbound(SrcInitTypeData%SSOutList) - UB(1:1) = ubound(SrcInitTypeData%SSOutList) + LB(1:1) = lbound(SrcInitTypeData%SSOutList, kind=B8Ki) + UB(1:1) = ubound(SrcInitTypeData%SSOutList, kind=B8Ki) if (.not. allocated(DstInitTypeData%SSOutList)) then allocate(DstInitTypeData%SSOutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1730,8 +1730,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim if (allocated(SrcInitTypeData%SSIK)) then - LB(1:2) = lbound(SrcInitTypeData%SSIK) - UB(1:2) = ubound(SrcInitTypeData%SSIK) + LB(1:2) = lbound(SrcInitTypeData%SSIK, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%SSIK, kind=B8Ki) if (.not. allocated(DstInitTypeData%SSIK)) then allocate(DstInitTypeData%SSIK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1742,8 +1742,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIK = SrcInitTypeData%SSIK end if if (allocated(SrcInitTypeData%SSIM)) then - LB(1:2) = lbound(SrcInitTypeData%SSIM) - UB(1:2) = ubound(SrcInitTypeData%SSIM) + LB(1:2) = lbound(SrcInitTypeData%SSIM, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%SSIM, kind=B8Ki) if (.not. allocated(DstInitTypeData%SSIM)) then allocate(DstInitTypeData%SSIM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1754,8 +1754,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIM = SrcInitTypeData%SSIM end if if (allocated(SrcInitTypeData%SSIfile)) then - LB(1:1) = lbound(SrcInitTypeData%SSIfile) - UB(1:1) = ubound(SrcInitTypeData%SSIfile) + LB(1:1) = lbound(SrcInitTypeData%SSIfile, kind=B8Ki) + UB(1:1) = ubound(SrcInitTypeData%SSIfile, kind=B8Ki) if (.not. allocated(DstInitTypeData%SSIfile)) then allocate(DstInitTypeData%SSIfile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1766,8 +1766,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile end if if (allocated(SrcInitTypeData%Soil_K)) then - LB(1:3) = lbound(SrcInitTypeData%Soil_K) - UB(1:3) = ubound(SrcInitTypeData%Soil_K) + LB(1:3) = lbound(SrcInitTypeData%Soil_K, kind=B8Ki) + UB(1:3) = ubound(SrcInitTypeData%Soil_K, kind=B8Ki) if (.not. allocated(DstInitTypeData%Soil_K)) then allocate(DstInitTypeData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1778,8 +1778,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K end if if (allocated(SrcInitTypeData%Soil_Points)) then - LB(1:2) = lbound(SrcInitTypeData%Soil_Points) - UB(1:2) = ubound(SrcInitTypeData%Soil_Points) + LB(1:2) = lbound(SrcInitTypeData%Soil_Points, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%Soil_Points, kind=B8Ki) if (.not. allocated(DstInitTypeData%Soil_Points)) then allocate(DstInitTypeData%Soil_Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1790,8 +1790,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points end if if (allocated(SrcInitTypeData%Soil_Nodes)) then - LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) - UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes) + LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes, kind=B8Ki) + UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes, kind=B8Ki) if (.not. allocated(DstInitTypeData%Soil_Nodes)) then allocate(DstInitTypeData%Soil_Nodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1806,8 +1806,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NPropC = SrcInitTypeData%NPropC DstInitTypeData%NPropR = SrcInitTypeData%NPropR if (allocated(SrcInitTypeData%Nodes)) then - LB(1:2) = lbound(SrcInitTypeData%Nodes) - UB(1:2) = ubound(SrcInitTypeData%Nodes) + LB(1:2) = lbound(SrcInitTypeData%Nodes, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%Nodes, kind=B8Ki) if (.not. allocated(DstInitTypeData%Nodes)) then allocate(DstInitTypeData%Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1818,8 +1818,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Nodes = SrcInitTypeData%Nodes end if if (allocated(SrcInitTypeData%PropsB)) then - LB(1:2) = lbound(SrcInitTypeData%PropsB) - UB(1:2) = ubound(SrcInitTypeData%PropsB) + LB(1:2) = lbound(SrcInitTypeData%PropsB, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropsB, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropsB)) then allocate(DstInitTypeData%PropsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1830,8 +1830,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsB = SrcInitTypeData%PropsB end if if (allocated(SrcInitTypeData%PropsC)) then - LB(1:2) = lbound(SrcInitTypeData%PropsC) - UB(1:2) = ubound(SrcInitTypeData%PropsC) + LB(1:2) = lbound(SrcInitTypeData%PropsC, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropsC, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropsC)) then allocate(DstInitTypeData%PropsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1842,8 +1842,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsC = SrcInitTypeData%PropsC end if if (allocated(SrcInitTypeData%PropsR)) then - LB(1:2) = lbound(SrcInitTypeData%PropsR) - UB(1:2) = ubound(SrcInitTypeData%PropsR) + LB(1:2) = lbound(SrcInitTypeData%PropsR, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%PropsR, kind=B8Ki) if (.not. allocated(DstInitTypeData%PropsR)) then allocate(DstInitTypeData%PropsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1854,8 +1854,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsR = SrcInitTypeData%PropsR end if if (allocated(SrcInitTypeData%K)) then - LB(1:2) = lbound(SrcInitTypeData%K) - UB(1:2) = ubound(SrcInitTypeData%K) + LB(1:2) = lbound(SrcInitTypeData%K, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%K, kind=B8Ki) if (.not. allocated(DstInitTypeData%K)) then allocate(DstInitTypeData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1866,8 +1866,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%K = SrcInitTypeData%K end if if (allocated(SrcInitTypeData%M)) then - LB(1:2) = lbound(SrcInitTypeData%M) - UB(1:2) = ubound(SrcInitTypeData%M) + LB(1:2) = lbound(SrcInitTypeData%M, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%M, kind=B8Ki) if (.not. allocated(DstInitTypeData%M)) then allocate(DstInitTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1878,8 +1878,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%M = SrcInitTypeData%M end if if (allocated(SrcInitTypeData%ElemProps)) then - LB(1:2) = lbound(SrcInitTypeData%ElemProps) - UB(1:2) = ubound(SrcInitTypeData%ElemProps) + LB(1:2) = lbound(SrcInitTypeData%ElemProps, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%ElemProps, kind=B8Ki) if (.not. allocated(DstInitTypeData%ElemProps)) then allocate(DstInitTypeData%ElemProps(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1890,8 +1890,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps end if if (allocated(SrcInitTypeData%MemberNodes)) then - LB(1:2) = lbound(SrcInitTypeData%MemberNodes) - UB(1:2) = ubound(SrcInitTypeData%MemberNodes) + LB(1:2) = lbound(SrcInitTypeData%MemberNodes, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%MemberNodes, kind=B8Ki) if (.not. allocated(DstInitTypeData%MemberNodes)) then allocate(DstInitTypeData%MemberNodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1902,8 +1902,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes end if if (allocated(SrcInitTypeData%NodesConnN)) then - LB(1:2) = lbound(SrcInitTypeData%NodesConnN) - UB(1:2) = ubound(SrcInitTypeData%NodesConnN) + LB(1:2) = lbound(SrcInitTypeData%NodesConnN, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%NodesConnN, kind=B8Ki) if (.not. allocated(DstInitTypeData%NodesConnN)) then allocate(DstInitTypeData%NodesConnN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1914,8 +1914,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN end if if (allocated(SrcInitTypeData%NodesConnE)) then - LB(1:2) = lbound(SrcInitTypeData%NodesConnE) - UB(1:2) = ubound(SrcInitTypeData%NodesConnE) + LB(1:2) = lbound(SrcInitTypeData%NodesConnE, kind=B8Ki) + UB(1:2) = ubound(SrcInitTypeData%NodesConnE, kind=B8Ki) if (.not. allocated(DstInitTypeData%NodesConnE)) then allocate(DstInitTypeData%NodesConnE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2037,42 +2037,42 @@ subroutine SD_PackInitType(Buf, Indata) call RegPack(Buf, InData%CBMod) call RegPack(Buf, allocated(InData%Joints)) if (allocated(InData%Joints)) then - call RegPackBounds(Buf, 2, lbound(InData%Joints), ubound(InData%Joints)) + call RegPackBounds(Buf, 2, lbound(InData%Joints, kind=B8Ki), ubound(InData%Joints, kind=B8Ki)) call RegPack(Buf, InData%Joints) end if call RegPack(Buf, allocated(InData%PropSetsB)) if (allocated(InData%PropSetsB)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsB), ubound(InData%PropSetsB)) + call RegPackBounds(Buf, 2, lbound(InData%PropSetsB, kind=B8Ki), ubound(InData%PropSetsB, kind=B8Ki)) call RegPack(Buf, InData%PropSetsB) end if call RegPack(Buf, allocated(InData%PropSetsC)) if (allocated(InData%PropSetsC)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsC), ubound(InData%PropSetsC)) + call RegPackBounds(Buf, 2, lbound(InData%PropSetsC, kind=B8Ki), ubound(InData%PropSetsC, kind=B8Ki)) call RegPack(Buf, InData%PropSetsC) end if call RegPack(Buf, allocated(InData%PropSetsR)) if (allocated(InData%PropSetsR)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsR), ubound(InData%PropSetsR)) + call RegPackBounds(Buf, 2, lbound(InData%PropSetsR, kind=B8Ki), ubound(InData%PropSetsR, kind=B8Ki)) call RegPack(Buf, InData%PropSetsR) end if call RegPack(Buf, allocated(InData%PropSetsX)) if (allocated(InData%PropSetsX)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsX), ubound(InData%PropSetsX)) + call RegPackBounds(Buf, 2, lbound(InData%PropSetsX, kind=B8Ki), ubound(InData%PropSetsX, kind=B8Ki)) call RegPack(Buf, InData%PropSetsX) end if call RegPack(Buf, allocated(InData%COSMs)) if (allocated(InData%COSMs)) then - call RegPackBounds(Buf, 2, lbound(InData%COSMs), ubound(InData%COSMs)) + call RegPackBounds(Buf, 2, lbound(InData%COSMs, kind=B8Ki), ubound(InData%COSMs, kind=B8Ki)) call RegPack(Buf, InData%COSMs) end if call RegPack(Buf, allocated(InData%CMass)) if (allocated(InData%CMass)) then - call RegPackBounds(Buf, 2, lbound(InData%CMass), ubound(InData%CMass)) + call RegPackBounds(Buf, 2, lbound(InData%CMass, kind=B8Ki), ubound(InData%CMass, kind=B8Ki)) call RegPack(Buf, InData%CMass) end if call RegPack(Buf, allocated(InData%JDampings)) if (allocated(InData%JDampings)) then - call RegPackBounds(Buf, 1, lbound(InData%JDampings), ubound(InData%JDampings)) + call RegPackBounds(Buf, 1, lbound(InData%JDampings, kind=B8Ki), ubound(InData%JDampings, kind=B8Ki)) call RegPack(Buf, InData%JDampings) end if call RegPack(Buf, InData%GuyanDampMod) @@ -2080,44 +2080,44 @@ subroutine SD_PackInitType(Buf, Indata) call RegPack(Buf, InData%GuyanDampMat) call RegPack(Buf, allocated(InData%Members)) if (allocated(InData%Members)) then - call RegPackBounds(Buf, 2, lbound(InData%Members), ubound(InData%Members)) + call RegPackBounds(Buf, 2, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) call RegPack(Buf, InData%Members) end if call RegPack(Buf, allocated(InData%SSOutList)) if (allocated(InData%SSOutList)) then - call RegPackBounds(Buf, 1, lbound(InData%SSOutList), ubound(InData%SSOutList)) + call RegPackBounds(Buf, 1, lbound(InData%SSOutList, kind=B8Ki), ubound(InData%SSOutList, kind=B8Ki)) call RegPack(Buf, InData%SSOutList) end if call RegPack(Buf, InData%OutCOSM) call RegPack(Buf, InData%TabDelim) call RegPack(Buf, allocated(InData%SSIK)) if (allocated(InData%SSIK)) then - call RegPackBounds(Buf, 2, lbound(InData%SSIK), ubound(InData%SSIK)) + call RegPackBounds(Buf, 2, lbound(InData%SSIK, kind=B8Ki), ubound(InData%SSIK, kind=B8Ki)) call RegPack(Buf, InData%SSIK) end if call RegPack(Buf, allocated(InData%SSIM)) if (allocated(InData%SSIM)) then - call RegPackBounds(Buf, 2, lbound(InData%SSIM), ubound(InData%SSIM)) + call RegPackBounds(Buf, 2, lbound(InData%SSIM, kind=B8Ki), ubound(InData%SSIM, kind=B8Ki)) call RegPack(Buf, InData%SSIM) end if call RegPack(Buf, allocated(InData%SSIfile)) if (allocated(InData%SSIfile)) then - call RegPackBounds(Buf, 1, lbound(InData%SSIfile), ubound(InData%SSIfile)) + call RegPackBounds(Buf, 1, lbound(InData%SSIfile, kind=B8Ki), ubound(InData%SSIfile, kind=B8Ki)) call RegPack(Buf, InData%SSIfile) end if call RegPack(Buf, allocated(InData%Soil_K)) if (allocated(InData%Soil_K)) then - call RegPackBounds(Buf, 3, lbound(InData%Soil_K), ubound(InData%Soil_K)) + call RegPackBounds(Buf, 3, lbound(InData%Soil_K, kind=B8Ki), ubound(InData%Soil_K, kind=B8Ki)) call RegPack(Buf, InData%Soil_K) end if call RegPack(Buf, allocated(InData%Soil_Points)) if (allocated(InData%Soil_Points)) then - call RegPackBounds(Buf, 2, lbound(InData%Soil_Points), ubound(InData%Soil_Points)) + call RegPackBounds(Buf, 2, lbound(InData%Soil_Points, kind=B8Ki), ubound(InData%Soil_Points, kind=B8Ki)) call RegPack(Buf, InData%Soil_Points) end if call RegPack(Buf, allocated(InData%Soil_Nodes)) if (allocated(InData%Soil_Nodes)) then - call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes), ubound(InData%Soil_Nodes)) + call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes, kind=B8Ki), ubound(InData%Soil_Nodes, kind=B8Ki)) call RegPack(Buf, InData%Soil_Nodes) end if call RegPack(Buf, InData%NElem) @@ -2126,52 +2126,52 @@ subroutine SD_PackInitType(Buf, Indata) call RegPack(Buf, InData%NPropR) call RegPack(Buf, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes), ubound(InData%Nodes)) + call RegPackBounds(Buf, 2, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) call RegPack(Buf, InData%Nodes) end if call RegPack(Buf, allocated(InData%PropsB)) if (allocated(InData%PropsB)) then - call RegPackBounds(Buf, 2, lbound(InData%PropsB), ubound(InData%PropsB)) + call RegPackBounds(Buf, 2, lbound(InData%PropsB, kind=B8Ki), ubound(InData%PropsB, kind=B8Ki)) call RegPack(Buf, InData%PropsB) end if call RegPack(Buf, allocated(InData%PropsC)) if (allocated(InData%PropsC)) then - call RegPackBounds(Buf, 2, lbound(InData%PropsC), ubound(InData%PropsC)) + call RegPackBounds(Buf, 2, lbound(InData%PropsC, kind=B8Ki), ubound(InData%PropsC, kind=B8Ki)) call RegPack(Buf, InData%PropsC) end if call RegPack(Buf, allocated(InData%PropsR)) if (allocated(InData%PropsR)) then - call RegPackBounds(Buf, 2, lbound(InData%PropsR), ubound(InData%PropsR)) + call RegPackBounds(Buf, 2, lbound(InData%PropsR, kind=B8Ki), ubound(InData%PropsR, kind=B8Ki)) call RegPack(Buf, InData%PropsR) end if call RegPack(Buf, allocated(InData%K)) if (allocated(InData%K)) then - call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) + call RegPackBounds(Buf, 2, lbound(InData%K, kind=B8Ki), ubound(InData%K, kind=B8Ki)) call RegPack(Buf, InData%K) end if call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then - call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) + call RegPackBounds(Buf, 2, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) call RegPack(Buf, InData%M) end if call RegPack(Buf, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then - call RegPackBounds(Buf, 2, lbound(InData%ElemProps), ubound(InData%ElemProps)) + call RegPackBounds(Buf, 2, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) call RegPack(Buf, InData%ElemProps) end if call RegPack(Buf, allocated(InData%MemberNodes)) if (allocated(InData%MemberNodes)) then - call RegPackBounds(Buf, 2, lbound(InData%MemberNodes), ubound(InData%MemberNodes)) + call RegPackBounds(Buf, 2, lbound(InData%MemberNodes, kind=B8Ki), ubound(InData%MemberNodes, kind=B8Ki)) call RegPack(Buf, InData%MemberNodes) end if call RegPack(Buf, allocated(InData%NodesConnN)) if (allocated(InData%NodesConnN)) then - call RegPackBounds(Buf, 2, lbound(InData%NodesConnN), ubound(InData%NodesConnN)) + call RegPackBounds(Buf, 2, lbound(InData%NodesConnN, kind=B8Ki), ubound(InData%NodesConnN, kind=B8Ki)) call RegPack(Buf, InData%NodesConnN) end if call RegPack(Buf, allocated(InData%NodesConnE)) if (allocated(InData%NodesConnE)) then - call RegPackBounds(Buf, 2, lbound(InData%NodesConnE), ubound(InData%NodesConnE)) + call RegPackBounds(Buf, 2, lbound(InData%NodesConnE, kind=B8Ki), ubound(InData%NodesConnE, kind=B8Ki)) call RegPack(Buf, InData%NodesConnE) end if call RegPack(Buf, InData%SSSum) @@ -2182,7 +2182,7 @@ subroutine SD_UnPackInitType(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_InitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitType' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2608,14 +2608,14 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm) - UB(1:1) = ubound(SrcContStateData%qm) + LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) if (.not. allocated(DstContStateData%qm)) then allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2626,8 +2626,8 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%qm = SrcContStateData%qm end if if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot) - UB(1:1) = ubound(SrcContStateData%qmdot) + LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) if (.not. allocated(DstContStateData%qmdot)) then allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2661,12 +2661,12 @@ subroutine SD_PackContState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%qm)) if (allocated(InData%qm)) then - call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) + call RegPackBounds(Buf, 1, lbound(InData%qm, kind=B8Ki), ubound(InData%qm, kind=B8Ki)) call RegPack(Buf, InData%qm) end if call RegPack(Buf, allocated(InData%qmdot)) if (allocated(InData%qmdot)) then - call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) + call RegPackBounds(Buf, 1, lbound(InData%qmdot, kind=B8Ki), ubound(InData%qmdot, kind=B8Ki)) call RegPack(Buf, InData%qmdot) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2676,7 +2676,7 @@ subroutine SD_UnPackContState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackContState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2794,16 +2794,16 @@ subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot) - UB(1:1) = ubound(SrcOtherStateData%xdot) + LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2824,16 +2824,16 @@ subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot) - UB(1:1) = ubound(OtherStateData%xdot) + LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) + UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2846,14 +2846,14 @@ subroutine SD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) - LB(1:1) = lbound(InData%xdot) - UB(1:1) = ubound(InData%xdot) + call RegPackBounds(Buf, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + LB(1:1) = lbound(InData%xdot, kind=B8Ki) + UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackContState(Buf, InData%xdot(i1)) end do @@ -2866,8 +2866,8 @@ subroutine SD_UnPackOtherState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOtherState' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2896,14 +2896,14 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%qmdotdot)) then - LB(1:1) = lbound(SrcMiscData%qmdotdot) - UB(1:1) = ubound(SrcMiscData%qmdotdot) + LB(1:1) = lbound(SrcMiscData%qmdotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%qmdotdot, kind=B8Ki) if (.not. allocated(DstMiscData%qmdotdot)) then allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2917,8 +2917,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%udot_TP = SrcMiscData%udot_TP DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP if (allocated(SrcMiscData%F_L)) then - LB(1:1) = lbound(SrcMiscData%F_L) - UB(1:1) = ubound(SrcMiscData%F_L) + LB(1:1) = lbound(SrcMiscData%F_L, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_L, kind=B8Ki) if (.not. allocated(DstMiscData%F_L)) then allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2929,8 +2929,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_L = SrcMiscData%F_L end if if (allocated(SrcMiscData%F_L2)) then - LB(1:1) = lbound(SrcMiscData%F_L2) - UB(1:1) = ubound(SrcMiscData%F_L2) + LB(1:1) = lbound(SrcMiscData%F_L2, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%F_L2, kind=B8Ki) if (.not. allocated(DstMiscData%F_L2)) then allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2941,8 +2941,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_L2 = SrcMiscData%F_L2 end if if (allocated(SrcMiscData%UR_bar)) then - LB(1:1) = lbound(SrcMiscData%UR_bar) - UB(1:1) = ubound(SrcMiscData%UR_bar) + LB(1:1) = lbound(SrcMiscData%UR_bar, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UR_bar, kind=B8Ki) if (.not. allocated(DstMiscData%UR_bar)) then allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2953,8 +2953,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UR_bar = SrcMiscData%UR_bar end if if (allocated(SrcMiscData%UR_bar_dot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dot) - UB(1:1) = ubound(SrcMiscData%UR_bar_dot) + LB(1:1) = lbound(SrcMiscData%UR_bar_dot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot, kind=B8Ki) if (.not. allocated(DstMiscData%UR_bar_dot)) then allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2965,8 +2965,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot end if if (allocated(SrcMiscData%UR_bar_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) - UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) if (.not. allocated(DstMiscData%UR_bar_dotdot)) then allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2977,8 +2977,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot end if if (allocated(SrcMiscData%UL)) then - LB(1:1) = lbound(SrcMiscData%UL) - UB(1:1) = ubound(SrcMiscData%UL) + LB(1:1) = lbound(SrcMiscData%UL, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL, kind=B8Ki) if (.not. allocated(DstMiscData%UL)) then allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2989,8 +2989,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL = SrcMiscData%UL end if if (allocated(SrcMiscData%UL_NS)) then - LB(1:1) = lbound(SrcMiscData%UL_NS) - UB(1:1) = ubound(SrcMiscData%UL_NS) + LB(1:1) = lbound(SrcMiscData%UL_NS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_NS, kind=B8Ki) if (.not. allocated(DstMiscData%UL_NS)) then allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3001,8 +3001,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_NS = SrcMiscData%UL_NS end if if (allocated(SrcMiscData%UL_dot)) then - LB(1:1) = lbound(SrcMiscData%UL_dot) - UB(1:1) = ubound(SrcMiscData%UL_dot) + LB(1:1) = lbound(SrcMiscData%UL_dot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_dot, kind=B8Ki) if (.not. allocated(DstMiscData%UL_dot)) then allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3013,8 +3013,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_dot = SrcMiscData%UL_dot end if if (allocated(SrcMiscData%UL_dotdot)) then - LB(1:1) = lbound(SrcMiscData%UL_dotdot) - UB(1:1) = ubound(SrcMiscData%UL_dotdot) + LB(1:1) = lbound(SrcMiscData%UL_dotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_dotdot, kind=B8Ki) if (.not. allocated(DstMiscData%UL_dotdot)) then allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3025,8 +3025,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot end if if (allocated(SrcMiscData%DU_full)) then - LB(1:1) = lbound(SrcMiscData%DU_full) - UB(1:1) = ubound(SrcMiscData%DU_full) + LB(1:1) = lbound(SrcMiscData%DU_full, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%DU_full, kind=B8Ki) if (.not. allocated(DstMiscData%DU_full)) then allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3037,8 +3037,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DU_full = SrcMiscData%DU_full end if if (allocated(SrcMiscData%U_full)) then - LB(1:1) = lbound(SrcMiscData%U_full) - UB(1:1) = ubound(SrcMiscData%U_full) + LB(1:1) = lbound(SrcMiscData%U_full, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full, kind=B8Ki) if (.not. allocated(DstMiscData%U_full)) then allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3049,8 +3049,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full = SrcMiscData%U_full end if if (allocated(SrcMiscData%U_full_NS)) then - LB(1:1) = lbound(SrcMiscData%U_full_NS) - UB(1:1) = ubound(SrcMiscData%U_full_NS) + LB(1:1) = lbound(SrcMiscData%U_full_NS, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_NS, kind=B8Ki) if (.not. allocated(DstMiscData%U_full_NS)) then allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3061,8 +3061,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_NS = SrcMiscData%U_full_NS end if if (allocated(SrcMiscData%U_full_dot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dot) - UB(1:1) = ubound(SrcMiscData%U_full_dot) + LB(1:1) = lbound(SrcMiscData%U_full_dot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_dot, kind=B8Ki) if (.not. allocated(DstMiscData%U_full_dot)) then allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3073,8 +3073,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_dot = SrcMiscData%U_full_dot end if if (allocated(SrcMiscData%U_full_dotdot)) then - LB(1:1) = lbound(SrcMiscData%U_full_dotdot) - UB(1:1) = ubound(SrcMiscData%U_full_dotdot) + LB(1:1) = lbound(SrcMiscData%U_full_dotdot, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot, kind=B8Ki) if (.not. allocated(DstMiscData%U_full_dotdot)) then allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3085,8 +3085,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot end if if (allocated(SrcMiscData%U_full_elast)) then - LB(1:1) = lbound(SrcMiscData%U_full_elast) - UB(1:1) = ubound(SrcMiscData%U_full_elast) + LB(1:1) = lbound(SrcMiscData%U_full_elast, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_full_elast, kind=B8Ki) if (.not. allocated(DstMiscData%U_full_elast)) then allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3097,8 +3097,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_full_elast = SrcMiscData%U_full_elast end if if (allocated(SrcMiscData%U_red)) then - LB(1:1) = lbound(SrcMiscData%U_red) - UB(1:1) = ubound(SrcMiscData%U_red) + LB(1:1) = lbound(SrcMiscData%U_red, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) if (.not. allocated(DstMiscData%U_red)) then allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3109,8 +3109,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%U_red = SrcMiscData%U_red end if if (allocated(SrcMiscData%FC_unit)) then - LB(1:1) = lbound(SrcMiscData%FC_unit) - UB(1:1) = ubound(SrcMiscData%FC_unit) + LB(1:1) = lbound(SrcMiscData%FC_unit, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) if (.not. allocated(DstMiscData%FC_unit)) then allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3121,8 +3121,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FC_unit = SrcMiscData%FC_unit end if if (allocated(SrcMiscData%SDWrOutput)) then - LB(1:1) = lbound(SrcMiscData%SDWrOutput) - UB(1:1) = ubound(SrcMiscData%SDWrOutput) + LB(1:1) = lbound(SrcMiscData%SDWrOutput, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%SDWrOutput, kind=B8Ki) if (.not. allocated(DstMiscData%SDWrOutput)) then allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3133,8 +3133,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput end if if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts) - UB(1:1) = ubound(SrcMiscData%AllOuts) + LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) if (.not. allocated(DstMiscData%AllOuts)) then allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3147,8 +3147,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%Decimat = SrcMiscData%Decimat if (allocated(SrcMiscData%Fext)) then - LB(1:1) = lbound(SrcMiscData%Fext) - UB(1:1) = ubound(SrcMiscData%Fext) + LB(1:1) = lbound(SrcMiscData%Fext, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Fext, kind=B8Ki) if (.not. allocated(DstMiscData%Fext)) then allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3159,8 +3159,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Fext = SrcMiscData%Fext end if if (allocated(SrcMiscData%Fext_red)) then - LB(1:1) = lbound(SrcMiscData%Fext_red) - UB(1:1) = ubound(SrcMiscData%Fext_red) + LB(1:1) = lbound(SrcMiscData%Fext_red, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Fext_red, kind=B8Ki) if (.not. allocated(DstMiscData%Fext_red)) then allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3171,8 +3171,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Fext_red = SrcMiscData%Fext_red end if if (allocated(SrcMiscData%UL_SIM)) then - LB(1:1) = lbound(SrcMiscData%UL_SIM) - UB(1:1) = ubound(SrcMiscData%UL_SIM) + LB(1:1) = lbound(SrcMiscData%UL_SIM, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) if (.not. allocated(DstMiscData%UL_SIM)) then allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3183,8 +3183,8 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%UL_SIM = SrcMiscData%UL_SIM end if if (allocated(SrcMiscData%UL_0m)) then - LB(1:1) = lbound(SrcMiscData%UL_0m) - UB(1:1) = ubound(SrcMiscData%UL_0m) + LB(1:1) = lbound(SrcMiscData%UL_0m, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%UL_0m, kind=B8Ki) if (.not. allocated(DstMiscData%UL_0m)) then allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3284,7 +3284,7 @@ subroutine SD_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%qmdotdot)) if (allocated(InData%qmdotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%qmdotdot), ubound(InData%qmdotdot)) + call RegPackBounds(Buf, 1, lbound(InData%qmdotdot, kind=B8Ki), ubound(InData%qmdotdot, kind=B8Ki)) call RegPack(Buf, InData%qmdotdot) end if call RegPack(Buf, InData%u_TP) @@ -3292,119 +3292,119 @@ subroutine SD_PackMisc(Buf, Indata) call RegPack(Buf, InData%udotdot_TP) call RegPack(Buf, allocated(InData%F_L)) if (allocated(InData%F_L)) then - call RegPackBounds(Buf, 1, lbound(InData%F_L), ubound(InData%F_L)) + call RegPackBounds(Buf, 1, lbound(InData%F_L, kind=B8Ki), ubound(InData%F_L, kind=B8Ki)) call RegPack(Buf, InData%F_L) end if call RegPack(Buf, allocated(InData%F_L2)) if (allocated(InData%F_L2)) then - call RegPackBounds(Buf, 1, lbound(InData%F_L2), ubound(InData%F_L2)) + call RegPackBounds(Buf, 1, lbound(InData%F_L2, kind=B8Ki), ubound(InData%F_L2, kind=B8Ki)) call RegPack(Buf, InData%F_L2) end if call RegPack(Buf, allocated(InData%UR_bar)) if (allocated(InData%UR_bar)) then - call RegPackBounds(Buf, 1, lbound(InData%UR_bar), ubound(InData%UR_bar)) + call RegPackBounds(Buf, 1, lbound(InData%UR_bar, kind=B8Ki), ubound(InData%UR_bar, kind=B8Ki)) call RegPack(Buf, InData%UR_bar) end if call RegPack(Buf, allocated(InData%UR_bar_dot)) if (allocated(InData%UR_bar_dot)) then - call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot), ubound(InData%UR_bar_dot)) + call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot, kind=B8Ki), ubound(InData%UR_bar_dot, kind=B8Ki)) call RegPack(Buf, InData%UR_bar_dot) end if call RegPack(Buf, allocated(InData%UR_bar_dotdot)) if (allocated(InData%UR_bar_dotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot), ubound(InData%UR_bar_dotdot)) + call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot, kind=B8Ki), ubound(InData%UR_bar_dotdot, kind=B8Ki)) call RegPack(Buf, InData%UR_bar_dotdot) end if call RegPack(Buf, allocated(InData%UL)) if (allocated(InData%UL)) then - call RegPackBounds(Buf, 1, lbound(InData%UL), ubound(InData%UL)) + call RegPackBounds(Buf, 1, lbound(InData%UL, kind=B8Ki), ubound(InData%UL, kind=B8Ki)) call RegPack(Buf, InData%UL) end if call RegPack(Buf, allocated(InData%UL_NS)) if (allocated(InData%UL_NS)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_NS), ubound(InData%UL_NS)) + call RegPackBounds(Buf, 1, lbound(InData%UL_NS, kind=B8Ki), ubound(InData%UL_NS, kind=B8Ki)) call RegPack(Buf, InData%UL_NS) end if call RegPack(Buf, allocated(InData%UL_dot)) if (allocated(InData%UL_dot)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_dot), ubound(InData%UL_dot)) + call RegPackBounds(Buf, 1, lbound(InData%UL_dot, kind=B8Ki), ubound(InData%UL_dot, kind=B8Ki)) call RegPack(Buf, InData%UL_dot) end if call RegPack(Buf, allocated(InData%UL_dotdot)) if (allocated(InData%UL_dotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot), ubound(InData%UL_dotdot)) + call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot, kind=B8Ki), ubound(InData%UL_dotdot, kind=B8Ki)) call RegPack(Buf, InData%UL_dotdot) end if call RegPack(Buf, allocated(InData%DU_full)) if (allocated(InData%DU_full)) then - call RegPackBounds(Buf, 1, lbound(InData%DU_full), ubound(InData%DU_full)) + call RegPackBounds(Buf, 1, lbound(InData%DU_full, kind=B8Ki), ubound(InData%DU_full, kind=B8Ki)) call RegPack(Buf, InData%DU_full) end if call RegPack(Buf, allocated(InData%U_full)) if (allocated(InData%U_full)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full), ubound(InData%U_full)) + call RegPackBounds(Buf, 1, lbound(InData%U_full, kind=B8Ki), ubound(InData%U_full, kind=B8Ki)) call RegPack(Buf, InData%U_full) end if call RegPack(Buf, allocated(InData%U_full_NS)) if (allocated(InData%U_full_NS)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_NS), ubound(InData%U_full_NS)) + call RegPackBounds(Buf, 1, lbound(InData%U_full_NS, kind=B8Ki), ubound(InData%U_full_NS, kind=B8Ki)) call RegPack(Buf, InData%U_full_NS) end if call RegPack(Buf, allocated(InData%U_full_dot)) if (allocated(InData%U_full_dot)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_dot), ubound(InData%U_full_dot)) + call RegPackBounds(Buf, 1, lbound(InData%U_full_dot, kind=B8Ki), ubound(InData%U_full_dot, kind=B8Ki)) call RegPack(Buf, InData%U_full_dot) end if call RegPack(Buf, allocated(InData%U_full_dotdot)) if (allocated(InData%U_full_dotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot), ubound(InData%U_full_dotdot)) + call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot, kind=B8Ki), ubound(InData%U_full_dotdot, kind=B8Ki)) call RegPack(Buf, InData%U_full_dotdot) end if call RegPack(Buf, allocated(InData%U_full_elast)) if (allocated(InData%U_full_elast)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_elast), ubound(InData%U_full_elast)) + call RegPackBounds(Buf, 1, lbound(InData%U_full_elast, kind=B8Ki), ubound(InData%U_full_elast, kind=B8Ki)) call RegPack(Buf, InData%U_full_elast) end if call RegPack(Buf, allocated(InData%U_red)) if (allocated(InData%U_red)) then - call RegPackBounds(Buf, 1, lbound(InData%U_red), ubound(InData%U_red)) + call RegPackBounds(Buf, 1, lbound(InData%U_red, kind=B8Ki), ubound(InData%U_red, kind=B8Ki)) call RegPack(Buf, InData%U_red) end if call RegPack(Buf, allocated(InData%FC_unit)) if (allocated(InData%FC_unit)) then - call RegPackBounds(Buf, 1, lbound(InData%FC_unit), ubound(InData%FC_unit)) + call RegPackBounds(Buf, 1, lbound(InData%FC_unit, kind=B8Ki), ubound(InData%FC_unit, kind=B8Ki)) call RegPack(Buf, InData%FC_unit) end if call RegPack(Buf, allocated(InData%SDWrOutput)) if (allocated(InData%SDWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput), ubound(InData%SDWrOutput)) + call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput, kind=B8Ki), ubound(InData%SDWrOutput, kind=B8Ki)) call RegPack(Buf, InData%SDWrOutput) end if call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) call RegPack(Buf, InData%AllOuts) end if call RegPack(Buf, InData%LastOutTime) call RegPack(Buf, InData%Decimat) call RegPack(Buf, allocated(InData%Fext)) if (allocated(InData%Fext)) then - call RegPackBounds(Buf, 1, lbound(InData%Fext), ubound(InData%Fext)) + call RegPackBounds(Buf, 1, lbound(InData%Fext, kind=B8Ki), ubound(InData%Fext, kind=B8Ki)) call RegPack(Buf, InData%Fext) end if call RegPack(Buf, allocated(InData%Fext_red)) if (allocated(InData%Fext_red)) then - call RegPackBounds(Buf, 1, lbound(InData%Fext_red), ubound(InData%Fext_red)) + call RegPackBounds(Buf, 1, lbound(InData%Fext_red, kind=B8Ki), ubound(InData%Fext_red, kind=B8Ki)) call RegPack(Buf, InData%Fext_red) end if call RegPack(Buf, allocated(InData%UL_SIM)) if (allocated(InData%UL_SIM)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_SIM), ubound(InData%UL_SIM)) + call RegPackBounds(Buf, 1, lbound(InData%UL_SIM, kind=B8Ki), ubound(InData%UL_SIM, kind=B8Ki)) call RegPack(Buf, InData%UL_SIM) end if call RegPack(Buf, allocated(InData%UL_0m)) if (allocated(InData%UL_0m)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_0m), ubound(InData%UL_0m)) + call RegPackBounds(Buf, 1, lbound(InData%UL_0m, kind=B8Ki), ubound(InData%UL_0m, kind=B8Ki)) call RegPack(Buf, InData%UL_0m) end if if (RegCheckErr(Buf, RoutineName)) return @@ -3414,7 +3414,7 @@ subroutine SD_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMisc' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -3772,8 +3772,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyParam' @@ -3785,8 +3785,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nDOF_red = SrcParamData%nDOF_red DstParamData%Nmembers = SrcParamData%Nmembers if (allocated(SrcParamData%Elems)) then - LB(1:2) = lbound(SrcParamData%Elems) - UB(1:2) = ubound(SrcParamData%Elems) + LB(1:2) = lbound(SrcParamData%Elems, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Elems, kind=B8Ki) if (.not. allocated(DstParamData%Elems)) then allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3797,8 +3797,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Elems = SrcParamData%Elems end if if (allocated(SrcParamData%ElemProps)) then - LB(1:1) = lbound(SrcParamData%ElemProps) - UB(1:1) = ubound(SrcParamData%ElemProps) + LB(1:1) = lbound(SrcParamData%ElemProps, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ElemProps, kind=B8Ki) if (.not. allocated(DstParamData%ElemProps)) then allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3813,8 +3813,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%FG)) then - LB(1:1) = lbound(SrcParamData%FG) - UB(1:1) = ubound(SrcParamData%FG) + LB(1:1) = lbound(SrcParamData%FG, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%FG, kind=B8Ki) if (.not. allocated(DstParamData%FG)) then allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3825,8 +3825,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FG = SrcParamData%FG end if if (allocated(SrcParamData%DP0)) then - LB(1:2) = lbound(SrcParamData%DP0) - UB(1:2) = ubound(SrcParamData%DP0) + LB(1:2) = lbound(SrcParamData%DP0, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%DP0, kind=B8Ki) if (.not. allocated(DstParamData%DP0)) then allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3837,8 +3837,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DP0 = SrcParamData%DP0 end if if (allocated(SrcParamData%NodeID2JointID)) then - LB(1:1) = lbound(SrcParamData%NodeID2JointID) - UB(1:1) = ubound(SrcParamData%NodeID2JointID) + LB(1:1) = lbound(SrcParamData%NodeID2JointID, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NodeID2JointID, kind=B8Ki) if (.not. allocated(DstParamData%NodeID2JointID)) then allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3850,8 +3850,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%reduced = SrcParamData%reduced if (allocated(SrcParamData%T_red)) then - LB(1:2) = lbound(SrcParamData%T_red) - UB(1:2) = ubound(SrcParamData%T_red) + LB(1:2) = lbound(SrcParamData%T_red, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%T_red, kind=B8Ki) if (.not. allocated(DstParamData%T_red)) then allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3862,8 +3862,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%T_red = SrcParamData%T_red end if if (allocated(SrcParamData%T_red_T)) then - LB(1:2) = lbound(SrcParamData%T_red_T) - UB(1:2) = ubound(SrcParamData%T_red_T) + LB(1:2) = lbound(SrcParamData%T_red_T, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%T_red_T, kind=B8Ki) if (.not. allocated(DstParamData%T_red_T)) then allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3874,8 +3874,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%T_red_T = SrcParamData%T_red_T end if if (allocated(SrcParamData%NodesDOF)) then - LB(1:1) = lbound(SrcParamData%NodesDOF) - UB(1:1) = ubound(SrcParamData%NodesDOF) + LB(1:1) = lbound(SrcParamData%NodesDOF, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NodesDOF, kind=B8Ki) if (.not. allocated(DstParamData%NodesDOF)) then allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3890,8 +3890,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%NodesDOFred)) then - LB(1:1) = lbound(SrcParamData%NodesDOFred) - UB(1:1) = ubound(SrcParamData%NodesDOFred) + LB(1:1) = lbound(SrcParamData%NodesDOFred, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%NodesDOFred, kind=B8Ki) if (.not. allocated(DstParamData%NodesDOFred)) then allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3906,8 +3906,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%ElemsDOF)) then - LB(1:2) = lbound(SrcParamData%ElemsDOF) - UB(1:2) = ubound(SrcParamData%ElemsDOF) + LB(1:2) = lbound(SrcParamData%ElemsDOF, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%ElemsDOF, kind=B8Ki) if (.not. allocated(DstParamData%ElemsDOF)) then allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3918,8 +3918,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ElemsDOF = SrcParamData%ElemsDOF end if if (allocated(SrcParamData%DOFred2Nodes)) then - LB(1:2) = lbound(SrcParamData%DOFred2Nodes) - UB(1:2) = ubound(SrcParamData%DOFred2Nodes) + LB(1:2) = lbound(SrcParamData%DOFred2Nodes, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes, kind=B8Ki) if (.not. allocated(DstParamData%DOFred2Nodes)) then allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3930,8 +3930,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes end if if (allocated(SrcParamData%CtrlElem2Channel)) then - LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) - UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel, kind=B8Ki) if (.not. allocated(DstParamData%CtrlElem2Channel)) then allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3946,8 +3946,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection DstParamData%Floating = SrcParamData%Floating if (allocated(SrcParamData%KMMDiag)) then - LB(1:1) = lbound(SrcParamData%KMMDiag) - UB(1:1) = ubound(SrcParamData%KMMDiag) + LB(1:1) = lbound(SrcParamData%KMMDiag, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%KMMDiag, kind=B8Ki) if (.not. allocated(DstParamData%KMMDiag)) then allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3958,8 +3958,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KMMDiag = SrcParamData%KMMDiag end if if (allocated(SrcParamData%CMMDiag)) then - LB(1:1) = lbound(SrcParamData%CMMDiag) - UB(1:1) = ubound(SrcParamData%CMMDiag) + LB(1:1) = lbound(SrcParamData%CMMDiag, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%CMMDiag, kind=B8Ki) if (.not. allocated(DstParamData%CMMDiag)) then allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3970,8 +3970,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CMMDiag = SrcParamData%CMMDiag end if if (allocated(SrcParamData%MMB)) then - LB(1:2) = lbound(SrcParamData%MMB) - UB(1:2) = ubound(SrcParamData%MMB) + LB(1:2) = lbound(SrcParamData%MMB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MMB, kind=B8Ki) if (.not. allocated(DstParamData%MMB)) then allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3982,8 +3982,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MMB = SrcParamData%MMB end if if (allocated(SrcParamData%MBmmB)) then - LB(1:2) = lbound(SrcParamData%MBmmB) - UB(1:2) = ubound(SrcParamData%MBmmB) + LB(1:2) = lbound(SrcParamData%MBmmB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MBmmB, kind=B8Ki) if (.not. allocated(DstParamData%MBmmB)) then allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3994,8 +3994,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MBmmB = SrcParamData%MBmmB end if if (allocated(SrcParamData%C1_11)) then - LB(1:2) = lbound(SrcParamData%C1_11) - UB(1:2) = ubound(SrcParamData%C1_11) + LB(1:2) = lbound(SrcParamData%C1_11, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C1_11, kind=B8Ki) if (.not. allocated(DstParamData%C1_11)) then allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4006,8 +4006,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C1_11 = SrcParamData%C1_11 end if if (allocated(SrcParamData%C1_12)) then - LB(1:2) = lbound(SrcParamData%C1_12) - UB(1:2) = ubound(SrcParamData%C1_12) + LB(1:2) = lbound(SrcParamData%C1_12, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C1_12, kind=B8Ki) if (.not. allocated(DstParamData%C1_12)) then allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4018,8 +4018,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C1_12 = SrcParamData%C1_12 end if if (allocated(SrcParamData%D1_141)) then - LB(1:2) = lbound(SrcParamData%D1_141) - UB(1:2) = ubound(SrcParamData%D1_141) + LB(1:2) = lbound(SrcParamData%D1_141, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D1_141, kind=B8Ki) if (.not. allocated(DstParamData%D1_141)) then allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4030,8 +4030,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D1_141 = SrcParamData%D1_141 end if if (allocated(SrcParamData%D1_142)) then - LB(1:2) = lbound(SrcParamData%D1_142) - UB(1:2) = ubound(SrcParamData%D1_142) + LB(1:2) = lbound(SrcParamData%D1_142, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D1_142, kind=B8Ki) if (.not. allocated(DstParamData%D1_142)) then allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4042,8 +4042,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D1_142 = SrcParamData%D1_142 end if if (allocated(SrcParamData%PhiM)) then - LB(1:2) = lbound(SrcParamData%PhiM) - UB(1:2) = ubound(SrcParamData%PhiM) + LB(1:2) = lbound(SrcParamData%PhiM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiM, kind=B8Ki) if (.not. allocated(DstParamData%PhiM)) then allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4054,8 +4054,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiM = SrcParamData%PhiM end if if (allocated(SrcParamData%C2_61)) then - LB(1:2) = lbound(SrcParamData%C2_61) - UB(1:2) = ubound(SrcParamData%C2_61) + LB(1:2) = lbound(SrcParamData%C2_61, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C2_61, kind=B8Ki) if (.not. allocated(DstParamData%C2_61)) then allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4066,8 +4066,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C2_61 = SrcParamData%C2_61 end if if (allocated(SrcParamData%C2_62)) then - LB(1:2) = lbound(SrcParamData%C2_62) - UB(1:2) = ubound(SrcParamData%C2_62) + LB(1:2) = lbound(SrcParamData%C2_62, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%C2_62, kind=B8Ki) if (.not. allocated(DstParamData%C2_62)) then allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4078,8 +4078,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C2_62 = SrcParamData%C2_62 end if if (allocated(SrcParamData%PhiRb_TI)) then - LB(1:2) = lbound(SrcParamData%PhiRb_TI) - UB(1:2) = ubound(SrcParamData%PhiRb_TI) + LB(1:2) = lbound(SrcParamData%PhiRb_TI, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiRb_TI, kind=B8Ki) if (.not. allocated(DstParamData%PhiRb_TI)) then allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4090,8 +4090,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI end if if (allocated(SrcParamData%D2_63)) then - LB(1:2) = lbound(SrcParamData%D2_63) - UB(1:2) = ubound(SrcParamData%D2_63) + LB(1:2) = lbound(SrcParamData%D2_63, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D2_63, kind=B8Ki) if (.not. allocated(DstParamData%D2_63)) then allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4102,8 +4102,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D2_63 = SrcParamData%D2_63 end if if (allocated(SrcParamData%D2_64)) then - LB(1:2) = lbound(SrcParamData%D2_64) - UB(1:2) = ubound(SrcParamData%D2_64) + LB(1:2) = lbound(SrcParamData%D2_64, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%D2_64, kind=B8Ki) if (.not. allocated(DstParamData%D2_64)) then allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4114,8 +4114,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%D2_64 = SrcParamData%D2_64 end if if (allocated(SrcParamData%MBB)) then - LB(1:2) = lbound(SrcParamData%MBB) - UB(1:2) = ubound(SrcParamData%MBB) + LB(1:2) = lbound(SrcParamData%MBB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MBB, kind=B8Ki) if (.not. allocated(DstParamData%MBB)) then allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4126,8 +4126,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MBB = SrcParamData%MBB end if if (allocated(SrcParamData%KBB)) then - LB(1:2) = lbound(SrcParamData%KBB) - UB(1:2) = ubound(SrcParamData%KBB) + LB(1:2) = lbound(SrcParamData%KBB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%KBB, kind=B8Ki) if (.not. allocated(DstParamData%KBB)) then allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4138,8 +4138,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBB = SrcParamData%KBB end if if (allocated(SrcParamData%CBB)) then - LB(1:2) = lbound(SrcParamData%CBB) - UB(1:2) = ubound(SrcParamData%CBB) + LB(1:2) = lbound(SrcParamData%CBB, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CBB, kind=B8Ki) if (.not. allocated(DstParamData%CBB)) then allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4150,8 +4150,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBB = SrcParamData%CBB end if if (allocated(SrcParamData%CMM)) then - LB(1:2) = lbound(SrcParamData%CMM) - UB(1:2) = ubound(SrcParamData%CMM) + LB(1:2) = lbound(SrcParamData%CMM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%CMM, kind=B8Ki) if (.not. allocated(DstParamData%CMM)) then allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4162,8 +4162,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CMM = SrcParamData%CMM end if if (allocated(SrcParamData%MBM)) then - LB(1:2) = lbound(SrcParamData%MBM) - UB(1:2) = ubound(SrcParamData%MBM) + LB(1:2) = lbound(SrcParamData%MBM, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%MBM, kind=B8Ki) if (.not. allocated(DstParamData%MBM)) then allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4174,8 +4174,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MBM = SrcParamData%MBM end if if (allocated(SrcParamData%PhiL_T)) then - LB(1:2) = lbound(SrcParamData%PhiL_T) - UB(1:2) = ubound(SrcParamData%PhiL_T) + LB(1:2) = lbound(SrcParamData%PhiL_T, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiL_T, kind=B8Ki) if (.not. allocated(DstParamData%PhiL_T)) then allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4186,8 +4186,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiL_T = SrcParamData%PhiL_T end if if (allocated(SrcParamData%PhiLInvOmgL2)) then - LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) - UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) if (.not. allocated(DstParamData%PhiLInvOmgL2)) then allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4198,8 +4198,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 end if if (allocated(SrcParamData%KLLm1)) then - LB(1:2) = lbound(SrcParamData%KLLm1) - UB(1:2) = ubound(SrcParamData%KLLm1) + LB(1:2) = lbound(SrcParamData%KLLm1, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%KLLm1, kind=B8Ki) if (.not. allocated(DstParamData%KLLm1)) then allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4210,8 +4210,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KLLm1 = SrcParamData%KLLm1 end if if (allocated(SrcParamData%AM2Jac)) then - LB(1:2) = lbound(SrcParamData%AM2Jac) - UB(1:2) = ubound(SrcParamData%AM2Jac) + LB(1:2) = lbound(SrcParamData%AM2Jac, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%AM2Jac, kind=B8Ki) if (.not. allocated(DstParamData%AM2Jac)) then allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4222,8 +4222,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AM2Jac = SrcParamData%AM2Jac end if if (allocated(SrcParamData%AM2JacPiv)) then - LB(1:1) = lbound(SrcParamData%AM2JacPiv) - UB(1:1) = ubound(SrcParamData%AM2JacPiv) + LB(1:1) = lbound(SrcParamData%AM2JacPiv, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%AM2JacPiv, kind=B8Ki) if (.not. allocated(DstParamData%AM2JacPiv)) then allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4234,8 +4234,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv end if if (allocated(SrcParamData%TI)) then - LB(1:2) = lbound(SrcParamData%TI) - UB(1:2) = ubound(SrcParamData%TI) + LB(1:2) = lbound(SrcParamData%TI, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TI, kind=B8Ki) if (.not. allocated(DstParamData%TI)) then allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4246,8 +4246,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TI = SrcParamData%TI end if if (allocated(SrcParamData%TIreact)) then - LB(1:2) = lbound(SrcParamData%TIreact) - UB(1:2) = ubound(SrcParamData%TIreact) + LB(1:2) = lbound(SrcParamData%TIreact, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%TIreact, kind=B8Ki) if (.not. allocated(DstParamData%TIreact)) then allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4262,8 +4262,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nNodes_L = SrcParamData%nNodes_L DstParamData%nNodes_C = SrcParamData%nNodes_C if (allocated(SrcParamData%Nodes_I)) then - LB(1:2) = lbound(SrcParamData%Nodes_I) - UB(1:2) = ubound(SrcParamData%Nodes_I) + LB(1:2) = lbound(SrcParamData%Nodes_I, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Nodes_I, kind=B8Ki) if (.not. allocated(DstParamData%Nodes_I)) then allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4274,8 +4274,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Nodes_I = SrcParamData%Nodes_I end if if (allocated(SrcParamData%Nodes_L)) then - LB(1:2) = lbound(SrcParamData%Nodes_L) - UB(1:2) = ubound(SrcParamData%Nodes_L) + LB(1:2) = lbound(SrcParamData%Nodes_L, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Nodes_L, kind=B8Ki) if (.not. allocated(DstParamData%Nodes_L)) then allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4286,8 +4286,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Nodes_L = SrcParamData%Nodes_L end if if (allocated(SrcParamData%Nodes_C)) then - LB(1:2) = lbound(SrcParamData%Nodes_C) - UB(1:2) = ubound(SrcParamData%Nodes_C) + LB(1:2) = lbound(SrcParamData%Nodes_C, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Nodes_C, kind=B8Ki) if (.not. allocated(DstParamData%Nodes_C)) then allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4310,8 +4310,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nDOF__L = SrcParamData%nDOF__L DstParamData%nDOF__F = SrcParamData%nDOF__F if (allocated(SrcParamData%IDI__)) then - LB(1:1) = lbound(SrcParamData%IDI__) - UB(1:1) = ubound(SrcParamData%IDI__) + LB(1:1) = lbound(SrcParamData%IDI__, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDI__, kind=B8Ki) if (.not. allocated(DstParamData%IDI__)) then allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4322,8 +4322,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDI__ = SrcParamData%IDI__ end if if (allocated(SrcParamData%IDI_Rb)) then - LB(1:1) = lbound(SrcParamData%IDI_Rb) - UB(1:1) = ubound(SrcParamData%IDI_Rb) + LB(1:1) = lbound(SrcParamData%IDI_Rb, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDI_Rb, kind=B8Ki) if (.not. allocated(DstParamData%IDI_Rb)) then allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4334,8 +4334,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDI_Rb = SrcParamData%IDI_Rb end if if (allocated(SrcParamData%IDI_F)) then - LB(1:1) = lbound(SrcParamData%IDI_F) - UB(1:1) = ubound(SrcParamData%IDI_F) + LB(1:1) = lbound(SrcParamData%IDI_F, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDI_F, kind=B8Ki) if (.not. allocated(DstParamData%IDI_F)) then allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4346,8 +4346,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDI_F = SrcParamData%IDI_F end if if (allocated(SrcParamData%IDL_L)) then - LB(1:1) = lbound(SrcParamData%IDL_L) - UB(1:1) = ubound(SrcParamData%IDL_L) + LB(1:1) = lbound(SrcParamData%IDL_L, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDL_L, kind=B8Ki) if (.not. allocated(DstParamData%IDL_L)) then allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4358,8 +4358,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDL_L = SrcParamData%IDL_L end if if (allocated(SrcParamData%IDC__)) then - LB(1:1) = lbound(SrcParamData%IDC__) - UB(1:1) = ubound(SrcParamData%IDC__) + LB(1:1) = lbound(SrcParamData%IDC__, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC__, kind=B8Ki) if (.not. allocated(DstParamData%IDC__)) then allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4370,8 +4370,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC__ = SrcParamData%IDC__ end if if (allocated(SrcParamData%IDC_Rb)) then - LB(1:1) = lbound(SrcParamData%IDC_Rb) - UB(1:1) = ubound(SrcParamData%IDC_Rb) + LB(1:1) = lbound(SrcParamData%IDC_Rb, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC_Rb, kind=B8Ki) if (.not. allocated(DstParamData%IDC_Rb)) then allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4382,8 +4382,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC_Rb = SrcParamData%IDC_Rb end if if (allocated(SrcParamData%IDC_L)) then - LB(1:1) = lbound(SrcParamData%IDC_L) - UB(1:1) = ubound(SrcParamData%IDC_L) + LB(1:1) = lbound(SrcParamData%IDC_L, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC_L, kind=B8Ki) if (.not. allocated(DstParamData%IDC_L)) then allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4394,8 +4394,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC_L = SrcParamData%IDC_L end if if (allocated(SrcParamData%IDC_F)) then - LB(1:1) = lbound(SrcParamData%IDC_F) - UB(1:1) = ubound(SrcParamData%IDC_F) + LB(1:1) = lbound(SrcParamData%IDC_F, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDC_F, kind=B8Ki) if (.not. allocated(DstParamData%IDC_F)) then allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4406,8 +4406,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDC_F = SrcParamData%IDC_F end if if (allocated(SrcParamData%IDR__)) then - LB(1:1) = lbound(SrcParamData%IDR__) - UB(1:1) = ubound(SrcParamData%IDR__) + LB(1:1) = lbound(SrcParamData%IDR__, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%IDR__, kind=B8Ki) if (.not. allocated(DstParamData%IDR__)) then allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4418,8 +4418,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%IDR__ = SrcParamData%IDR__ end if if (allocated(SrcParamData%ID__Rb)) then - LB(1:1) = lbound(SrcParamData%ID__Rb) - UB(1:1) = ubound(SrcParamData%ID__Rb) + LB(1:1) = lbound(SrcParamData%ID__Rb, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ID__Rb, kind=B8Ki) if (.not. allocated(DstParamData%ID__Rb)) then allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4430,8 +4430,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ID__Rb = SrcParamData%ID__Rb end if if (allocated(SrcParamData%ID__L)) then - LB(1:1) = lbound(SrcParamData%ID__L) - UB(1:1) = ubound(SrcParamData%ID__L) + LB(1:1) = lbound(SrcParamData%ID__L, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ID__L, kind=B8Ki) if (.not. allocated(DstParamData%ID__L)) then allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4442,8 +4442,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ID__L = SrcParamData%ID__L end if if (allocated(SrcParamData%ID__F)) then - LB(1:1) = lbound(SrcParamData%ID__F) - UB(1:1) = ubound(SrcParamData%ID__F) + LB(1:1) = lbound(SrcParamData%ID__F, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ID__F, kind=B8Ki) if (.not. allocated(DstParamData%ID__F)) then allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4461,8 +4461,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutFmt = SrcParamData%OutFmt DstParamData%OutSFmt = SrcParamData%OutSFmt if (allocated(SrcParamData%MoutLst)) then - LB(1:1) = lbound(SrcParamData%MoutLst) - UB(1:1) = ubound(SrcParamData%MoutLst) + LB(1:1) = lbound(SrcParamData%MoutLst, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MoutLst, kind=B8Ki) if (.not. allocated(DstParamData%MoutLst)) then allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4477,8 +4477,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%MoutLst2)) then - LB(1:1) = lbound(SrcParamData%MoutLst2) - UB(1:1) = ubound(SrcParamData%MoutLst2) + LB(1:1) = lbound(SrcParamData%MoutLst2, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MoutLst2, kind=B8Ki) if (.not. allocated(DstParamData%MoutLst2)) then allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4493,8 +4493,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%MoutLst3)) then - LB(1:1) = lbound(SrcParamData%MoutLst3) - UB(1:1) = ubound(SrcParamData%MoutLst3) + LB(1:1) = lbound(SrcParamData%MoutLst3, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%MoutLst3, kind=B8Ki) if (.not. allocated(DstParamData%MoutLst3)) then allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4509,8 +4509,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam) - UB(1:1) = ubound(SrcParamData%OutParam) + LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) if (.not. allocated(DstParamData%OutParam)) then allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4532,8 +4532,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutAllDims = SrcParamData%OutAllDims DstParamData%OutDec = SrcParamData%OutDec if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx) - UB(1:2) = ubound(SrcParamData%Jac_u_indx) + LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) + UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) if (.not. allocated(DstParamData%Jac_u_indx)) then allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4544,8 +4544,8 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du) - UB(1:1) = ubound(SrcParamData%du) + LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) if (.not. allocated(DstParamData%du)) then allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4565,8 +4565,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) type(SD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_DestroyParam' @@ -4576,8 +4576,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Elems) end if if (allocated(ParamData%ElemProps)) then - LB(1:1) = lbound(ParamData%ElemProps) - UB(1:1) = ubound(ParamData%ElemProps) + LB(1:1) = lbound(ParamData%ElemProps, kind=B8Ki) + UB(1:1) = ubound(ParamData%ElemProps, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4600,8 +4600,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%T_red_T) end if if (allocated(ParamData%NodesDOF)) then - LB(1:1) = lbound(ParamData%NodesDOF) - UB(1:1) = ubound(ParamData%NodesDOF) + LB(1:1) = lbound(ParamData%NodesDOF, kind=B8Ki) + UB(1:1) = ubound(ParamData%NodesDOF, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4609,8 +4609,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%NodesDOF) end if if (allocated(ParamData%NodesDOFred)) then - LB(1:1) = lbound(ParamData%NodesDOFred) - UB(1:1) = ubound(ParamData%NodesDOFred) + LB(1:1) = lbound(ParamData%NodesDOFred, kind=B8Ki) + UB(1:1) = ubound(ParamData%NodesDOFred, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4750,8 +4750,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%ID__F) end if if (allocated(ParamData%MoutLst)) then - LB(1:1) = lbound(ParamData%MoutLst) - UB(1:1) = ubound(ParamData%MoutLst) + LB(1:1) = lbound(ParamData%MoutLst, kind=B8Ki) + UB(1:1) = ubound(ParamData%MoutLst, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4759,8 +4759,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst) end if if (allocated(ParamData%MoutLst2)) then - LB(1:1) = lbound(ParamData%MoutLst2) - UB(1:1) = ubound(ParamData%MoutLst2) + LB(1:1) = lbound(ParamData%MoutLst2, kind=B8Ki) + UB(1:1) = ubound(ParamData%MoutLst2, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4768,8 +4768,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst2) end if if (allocated(ParamData%MoutLst3)) then - LB(1:1) = lbound(ParamData%MoutLst3) - UB(1:1) = ubound(ParamData%MoutLst3) + LB(1:1) = lbound(ParamData%MoutLst3, kind=B8Ki) + UB(1:1) = ubound(ParamData%MoutLst3, kind=B8Ki) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst3(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4777,8 +4777,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst3) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam) - UB(1:1) = ubound(ParamData%OutParam) + LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4797,8 +4797,8 @@ subroutine SD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%SDDeltaT) call RegPack(Buf, InData%IntMethod) @@ -4807,75 +4807,75 @@ subroutine SD_PackParam(Buf, Indata) call RegPack(Buf, InData%Nmembers) call RegPack(Buf, allocated(InData%Elems)) if (allocated(InData%Elems)) then - call RegPackBounds(Buf, 2, lbound(InData%Elems), ubound(InData%Elems)) + call RegPackBounds(Buf, 2, lbound(InData%Elems, kind=B8Ki), ubound(InData%Elems, kind=B8Ki)) call RegPack(Buf, InData%Elems) end if call RegPack(Buf, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then - call RegPackBounds(Buf, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) - LB(1:1) = lbound(InData%ElemProps) - UB(1:1) = ubound(InData%ElemProps) + call RegPackBounds(Buf, 1, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) + LB(1:1) = lbound(InData%ElemProps, kind=B8Ki) + UB(1:1) = ubound(InData%ElemProps, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackElemPropType(Buf, InData%ElemProps(i1)) end do end if call RegPack(Buf, allocated(InData%FG)) if (allocated(InData%FG)) then - call RegPackBounds(Buf, 1, lbound(InData%FG), ubound(InData%FG)) + call RegPackBounds(Buf, 1, lbound(InData%FG, kind=B8Ki), ubound(InData%FG, kind=B8Ki)) call RegPack(Buf, InData%FG) end if call RegPack(Buf, allocated(InData%DP0)) if (allocated(InData%DP0)) then - call RegPackBounds(Buf, 2, lbound(InData%DP0), ubound(InData%DP0)) + call RegPackBounds(Buf, 2, lbound(InData%DP0, kind=B8Ki), ubound(InData%DP0, kind=B8Ki)) call RegPack(Buf, InData%DP0) end if call RegPack(Buf, allocated(InData%NodeID2JointID)) if (allocated(InData%NodeID2JointID)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID), ubound(InData%NodeID2JointID)) + call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID, kind=B8Ki), ubound(InData%NodeID2JointID, kind=B8Ki)) call RegPack(Buf, InData%NodeID2JointID) end if call RegPack(Buf, InData%reduced) call RegPack(Buf, allocated(InData%T_red)) if (allocated(InData%T_red)) then - call RegPackBounds(Buf, 2, lbound(InData%T_red), ubound(InData%T_red)) + call RegPackBounds(Buf, 2, lbound(InData%T_red, kind=B8Ki), ubound(InData%T_red, kind=B8Ki)) call RegPack(Buf, InData%T_red) end if call RegPack(Buf, allocated(InData%T_red_T)) if (allocated(InData%T_red_T)) then - call RegPackBounds(Buf, 2, lbound(InData%T_red_T), ubound(InData%T_red_T)) + call RegPackBounds(Buf, 2, lbound(InData%T_red_T, kind=B8Ki), ubound(InData%T_red_T, kind=B8Ki)) call RegPack(Buf, InData%T_red_T) end if call RegPack(Buf, allocated(InData%NodesDOF)) if (allocated(InData%NodesDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) - LB(1:1) = lbound(InData%NodesDOF) - UB(1:1) = ubound(InData%NodesDOF) + call RegPackBounds(Buf, 1, lbound(InData%NodesDOF, kind=B8Ki), ubound(InData%NodesDOF, kind=B8Ki)) + LB(1:1) = lbound(InData%NodesDOF, kind=B8Ki) + UB(1:1) = ubound(InData%NodesDOF, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackIList(Buf, InData%NodesDOF(i1)) end do end if call RegPack(Buf, allocated(InData%NodesDOFred)) if (allocated(InData%NodesDOFred)) then - call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) - LB(1:1) = lbound(InData%NodesDOFred) - UB(1:1) = ubound(InData%NodesDOFred) + call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred, kind=B8Ki), ubound(InData%NodesDOFred, kind=B8Ki)) + LB(1:1) = lbound(InData%NodesDOFred, kind=B8Ki) + UB(1:1) = ubound(InData%NodesDOFred, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackIList(Buf, InData%NodesDOFred(i1)) end do end if call RegPack(Buf, allocated(InData%ElemsDOF)) if (allocated(InData%ElemsDOF)) then - call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF), ubound(InData%ElemsDOF)) + call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF, kind=B8Ki), ubound(InData%ElemsDOF, kind=B8Ki)) call RegPack(Buf, InData%ElemsDOF) end if call RegPack(Buf, allocated(InData%DOFred2Nodes)) if (allocated(InData%DOFred2Nodes)) then - call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes), ubound(InData%DOFred2Nodes)) + call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes, kind=B8Ki), ubound(InData%DOFred2Nodes, kind=B8Ki)) call RegPack(Buf, InData%DOFred2Nodes) end if call RegPack(Buf, allocated(InData%CtrlElem2Channel)) if (allocated(InData%CtrlElem2Channel)) then - call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel), ubound(InData%CtrlElem2Channel)) + call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel, kind=B8Ki), ubound(InData%CtrlElem2Channel, kind=B8Ki)) call RegPack(Buf, InData%CtrlElem2Channel) end if call RegPack(Buf, InData%nDOFM) @@ -4884,132 +4884,132 @@ subroutine SD_PackParam(Buf, Indata) call RegPack(Buf, InData%Floating) call RegPack(Buf, allocated(InData%KMMDiag)) if (allocated(InData%KMMDiag)) then - call RegPackBounds(Buf, 1, lbound(InData%KMMDiag), ubound(InData%KMMDiag)) + call RegPackBounds(Buf, 1, lbound(InData%KMMDiag, kind=B8Ki), ubound(InData%KMMDiag, kind=B8Ki)) call RegPack(Buf, InData%KMMDiag) end if call RegPack(Buf, allocated(InData%CMMDiag)) if (allocated(InData%CMMDiag)) then - call RegPackBounds(Buf, 1, lbound(InData%CMMDiag), ubound(InData%CMMDiag)) + call RegPackBounds(Buf, 1, lbound(InData%CMMDiag, kind=B8Ki), ubound(InData%CMMDiag, kind=B8Ki)) call RegPack(Buf, InData%CMMDiag) end if call RegPack(Buf, allocated(InData%MMB)) if (allocated(InData%MMB)) then - call RegPackBounds(Buf, 2, lbound(InData%MMB), ubound(InData%MMB)) + call RegPackBounds(Buf, 2, lbound(InData%MMB, kind=B8Ki), ubound(InData%MMB, kind=B8Ki)) call RegPack(Buf, InData%MMB) end if call RegPack(Buf, allocated(InData%MBmmB)) if (allocated(InData%MBmmB)) then - call RegPackBounds(Buf, 2, lbound(InData%MBmmB), ubound(InData%MBmmB)) + call RegPackBounds(Buf, 2, lbound(InData%MBmmB, kind=B8Ki), ubound(InData%MBmmB, kind=B8Ki)) call RegPack(Buf, InData%MBmmB) end if call RegPack(Buf, allocated(InData%C1_11)) if (allocated(InData%C1_11)) then - call RegPackBounds(Buf, 2, lbound(InData%C1_11), ubound(InData%C1_11)) + call RegPackBounds(Buf, 2, lbound(InData%C1_11, kind=B8Ki), ubound(InData%C1_11, kind=B8Ki)) call RegPack(Buf, InData%C1_11) end if call RegPack(Buf, allocated(InData%C1_12)) if (allocated(InData%C1_12)) then - call RegPackBounds(Buf, 2, lbound(InData%C1_12), ubound(InData%C1_12)) + call RegPackBounds(Buf, 2, lbound(InData%C1_12, kind=B8Ki), ubound(InData%C1_12, kind=B8Ki)) call RegPack(Buf, InData%C1_12) end if call RegPack(Buf, allocated(InData%D1_141)) if (allocated(InData%D1_141)) then - call RegPackBounds(Buf, 2, lbound(InData%D1_141), ubound(InData%D1_141)) + call RegPackBounds(Buf, 2, lbound(InData%D1_141, kind=B8Ki), ubound(InData%D1_141, kind=B8Ki)) call RegPack(Buf, InData%D1_141) end if call RegPack(Buf, allocated(InData%D1_142)) if (allocated(InData%D1_142)) then - call RegPackBounds(Buf, 2, lbound(InData%D1_142), ubound(InData%D1_142)) + call RegPackBounds(Buf, 2, lbound(InData%D1_142, kind=B8Ki), ubound(InData%D1_142, kind=B8Ki)) call RegPack(Buf, InData%D1_142) end if call RegPack(Buf, allocated(InData%PhiM)) if (allocated(InData%PhiM)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiM), ubound(InData%PhiM)) + call RegPackBounds(Buf, 2, lbound(InData%PhiM, kind=B8Ki), ubound(InData%PhiM, kind=B8Ki)) call RegPack(Buf, InData%PhiM) end if call RegPack(Buf, allocated(InData%C2_61)) if (allocated(InData%C2_61)) then - call RegPackBounds(Buf, 2, lbound(InData%C2_61), ubound(InData%C2_61)) + call RegPackBounds(Buf, 2, lbound(InData%C2_61, kind=B8Ki), ubound(InData%C2_61, kind=B8Ki)) call RegPack(Buf, InData%C2_61) end if call RegPack(Buf, allocated(InData%C2_62)) if (allocated(InData%C2_62)) then - call RegPackBounds(Buf, 2, lbound(InData%C2_62), ubound(InData%C2_62)) + call RegPackBounds(Buf, 2, lbound(InData%C2_62, kind=B8Ki), ubound(InData%C2_62, kind=B8Ki)) call RegPack(Buf, InData%C2_62) end if call RegPack(Buf, allocated(InData%PhiRb_TI)) if (allocated(InData%PhiRb_TI)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI), ubound(InData%PhiRb_TI)) + call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI, kind=B8Ki), ubound(InData%PhiRb_TI, kind=B8Ki)) call RegPack(Buf, InData%PhiRb_TI) end if call RegPack(Buf, allocated(InData%D2_63)) if (allocated(InData%D2_63)) then - call RegPackBounds(Buf, 2, lbound(InData%D2_63), ubound(InData%D2_63)) + call RegPackBounds(Buf, 2, lbound(InData%D2_63, kind=B8Ki), ubound(InData%D2_63, kind=B8Ki)) call RegPack(Buf, InData%D2_63) end if call RegPack(Buf, allocated(InData%D2_64)) if (allocated(InData%D2_64)) then - call RegPackBounds(Buf, 2, lbound(InData%D2_64), ubound(InData%D2_64)) + call RegPackBounds(Buf, 2, lbound(InData%D2_64, kind=B8Ki), ubound(InData%D2_64, kind=B8Ki)) call RegPack(Buf, InData%D2_64) end if call RegPack(Buf, allocated(InData%MBB)) if (allocated(InData%MBB)) then - call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) + call RegPackBounds(Buf, 2, lbound(InData%MBB, kind=B8Ki), ubound(InData%MBB, kind=B8Ki)) call RegPack(Buf, InData%MBB) end if call RegPack(Buf, allocated(InData%KBB)) if (allocated(InData%KBB)) then - call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) + call RegPackBounds(Buf, 2, lbound(InData%KBB, kind=B8Ki), ubound(InData%KBB, kind=B8Ki)) call RegPack(Buf, InData%KBB) end if call RegPack(Buf, allocated(InData%CBB)) if (allocated(InData%CBB)) then - call RegPackBounds(Buf, 2, lbound(InData%CBB), ubound(InData%CBB)) + call RegPackBounds(Buf, 2, lbound(InData%CBB, kind=B8Ki), ubound(InData%CBB, kind=B8Ki)) call RegPack(Buf, InData%CBB) end if call RegPack(Buf, allocated(InData%CMM)) if (allocated(InData%CMM)) then - call RegPackBounds(Buf, 2, lbound(InData%CMM), ubound(InData%CMM)) + call RegPackBounds(Buf, 2, lbound(InData%CMM, kind=B8Ki), ubound(InData%CMM, kind=B8Ki)) call RegPack(Buf, InData%CMM) end if call RegPack(Buf, allocated(InData%MBM)) if (allocated(InData%MBM)) then - call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) + call RegPackBounds(Buf, 2, lbound(InData%MBM, kind=B8Ki), ubound(InData%MBM, kind=B8Ki)) call RegPack(Buf, InData%MBM) end if call RegPack(Buf, allocated(InData%PhiL_T)) if (allocated(InData%PhiL_T)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiL_T), ubound(InData%PhiL_T)) + call RegPackBounds(Buf, 2, lbound(InData%PhiL_T, kind=B8Ki), ubound(InData%PhiL_T, kind=B8Ki)) call RegPack(Buf, InData%PhiL_T) end if call RegPack(Buf, allocated(InData%PhiLInvOmgL2)) if (allocated(InData%PhiLInvOmgL2)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2), ubound(InData%PhiLInvOmgL2)) + call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2, kind=B8Ki), ubound(InData%PhiLInvOmgL2, kind=B8Ki)) call RegPack(Buf, InData%PhiLInvOmgL2) end if call RegPack(Buf, allocated(InData%KLLm1)) if (allocated(InData%KLLm1)) then - call RegPackBounds(Buf, 2, lbound(InData%KLLm1), ubound(InData%KLLm1)) + call RegPackBounds(Buf, 2, lbound(InData%KLLm1, kind=B8Ki), ubound(InData%KLLm1, kind=B8Ki)) call RegPack(Buf, InData%KLLm1) end if call RegPack(Buf, allocated(InData%AM2Jac)) if (allocated(InData%AM2Jac)) then - call RegPackBounds(Buf, 2, lbound(InData%AM2Jac), ubound(InData%AM2Jac)) + call RegPackBounds(Buf, 2, lbound(InData%AM2Jac, kind=B8Ki), ubound(InData%AM2Jac, kind=B8Ki)) call RegPack(Buf, InData%AM2Jac) end if call RegPack(Buf, allocated(InData%AM2JacPiv)) if (allocated(InData%AM2JacPiv)) then - call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv), ubound(InData%AM2JacPiv)) + call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv, kind=B8Ki), ubound(InData%AM2JacPiv, kind=B8Ki)) call RegPack(Buf, InData%AM2JacPiv) end if call RegPack(Buf, allocated(InData%TI)) if (allocated(InData%TI)) then - call RegPackBounds(Buf, 2, lbound(InData%TI), ubound(InData%TI)) + call RegPackBounds(Buf, 2, lbound(InData%TI, kind=B8Ki), ubound(InData%TI, kind=B8Ki)) call RegPack(Buf, InData%TI) end if call RegPack(Buf, allocated(InData%TIreact)) if (allocated(InData%TIreact)) then - call RegPackBounds(Buf, 2, lbound(InData%TIreact), ubound(InData%TIreact)) + call RegPackBounds(Buf, 2, lbound(InData%TIreact, kind=B8Ki), ubound(InData%TIreact, kind=B8Ki)) call RegPack(Buf, InData%TIreact) end if call RegPack(Buf, InData%nNodes) @@ -5018,17 +5018,17 @@ subroutine SD_PackParam(Buf, Indata) call RegPack(Buf, InData%nNodes_C) call RegPack(Buf, allocated(InData%Nodes_I)) if (allocated(InData%Nodes_I)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes_I), ubound(InData%Nodes_I)) + call RegPackBounds(Buf, 2, lbound(InData%Nodes_I, kind=B8Ki), ubound(InData%Nodes_I, kind=B8Ki)) call RegPack(Buf, InData%Nodes_I) end if call RegPack(Buf, allocated(InData%Nodes_L)) if (allocated(InData%Nodes_L)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes_L), ubound(InData%Nodes_L)) + call RegPackBounds(Buf, 2, lbound(InData%Nodes_L, kind=B8Ki), ubound(InData%Nodes_L, kind=B8Ki)) call RegPack(Buf, InData%Nodes_L) end if call RegPack(Buf, allocated(InData%Nodes_C)) if (allocated(InData%Nodes_C)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes_C), ubound(InData%Nodes_C)) + call RegPackBounds(Buf, 2, lbound(InData%Nodes_C, kind=B8Ki), ubound(InData%Nodes_C, kind=B8Ki)) call RegPack(Buf, InData%Nodes_C) end if call RegPack(Buf, InData%nDOFI__) @@ -5045,62 +5045,62 @@ subroutine SD_PackParam(Buf, Indata) call RegPack(Buf, InData%nDOF__F) call RegPack(Buf, allocated(InData%IDI__)) if (allocated(InData%IDI__)) then - call RegPackBounds(Buf, 1, lbound(InData%IDI__), ubound(InData%IDI__)) + call RegPackBounds(Buf, 1, lbound(InData%IDI__, kind=B8Ki), ubound(InData%IDI__, kind=B8Ki)) call RegPack(Buf, InData%IDI__) end if call RegPack(Buf, allocated(InData%IDI_Rb)) if (allocated(InData%IDI_Rb)) then - call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb), ubound(InData%IDI_Rb)) + call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb, kind=B8Ki), ubound(InData%IDI_Rb, kind=B8Ki)) call RegPack(Buf, InData%IDI_Rb) end if call RegPack(Buf, allocated(InData%IDI_F)) if (allocated(InData%IDI_F)) then - call RegPackBounds(Buf, 1, lbound(InData%IDI_F), ubound(InData%IDI_F)) + call RegPackBounds(Buf, 1, lbound(InData%IDI_F, kind=B8Ki), ubound(InData%IDI_F, kind=B8Ki)) call RegPack(Buf, InData%IDI_F) end if call RegPack(Buf, allocated(InData%IDL_L)) if (allocated(InData%IDL_L)) then - call RegPackBounds(Buf, 1, lbound(InData%IDL_L), ubound(InData%IDL_L)) + call RegPackBounds(Buf, 1, lbound(InData%IDL_L, kind=B8Ki), ubound(InData%IDL_L, kind=B8Ki)) call RegPack(Buf, InData%IDL_L) end if call RegPack(Buf, allocated(InData%IDC__)) if (allocated(InData%IDC__)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC__), ubound(InData%IDC__)) + call RegPackBounds(Buf, 1, lbound(InData%IDC__, kind=B8Ki), ubound(InData%IDC__, kind=B8Ki)) call RegPack(Buf, InData%IDC__) end if call RegPack(Buf, allocated(InData%IDC_Rb)) if (allocated(InData%IDC_Rb)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb), ubound(InData%IDC_Rb)) + call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb, kind=B8Ki), ubound(InData%IDC_Rb, kind=B8Ki)) call RegPack(Buf, InData%IDC_Rb) end if call RegPack(Buf, allocated(InData%IDC_L)) if (allocated(InData%IDC_L)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC_L), ubound(InData%IDC_L)) + call RegPackBounds(Buf, 1, lbound(InData%IDC_L, kind=B8Ki), ubound(InData%IDC_L, kind=B8Ki)) call RegPack(Buf, InData%IDC_L) end if call RegPack(Buf, allocated(InData%IDC_F)) if (allocated(InData%IDC_F)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC_F), ubound(InData%IDC_F)) + call RegPackBounds(Buf, 1, lbound(InData%IDC_F, kind=B8Ki), ubound(InData%IDC_F, kind=B8Ki)) call RegPack(Buf, InData%IDC_F) end if call RegPack(Buf, allocated(InData%IDR__)) if (allocated(InData%IDR__)) then - call RegPackBounds(Buf, 1, lbound(InData%IDR__), ubound(InData%IDR__)) + call RegPackBounds(Buf, 1, lbound(InData%IDR__, kind=B8Ki), ubound(InData%IDR__, kind=B8Ki)) call RegPack(Buf, InData%IDR__) end if call RegPack(Buf, allocated(InData%ID__Rb)) if (allocated(InData%ID__Rb)) then - call RegPackBounds(Buf, 1, lbound(InData%ID__Rb), ubound(InData%ID__Rb)) + call RegPackBounds(Buf, 1, lbound(InData%ID__Rb, kind=B8Ki), ubound(InData%ID__Rb, kind=B8Ki)) call RegPack(Buf, InData%ID__Rb) end if call RegPack(Buf, allocated(InData%ID__L)) if (allocated(InData%ID__L)) then - call RegPackBounds(Buf, 1, lbound(InData%ID__L), ubound(InData%ID__L)) + call RegPackBounds(Buf, 1, lbound(InData%ID__L, kind=B8Ki), ubound(InData%ID__L, kind=B8Ki)) call RegPack(Buf, InData%ID__L) end if call RegPack(Buf, allocated(InData%ID__F)) if (allocated(InData%ID__F)) then - call RegPackBounds(Buf, 1, lbound(InData%ID__F), ubound(InData%ID__F)) + call RegPackBounds(Buf, 1, lbound(InData%ID__F, kind=B8Ki), ubound(InData%ID__F, kind=B8Ki)) call RegPack(Buf, InData%ID__F) end if call RegPack(Buf, InData%NMOutputs) @@ -5112,36 +5112,36 @@ subroutine SD_PackParam(Buf, Indata) call RegPack(Buf, InData%OutSFmt) call RegPack(Buf, allocated(InData%MoutLst)) if (allocated(InData%MoutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) - LB(1:1) = lbound(InData%MoutLst) - UB(1:1) = ubound(InData%MoutLst) + call RegPackBounds(Buf, 1, lbound(InData%MoutLst, kind=B8Ki), ubound(InData%MoutLst, kind=B8Ki)) + LB(1:1) = lbound(InData%MoutLst, kind=B8Ki) + UB(1:1) = ubound(InData%MoutLst, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(Buf, InData%MoutLst(i1)) end do end if call RegPack(Buf, allocated(InData%MoutLst2)) if (allocated(InData%MoutLst2)) then - call RegPackBounds(Buf, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) - LB(1:1) = lbound(InData%MoutLst2) - UB(1:1) = ubound(InData%MoutLst2) + call RegPackBounds(Buf, 1, lbound(InData%MoutLst2, kind=B8Ki), ubound(InData%MoutLst2, kind=B8Ki)) + LB(1:1) = lbound(InData%MoutLst2, kind=B8Ki) + UB(1:1) = ubound(InData%MoutLst2, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(Buf, InData%MoutLst2(i1)) end do end if call RegPack(Buf, allocated(InData%MoutLst3)) if (allocated(InData%MoutLst3)) then - call RegPackBounds(Buf, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) - LB(1:1) = lbound(InData%MoutLst3) - UB(1:1) = ubound(InData%MoutLst3) + call RegPackBounds(Buf, 1, lbound(InData%MoutLst3, kind=B8Ki), ubound(InData%MoutLst3, kind=B8Ki)) + LB(1:1) = lbound(InData%MoutLst3, kind=B8Ki) + UB(1:1) = ubound(InData%MoutLst3, kind=B8Ki) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(Buf, InData%MoutLst3(i1)) end do end if call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) - LB(1:1) = lbound(InData%OutParam) - UB(1:1) = ubound(InData%OutParam) + call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do @@ -5155,12 +5155,12 @@ subroutine SD_PackParam(Buf, Indata) call RegPack(Buf, InData%OutDec) call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) call RegPack(Buf, InData%Jac_u_indx) end if call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) call RegPack(Buf, InData%du) end if call RegPack(Buf, InData%dx) @@ -5174,8 +5174,8 @@ subroutine SD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackParam' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2 + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6108,7 +6108,7 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInput' @@ -6121,8 +6121,8 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%CableDeltaL)) then - LB(1:1) = lbound(SrcInputData%CableDeltaL) - UB(1:1) = ubound(SrcInputData%CableDeltaL) + LB(1:1) = lbound(SrcInputData%CableDeltaL, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%CableDeltaL, kind=B8Ki) if (.not. allocated(DstInputData%CableDeltaL)) then allocate(DstInputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6161,7 +6161,7 @@ subroutine SD_PackInput(Buf, Indata) call MeshPack(Buf, InData%LMesh) call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL, kind=B8Ki), ubound(InData%CableDeltaL, kind=B8Ki)) call RegPack(Buf, InData%CableDeltaL) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6171,7 +6171,7 @@ subroutine SD_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -6199,7 +6199,7 @@ subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyOutput' @@ -6215,8 +6215,8 @@ subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput) - UB(1:1) = ubound(SrcOutputData%WriteOutput) + LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) if (.not. allocated(DstOutputData%WriteOutput)) then allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6258,7 +6258,7 @@ subroutine SD_PackOutput(Buf, Indata) call MeshPack(Buf, InData%Y3Mesh) call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return @@ -6268,7 +6268,7 @@ subroutine SD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 19cb174848..fcefcf10ab 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -361,14 +361,14 @@ subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_DX_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%toSC)) then - LB(1:1) = lbound(SrcInputData%toSC) - UB(1:1) = ubound(SrcInputData%toSC) + LB(1:1) = lbound(SrcInputData%toSC, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%toSC, kind=B8Ki) if (.not. associated(DstInputData%toSC)) then allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -410,7 +410,7 @@ subroutine SC_DX_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%toSC)) if (associated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%toSC) @@ -423,10 +423,10 @@ subroutine SC_DX_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SC_DX_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%toSC)) deallocate(OutData%toSC) @@ -507,7 +507,7 @@ SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSC_Len = SIZE(InputData%toSC) IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1))) + InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -518,14 +518,14 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_DX_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%fromSC)) then - LB(1:1) = lbound(SrcOutputData%fromSC) - UB(1:1) = ubound(SrcOutputData%fromSC) + LB(1:1) = lbound(SrcOutputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%fromSC, kind=B8Ki) if (.not. associated(DstOutputData%fromSC)) then allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -539,8 +539,8 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%fromSC = SrcOutputData%fromSC end if if (associated(SrcOutputData%fromSCglob)) then - LB(1:1) = lbound(SrcOutputData%fromSCglob) - UB(1:1) = ubound(SrcOutputData%fromSCglob) + LB(1:1) = lbound(SrcOutputData%fromSCglob, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%fromSCglob, kind=B8Ki) if (.not. associated(DstOutputData%fromSCglob)) then allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -588,7 +588,7 @@ subroutine SC_DX_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%fromSC)) if (associated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fromSC) @@ -596,7 +596,7 @@ subroutine SC_DX_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%fromSCglob)) if (associated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fromSCglob) @@ -609,10 +609,10 @@ subroutine SC_DX_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SC_DX_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%fromSC)) deallocate(OutData%fromSC) @@ -728,7 +728,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1))) + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1, kind=B8Ki))) END IF END IF @@ -740,7 +740,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1))) + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1, kind=B8Ki))) END IF END IF END SUBROUTINE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index a78ceeb316..dce6747bce 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -392,7 +392,7 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SC_CopyParam' @@ -419,8 +419,8 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine if (associated(SrcParamData%ParamGlobal)) then - LB(1:1) = lbound(SrcParamData%ParamGlobal) - UB(1:1) = ubound(SrcParamData%ParamGlobal) + LB(1:1) = lbound(SrcParamData%ParamGlobal, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ParamGlobal, kind=B8Ki) if (.not. associated(DstParamData%ParamGlobal)) then allocate(DstParamData%ParamGlobal(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -434,8 +434,8 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ParamGlobal = SrcParamData%ParamGlobal end if if (associated(SrcParamData%ParamTurbine)) then - LB(1:1) = lbound(SrcParamData%ParamTurbine) - UB(1:1) = ubound(SrcParamData%ParamTurbine) + LB(1:1) = lbound(SrcParamData%ParamTurbine, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%ParamTurbine, kind=B8Ki) if (.not. associated(DstParamData%ParamTurbine)) then allocate(DstParamData%ParamTurbine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -498,7 +498,7 @@ subroutine SC_PackParam(Buf, Indata) call RegPack(Buf, InData%NumParamTurbine) call RegPack(Buf, associated(InData%ParamGlobal)) if (associated(InData%ParamGlobal)) then - call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal), ubound(InData%ParamGlobal)) + call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal, kind=B8Ki), ubound(InData%ParamGlobal, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%ParamGlobal), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%ParamGlobal) @@ -506,7 +506,7 @@ subroutine SC_PackParam(Buf, Indata) end if call RegPack(Buf, associated(InData%ParamTurbine)) if (associated(InData%ParamTurbine)) then - call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine), ubound(InData%ParamTurbine)) + call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine, kind=B8Ki), ubound(InData%ParamTurbine, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%ParamTurbine), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%ParamTurbine) @@ -520,10 +520,10 @@ subroutine SC_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackParam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return call RegUnpack(Buf, OutData%DT) @@ -690,7 +690,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) IF (ParamData%C_obj%ParamGlobal_Len > 0) & - ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(LBOUND(ParamData%ParamGlobal,1))) + ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(LBOUND(ParamData%ParamGlobal,1, kind=B8Ki))) END IF END IF @@ -702,7 +702,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) IF (ParamData%C_obj%ParamTurbine_Len > 0) & - ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(LBOUND(ParamData%ParamTurbine,1))) + ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(LBOUND(ParamData%ParamTurbine,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -713,14 +713,14 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcDiscStateData%Global)) then - LB(1:1) = lbound(SrcDiscStateData%Global) - UB(1:1) = ubound(SrcDiscStateData%Global) + LB(1:1) = lbound(SrcDiscStateData%Global, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%Global, kind=B8Ki) if (.not. associated(DstDiscStateData%Global)) then allocate(DstDiscStateData%Global(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -734,8 +734,8 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Global = SrcDiscStateData%Global end if if (associated(SrcDiscStateData%Turbine)) then - LB(1:1) = lbound(SrcDiscStateData%Turbine) - UB(1:1) = ubound(SrcDiscStateData%Turbine) + LB(1:1) = lbound(SrcDiscStateData%Turbine, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%Turbine, kind=B8Ki) if (.not. associated(DstDiscStateData%Turbine)) then allocate(DstDiscStateData%Turbine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -783,7 +783,7 @@ subroutine SC_PackDiscState(Buf, Indata) end if call RegPack(Buf, associated(InData%Global)) if (associated(InData%Global)) then - call RegPackBounds(Buf, 1, lbound(InData%Global), ubound(InData%Global)) + call RegPackBounds(Buf, 1, lbound(InData%Global, kind=B8Ki), ubound(InData%Global, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Global), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Global) @@ -791,7 +791,7 @@ subroutine SC_PackDiscState(Buf, Indata) end if call RegPack(Buf, associated(InData%Turbine)) if (associated(InData%Turbine)) then - call RegPackBounds(Buf, 1, lbound(InData%Turbine), ubound(InData%Turbine)) + call RegPackBounds(Buf, 1, lbound(InData%Turbine, kind=B8Ki), ubound(InData%Turbine, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%Turbine), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%Turbine) @@ -804,10 +804,10 @@ subroutine SC_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SC_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackDiscState' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%Global)) deallocate(OutData%Global) @@ -923,7 +923,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ELSE DiscStateData%C_obj%Global_Len = SIZE(DiscStateData%Global) IF (DiscStateData%C_obj%Global_Len > 0) & - DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(LBOUND(DiscStateData%Global,1))) + DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(LBOUND(DiscStateData%Global,1, kind=B8Ki))) END IF END IF @@ -935,7 +935,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ELSE DiscStateData%C_obj%Turbine_Len = SIZE(DiscStateData%Turbine) IF (DiscStateData%C_obj%Turbine_Len > 0) & - DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(LBOUND(DiscStateData%Turbine,1))) + DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(LBOUND(DiscStateData%Turbine,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -1270,14 +1270,14 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%toSCglob)) then - LB(1:1) = lbound(SrcInputData%toSCglob) - UB(1:1) = ubound(SrcInputData%toSCglob) + LB(1:1) = lbound(SrcInputData%toSCglob, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%toSCglob, kind=B8Ki) if (.not. associated(DstInputData%toSCglob)) then allocate(DstInputData%toSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1291,8 +1291,8 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%toSCglob = SrcInputData%toSCglob end if if (associated(SrcInputData%toSC)) then - LB(1:1) = lbound(SrcInputData%toSC) - UB(1:1) = ubound(SrcInputData%toSC) + LB(1:1) = lbound(SrcInputData%toSC, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%toSC, kind=B8Ki) if (.not. associated(DstInputData%toSC)) then allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1340,7 +1340,7 @@ subroutine SC_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%toSCglob)) if (associated(InData%toSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%toSCglob), ubound(InData%toSCglob)) + call RegPackBounds(Buf, 1, lbound(InData%toSCglob, kind=B8Ki), ubound(InData%toSCglob, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%toSCglob), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%toSCglob) @@ -1348,7 +1348,7 @@ subroutine SC_PackInput(Buf, Indata) end if call RegPack(Buf, associated(InData%toSC)) if (associated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%toSC) @@ -1361,10 +1361,10 @@ subroutine SC_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%toSCglob)) deallocate(OutData%toSCglob) @@ -1480,7 +1480,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSCglob_Len = SIZE(InputData%toSCglob) IF (InputData%C_obj%toSCglob_Len > 0) & - InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(LBOUND(InputData%toSCglob,1))) + InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(LBOUND(InputData%toSCglob,1, kind=B8Ki))) END IF END IF @@ -1492,7 +1492,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSC_Len = SIZE(InputData%toSC) IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1))) + InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1, kind=B8Ki))) END IF END IF END SUBROUTINE @@ -1503,14 +1503,14 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%fromSCglob)) then - LB(1:1) = lbound(SrcOutputData%fromSCglob) - UB(1:1) = ubound(SrcOutputData%fromSCglob) + LB(1:1) = lbound(SrcOutputData%fromSCglob, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%fromSCglob, kind=B8Ki) if (.not. associated(DstOutputData%fromSCglob)) then allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1524,8 +1524,8 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%fromSCglob = SrcOutputData%fromSCglob end if if (associated(SrcOutputData%fromSC)) then - LB(1:1) = lbound(SrcOutputData%fromSC) - UB(1:1) = ubound(SrcOutputData%fromSC) + LB(1:1) = lbound(SrcOutputData%fromSC, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%fromSC, kind=B8Ki) if (.not. associated(DstOutputData%fromSC)) then allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1573,7 +1573,7 @@ subroutine SC_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%fromSCglob)) if (associated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fromSCglob) @@ -1581,7 +1581,7 @@ subroutine SC_PackOutput(Buf, Indata) end if call RegPack(Buf, associated(InData%fromSC)) if (associated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) if (.not. PtrInIndex) then call RegPack(Buf, InData%fromSC) @@ -1594,10 +1594,10 @@ subroutine SC_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(SC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - integer(IntKi) :: PtrIdx + integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) @@ -1713,7 +1713,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1))) + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1, kind=B8Ki))) END IF END IF @@ -1725,7 +1725,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1))) + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1, kind=B8Ki))) END IF END IF END SUBROUTINE diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 61bfb7e301..ea0d0bd9b8 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -453,15 +453,15 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -472,8 +472,8 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -514,12 +514,12 @@ subroutine WD_PackInitOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputHdr) end if call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) call RegPack(Buf, InData%WriteOutputUnt) end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) @@ -530,7 +530,7 @@ subroutine WD_UnPackInitOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -610,14 +610,14 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%xhat_plane)) then - LB(1:2) = lbound(SrcDiscStateData%xhat_plane) - UB(1:2) = ubound(SrcDiscStateData%xhat_plane) + LB(1:2) = lbound(SrcDiscStateData%xhat_plane, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%xhat_plane, kind=B8Ki) if (.not. allocated(DstDiscStateData%xhat_plane)) then allocate(DstDiscStateData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -628,8 +628,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane end if if (allocated(SrcDiscStateData%YawErr_filt)) then - LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) - UB(1:1) = ubound(SrcDiscStateData%YawErr_filt) + LB(1:1) = lbound(SrcDiscStateData%YawErr_filt, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%YawErr_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%YawErr_filt)) then allocate(DstDiscStateData%YawErr_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -642,8 +642,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt if (allocated(SrcDiscStateData%V_plane_filt)) then - LB(1:2) = lbound(SrcDiscStateData%V_plane_filt) - UB(1:2) = ubound(SrcDiscStateData%V_plane_filt) + LB(1:2) = lbound(SrcDiscStateData%V_plane_filt, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%V_plane_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%V_plane_filt)) then allocate(DstDiscStateData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -654,8 +654,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt end if if (allocated(SrcDiscStateData%p_plane)) then - LB(1:2) = lbound(SrcDiscStateData%p_plane) - UB(1:2) = ubound(SrcDiscStateData%p_plane) + LB(1:2) = lbound(SrcDiscStateData%p_plane, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%p_plane, kind=B8Ki) if (.not. allocated(DstDiscStateData%p_plane)) then allocate(DstDiscStateData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,8 +666,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%p_plane = SrcDiscStateData%p_plane end if if (allocated(SrcDiscStateData%x_plane)) then - LB(1:1) = lbound(SrcDiscStateData%x_plane) - UB(1:1) = ubound(SrcDiscStateData%x_plane) + LB(1:1) = lbound(SrcDiscStateData%x_plane, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%x_plane, kind=B8Ki) if (.not. allocated(DstDiscStateData%x_plane)) then allocate(DstDiscStateData%x_plane(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -678,8 +678,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%x_plane = SrcDiscStateData%x_plane end if if (allocated(SrcDiscStateData%Vx_wake)) then - LB(1:2) = lbound(SrcDiscStateData%Vx_wake) - UB(1:2) = ubound(SrcDiscStateData%Vx_wake) + LB(1:2) = lbound(SrcDiscStateData%Vx_wake, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Vx_wake, kind=B8Ki) if (.not. allocated(DstDiscStateData%Vx_wake)) then allocate(DstDiscStateData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -690,8 +690,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake end if if (allocated(SrcDiscStateData%Vr_wake)) then - LB(1:2) = lbound(SrcDiscStateData%Vr_wake) - UB(1:2) = ubound(SrcDiscStateData%Vr_wake) + LB(1:2) = lbound(SrcDiscStateData%Vr_wake, kind=B8Ki) + UB(1:2) = ubound(SrcDiscStateData%Vr_wake, kind=B8Ki) if (.not. allocated(DstDiscStateData%Vr_wake)) then allocate(DstDiscStateData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -702,8 +702,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake end if if (allocated(SrcDiscStateData%Vx_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) - UB(1:3) = ubound(SrcDiscStateData%Vx_wake2) + LB(1:3) = lbound(SrcDiscStateData%Vx_wake2, kind=B8Ki) + UB(1:3) = ubound(SrcDiscStateData%Vx_wake2, kind=B8Ki) if (.not. allocated(DstDiscStateData%Vx_wake2)) then allocate(DstDiscStateData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -714,8 +714,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 end if if (allocated(SrcDiscStateData%Vy_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) - UB(1:3) = ubound(SrcDiscStateData%Vy_wake2) + LB(1:3) = lbound(SrcDiscStateData%Vy_wake2, kind=B8Ki) + UB(1:3) = ubound(SrcDiscStateData%Vy_wake2, kind=B8Ki) if (.not. allocated(DstDiscStateData%Vy_wake2)) then allocate(DstDiscStateData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -726,8 +726,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 end if if (allocated(SrcDiscStateData%Vz_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) - UB(1:3) = ubound(SrcDiscStateData%Vz_wake2) + LB(1:3) = lbound(SrcDiscStateData%Vz_wake2, kind=B8Ki) + UB(1:3) = ubound(SrcDiscStateData%Vz_wake2, kind=B8Ki) if (.not. allocated(DstDiscStateData%Vz_wake2)) then allocate(DstDiscStateData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -738,8 +738,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 end if if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) - UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt) + LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%Vx_wind_disk_filt)) then allocate(DstDiscStateData%Vx_wind_disk_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -750,8 +750,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt end if if (allocated(SrcDiscStateData%TI_amb_filt)) then - LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) - UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt) + LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%TI_amb_filt)) then allocate(DstDiscStateData%TI_amb_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -762,8 +762,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt end if if (allocated(SrcDiscStateData%D_rotor_filt)) then - LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) - UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt) + LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%D_rotor_filt)) then allocate(DstDiscStateData%D_rotor_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -775,8 +775,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt if (allocated(SrcDiscStateData%Ct_azavg_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt) - UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt) + LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%Ct_azavg_filt)) then allocate(DstDiscStateData%Ct_azavg_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -787,8 +787,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt end if if (allocated(SrcDiscStateData%Cq_azavg_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) - UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt) + LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt, kind=B8Ki) + UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt, kind=B8Ki) if (.not. allocated(DstDiscStateData%Cq_azavg_filt)) then allocate(DstDiscStateData%Cq_azavg_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -861,80 +861,80 @@ subroutine WD_PackDiscState(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%xhat_plane)) if (allocated(InData%xhat_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPackBounds(Buf, 2, lbound(InData%xhat_plane, kind=B8Ki), ubound(InData%xhat_plane, kind=B8Ki)) call RegPack(Buf, InData%xhat_plane) end if call RegPack(Buf, allocated(InData%YawErr_filt)) if (allocated(InData%YawErr_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt), ubound(InData%YawErr_filt)) + call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt, kind=B8Ki), ubound(InData%YawErr_filt, kind=B8Ki)) call RegPack(Buf, InData%YawErr_filt) end if call RegPack(Buf, InData%psi_skew_filt) call RegPack(Buf, InData%chi_skew_filt) call RegPack(Buf, allocated(InData%V_plane_filt)) if (allocated(InData%V_plane_filt)) then - call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt), ubound(InData%V_plane_filt)) + call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt, kind=B8Ki), ubound(InData%V_plane_filt, kind=B8Ki)) call RegPack(Buf, InData%V_plane_filt) end if call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPackBounds(Buf, 2, lbound(InData%p_plane, kind=B8Ki), ubound(InData%p_plane, kind=B8Ki)) call RegPack(Buf, InData%p_plane) end if call RegPack(Buf, allocated(InData%x_plane)) if (allocated(InData%x_plane)) then - call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) + call RegPackBounds(Buf, 1, lbound(InData%x_plane, kind=B8Ki), ubound(InData%x_plane, kind=B8Ki)) call RegPack(Buf, InData%x_plane) end if call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPackBounds(Buf, 2, lbound(InData%Vx_wake, kind=B8Ki), ubound(InData%Vx_wake, kind=B8Ki)) call RegPack(Buf, InData%Vx_wake) end if call RegPack(Buf, allocated(InData%Vr_wake)) if (allocated(InData%Vr_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) + call RegPackBounds(Buf, 2, lbound(InData%Vr_wake, kind=B8Ki), ubound(InData%Vr_wake, kind=B8Ki)) call RegPack(Buf, InData%Vr_wake) end if call RegPack(Buf, allocated(InData%Vx_wake2)) if (allocated(InData%Vx_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) + call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2, kind=B8Ki), ubound(InData%Vx_wake2, kind=B8Ki)) call RegPack(Buf, InData%Vx_wake2) end if call RegPack(Buf, allocated(InData%Vy_wake2)) if (allocated(InData%Vy_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) + call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2, kind=B8Ki), ubound(InData%Vy_wake2, kind=B8Ki)) call RegPack(Buf, InData%Vy_wake2) end if call RegPack(Buf, allocated(InData%Vz_wake2)) if (allocated(InData%Vz_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) + call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2, kind=B8Ki), ubound(InData%Vz_wake2, kind=B8Ki)) call RegPack(Buf, InData%Vz_wake2) end if call RegPack(Buf, allocated(InData%Vx_wind_disk_filt)) if (allocated(InData%Vx_wind_disk_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt), ubound(InData%Vx_wind_disk_filt)) + call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt, kind=B8Ki), ubound(InData%Vx_wind_disk_filt, kind=B8Ki)) call RegPack(Buf, InData%Vx_wind_disk_filt) end if call RegPack(Buf, allocated(InData%TI_amb_filt)) if (allocated(InData%TI_amb_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt), ubound(InData%TI_amb_filt)) + call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt, kind=B8Ki), ubound(InData%TI_amb_filt, kind=B8Ki)) call RegPack(Buf, InData%TI_amb_filt) end if call RegPack(Buf, allocated(InData%D_rotor_filt)) if (allocated(InData%D_rotor_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt), ubound(InData%D_rotor_filt)) + call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt, kind=B8Ki), ubound(InData%D_rotor_filt, kind=B8Ki)) call RegPack(Buf, InData%D_rotor_filt) end if call RegPack(Buf, InData%Vx_rel_disk_filt) call RegPack(Buf, allocated(InData%Ct_azavg_filt)) if (allocated(InData%Ct_azavg_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt), ubound(InData%Ct_azavg_filt)) + call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt, kind=B8Ki), ubound(InData%Ct_azavg_filt, kind=B8Ki)) call RegPack(Buf, InData%Ct_azavg_filt) end if call RegPack(Buf, allocated(InData%Cq_azavg_filt)) if (allocated(InData%Cq_azavg_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt), ubound(InData%Cq_azavg_filt)) + call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt, kind=B8Ki), ubound(InData%Cq_azavg_filt, kind=B8Ki)) call RegPack(Buf, InData%Cq_azavg_filt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -944,7 +944,7 @@ subroutine WD_UnPackDiscState(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackDiscState' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -1250,14 +1250,14 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%dvtdr)) then - LB(1:1) = lbound(SrcMiscData%dvtdr) - UB(1:1) = ubound(SrcMiscData%dvtdr) + LB(1:1) = lbound(SrcMiscData%dvtdr, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%dvtdr, kind=B8Ki) if (.not. allocated(DstMiscData%dvtdr)) then allocate(DstMiscData%dvtdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1268,8 +1268,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvtdr = SrcMiscData%dvtdr end if if (allocated(SrcMiscData%vt_tot)) then - LB(1:2) = lbound(SrcMiscData%vt_tot) - UB(1:2) = ubound(SrcMiscData%vt_tot) + LB(1:2) = lbound(SrcMiscData%vt_tot, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%vt_tot, kind=B8Ki) if (.not. allocated(DstMiscData%vt_tot)) then allocate(DstMiscData%vt_tot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1280,8 +1280,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_tot = SrcMiscData%vt_tot end if if (allocated(SrcMiscData%vt_amb)) then - LB(1:2) = lbound(SrcMiscData%vt_amb) - UB(1:2) = ubound(SrcMiscData%vt_amb) + LB(1:2) = lbound(SrcMiscData%vt_amb, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%vt_amb, kind=B8Ki) if (.not. allocated(DstMiscData%vt_amb)) then allocate(DstMiscData%vt_amb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1292,8 +1292,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_amb = SrcMiscData%vt_amb end if if (allocated(SrcMiscData%vt_shr)) then - LB(1:2) = lbound(SrcMiscData%vt_shr) - UB(1:2) = ubound(SrcMiscData%vt_shr) + LB(1:2) = lbound(SrcMiscData%vt_shr, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%vt_shr, kind=B8Ki) if (.not. allocated(DstMiscData%vt_shr)) then allocate(DstMiscData%vt_shr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1304,8 +1304,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_shr = SrcMiscData%vt_shr end if if (allocated(SrcMiscData%vt_tot2)) then - LB(1:3) = lbound(SrcMiscData%vt_tot2) - UB(1:3) = ubound(SrcMiscData%vt_tot2) + LB(1:3) = lbound(SrcMiscData%vt_tot2, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%vt_tot2, kind=B8Ki) if (.not. allocated(DstMiscData%vt_tot2)) then allocate(DstMiscData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1316,8 +1316,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 end if if (allocated(SrcMiscData%vt_amb2)) then - LB(1:3) = lbound(SrcMiscData%vt_amb2) - UB(1:3) = ubound(SrcMiscData%vt_amb2) + LB(1:3) = lbound(SrcMiscData%vt_amb2, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%vt_amb2, kind=B8Ki) if (.not. allocated(DstMiscData%vt_amb2)) then allocate(DstMiscData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1328,8 +1328,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 end if if (allocated(SrcMiscData%vt_shr2)) then - LB(1:3) = lbound(SrcMiscData%vt_shr2) - UB(1:3) = ubound(SrcMiscData%vt_shr2) + LB(1:3) = lbound(SrcMiscData%vt_shr2, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%vt_shr2, kind=B8Ki) if (.not. allocated(DstMiscData%vt_shr2)) then allocate(DstMiscData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1340,8 +1340,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 end if if (allocated(SrcMiscData%dvx_dy)) then - LB(1:3) = lbound(SrcMiscData%dvx_dy) - UB(1:3) = ubound(SrcMiscData%dvx_dy) + LB(1:3) = lbound(SrcMiscData%dvx_dy, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%dvx_dy, kind=B8Ki) if (.not. allocated(DstMiscData%dvx_dy)) then allocate(DstMiscData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1352,8 +1352,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvx_dy = SrcMiscData%dvx_dy end if if (allocated(SrcMiscData%dvx_dz)) then - LB(1:3) = lbound(SrcMiscData%dvx_dz) - UB(1:3) = ubound(SrcMiscData%dvx_dz) + LB(1:3) = lbound(SrcMiscData%dvx_dz, kind=B8Ki) + UB(1:3) = ubound(SrcMiscData%dvx_dz, kind=B8Ki) if (.not. allocated(DstMiscData%dvx_dz)) then allocate(DstMiscData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1364,8 +1364,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvx_dz = SrcMiscData%dvx_dz end if if (allocated(SrcMiscData%nu_dvx_dy)) then - LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) - UB(1:2) = ubound(SrcMiscData%nu_dvx_dy) + LB(1:2) = lbound(SrcMiscData%nu_dvx_dy, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dy, kind=B8Ki) if (.not. allocated(DstMiscData%nu_dvx_dy)) then allocate(DstMiscData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1376,8 +1376,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy end if if (allocated(SrcMiscData%nu_dvx_dz)) then - LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) - UB(1:2) = ubound(SrcMiscData%nu_dvx_dz) + LB(1:2) = lbound(SrcMiscData%nu_dvx_dz, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dz, kind=B8Ki) if (.not. allocated(DstMiscData%nu_dvx_dz)) then allocate(DstMiscData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1388,8 +1388,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz end if if (allocated(SrcMiscData%dnuvx_dy)) then - LB(1:2) = lbound(SrcMiscData%dnuvx_dy) - UB(1:2) = ubound(SrcMiscData%dnuvx_dy) + LB(1:2) = lbound(SrcMiscData%dnuvx_dy, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dnuvx_dy, kind=B8Ki) if (.not. allocated(DstMiscData%dnuvx_dy)) then allocate(DstMiscData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1400,8 +1400,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy end if if (allocated(SrcMiscData%dnuvx_dz)) then - LB(1:2) = lbound(SrcMiscData%dnuvx_dz) - UB(1:2) = ubound(SrcMiscData%dnuvx_dz) + LB(1:2) = lbound(SrcMiscData%dnuvx_dz, kind=B8Ki) + UB(1:2) = ubound(SrcMiscData%dnuvx_dz, kind=B8Ki) if (.not. allocated(DstMiscData%dnuvx_dz)) then allocate(DstMiscData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1412,8 +1412,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz end if if (allocated(SrcMiscData%a)) then - LB(1:1) = lbound(SrcMiscData%a) - UB(1:1) = ubound(SrcMiscData%a) + LB(1:1) = lbound(SrcMiscData%a, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%a, kind=B8Ki) if (.not. allocated(DstMiscData%a)) then allocate(DstMiscData%a(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1424,8 +1424,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%a = SrcMiscData%a end if if (allocated(SrcMiscData%b)) then - LB(1:1) = lbound(SrcMiscData%b) - UB(1:1) = ubound(SrcMiscData%b) + LB(1:1) = lbound(SrcMiscData%b, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%b, kind=B8Ki) if (.not. allocated(DstMiscData%b)) then allocate(DstMiscData%b(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1436,8 +1436,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%b = SrcMiscData%b end if if (allocated(SrcMiscData%c)) then - LB(1:1) = lbound(SrcMiscData%c) - UB(1:1) = ubound(SrcMiscData%c) + LB(1:1) = lbound(SrcMiscData%c, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%c, kind=B8Ki) if (.not. allocated(DstMiscData%c)) then allocate(DstMiscData%c(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1448,8 +1448,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%c = SrcMiscData%c end if if (allocated(SrcMiscData%d)) then - LB(1:1) = lbound(SrcMiscData%d) - UB(1:1) = ubound(SrcMiscData%d) + LB(1:1) = lbound(SrcMiscData%d, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%d, kind=B8Ki) if (.not. allocated(DstMiscData%d)) then allocate(DstMiscData%d(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1460,8 +1460,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%d = SrcMiscData%d end if if (allocated(SrcMiscData%r_wake)) then - LB(1:1) = lbound(SrcMiscData%r_wake) - UB(1:1) = ubound(SrcMiscData%r_wake) + LB(1:1) = lbound(SrcMiscData%r_wake, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%r_wake, kind=B8Ki) if (.not. allocated(DstMiscData%r_wake)) then allocate(DstMiscData%r_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1472,8 +1472,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_wake = SrcMiscData%r_wake end if if (allocated(SrcMiscData%Vx_high)) then - LB(1:1) = lbound(SrcMiscData%Vx_high) - UB(1:1) = ubound(SrcMiscData%Vx_high) + LB(1:1) = lbound(SrcMiscData%Vx_high, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Vx_high, kind=B8Ki) if (.not. allocated(DstMiscData%Vx_high)) then allocate(DstMiscData%Vx_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1484,8 +1484,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vx_high = SrcMiscData%Vx_high end if if (allocated(SrcMiscData%Vx_polar)) then - LB(1:1) = lbound(SrcMiscData%Vx_polar) - UB(1:1) = ubound(SrcMiscData%Vx_polar) + LB(1:1) = lbound(SrcMiscData%Vx_polar, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Vx_polar, kind=B8Ki) if (.not. allocated(DstMiscData%Vx_polar)) then allocate(DstMiscData%Vx_polar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1496,8 +1496,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vx_polar = SrcMiscData%Vx_polar end if if (allocated(SrcMiscData%Vt_wake)) then - LB(1:1) = lbound(SrcMiscData%Vt_wake) - UB(1:1) = ubound(SrcMiscData%Vt_wake) + LB(1:1) = lbound(SrcMiscData%Vt_wake, kind=B8Ki) + UB(1:1) = ubound(SrcMiscData%Vt_wake, kind=B8Ki) if (.not. allocated(DstMiscData%Vt_wake)) then allocate(DstMiscData%Vt_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1590,107 +1590,107 @@ subroutine WD_PackMisc(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%dvtdr)) if (allocated(InData%dvtdr)) then - call RegPackBounds(Buf, 1, lbound(InData%dvtdr), ubound(InData%dvtdr)) + call RegPackBounds(Buf, 1, lbound(InData%dvtdr, kind=B8Ki), ubound(InData%dvtdr, kind=B8Ki)) call RegPack(Buf, InData%dvtdr) end if call RegPack(Buf, allocated(InData%vt_tot)) if (allocated(InData%vt_tot)) then - call RegPackBounds(Buf, 2, lbound(InData%vt_tot), ubound(InData%vt_tot)) + call RegPackBounds(Buf, 2, lbound(InData%vt_tot, kind=B8Ki), ubound(InData%vt_tot, kind=B8Ki)) call RegPack(Buf, InData%vt_tot) end if call RegPack(Buf, allocated(InData%vt_amb)) if (allocated(InData%vt_amb)) then - call RegPackBounds(Buf, 2, lbound(InData%vt_amb), ubound(InData%vt_amb)) + call RegPackBounds(Buf, 2, lbound(InData%vt_amb, kind=B8Ki), ubound(InData%vt_amb, kind=B8Ki)) call RegPack(Buf, InData%vt_amb) end if call RegPack(Buf, allocated(InData%vt_shr)) if (allocated(InData%vt_shr)) then - call RegPackBounds(Buf, 2, lbound(InData%vt_shr), ubound(InData%vt_shr)) + call RegPackBounds(Buf, 2, lbound(InData%vt_shr, kind=B8Ki), ubound(InData%vt_shr, kind=B8Ki)) call RegPack(Buf, InData%vt_shr) end if call RegPack(Buf, allocated(InData%vt_tot2)) if (allocated(InData%vt_tot2)) then - call RegPackBounds(Buf, 3, lbound(InData%vt_tot2), ubound(InData%vt_tot2)) + call RegPackBounds(Buf, 3, lbound(InData%vt_tot2, kind=B8Ki), ubound(InData%vt_tot2, kind=B8Ki)) call RegPack(Buf, InData%vt_tot2) end if call RegPack(Buf, allocated(InData%vt_amb2)) if (allocated(InData%vt_amb2)) then - call RegPackBounds(Buf, 3, lbound(InData%vt_amb2), ubound(InData%vt_amb2)) + call RegPackBounds(Buf, 3, lbound(InData%vt_amb2, kind=B8Ki), ubound(InData%vt_amb2, kind=B8Ki)) call RegPack(Buf, InData%vt_amb2) end if call RegPack(Buf, allocated(InData%vt_shr2)) if (allocated(InData%vt_shr2)) then - call RegPackBounds(Buf, 3, lbound(InData%vt_shr2), ubound(InData%vt_shr2)) + call RegPackBounds(Buf, 3, lbound(InData%vt_shr2, kind=B8Ki), ubound(InData%vt_shr2, kind=B8Ki)) call RegPack(Buf, InData%vt_shr2) end if call RegPack(Buf, allocated(InData%dvx_dy)) if (allocated(InData%dvx_dy)) then - call RegPackBounds(Buf, 3, lbound(InData%dvx_dy), ubound(InData%dvx_dy)) + call RegPackBounds(Buf, 3, lbound(InData%dvx_dy, kind=B8Ki), ubound(InData%dvx_dy, kind=B8Ki)) call RegPack(Buf, InData%dvx_dy) end if call RegPack(Buf, allocated(InData%dvx_dz)) if (allocated(InData%dvx_dz)) then - call RegPackBounds(Buf, 3, lbound(InData%dvx_dz), ubound(InData%dvx_dz)) + call RegPackBounds(Buf, 3, lbound(InData%dvx_dz, kind=B8Ki), ubound(InData%dvx_dz, kind=B8Ki)) call RegPack(Buf, InData%dvx_dz) end if call RegPack(Buf, allocated(InData%nu_dvx_dy)) if (allocated(InData%nu_dvx_dy)) then - call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy), ubound(InData%nu_dvx_dy)) + call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy, kind=B8Ki), ubound(InData%nu_dvx_dy, kind=B8Ki)) call RegPack(Buf, InData%nu_dvx_dy) end if call RegPack(Buf, allocated(InData%nu_dvx_dz)) if (allocated(InData%nu_dvx_dz)) then - call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz), ubound(InData%nu_dvx_dz)) + call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz, kind=B8Ki), ubound(InData%nu_dvx_dz, kind=B8Ki)) call RegPack(Buf, InData%nu_dvx_dz) end if call RegPack(Buf, allocated(InData%dnuvx_dy)) if (allocated(InData%dnuvx_dy)) then - call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy), ubound(InData%dnuvx_dy)) + call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy, kind=B8Ki), ubound(InData%dnuvx_dy, kind=B8Ki)) call RegPack(Buf, InData%dnuvx_dy) end if call RegPack(Buf, allocated(InData%dnuvx_dz)) if (allocated(InData%dnuvx_dz)) then - call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz), ubound(InData%dnuvx_dz)) + call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz, kind=B8Ki), ubound(InData%dnuvx_dz, kind=B8Ki)) call RegPack(Buf, InData%dnuvx_dz) end if call RegPack(Buf, allocated(InData%a)) if (allocated(InData%a)) then - call RegPackBounds(Buf, 1, lbound(InData%a), ubound(InData%a)) + call RegPackBounds(Buf, 1, lbound(InData%a, kind=B8Ki), ubound(InData%a, kind=B8Ki)) call RegPack(Buf, InData%a) end if call RegPack(Buf, allocated(InData%b)) if (allocated(InData%b)) then - call RegPackBounds(Buf, 1, lbound(InData%b), ubound(InData%b)) + call RegPackBounds(Buf, 1, lbound(InData%b, kind=B8Ki), ubound(InData%b, kind=B8Ki)) call RegPack(Buf, InData%b) end if call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then - call RegPackBounds(Buf, 1, lbound(InData%c), ubound(InData%c)) + call RegPackBounds(Buf, 1, lbound(InData%c, kind=B8Ki), ubound(InData%c, kind=B8Ki)) call RegPack(Buf, InData%c) end if call RegPack(Buf, allocated(InData%d)) if (allocated(InData%d)) then - call RegPackBounds(Buf, 1, lbound(InData%d), ubound(InData%d)) + call RegPackBounds(Buf, 1, lbound(InData%d, kind=B8Ki), ubound(InData%d, kind=B8Ki)) call RegPack(Buf, InData%d) end if call RegPack(Buf, allocated(InData%r_wake)) if (allocated(InData%r_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%r_wake), ubound(InData%r_wake)) + call RegPackBounds(Buf, 1, lbound(InData%r_wake, kind=B8Ki), ubound(InData%r_wake, kind=B8Ki)) call RegPack(Buf, InData%r_wake) end if call RegPack(Buf, allocated(InData%Vx_high)) if (allocated(InData%Vx_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_high), ubound(InData%Vx_high)) + call RegPackBounds(Buf, 1, lbound(InData%Vx_high, kind=B8Ki), ubound(InData%Vx_high, kind=B8Ki)) call RegPack(Buf, InData%Vx_high) end if call RegPack(Buf, allocated(InData%Vx_polar)) if (allocated(InData%Vx_polar)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_polar), ubound(InData%Vx_polar)) + call RegPackBounds(Buf, 1, lbound(InData%Vx_polar, kind=B8Ki), ubound(InData%Vx_polar, kind=B8Ki)) call RegPack(Buf, InData%Vx_polar) end if call RegPack(Buf, allocated(InData%Vt_wake)) if (allocated(InData%Vt_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%Vt_wake), ubound(InData%Vt_wake)) + call RegPackBounds(Buf, 1, lbound(InData%Vt_wake, kind=B8Ki), ubound(InData%Vt_wake, kind=B8Ki)) call RegPack(Buf, InData%Vt_wake) end if call RegPack(Buf, InData%GammaCurl) @@ -1702,7 +1702,7 @@ subroutine WD_UnPackMisc(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackMisc' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2012,7 +2012,7 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyParam' ErrStat = ErrID_None @@ -2022,8 +2022,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumRadii = SrcParamData%NumRadii DstParamData%dr = SrcParamData%dr if (allocated(SrcParamData%r)) then - LB(1:1) = lbound(SrcParamData%r) - UB(1:1) = ubound(SrcParamData%r) + LB(1:1) = lbound(SrcParamData%r, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%r, kind=B8Ki) if (.not. allocated(DstParamData%r)) then allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2034,8 +2034,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%r = SrcParamData%r end if if (allocated(SrcParamData%y)) then - LB(1:1) = lbound(SrcParamData%y) - UB(1:1) = ubound(SrcParamData%y) + LB(1:1) = lbound(SrcParamData%y, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%y, kind=B8Ki) if (.not. allocated(DstParamData%y)) then allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2046,8 +2046,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%y = SrcParamData%y end if if (allocated(SrcParamData%z)) then - LB(1:1) = lbound(SrcParamData%z) - UB(1:1) = ubound(SrcParamData%z) + LB(1:1) = lbound(SrcParamData%z, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%z, kind=B8Ki) if (.not. allocated(DstParamData%z)) then allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2121,17 +2121,17 @@ subroutine WD_PackParam(Buf, Indata) call RegPack(Buf, InData%dr) call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then - call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) + call RegPackBounds(Buf, 1, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) call RegPack(Buf, InData%r) end if call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) call RegPack(Buf, InData%y) end if call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) call RegPack(Buf, InData%z) end if call RegPack(Buf, InData%Mod_Wake) @@ -2174,7 +2174,7 @@ subroutine WD_UnPackParam(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackParam' - integer(IntKi) :: LB(1), UB(1) + integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2302,7 +2302,7 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyInput' ErrStat = ErrID_None @@ -2313,8 +2313,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%chi_skew = SrcInputData%chi_skew DstInputData%p_hub = SrcInputData%p_hub if (allocated(SrcInputData%V_plane)) then - LB(1:2) = lbound(SrcInputData%V_plane) - UB(1:2) = ubound(SrcInputData%V_plane) + LB(1:2) = lbound(SrcInputData%V_plane, kind=B8Ki) + UB(1:2) = ubound(SrcInputData%V_plane, kind=B8Ki) if (.not. allocated(DstInputData%V_plane)) then allocate(DstInputData%V_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2329,8 +2329,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%D_rotor = SrcInputData%D_rotor DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk if (allocated(SrcInputData%Ct_azavg)) then - LB(1:1) = lbound(SrcInputData%Ct_azavg) - UB(1:1) = ubound(SrcInputData%Ct_azavg) + LB(1:1) = lbound(SrcInputData%Ct_azavg, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%Ct_azavg, kind=B8Ki) if (.not. allocated(DstInputData%Ct_azavg)) then allocate(DstInputData%Ct_azavg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2341,8 +2341,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Ct_azavg = SrcInputData%Ct_azavg end if if (allocated(SrcInputData%Cq_azavg)) then - LB(1:1) = lbound(SrcInputData%Cq_azavg) - UB(1:1) = ubound(SrcInputData%Cq_azavg) + LB(1:1) = lbound(SrcInputData%Cq_azavg, kind=B8Ki) + UB(1:1) = ubound(SrcInputData%Cq_azavg, kind=B8Ki) if (.not. allocated(DstInputData%Cq_azavg)) then allocate(DstInputData%Cq_azavg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2384,7 +2384,7 @@ subroutine WD_PackInput(Buf, Indata) call RegPack(Buf, InData%p_hub) call RegPack(Buf, allocated(InData%V_plane)) if (allocated(InData%V_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%V_plane), ubound(InData%V_plane)) + call RegPackBounds(Buf, 2, lbound(InData%V_plane, kind=B8Ki), ubound(InData%V_plane, kind=B8Ki)) call RegPack(Buf, InData%V_plane) end if call RegPack(Buf, InData%Vx_wind_disk) @@ -2393,12 +2393,12 @@ subroutine WD_PackInput(Buf, Indata) call RegPack(Buf, InData%Vx_rel_disk) call RegPack(Buf, allocated(InData%Ct_azavg)) if (allocated(InData%Ct_azavg)) then - call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg), ubound(InData%Ct_azavg)) + call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg, kind=B8Ki), ubound(InData%Ct_azavg, kind=B8Ki)) call RegPack(Buf, InData%Ct_azavg) end if call RegPack(Buf, allocated(InData%Cq_azavg)) if (allocated(InData%Cq_azavg)) then - call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg), ubound(InData%Cq_azavg)) + call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg, kind=B8Ki), ubound(InData%Cq_azavg, kind=B8Ki)) call RegPack(Buf, InData%Cq_azavg) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2408,7 +2408,7 @@ subroutine WD_UnPackInput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInput' - integer(IntKi) :: LB(2), UB(2) + integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return @@ -2480,14 +2480,14 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%xhat_plane)) then - LB(1:2) = lbound(SrcOutputData%xhat_plane) - UB(1:2) = ubound(SrcOutputData%xhat_plane) + LB(1:2) = lbound(SrcOutputData%xhat_plane, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%xhat_plane, kind=B8Ki) if (.not. allocated(DstOutputData%xhat_plane)) then allocate(DstOutputData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2498,8 +2498,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%xhat_plane = SrcOutputData%xhat_plane end if if (allocated(SrcOutputData%p_plane)) then - LB(1:2) = lbound(SrcOutputData%p_plane) - UB(1:2) = ubound(SrcOutputData%p_plane) + LB(1:2) = lbound(SrcOutputData%p_plane, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%p_plane, kind=B8Ki) if (.not. allocated(DstOutputData%p_plane)) then allocate(DstOutputData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2510,8 +2510,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%p_plane = SrcOutputData%p_plane end if if (allocated(SrcOutputData%Vx_wake)) then - LB(1:2) = lbound(SrcOutputData%Vx_wake) - UB(1:2) = ubound(SrcOutputData%Vx_wake) + LB(1:2) = lbound(SrcOutputData%Vx_wake, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Vx_wake, kind=B8Ki) if (.not. allocated(DstOutputData%Vx_wake)) then allocate(DstOutputData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2522,8 +2522,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vx_wake = SrcOutputData%Vx_wake end if if (allocated(SrcOutputData%Vr_wake)) then - LB(1:2) = lbound(SrcOutputData%Vr_wake) - UB(1:2) = ubound(SrcOutputData%Vr_wake) + LB(1:2) = lbound(SrcOutputData%Vr_wake, kind=B8Ki) + UB(1:2) = ubound(SrcOutputData%Vr_wake, kind=B8Ki) if (.not. allocated(DstOutputData%Vr_wake)) then allocate(DstOutputData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2534,8 +2534,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vr_wake = SrcOutputData%Vr_wake end if if (allocated(SrcOutputData%Vx_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vx_wake2) - UB(1:3) = ubound(SrcOutputData%Vx_wake2) + LB(1:3) = lbound(SrcOutputData%Vx_wake2, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%Vx_wake2, kind=B8Ki) if (.not. allocated(DstOutputData%Vx_wake2)) then allocate(DstOutputData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2546,8 +2546,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 end if if (allocated(SrcOutputData%Vy_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vy_wake2) - UB(1:3) = ubound(SrcOutputData%Vy_wake2) + LB(1:3) = lbound(SrcOutputData%Vy_wake2, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%Vy_wake2, kind=B8Ki) if (.not. allocated(DstOutputData%Vy_wake2)) then allocate(DstOutputData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2558,8 +2558,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 end if if (allocated(SrcOutputData%Vz_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vz_wake2) - UB(1:3) = ubound(SrcOutputData%Vz_wake2) + LB(1:3) = lbound(SrcOutputData%Vz_wake2, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%Vz_wake2, kind=B8Ki) if (.not. allocated(DstOutputData%Vz_wake2)) then allocate(DstOutputData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2570,8 +2570,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 end if if (allocated(SrcOutputData%D_wake)) then - LB(1:1) = lbound(SrcOutputData%D_wake) - UB(1:1) = ubound(SrcOutputData%D_wake) + LB(1:1) = lbound(SrcOutputData%D_wake, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%D_wake, kind=B8Ki) if (.not. allocated(DstOutputData%D_wake)) then allocate(DstOutputData%D_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2582,8 +2582,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%D_wake = SrcOutputData%D_wake end if if (allocated(SrcOutputData%x_plane)) then - LB(1:1) = lbound(SrcOutputData%x_plane) - UB(1:1) = ubound(SrcOutputData%x_plane) + LB(1:1) = lbound(SrcOutputData%x_plane, kind=B8Ki) + UB(1:1) = ubound(SrcOutputData%x_plane, kind=B8Ki) if (.not. allocated(DstOutputData%x_plane)) then allocate(DstOutputData%x_plane(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2594,8 +2594,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%x_plane = SrcOutputData%x_plane end if if (allocated(SrcOutputData%WAT_k_mt)) then - LB(1:3) = lbound(SrcOutputData%WAT_k_mt) - UB(1:3) = ubound(SrcOutputData%WAT_k_mt) + LB(1:3) = lbound(SrcOutputData%WAT_k_mt, kind=B8Ki) + UB(1:3) = ubound(SrcOutputData%WAT_k_mt, kind=B8Ki) if (.not. allocated(DstOutputData%WAT_k_mt)) then allocate(DstOutputData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2653,52 +2653,52 @@ subroutine WD_PackOutput(Buf, Indata) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, allocated(InData%xhat_plane)) if (allocated(InData%xhat_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPackBounds(Buf, 2, lbound(InData%xhat_plane, kind=B8Ki), ubound(InData%xhat_plane, kind=B8Ki)) call RegPack(Buf, InData%xhat_plane) end if call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPackBounds(Buf, 2, lbound(InData%p_plane, kind=B8Ki), ubound(InData%p_plane, kind=B8Ki)) call RegPack(Buf, InData%p_plane) end if call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPackBounds(Buf, 2, lbound(InData%Vx_wake, kind=B8Ki), ubound(InData%Vx_wake, kind=B8Ki)) call RegPack(Buf, InData%Vx_wake) end if call RegPack(Buf, allocated(InData%Vr_wake)) if (allocated(InData%Vr_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) + call RegPackBounds(Buf, 2, lbound(InData%Vr_wake, kind=B8Ki), ubound(InData%Vr_wake, kind=B8Ki)) call RegPack(Buf, InData%Vr_wake) end if call RegPack(Buf, allocated(InData%Vx_wake2)) if (allocated(InData%Vx_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) + call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2, kind=B8Ki), ubound(InData%Vx_wake2, kind=B8Ki)) call RegPack(Buf, InData%Vx_wake2) end if call RegPack(Buf, allocated(InData%Vy_wake2)) if (allocated(InData%Vy_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) + call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2, kind=B8Ki), ubound(InData%Vy_wake2, kind=B8Ki)) call RegPack(Buf, InData%Vy_wake2) end if call RegPack(Buf, allocated(InData%Vz_wake2)) if (allocated(InData%Vz_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) + call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2, kind=B8Ki), ubound(InData%Vz_wake2, kind=B8Ki)) call RegPack(Buf, InData%Vz_wake2) end if call RegPack(Buf, allocated(InData%D_wake)) if (allocated(InData%D_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%D_wake), ubound(InData%D_wake)) + call RegPackBounds(Buf, 1, lbound(InData%D_wake, kind=B8Ki), ubound(InData%D_wake, kind=B8Ki)) call RegPack(Buf, InData%D_wake) end if call RegPack(Buf, allocated(InData%x_plane)) if (allocated(InData%x_plane)) then - call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) + call RegPackBounds(Buf, 1, lbound(InData%x_plane, kind=B8Ki), ubound(InData%x_plane, kind=B8Ki)) call RegPack(Buf, InData%x_plane) end if call RegPack(Buf, allocated(InData%WAT_k_mt)) if (allocated(InData%WAT_k_mt)) then - call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) + call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt, kind=B8Ki), ubound(InData%WAT_k_mt, kind=B8Ki)) call RegPack(Buf, InData%WAT_k_mt) end if if (RegCheckErr(Buf, RoutineName)) return @@ -2708,7 +2708,7 @@ subroutine WD_UnPackOutput(Buf, OutData) type(PackBuffer), intent(inout) :: Buf type(WD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackOutput' - integer(IntKi) :: LB(3), UB(3) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return From db9a370081e88faa765db89a73dd6cdc3576f826 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Dec 2023 14:45:01 -0700 Subject: [PATCH 105/232] ExtLoads: update cpp test case --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 9a42b24203..4d36d8101c 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9a42b2420312ab5dfd49065e7ddab6fb69dc7d3f +Subproject commit 4d36d8101cd7d6b3f7169c6d412251b8257f32f2 From 33269e0f4a46cf624d73aa9bdb03ce7a56086ebd Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Wed, 6 Dec 2023 12:33:13 -0700 Subject: [PATCH 106/232] Echo file removed from driver --- modules/moordyn/src/MoorDyn_Driver.f90 | 30 +++++++++++++------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 219dfe0f2a..27428eb326 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -28,7 +28,7 @@ PROGRAM MoorDyn_Driver IMPLICIT NONE TYPE MD_Drvr_InitInput - LOGICAL :: Echo + ! LOGICAL :: Echo REAL(DbKi) :: Gravity REAL(DbKi) :: rhoW REAL(DbKi) :: WtrDepth @@ -120,7 +120,7 @@ PROGRAM MoorDyn_Driver ErrMsg = "" ErrStat = ErrID_None - UnEcho=-1 + UnEcho=-1 ! set to -1 as echo is no longer used by MD UnIn =-1 ! TODO: Sort out error handling (two sets of flags currently used) @@ -162,7 +162,7 @@ PROGRAM MoorDyn_Driver MD_InitInp%RootName = drvrInitInp%OutRootName MD_InitInp%UsePrimaryInputFile = .TRUE. !MD_InitInp%PassedPrimaryInputData = - MD_InitInp%Echo = drvrInitInp%Echo + ! MD_InitInp%Echo = drvrInitInp%Echo !MD_InitInp%OutList = <<<< never used? MD_InitInp%Linearize = .FALSE. @@ -738,7 +738,7 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp) ! Local variables INTEGER :: J ! generic integer for counting - CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file + ! CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file CHARACTER(1024) :: FileName ! Name of MoorDyn input file CHARACTER(1024) :: FilePath ! Name of path to MoorDyn input file @@ -756,17 +756,17 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp) ! Read until "echo" CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2); call AbortIfFailed() CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 2', ErrStat2, ErrMsg2); call AbortIfFailed() - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat2, ErrMsg2); call AbortIfFailed() - ! If we echo, we rewind - IF ( InitInp%Echo ) THEN - EchoFile = TRIM(FileName)//'.echo' - CALL GetNewUnit( UnEcho ) - CALL OpenEcho ( UnEcho, EchoFile, ErrStat2, ErrMsg2 ); call AbortIfFailed() - REWIND(UnIn) - CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 2', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() - END IF + ! CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat2, ErrMsg2); call AbortIfFailed() + ! ! If we echo, we rewind + ! IF ( InitInp%Echo ) THEN + ! EchoFile = TRIM(FileName)//'.echo' + ! CALL GetNewUnit( UnEcho ) + ! CALL OpenEcho ( UnEcho, EchoFile, ErrStat2, ErrMsg2 ); call AbortIfFailed() + ! REWIND(UnIn) + ! CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + ! CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 2', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + ! CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + ! END IF !---------------------- ENVIRONMENTAL CONDITIONS ------------------------------------------------- CALL ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() CALL ReadVar( UnIn, FileName, InitInp%Gravity, 'Gravity', 'Gravity', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() From 5cc5e19ceb5f68c2b56edd67ff0844b2e5cffbc9 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Wed, 6 Dec 2023 16:03:40 -0700 Subject: [PATCH 107/232] Indexing and building wave grid fix --- modules/moordyn/src/MoorDyn_Misc.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index ddc8bf25a6..d3c6ae542e 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1736,9 +1736,9 @@ SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) else if (coordtype==2) then coordarray(1) = tempArray(1) coordarray(n) = tempArray(2) - dx = (coordarray(n)-coordarray(0))/REAL(n-1) - do i=2,n-1 - coordarray(i) = coordarray(1) + REAL(i)*dx + dx = (coordarray(n)-coordarray(1))/REAL(n-1) + do i=2,n + coordarray(i) = coordarray(i-1) + dx end do else From 4d0c65d4c318f925c30567da0921d3b08cd8a579 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Sun, 10 Dec 2023 16:39:05 -0700 Subject: [PATCH 108/232] Fix coupled rods initial orentation --- modules/moordyn/src/MoorDyn.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index d0ab4b941c..6e3f63272f 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1811,9 +1811,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set absolute initial positions in MoorDyn IF (p%Standalone /= 1) THEN - OrMatRef = TRANSPOSE( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< + OrMatRef = ( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation - OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Rod's relative orientation with the turbine's initial orientation + OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Rod's relative orientation with the turbine's initial orientation u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math @@ -1821,7 +1821,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, OrMatRef)) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation + m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = MATMUL(OrMat2 , (/0.0, 0.0, 1.0/) ) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation ENDIF ! >>> still need to set Rod initial orientations accounting for PtfmInit rotation <<< From 0f642c68588aa96d3e4f51a544a9b377f8283109 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Sun, 10 Dec 2023 18:30:45 -0700 Subject: [PATCH 109/232] Added error handling for wave grid coordinate strings --- modules/moordyn/src/MoorDyn_Misc.f90 | 98 ++++++++++++++++------------ 1 file changed, 55 insertions(+), 43 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index d3c6ae542e..23189361f3 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1387,14 +1387,17 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed CALL gridAxisCoords(coordtype, entries2, p%pxWave, p%nxWave, ErrStat2, ErrMsg2) + Call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, 'MD_getWaterKin') ! Y grid points READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed CALL gridAxisCoords(coordtype, entries2, p%pyWave, p%nyWave, ErrStat2, ErrMsg2) + Call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, 'MD_getWaterKin') ! Z grid points READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed CALL gridAxisCoords(coordtype, entries2, p%pzWave, p%nzWave, ErrStat2, ErrMsg2) + Call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, 'MD_getWaterKin') ! ----- current ----- CALL ReadCom( UnIn, FileName, 'current header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return CALL ReadVar( UnIn, FileName, p%Current, 'CurrentMod', 'CurrentMod', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return @@ -1707,49 +1710,58 @@ SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) REAL(ReKi) :: tempArray (100) REAL(ReKi) :: dx INTEGER(IntKi) :: nEntries, I - - ! get array of coordinate entries - CALL stringToArray(entries, nEntries, tempArray) - - ! set number of coordinates - if ( coordtype==0) then ! 0: not used - make one grid point at zero - n = 1; - else if (coordtype==1) then ! 1: list values in ascending order - n = nEntries - else if (coordtype==2) then ! 2: uniform specified by -xlim, xlim, num - n = int(tempArray(3)) - else - print *, "Error: invalid coordinate type specified to gridAxisCoords" - end if - - ! allocate coordinate array - CALL AllocAry(coordarray, n, 'x,y, or z grid points' , ErrStat, ErrMsg) - !ALLOCATE ( coordarray(n), STAT=ErrStat) - - ! fill in coordinates - if ( coordtype==0) then - coordarray(1) = 0.0_ReKi - - else if (coordtype==1) then - coordarray(1:n) = tempArray(1:n) - - else if (coordtype==2) then - coordarray(1) = tempArray(1) - coordarray(n) = tempArray(2) - dx = (coordarray(n)-coordarray(1))/REAL(n-1) - do i=2,n - coordarray(i) = coordarray(i-1) + dx - end do - - else - print *, "Error: invalid coordinate type specified to gridAxisCoords" - end if - - print *, "Set water grid coordinates to :" - DO i=1,n - print *, " ", coordarray(i) - end do - + + IF (len(trim(entries)) == len(entries)) THEN + print*, "Warning: Only 120 characters read from wave grid coordinates" + END IF + + IF (entries(len(entries):len(entries)) == ',') THEN + ErrStat = ErrID_Fatal + ErrMsg = 'Last character of wave grid coordinate list cannot be comma' + ELSE + ! get array of coordinate entries + CALL stringToArray(entries, nEntries, tempArray) + + ! set number of coordinates + if ( coordtype==0) then ! 0: not used - make one grid point at zero + n = 1; + else if (coordtype==1) then ! 1: list values in ascending order + n = nEntries + else if (coordtype==2) then ! 2: uniform specified by -xlim, xlim, num + n = int(tempArray(3)) + else + print *, "Error: invalid coordinate type specified to gridAxisCoords" + end if + + ! allocate coordinate array + CALL AllocAry(coordarray, n, 'x,y, or z grid points' , ErrStat, ErrMsg) + !ALLOCATE ( coordarray(n), STAT=ErrStat) + + ! fill in coordinates + if ( coordtype==0) then + coordarray(1) = 0.0_ReKi + + else if (coordtype==1) then + coordarray(1:n) = tempArray(1:n) + + else if (coordtype==2) then + coordarray(1) = tempArray(1) + coordarray(n) = tempArray(2) + dx = (coordarray(n)-coordarray(1))/REAL(n-1) + do i=2,n + coordarray(i) = coordarray(i-1) + dx + end do + + else + print *, "Error: invalid coordinate type specified to gridAxisCoords" + end if + + ! print *, "Set water grid coordinates to :" + ! DO i=1,n + ! print *, " ", coordarray(i) + ! end do + END IF + END SUBROUTINE gridAxisCoords From 69fb0b87f6f55e74dd909085e9ef6d0bf4768aa3 Mon Sep 17 00:00:00 2001 From: Ganesh Vijayakumar Date: Mon, 11 Dec 2023 12:10:04 -0700 Subject: [PATCH 110/232] Fix issues to get C++ API to run --- glue-codes/openfast-cpp/src/FAST_Prog.cpp | 7 +++++-- glue-codes/openfast-cpp/src/OpenFAST.cpp | 16 +++++++++++++--- modules/openfast-library/src/FAST_Library.f90 | 12 +++++++++--- 3 files changed, 27 insertions(+), 8 deletions(-) diff --git a/glue-codes/openfast-cpp/src/FAST_Prog.cpp b/glue-codes/openfast-cpp/src/FAST_Prog.cpp index ab68e388ef..1143313b3e 100644 --- a/glue-codes/openfast-cpp/src/FAST_Prog.cpp +++ b/glue-codes/openfast-cpp/src/FAST_Prog.cpp @@ -71,6 +71,9 @@ void readTurbineData(int iTurb, fast::fastInputs & fi, YAML::Node turbNode) { get_if_present(turbNode, "num_force_pts_blade", fi.globTurbineData[iTurb].numForcePtsBlade, 0); get_if_present(turbNode, "num_force_pts_tower", fi.globTurbineData[iTurb].numForcePtsTwr, 0); + fi.globTurbineData[iTurb].numForcePts = + fi.globTurbineData[iTurb].numForcePtsBlade + + fi.globTurbineData[iTurb].numForcePtsTwr; float fZero = 0.0; get_if_present(turbNode, "nacelle_cd", fi.globTurbineData[iTurb].nacelle_cd, fZero); @@ -145,7 +148,7 @@ void readInputFile(fast::fastInputs & fi, std::string cInterfaceInputFile, doubl get_if_present(cDriverInp, "set_exp_law_wind", *setExpLawWind, false); get_if_present(cDriverInp, "set_uniform_x_blade_forces", *setUniformXBladeForces, false); if (setUniformXBladeForces) - get_required(cDriverInp, "x_blade_force", *xBladeForce); + get_if_present(cDriverInp, "x_blade_force", *xBladeForce, 0.0); get_if_present(cDriverInp, "super_controller", fi.scStatus, false); if(fi.scStatus) { @@ -197,7 +200,7 @@ int main(int argc, char** argv) { bool setUniformXBladeForces; // Set uniform X blade forces on all blade nodes int nIter; double xBladeForce = 0.0; - + std::string cDriverInputFile=argv[1]; fast::OpenFAST FAST; fast::fastInputs fi ; diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 0b002df101..d9fd1cb20c 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -224,7 +224,8 @@ void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { ierr = nc_enddef(ncid); check_nc_error(ierr, "nc_enddef"); - if (turbineData[iTurbLoc].sType == EXTINFLOW) { + if ( (turbineData[iTurbLoc].sType == EXTINFLOW) && (turbineData[iTurbLoc].inflowType == 2) ) { + int nfpts_data = 3*get_numForcePtsLoc(iTurbLoc); int ierr = nc_put_var_double(ncid, ncRstVarIDs_["xref_force"], velForceNodeData[iTurbLoc][fast::STATE_NP1].xref_force.data()); } @@ -729,6 +730,8 @@ void fast::OpenFAST::init() { ErrMsg); checkError(ErrStat, ErrMsg); + std::cerr << "turbineData[iTurb].inflowType = " << turbineData[iTurb].inflowType << std::endl; + turbineData[iTurb].numVelPtsTwr = extinfw_o_t_FAST[iTurb].u_Len - turbineData[iTurb].numBlades*turbineData[iTurb].numVelPtsBlade - 1; if(turbineData[iTurb].numVelPtsTwr == 0) { turbineData[iTurb].numForcePtsTwr = 0; @@ -2118,6 +2121,11 @@ void fast::OpenFAST::allocateMemory_postInit(int iTurbLoc) { } } } + std::cerr << "turbineData[iTurbLoc].inflowType " << turbineData[iTurbLoc].inflowType << std::endl; + std::cerr << "turbineData[iTurbLoc].numForcePtsTwr = " << turbineData[iTurbLoc].numForcePtsTwr << std::endl; + std::cerr << "turbineData[iTurbLoc].numForcePtsBlade = " << turbineData[iTurbLoc].numForcePtsBlade << std::endl; + std::cerr << "turbineData[iTurbLoc].numForcePts = " << turbineData[iTurbLoc].numForcePts << std::endl; + } else if (turbineData[iTurbLoc].sType == EXTLOADS) { turbineData[iTurbLoc].nBRfsiPtsBlade.resize(turbineData[iTurbLoc].numBlades); @@ -2360,6 +2368,8 @@ void fast::OpenFAST::get_data_from_openfast(timeStep t) { if (turbineData[iTurb].inflowType == 2) { int nvelpts = get_numVelPtsLoc(iTurb); int nfpts = get_numForcePtsLoc(iTurb); + std::cerr << "nvelpts = " << nvelpts << std::endl; + std::cerr << "nfpts = " << nfpts << " " << get_numForcePtsBladeLoc(iTurb) << " " << get_numForcePtsTwrLoc(iTurb) << std::endl; for (int i=0; i Date: Mon, 11 Dec 2023 15:16:08 -0700 Subject: [PATCH 111/232] ExtLoads: rename `Input_bak` to `Input_Saved` etc. for clarity --- .../openfast-library/src/FAST_Registry.txt | 68 +- modules/openfast-library/src/FAST_Subs.f90 | 212 +- modules/openfast-library/src/FAST_Types.f90 | 1920 ++++++++--------- 3 files changed, 1100 insertions(+), 1100 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 37b8a5b85b..07a57f7c18 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -57,7 +57,7 @@ param ^ - INTEGER Module_MD - 16 - "MoorDyn" - param ^ - INTEGER Module_Orca - 17 - "OrcaFlex integration (HD/Mooring)" - param ^ - INTEGER Module_IceF - 18 - "IceFloe" - param ^ - INTEGER Module_IceD - 19 - "IceDyn" - -param ^ - INTEGER NumModules - 20 - "The number of modules available in FAST" - +param ^ - INTEGER NumModules - 19 - "The number of modules available in FAST" - # Other Constants param ^ - INTEGER MaxNBlades - 3 - "Maximum number of blades allowed on a turbine" - param ^ - INTEGER IceD_MaxLegs - 4 - "because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number" - @@ -406,9 +406,9 @@ typedef ^ ^ IceD_InputType u {:} - - "System inputs" typedef ^ ^ IceD_OutputType y {:} - - "System outputs" typedef ^ ^ IceD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ IceD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ IceD_InputType Input_bak {:}{:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ IceD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:}{:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... BeamDyn data ....................................................................................................... # [ the last dimension of each allocatable array is for the instance of BeamDyn being used ] @@ -424,9 +424,9 @@ typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ BD_InputType Input_bak {:}{:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ BD_InputType Input_Saved {:}{:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:}{:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... typedef FAST ElastoDyn_Data ED_ContinuousStateType x {4} - - "Continuous states" @@ -441,9 +441,9 @@ typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcS typedef ^ ^ ED_OutputType Output_bak {:} - - "Backup Array of outputs associated with InputTimes" typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ED_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ ED_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ServoDyn data ....................................................................................................... @@ -459,9 +459,9 @@ typedef ^ ^ SrvD_MiscVarType m_bak - - - "Backup Misc (optimization) variables n typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SrvD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ SrvD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn14 data ....................................................................................................... typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {4} - - "Continuous states" @@ -473,9 +473,9 @@ typedef ^ ^ AD14_InputType u - - - "System inputs" typedef ^ ^ AD14_OutputType y - - - "System outputs" typedef ^ ^ AD14_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD14_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ AD14_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ AD14_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... typedef FAST AeroDyn_Data AD_ContinuousStateType x {4} - - "Continuous states" @@ -489,9 +489,9 @@ typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ AD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ AD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtLoads data ....................................................................................................... typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {2} - - "Continuous states" @@ -516,9 +516,9 @@ typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ InflowWind_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ InflowWind_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExternalInflow integration data ....................................................................................................... typedef FAST ExternalInflow_Data ExtInfw_InputType u - - - "System inputs" @@ -541,11 +541,11 @@ typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ SD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {4} - - "Continuous states" @@ -557,9 +557,9 @@ typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" typedef ^ ^ ExtPtfm_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ ExtPtfm_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ ExtPtfm_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ ExtPtfm_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... SeaState data ....................................................................................................... typedef FAST SeaState_Data SeaSt_ContinuousStateType x {4} - - "Continuous states" @@ -571,11 +571,11 @@ typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" typedef ^ ^ SeaSt_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SeaSt_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ SeaSt_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ SeaSt_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ SeaSt_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ SeaSt_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {4} - - "Continuous states" @@ -589,9 +589,9 @@ typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ HydroDyn_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ HydroDyn_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {4} - - "Continuous states" @@ -603,9 +603,9 @@ typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" typedef ^ ^ IceFloe_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ IceFloe_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ IceFloe_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ IceFloe_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MAP data ....................................................................................................... typedef FAST MAP_Data MAP_ContinuousStateType x {4} - - "Continuous states" @@ -619,9 +619,9 @@ typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (cop typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ MAP_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ MAP_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {4} - - "Continuous states" @@ -633,9 +633,9 @@ typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" typedef ^ ^ FEAM_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ FEAM_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ FEAM_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ FEAM_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... typedef FAST MoorDyn_Data MD_ContinuousStateType x {4} - - "Continuous states" @@ -649,9 +649,9 @@ typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ MD_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ MD_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {4} - - "Continuous states" @@ -663,9 +663,9 @@ typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" typedef ^ ^ Orca_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ Orca_InputType Input {:} - - "Array of inputs associated with InputTimes" -typedef ^ ^ Orca_InputType Input_bak {:} - - "Backup Array of inputs associated with InputTimes" +typedef ^ ^ Orca_InputType Input_Saved {:} - - "Backup Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" -typedef ^ ^ DbKi InputTimes_bak {:} - - "Backup Array of times associated with Input Array" +typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FAST_ModuleMapType data ....................................................................................................... # ! Data structures for mapping and coupling the various modules together @@ -700,7 +700,7 @@ typedef ^ FAST_ModuleMapType MeshMapType SubStructure_2_SStC_P_P {:} - - "Map Su # ED --> SrvD -- PlatformPtMesh motion to SrvD%PtfmMotionMesh for passing to DLL typedef ^ FAST_ModuleMapType MeshMapType ED_P_2_SrvD_P_P - - - "Map ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller" # ED/BD <-> AD (blades) -typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_AD_L_B {:} - - "Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes" +typedef ^ FAST_ModuleMapType MeshMapType BDED_L_2_AD_L_B {:} - - "Map ElastoDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes" typedef ^ FAST_ModuleMapType MeshMapType AD_L_2_BDED_B {:} - - "Map AeroDyn14 InputMarkers or AeroDyn BladeLoad line2 meshes to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes" typedef ^ FAST_ModuleMapType MeshMapType BD_L_2_BD_L {:} - - "Map BeamDyn BldMotion output meshes to locations on the BD input DistrLoad mesh stored in MeshMapType%y_BD_BldMotion_4Loads (BD input and output meshes are not siblings and in fact have nodes at different locations" # ED <-> AD (nacelle, tower, hub, blade root, tailfin) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index ec6e8f37f8..c130da47e4 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -242,9 +242,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( ED%Input_bak( p_FAST%InterpOrder+1 ), ED%InputTimes_bak( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + ALLOCATE( ED%Input_Saved( p_FAST%InterpOrder+1 ), ED%InputTimes_Saved( p_FAST%InterpOrder+1 ), ED%Output_bak( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_bak, ED%Output_bak, and ED%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input_Saved, ED%Output_bak, and ED%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -332,9 +332,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( BD%Input_bak( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes_bak( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + ALLOCATE( BD%Input_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), BD%InputTimes_Saved( p_FAST%InterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input_bak and BD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating BD%Input_Saved and BD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -448,9 +448,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( AD14%Input_bak( p_FAST%InterpOrder+1 ), AD14%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( AD14%Input_Saved( p_FAST%InterpOrder+1 ), AD14%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input_bak and AD14%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating AD14%Input_Saved and AD14%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -462,7 +462,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( AD%Input_bak( p_FAST%InterpOrder+1 ), AD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() @@ -627,9 +627,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( IfW%Input_bak( p_FAST%InterpOrder+1 ), IfW%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( IfW%Input_Saved( p_FAST%InterpOrder+1 ), IfW%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_bak and IfW%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating IfW%Input_Saved and IfW%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -848,9 +848,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( SeaSt%Input_bak( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( SeaSt%Input_Saved( p_FAST%InterpOrder+1 ), SeaSt%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_bak and SeaSt%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating SeaSt%Input_Saved and SeaSt%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -944,9 +944,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( HD%Input_bak( p_FAST%InterpOrder+1 ), HD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( HD%Input_Saved( p_FAST%InterpOrder+1 ), HD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input_bak and HD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input_Saved and HD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1006,9 +1006,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( SD%Input_bak( p_FAST%InterpOrder+1 ), SD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( SD%Input_Saved( p_FAST%InterpOrder+1 ), SD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input_bak and SD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating SD%Input_Saved and SD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1020,9 +1020,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( ExtPtfm%Input_bak( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( ExtPtfm%Input_Saved( p_FAST%InterpOrder+1 ), ExtPtfm%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input_bak and ExtPtfm%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtPtfm%Input_Saved and ExtPtfm%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1118,9 +1118,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - ALLOCATE( MAPp%Input_bak( p_FAST%InterpOrder+1 ), MAPp%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( MAPp%Input_Saved( p_FAST%InterpOrder+1 ), MAPp%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input_bak and MAPp%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating MAPp%Input_Saved and MAPp%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1130,9 +1130,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - ALLOCATE( MD%Input_bak( p_FAST%InterpOrder+1 ), MD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( MD%Input_Saved( p_FAST%InterpOrder+1 ), MD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input_bak and MD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input_Saved and MD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1142,9 +1142,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - ALLOCATE( FEAM%Input_bak( p_FAST%InterpOrder+1 ), FEAM%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( FEAM%Input_Saved( p_FAST%InterpOrder+1 ), FEAM%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input_bak and FEAM%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating FEAM%Input_Saved and FEAM%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1154,9 +1154,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - ALLOCATE( Orca%Input_bak( p_FAST%InterpOrder+1 ), Orca%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( Orca%Input_Saved( p_FAST%InterpOrder+1 ), Orca%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input_bak and Orca%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating Orca%Input_Saved and Orca%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1317,9 +1317,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( IceF%Input_bak( p_FAST%InterpOrder+1 ), IceF%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( IceF%Input_Saved( p_FAST%InterpOrder+1 ), IceF%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input_bak and IceF%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating IceF%Input_Saved and IceF%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1341,9 +1341,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( IceD%Input_bak( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes_bak( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) + ALLOCATE( IceD%Input_Saved( p_FAST%InterpOrder+1, IceDim ), IceD%InputTimes_Saved( p_FAST%InterpOrder+1, IceDim ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input_bak and IceD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating IceD%Input_Saved and IceD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -1450,9 +1450,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( SrvD%Input_bak( p_FAST%InterpOrder+1 ), SrvD%InputTimes_bak( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ALLOCATE( SrvD%Input_Saved( p_FAST%InterpOrder+1 ), SrvD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_bak and SrvD%InputTimes_bak.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_Saved and SrvD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF @@ -5686,12 +5686,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! order = SIZE(ED%Input) DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + ED%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !ED_OutputTimes(p_FAST%InterpOrder + 1 + j) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(1), ED%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyInput (ED%Input(1), ED%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_NEWCOPY, Errstat2, ErrMsg2) !BJJ: THIS IS REALLY ONLY NECESSARY FOR ED-HD COUPLING AT THE MOMENT @@ -5722,11 +5722,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes_bak(j,k) = t_initial - (j - 1) * p_FAST%dt + BD%InputTimes_Saved(j,k) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(1,k), BD%Input_bak(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyInput (BD%Input(1,k), BD%Input_Saved(j,k), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5759,12 +5759,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Initialize Input-Output arrays for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + SrvD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyInput (SrvD%Input(1), SrvD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5798,11 +5798,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - AD14%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + AD14%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL AD14_CopyInput (AD14%Input(1), AD14%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyInput (AD14%Input(1), AD14%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5830,11 +5830,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + AD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(1), AD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyInput (AD%Input(1), AD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5866,12 +5866,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + IfW%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !IfW%OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyInput (IfW%Input(1), IfW%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5901,12 +5901,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD IF ( p_FAST%CompHydro == Module_HD ) THEN ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + HD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !HD_OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyInput (HD%Input(1), HD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5937,12 +5937,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + SD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !SD_OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(1), SD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyInput (SD%Input(1), SD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -5970,11 +5970,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + ExtPtfm%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), ExtPtfm%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6005,12 +6005,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + MAPp%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !MAP_OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyInput (MAPp%Input(1), MAPp%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6042,12 +6042,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + MD%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !MD_OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(1), MD%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyInput (MD%Input(1), MD%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6077,12 +6077,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + FEAM%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !FEAM_OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyInput (FEAM%Input(1), FEAM%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6110,11 +6110,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + Orca%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(1), Orca%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyInput (Orca%Input(1), Orca%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6145,12 +6145,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes_bak(j) = t_initial - (j - 1) * p_FAST%dt + IceF%InputTimes_Saved(j) = t_initial - (j - 1) * p_FAST%dt !IceF_OutputTimes(i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_bak(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyInput (IceF%Input(1), IceF%Input_Saved(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6180,12 +6180,12 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes_bak(j,i) = t_initial - (j - 1) * p_FAST%dt + IceD%InputTimes_Saved(j,i) = t_initial - (j - 1) * p_FAST%dt !IceD%OutputTimes(j,i) = t_initial - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_bak(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyInput (IceD%Input(1,i), IceD%Input_Saved(j,i), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6299,7 +6299,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input_bak(j), ED%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyInput (ED%Input_Saved(j), ED%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO CALL ED_CopyOutput (ED%Output_bak(1), ED%y, MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6335,7 +6335,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input_bak(j,k), BD%Input(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyInput (BD%Input_Saved(j,k), BD%Input(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6382,7 +6382,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input_bak(j), SrvD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyInput (SrvD%Input_Saved(j), SrvD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6417,7 +6417,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL AD14_CopyInput (AD14%Input_bak(j), AD14%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyInput (AD14%Input_Saved(j), AD14%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6447,7 +6447,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input_bak(j), AD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyInput (AD%Input_Saved(j), AD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6480,7 +6480,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input_bak(j), IfW%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyInput (IfW%Input_Saved(j), IfW%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6513,7 +6513,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input_bak(j), HD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyInput (HD%Input_Saved(j), HD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6547,7 +6547,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input_bak(j), SD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyInput (SD%Input_Saved(j), SD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6577,7 +6577,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input_bak(j), ExtPtfm%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyInput (ExtPtfm%Input_Saved(j), ExtPtfm%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6611,7 +6611,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input_bak(j), MAPp%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyInput (MAPp%Input_Saved(j), MAPp%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6642,7 +6642,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input_bak(j), MD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyInput (MD%Input_Saved(j), MD%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6673,7 +6673,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input_bak(j), FEAM%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyInput (FEAM%Input_Saved(j), FEAM%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6703,7 +6703,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input_bak(j), Orca%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyInput (Orca%Input_Saved(j), Orca%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6737,7 +6737,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input_bak(j), IceF%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyInput (IceF%Input_Saved(j), IceF%Input(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6770,7 +6770,7 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input_bak(j,i), IceD%Input(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyInput (IceD%Input_Saved(j,i), IceD%Input(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6882,11 +6882,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- DO j = 1, p_FAST%InterpOrder + 1 - ED%InputTimes_bak(j) = ED%InputTimes(j) + ED%InputTimes_Saved(j) = ED%InputTimes(j) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL ED_CopyInput (ED%Input(j), ED%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyInput (ED%Input(j), ED%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO CALL ED_CopyOutput (ED%y, ED%Output_bak(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6918,11 +6918,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - BD%InputTimes_bak(j,k) = BD%InputTimes(j,k) + BD%InputTimes_Saved(j,k) = BD%InputTimes(j,k) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL BD_CopyInput (BD%Input(j,k), BD%Input_bak(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyInput (BD%Input(j,k), BD%Input_Saved(j,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6951,11 +6951,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Initialize Input-Output arrays for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - SrvD%InputTimes_bak(j) = SrvD%InputTimes(j) + SrvD%InputTimes_Saved(j) = SrvD%InputTimes(j) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6986,11 +6986,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - AD14%InputTimes_bak(j) = AD14%InputTimes(j) + AD14%InputTimes_Saved(j) = AD14%InputTimes(j) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL AD14_CopyInput (AD14%Input(j), AD14%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyInput (AD14%Input(j), AD14%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7016,11 +7016,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - AD%InputTimes_bak(j) = AD%InputTimes(j) + AD%InputTimes_Saved(j) = AD%InputTimes(j) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL AD_CopyInput (AD%Input(j), AD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyInput (AD%Input(j), AD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7048,12 +7048,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - IfW%InputTimes_bak(j) = IfW%InputTimes(j) + IfW%InputTimes_Saved(j) = IfW%InputTimes(j) !IfW%OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7081,12 +7081,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, IF ( p_FAST%CompHydro == Module_HD ) THEN ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - HD%InputTimes_bak(j) = HD%InputTimes(j) + HD%InputTimes_Saved(j) = HD%InputTimes(j) !HD_OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyInput (HD%Input(j), HD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7115,12 +7115,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - SD%InputTimes_bak(j) = SD%InputTimes(j) + SD%InputTimes_Saved(j) = SD%InputTimes(j) !SD_OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL SD_CopyInput (SD%Input(j), SD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyInput (SD%Input(j), SD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7146,11 +7146,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - ExtPtfm%InputTimes_bak(j) = ExtPtfm%InputTimes(j) + ExtPtfm%InputTimes_Saved(j) = ExtPtfm%InputTimes(j) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7179,12 +7179,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - MAPp%InputTimes_bak(j) = MAPp%InputTimes(j) + MAPp%InputTimes_Saved(j) = MAPp%InputTimes(j) !MAP_OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7210,12 +7210,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - MD%InputTimes_bak(j) = MD%InputTimes(j) + MD%InputTimes_Saved(j) = MD%InputTimes(j) !MD_OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL MD_CopyInput (MD%Input(j), MD%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyInput (MD%Input(j), MD%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7241,12 +7241,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - FEAM%InputTimes_bak(j) = FEAM%InputTimes(j) + FEAM%InputTimes_Saved(j) = FEAM%InputTimes(j) !FEAM_OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7272,11 +7272,11 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - Orca%InputTimes_bak(j) = Orca%InputTimes(j) + Orca%InputTimes_Saved(j) = Orca%InputTimes(j) END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL Orca_CopyInput (Orca%Input(j), Orca%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyInput (Orca%Input(j), Orca%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7305,12 +7305,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - IceF%InputTimes_bak(j) = IceF%InputTimes(j) + IceF%InputTimes_Saved(j) = IceF%InputTimes(j) !IceF_OutputTimes(i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_bak(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input_Saved(j), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7338,12 +7338,12 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! Copy values for interpolation/extrapolation: DO j = 1, p_FAST%InterpOrder + 1 - IceD%InputTimes_bak(j,i) = IceD%InputTimes(j,i) + IceD%InputTimes_Saved(j,i) = IceD%InputTimes(j,i) !IceD%OutputTimes(j,i) = t_global - (j - 1) * dt END DO DO j = 1, p_FAST%InterpOrder + 1 - CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_bak(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input_Saved(j,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 6e6b59889b..06aa8e9627 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -72,7 +72,7 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 17 ! OrcaFlex integration (HD/Mooring) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 18 ! IceFloe [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 20 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 19 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxNBlades = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] @@ -402,9 +402,9 @@ MODULE FAST_Types TYPE(IceD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(IceD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceDyn_Data ! ======================= ! ========= BeamDyn_Data ======= @@ -420,9 +420,9 @@ MODULE FAST_Types TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE BeamDyn_Data ! ======================= ! ========= ElastoDyn_Data ======= @@ -439,9 +439,9 @@ MODULE FAST_Types TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output_bak !< Backup Array of outputs associated with InputTimes [-] TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ElastoDyn_Data ! ======================= ! ========= ServoDyn_Data ======= @@ -458,9 +458,9 @@ MODULE FAST_Types TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ServoDyn_Data ! ======================= ! ========= AeroDyn14_Data ======= @@ -474,9 +474,9 @@ MODULE FAST_Types TYPE(AD14_OutputType) :: y !< System outputs [-] TYPE(AD14_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(AD14_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn14_Data ! ======================= ! ========= AeroDyn_Data ======= @@ -492,9 +492,9 @@ MODULE FAST_Types TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE AeroDyn_Data ! ======================= ! ========= ExtLoads_Data ======= @@ -523,9 +523,9 @@ MODULE FAST_Types TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE InflowWind_Data ! ======================= ! ========= ExternalInflow_Data ======= @@ -554,11 +554,11 @@ MODULE FAST_Types TYPE(SD_OutputType) :: y !< System outputs [-] TYPE(SD_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] TYPE(SD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= ! ========= ExtPtfm_Data ======= @@ -572,9 +572,9 @@ MODULE FAST_Types TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] TYPE(ExtPtfm_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE ExtPtfm_Data ! ======================= ! ========= SeaState_Data ======= @@ -588,11 +588,11 @@ MODULE FAST_Types TYPE(SeaSt_OutputType) :: y !< System outputs [-] TYPE(SeaSt_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] TYPE(SeaSt_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(SeaSt_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE SeaState_Data ! ======================= ! ========= HydroDyn_Data ======= @@ -608,9 +608,9 @@ MODULE FAST_Types TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE HydroDyn_Data ! ======================= ! ========= IceFloe_Data ======= @@ -624,9 +624,9 @@ MODULE FAST_Types TYPE(IceFloe_OutputType) :: y !< System outputs [-] TYPE(IceFloe_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE IceFloe_Data ! ======================= ! ========= MAP_Data ======= @@ -642,9 +642,9 @@ MODULE FAST_Types TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MAP_Data ! ======================= ! ========= FEAMooring_Data ======= @@ -658,9 +658,9 @@ MODULE FAST_Types TYPE(FEAM_OutputType) :: y !< System outputs [-] TYPE(FEAM_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE FEAMooring_Data ! ======================= ! ========= MoorDyn_Data ======= @@ -676,9 +676,9 @@ MODULE FAST_Types TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE MoorDyn_Data ! ======================= ! ========= OrcaFlex_Data ======= @@ -692,9 +692,9 @@ MODULE FAST_Types TYPE(Orca_OutputType) :: y !< System outputs [-] TYPE(Orca_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] - TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_bak !< Backup Array of inputs associated with InputTimes [-] + TYPE(Orca_InputType) , DIMENSION(:), ALLOCATABLE :: Input_Saved !< Backup Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_bak !< Backup Array of times associated with Input Array [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes_Saved !< Backup Array of times associated with Input Array [-] END TYPE OrcaFlex_Data ! ======================= ! ========= FAST_ModuleMapType ======= @@ -722,7 +722,7 @@ MODULE FAST_Types TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SStC_P_P_2_SubStructure !< Map ServoDyn/SStC platform point mesh load to SubDyn/ElastoDyn point load mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SubStructure_2_SStC_P_P !< Map SubDyn y3mesh or ED platform mesh motion to ServoDyn/SStC point mesh [-] TYPE(MeshMapType) :: ED_P_2_SrvD_P_P !< Map ElastoDyn platform point mesh motion to ServoDyn point mesh -- for passing to controller [-] - TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_AD_L_B !< Map ElastoDyn/BeamDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BDED_L_2_AD_L_B !< Map ElastoDyn BladeLn2Mesh point meshes OR BeamDyn BldMotion line2 meshes to AeroDyn14 InputMarkers OR AeroDyn BladeMotion line2 meshes [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_L_2_BDED_B !< Map AeroDyn14 InputMarkers or AeroDyn BladeLoad line2 meshes to ElastoDyn BladePtLoad point meshes or BeamDyn BldMotion line2 meshes [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: BD_L_2_BD_L !< Map BeamDyn BldMotion output meshes to locations on the BD input DistrLoad mesh stored in MeshMapType%y_BD_BldMotion_4Loads (BD input and output meshes are not siblings and in fact have nodes at different locations [-] TYPE(MeshMapType) :: ED_P_2_AD_P_N !< Map ElastoDyn Nacelle point motion mesh to AeroDyn Nacelle point motion mesh [-] @@ -16850,21 +16850,21 @@ SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCod ENDDO ENDDO ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input_bak,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input_bak,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input_bak,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input_bak)) THEN - ALLOCATE(DstIceDyn_DataData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcIceDyn_DataData%Input_Saved,1) + i2_l = LBOUND(SrcIceDyn_DataData%Input_Saved,2) + i2_u = UBOUND(SrcIceDyn_DataData%Input_Saved,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstIceDyn_DataData%Input_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input_bak,2), UBOUND(SrcIceDyn_DataData%Input_bak,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input_bak,1), UBOUND(SrcIceDyn_DataData%Input_bak,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input_bak(i1,i2), DstIceDyn_DataData%Input_bak(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i2 = LBOUND(SrcIceDyn_DataData%Input_Saved,2), UBOUND(SrcIceDyn_DataData%Input_Saved,2) + DO i1 = LBOUND(SrcIceDyn_DataData%Input_Saved,1), UBOUND(SrcIceDyn_DataData%Input_Saved,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%Input_Saved(i1,i2), DstIceDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -16884,19 +16884,19 @@ SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCod END IF DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes_bak,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes_bak,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes_bak,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcIceDyn_DataData%InputTimes_Saved,1) + i2_l = LBOUND(SrcIceDyn_DataData%InputTimes_Saved,2) + i2_u = UBOUND(SrcIceDyn_DataData%InputTimes_Saved,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstIceDyn_DataData%InputTimes_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstIceDyn_DataData%InputTimes_bak = SrcIceDyn_DataData%InputTimes_bak + DstIceDyn_DataData%InputTimes_Saved = SrcIceDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyIceDyn_Data @@ -16994,20 +16994,20 @@ SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ENDDO DEALLOCATE(IceDyn_DataData%Input) ENDIF -IF (ALLOCATED(IceDyn_DataData%Input_bak)) THEN -DO i2 = LBOUND(IceDyn_DataData%Input_bak,2), UBOUND(IceDyn_DataData%Input_bak,2) -DO i1 = LBOUND(IceDyn_DataData%Input_bak,1), UBOUND(IceDyn_DataData%Input_bak,1) - CALL IceD_DestroyInput( IceDyn_DataData%Input_bak(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(IceDyn_DataData%Input_Saved)) THEN +DO i2 = LBOUND(IceDyn_DataData%Input_Saved,2), UBOUND(IceDyn_DataData%Input_Saved,2) +DO i1 = LBOUND(IceDyn_DataData%Input_Saved,1), UBOUND(IceDyn_DataData%Input_Saved,1) + CALL IceD_DestroyInput( IceDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO - DEALLOCATE(IceDyn_DataData%Input_bak) + DEALLOCATE(IceDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN DEALLOCATE(IceDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes_bak) +IF (ALLOCATED(IceDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(IceDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyIceDyn_Data @@ -17264,25 +17264,25 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input_bak upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Input_Saved upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input_Saved,2), UBOUND(InData%Input_Saved,2) + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -17294,10 +17294,10 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -17720,22 +17720,22 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_bak,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i2 = LBOUND(InData%Input_Saved,2), UBOUND(InData%Input_Saved,2) + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17786,22 +17786,22 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_bak,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%InputTimes_bak,2), UBOUND(InData%InputTimes_bak,2) - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1,i2) + DO i2 = LBOUND(InData%InputTimes_Saved,2), UBOUND(InData%InputTimes_Saved,2) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO @@ -18365,7 +18365,7 @@ SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -18375,14 +18375,14 @@ SUBROUTINE FAST_UnPackIceDyn_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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Input_bak,2), UBOUND(OutData%Input_bak,2) - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i2 = LBOUND(OutData%Input_Saved,2), UBOUND(OutData%Input_Saved,2) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18416,7 +18416,7 @@ SUBROUTINE FAST_UnPackIceDyn_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 IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1,i2), ErrStat2, ErrMsg2 ) ! Input_bak + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1,i2), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18449,7 +18449,7 @@ SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -18459,15 +18459,15 @@ SUBROUTINE FAST_UnPackIceDyn_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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%InputTimes_bak,2), UBOUND(OutData%InputTimes_bak,2) - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1,i2) = DbKiBuf(Db_Xferred) + DO i2 = LBOUND(OutData%InputTimes_Saved,2), UBOUND(OutData%InputTimes_Saved,2) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO @@ -18690,21 +18690,21 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl ENDDO ENDDO ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input_bak,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input_bak,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input_bak,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input_bak)) THEN - ALLOCATE(DstBeamDyn_DataData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBeamDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Input_Saved,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Input_Saved,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Input_Saved,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstBeamDyn_DataData%Input_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input_bak,2), UBOUND(SrcBeamDyn_DataData%Input_bak,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input_bak,1), UBOUND(SrcBeamDyn_DataData%Input_bak,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input_bak(i1,i2), DstBeamDyn_DataData%Input_bak(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i2 = LBOUND(SrcBeamDyn_DataData%Input_Saved,2), UBOUND(SrcBeamDyn_DataData%Input_Saved,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Input_Saved,1), UBOUND(SrcBeamDyn_DataData%Input_Saved,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%Input_Saved(i1,i2), DstBeamDyn_DataData%Input_Saved(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -18724,19 +18724,19 @@ SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, Ctrl END IF DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes_bak,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes_bak,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes_bak,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes_Saved,1) + i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes_Saved,2) + i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes_Saved,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstBeamDyn_DataData%InputTimes_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBeamDyn_DataData%InputTimes_bak = SrcBeamDyn_DataData%InputTimes_bak + DstBeamDyn_DataData%InputTimes_Saved = SrcBeamDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyBeamDyn_Data @@ -18850,20 +18850,20 @@ SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(BeamDyn_DataData%Input) ENDIF -IF (ALLOCATED(BeamDyn_DataData%Input_bak)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Input_bak,2), UBOUND(BeamDyn_DataData%Input_bak,2) -DO i1 = LBOUND(BeamDyn_DataData%Input_bak,1), UBOUND(BeamDyn_DataData%Input_bak,1) - CALL BD_DestroyInput( BeamDyn_DataData%Input_bak(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(BeamDyn_DataData%Input_Saved)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Input_Saved,2), UBOUND(BeamDyn_DataData%Input_Saved,2) +DO i1 = LBOUND(BeamDyn_DataData%Input_Saved,1), UBOUND(BeamDyn_DataData%Input_Saved,1) + CALL BD_DestroyInput( BeamDyn_DataData%Input_Saved(i1,i2), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO ENDDO - DEALLOCATE(BeamDyn_DataData%Input_bak) + DEALLOCATE(BeamDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN DEALLOCATE(BeamDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes_bak) +IF (ALLOCATED(BeamDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(BeamDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyBeamDyn_Data @@ -19168,25 +19168,25 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input_bak upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Input_Saved upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input_Saved,2), UBOUND(InData%Input_Saved,2) + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -19198,10 +19198,10 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -19711,22 +19711,22 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_bak,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Input_bak,2), UBOUND(InData%Input_bak,2) - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i2 = LBOUND(InData%Input_Saved,2), UBOUND(InData%Input_Saved,2) + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19777,22 +19777,22 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_bak,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%InputTimes_bak,2), UBOUND(InData%InputTimes_bak,2) - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1,i2) + DO i2 = LBOUND(InData%InputTimes_Saved,2), UBOUND(InData%InputTimes_Saved,2) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO @@ -20473,7 +20473,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -20483,14 +20483,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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Input_bak,2), UBOUND(OutData%Input_bak,2) - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i2 = LBOUND(OutData%Input_Saved,2), UBOUND(OutData%Input_Saved,2) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -20524,7 +20524,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_bak(i1,i2), ErrStat2, ErrMsg2 ) ! Input_bak + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1,i2), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20557,7 +20557,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -20567,15 +20567,15 @@ 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%InputTimes_bak,2), UBOUND(OutData%InputTimes_bak,2) - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1,i2) = DbKiBuf(Db_Xferred) + DO i2 = LBOUND(OutData%InputTimes_Saved,2), UBOUND(OutData%InputTimes_Saved,2) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO @@ -20680,18 +20680,18 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input_bak)) THEN - ALLOCATE(DstElastoDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcElastoDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstElastoDyn_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input_bak,1), UBOUND(SrcElastoDyn_DataData%Input_bak,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input_bak(i1), DstElastoDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%Input_Saved,1), UBOUND(SrcElastoDyn_DataData%Input_Saved,1) + CALL ED_CopyInput( SrcElastoDyn_DataData%Input_Saved(i1), DstElastoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -20708,17 +20708,17 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData END IF DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstElastoDyn_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstElastoDyn_DataData%InputTimes_bak = SrcElastoDyn_DataData%InputTimes_bak + DstElastoDyn_DataData%InputTimes_Saved = SrcElastoDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyElastoDyn_Data @@ -20790,18 +20790,18 @@ SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg, DEAL ENDDO DEALLOCATE(ElastoDyn_DataData%Input) ENDIF -IF (ALLOCATED(ElastoDyn_DataData%Input_bak)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Input_bak,1), UBOUND(ElastoDyn_DataData%Input_bak,1) - CALL ED_DestroyInput( ElastoDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(ElastoDyn_DataData%Input_Saved)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Input_Saved,1), UBOUND(ElastoDyn_DataData%Input_Saved,1) + CALL ED_DestroyInput( ElastoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(ElastoDyn_DataData%Input_bak) + DEALLOCATE(ElastoDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN DEALLOCATE(ElastoDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes_bak) +IF (ALLOCATED(ElastoDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(ElastoDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyElastoDyn_Data @@ -21071,24 +21071,24 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -21099,10 +21099,10 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -21514,18 +21514,18 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21570,18 +21570,18 @@ SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -22158,20 +22158,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_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -22205,7 +22205,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22232,21 +22232,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -22337,18 +22337,18 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input_bak)) THEN - ALLOCATE(DstServoDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcServoDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcServoDyn_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstServoDyn_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input_bak,1), UBOUND(SrcServoDyn_DataData%Input_bak,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input_bak(i1), DstServoDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%Input_Saved,1), UBOUND(SrcServoDyn_DataData%Input_Saved,1) + CALL SrvD_CopyInput( SrcServoDyn_DataData%Input_Saved(i1), DstServoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -22365,17 +22365,17 @@ SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, C END IF DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcServoDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcServoDyn_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstServoDyn_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstServoDyn_DataData%InputTimes_bak = SrcServoDyn_DataData%InputTimes_bak + DstServoDyn_DataData%InputTimes_Saved = SrcServoDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyServoDyn_Data @@ -22442,18 +22442,18 @@ SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(ServoDyn_DataData%Input) ENDIF -IF (ALLOCATED(ServoDyn_DataData%Input_bak)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Input_bak,1), UBOUND(ServoDyn_DataData%Input_bak,1) - CALL SrvD_DestroyInput( ServoDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(ServoDyn_DataData%Input_Saved)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Input_Saved,1), UBOUND(ServoDyn_DataData%Input_Saved,1) + CALL SrvD_DestroyInput( ServoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(ServoDyn_DataData%Input_bak) + DEALLOCATE(ServoDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN DEALLOCATE(ServoDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes_bak) +IF (ALLOCATED(ServoDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(ServoDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyServoDyn_Data @@ -22717,24 +22717,24 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -22745,10 +22745,10 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -23147,18 +23147,18 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23203,18 +23203,18 @@ SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -23775,20 +23775,20 @@ 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 ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -23822,7 +23822,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23849,21 +23849,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -23932,18 +23932,18 @@ SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input_bak,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input_bak)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%Input_Saved,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input_Saved)) THEN + ALLOCATE(DstAeroDyn14_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input_bak,1), UBOUND(SrcAeroDyn14_DataData%Input_bak,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input_bak(i1), DstAeroDyn14_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%Input_Saved,1), UBOUND(SrcAeroDyn14_DataData%Input_Saved,1) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input_Saved(i1), DstAeroDyn14_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -23960,17 +23960,17 @@ SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData END IF DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes_bak)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstAeroDyn14_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstAeroDyn14_DataData%InputTimes_bak = SrcAeroDyn14_DataData%InputTimes_bak + DstAeroDyn14_DataData%InputTimes_Saved = SrcAeroDyn14_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyAeroDyn14_Data @@ -24026,18 +24026,18 @@ SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg, DEAL ENDDO DEALLOCATE(AeroDyn14_DataData%Input) ENDIF -IF (ALLOCATED(AeroDyn14_DataData%Input_bak)) THEN -DO i1 = LBOUND(AeroDyn14_DataData%Input_bak,1), UBOUND(AeroDyn14_DataData%Input_bak,1) - CALL AD14_DestroyInput( AeroDyn14_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(AeroDyn14_DataData%Input_Saved)) THEN +DO i1 = LBOUND(AeroDyn14_DataData%Input_Saved,1), UBOUND(AeroDyn14_DataData%Input_Saved,1) + CALL AD14_DestroyInput( AeroDyn14_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(AeroDyn14_DataData%Input_bak) + DEALLOCATE(AeroDyn14_DataData%Input_Saved) ENDIF IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN DEALLOCATE(AeroDyn14_DataData%InputTimes) ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes_bak)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes_bak) +IF (ALLOCATED(AeroDyn14_DataData%InputTimes_Saved)) THEN + DEALLOCATE(AeroDyn14_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyAeroDyn14_Data @@ -24244,24 +24244,24 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -24272,10 +24272,10 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -24577,18 +24577,18 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -24633,18 +24633,18 @@ SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -25069,20 +25069,20 @@ 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 ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -25116,7 +25116,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25143,21 +25143,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -25245,18 +25245,18 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input_bak)) THEN - ALLOCATE(DstAeroDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstAeroDyn_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input_bak,1), UBOUND(SrcAeroDyn_DataData%Input_bak,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input_bak(i1), DstAeroDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%Input_Saved,1), UBOUND(SrcAeroDyn_DataData%Input_Saved,1) + CALL AD_CopyInput( SrcAeroDyn_DataData%Input_Saved(i1), DstAeroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -25273,17 +25273,17 @@ SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, Ctrl END IF DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstAeroDyn_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstAeroDyn_DataData%InputTimes_bak = SrcAeroDyn_DataData%InputTimes_bak + DstAeroDyn_DataData%InputTimes_Saved = SrcAeroDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyAeroDyn_Data @@ -25348,18 +25348,18 @@ SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(AeroDyn_DataData%Input) ENDIF -IF (ALLOCATED(AeroDyn_DataData%Input_bak)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Input_bak,1), UBOUND(AeroDyn_DataData%Input_bak,1) - CALL AD_DestroyInput( AeroDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(AeroDyn_DataData%Input_Saved)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Input_Saved,1), UBOUND(AeroDyn_DataData%Input_Saved,1) + CALL AD_DestroyInput( AeroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(AeroDyn_DataData%Input_bak) + DEALLOCATE(AeroDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN DEALLOCATE(AeroDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes_bak) +IF (ALLOCATED(AeroDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(AeroDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyAeroDyn_Data @@ -25606,24 +25606,24 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -25634,10 +25634,10 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -26008,18 +26008,18 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26064,18 +26064,18 @@ SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -26596,20 +26596,20 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26643,7 +26643,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26670,21 +26670,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -27727,18 +27727,18 @@ SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataD IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input_bak,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input_bak)) THEN - ALLOCATE(DstInflowWind_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Input_Saved,1) + i1_u = UBOUND(SrcInflowWind_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input_Saved)) THEN + ALLOCATE(DstInflowWind_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input_bak,1), UBOUND(SrcInflowWind_DataData%Input_bak,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input_bak(i1), DstInflowWind_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%Input_Saved,1), UBOUND(SrcInflowWind_DataData%Input_Saved,1) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input_Saved(i1), DstInflowWind_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -27755,17 +27755,17 @@ SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataD END IF DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes_bak)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcInflowWind_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstInflowWind_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInflowWind_DataData%InputTimes_bak = SrcInflowWind_DataData%InputTimes_bak + DstInflowWind_DataData%InputTimes_Saved = SrcInflowWind_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyInflowWind_Data @@ -27830,18 +27830,18 @@ SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg, DE ENDDO DEALLOCATE(InflowWind_DataData%Input) ENDIF -IF (ALLOCATED(InflowWind_DataData%Input_bak)) THEN -DO i1 = LBOUND(InflowWind_DataData%Input_bak,1), UBOUND(InflowWind_DataData%Input_bak,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(InflowWind_DataData%Input_Saved)) THEN +DO i1 = LBOUND(InflowWind_DataData%Input_Saved,1), UBOUND(InflowWind_DataData%Input_Saved,1) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(InflowWind_DataData%Input_bak) + DEALLOCATE(InflowWind_DataData%Input_Saved) ENDIF IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN DEALLOCATE(InflowWind_DataData%InputTimes) ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes_bak)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes_bak) +IF (ALLOCATED(InflowWind_DataData%InputTimes_Saved)) THEN + DEALLOCATE(InflowWind_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyInflowWind_Data @@ -28088,24 +28088,24 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -28116,10 +28116,10 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -28490,18 +28490,18 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28546,18 +28546,18 @@ SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -29078,20 +29078,20 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -29125,7 +29125,7 @@ SUBROUTINE FAST_UnPackInflowWind_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 InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -29152,21 +29152,21 @@ SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -30129,18 +30129,18 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input_bak)) THEN - ALLOCATE(DstSubDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSubDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcSubDyn_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstSubDyn_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input_bak,1), UBOUND(SrcSubDyn_DataData%Input_bak,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input_bak(i1), DstSubDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSubDyn_DataData%Input_Saved,1), UBOUND(SrcSubDyn_DataData%Input_Saved,1) + CALL SD_CopyInput( SrcSubDyn_DataData%Input_Saved(i1), DstSubDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -30176,17 +30176,17 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod END IF DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSubDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcSubDyn_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstSubDyn_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstSubDyn_DataData%InputTimes_bak = SrcSubDyn_DataData%InputTimes_bak + DstSubDyn_DataData%InputTimes_Saved = SrcSubDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopySubDyn_Data @@ -30242,12 +30242,12 @@ SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATE ENDDO DEALLOCATE(SubDyn_DataData%Input) ENDIF -IF (ALLOCATED(SubDyn_DataData%Input_bak)) THEN -DO i1 = LBOUND(SubDyn_DataData%Input_bak,1), UBOUND(SubDyn_DataData%Input_bak,1) - CALL SD_DestroyInput( SubDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(SubDyn_DataData%Input_Saved)) THEN +DO i1 = LBOUND(SubDyn_DataData%Input_Saved,1), UBOUND(SubDyn_DataData%Input_Saved,1) + CALL SD_DestroyInput( SubDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(SubDyn_DataData%Input_bak) + DEALLOCATE(SubDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(SubDyn_DataData%Output)) THEN DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) @@ -30261,8 +30261,8 @@ SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg, DEALLOCATE IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN DEALLOCATE(SubDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(SubDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes_bak) +IF (ALLOCATED(SubDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(SubDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroySubDyn_Data @@ -30469,24 +30469,24 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -30537,10 +30537,10 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -30842,18 +30842,18 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -30967,18 +30967,18 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -31403,20 +31403,20 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -31450,7 +31450,7 @@ SUBROUTINE FAST_UnPackSubDyn_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 SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -31573,21 +31573,21 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -31656,18 +31656,18 @@ SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input_bak,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input_bak)) THEN - ALLOCATE(DstExtPtfm_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcExtPtfm_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%Input_Saved,1) + i1_u = UBOUND(SrcExtPtfm_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input_Saved)) THEN + ALLOCATE(DstExtPtfm_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input_bak,1), UBOUND(SrcExtPtfm_DataData%Input_bak,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input_bak(i1), DstExtPtfm_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcExtPtfm_DataData%Input_Saved,1), UBOUND(SrcExtPtfm_DataData%Input_Saved,1) + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input_Saved(i1), DstExtPtfm_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -31684,17 +31684,17 @@ SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, Ctrl END IF DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes_bak)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstExtPtfm_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstExtPtfm_DataData%InputTimes_bak = SrcExtPtfm_DataData%InputTimes_bak + DstExtPtfm_DataData%InputTimes_Saved = SrcExtPtfm_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyExtPtfm_Data @@ -31750,18 +31750,18 @@ SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(ExtPtfm_DataData%Input) ENDIF -IF (ALLOCATED(ExtPtfm_DataData%Input_bak)) THEN -DO i1 = LBOUND(ExtPtfm_DataData%Input_bak,1), UBOUND(ExtPtfm_DataData%Input_bak,1) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(ExtPtfm_DataData%Input_Saved)) THEN +DO i1 = LBOUND(ExtPtfm_DataData%Input_Saved,1), UBOUND(ExtPtfm_DataData%Input_Saved,1) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(ExtPtfm_DataData%Input_bak) + DEALLOCATE(ExtPtfm_DataData%Input_Saved) ENDIF IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN DEALLOCATE(ExtPtfm_DataData%InputTimes) ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes_bak)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes_bak) +IF (ALLOCATED(ExtPtfm_DataData%InputTimes_Saved)) THEN + DEALLOCATE(ExtPtfm_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyExtPtfm_Data @@ -31968,24 +31968,24 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -31996,10 +31996,10 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -32301,18 +32301,18 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -32357,18 +32357,18 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -32793,20 +32793,20 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -32840,7 +32840,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_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -32867,21 +32867,21 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -32950,18 +32950,18 @@ SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcSeaState_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Input_bak,1) - i1_u = UBOUND(SrcSeaState_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Input_bak)) THEN - ALLOCATE(DstSeaState_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSeaState_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcSeaState_DataData%Input_Saved,1) + i1_u = UBOUND(SrcSeaState_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%Input_Saved)) THEN + ALLOCATE(DstSeaState_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcSeaState_DataData%Input_bak,1), UBOUND(SrcSeaState_DataData%Input_bak,1) - CALL SeaSt_CopyInput( SrcSeaState_DataData%Input_bak(i1), DstSeaState_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSeaState_DataData%Input_Saved,1), UBOUND(SrcSeaState_DataData%Input_Saved,1) + CALL SeaSt_CopyInput( SrcSeaState_DataData%Input_Saved(i1), DstSeaState_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -32997,17 +32997,17 @@ SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, C END IF DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcSeaState_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcSeaState_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcSeaState_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes_bak)) THEN - ALLOCATE(DstSeaState_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSeaState_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcSeaState_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcSeaState_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstSeaState_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstSeaState_DataData%InputTimes_bak = SrcSeaState_DataData%InputTimes_bak + DstSeaState_DataData%InputTimes_Saved = SrcSeaState_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopySeaState_Data @@ -33063,12 +33063,12 @@ SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(SeaState_DataData%Input) ENDIF -IF (ALLOCATED(SeaState_DataData%Input_bak)) THEN -DO i1 = LBOUND(SeaState_DataData%Input_bak,1), UBOUND(SeaState_DataData%Input_bak,1) - CALL SeaSt_DestroyInput( SeaState_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(SeaState_DataData%Input_Saved)) THEN +DO i1 = LBOUND(SeaState_DataData%Input_Saved,1), UBOUND(SeaState_DataData%Input_Saved,1) + CALL SeaSt_DestroyInput( SeaState_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(SeaState_DataData%Input_bak) + DEALLOCATE(SeaState_DataData%Input_Saved) ENDIF IF (ALLOCATED(SeaState_DataData%Output)) THEN DO i1 = LBOUND(SeaState_DataData%Output,1), UBOUND(SeaState_DataData%Output,1) @@ -33082,8 +33082,8 @@ SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(SeaState_DataData%InputTimes)) THEN DEALLOCATE(SeaState_DataData%InputTimes) ENDIF -IF (ALLOCATED(SeaState_DataData%InputTimes_bak)) THEN - DEALLOCATE(SeaState_DataData%InputTimes_bak) +IF (ALLOCATED(SeaState_DataData%InputTimes_Saved)) THEN + DEALLOCATE(SeaState_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroySeaState_Data @@ -33290,24 +33290,24 @@ SUBROUTINE FAST_PackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -33358,10 +33358,10 @@ SUBROUTINE FAST_PackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -33663,18 +33663,18 @@ SUBROUTINE FAST_PackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -33788,18 +33788,18 @@ SUBROUTINE FAST_PackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -34224,20 +34224,20 @@ SUBROUTINE FAST_UnPackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -34271,7 +34271,7 @@ SUBROUTINE FAST_UnPackSeaState_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 SeaSt_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL SeaSt_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -34394,21 +34394,21 @@ SUBROUTINE FAST_UnPackSeaState_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -34496,18 +34496,18 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input_bak)) THEN - ALLOCATE(DstHydroDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcHydroDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstHydroDyn_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input_bak,1), UBOUND(SrcHydroDyn_DataData%Input_bak,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input_bak(i1), DstHydroDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcHydroDyn_DataData%Input_Saved,1), UBOUND(SrcHydroDyn_DataData%Input_Saved,1) + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input_Saved(i1), DstHydroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -34524,17 +34524,17 @@ SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, C END IF DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstHydroDyn_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstHydroDyn_DataData%InputTimes_bak = SrcHydroDyn_DataData%InputTimes_bak + DstHydroDyn_DataData%InputTimes_Saved = SrcHydroDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyHydroDyn_Data @@ -34599,18 +34599,18 @@ SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(HydroDyn_DataData%Input) ENDIF -IF (ALLOCATED(HydroDyn_DataData%Input_bak)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Input_bak,1), UBOUND(HydroDyn_DataData%Input_bak,1) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(HydroDyn_DataData%Input_Saved)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Input_Saved,1), UBOUND(HydroDyn_DataData%Input_Saved,1) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(HydroDyn_DataData%Input_bak) + DEALLOCATE(HydroDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN DEALLOCATE(HydroDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes_bak) +IF (ALLOCATED(HydroDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(HydroDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyHydroDyn_Data @@ -34857,24 +34857,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -34885,10 +34885,10 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -35259,18 +35259,18 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -35315,18 +35315,18 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -35847,20 +35847,20 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -35894,7 +35894,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -35921,21 +35921,21 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -36004,18 +36004,18 @@ SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input_bak,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input_bak)) THEN - ALLOCATE(DstIceFloe_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceFloe_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%Input_Saved,1) + i1_u = UBOUND(SrcIceFloe_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input_Saved)) THEN + ALLOCATE(DstIceFloe_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input_bak,1), UBOUND(SrcIceFloe_DataData%Input_bak,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input_bak(i1), DstIceFloe_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcIceFloe_DataData%Input_Saved,1), UBOUND(SrcIceFloe_DataData%Input_Saved,1) + CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input_Saved(i1), DstIceFloe_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -36032,17 +36032,17 @@ SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, Ctrl END IF DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes_bak)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceFloe_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcIceFloe_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstIceFloe_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstIceFloe_DataData%InputTimes_bak = SrcIceFloe_DataData%InputTimes_bak + DstIceFloe_DataData%InputTimes_Saved = SrcIceFloe_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyIceFloe_Data @@ -36098,18 +36098,18 @@ SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(IceFloe_DataData%Input) ENDIF -IF (ALLOCATED(IceFloe_DataData%Input_bak)) THEN -DO i1 = LBOUND(IceFloe_DataData%Input_bak,1), UBOUND(IceFloe_DataData%Input_bak,1) - CALL IceFloe_DestroyInput( IceFloe_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(IceFloe_DataData%Input_Saved)) THEN +DO i1 = LBOUND(IceFloe_DataData%Input_Saved,1), UBOUND(IceFloe_DataData%Input_Saved,1) + CALL IceFloe_DestroyInput( IceFloe_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(IceFloe_DataData%Input_bak) + DEALLOCATE(IceFloe_DataData%Input_Saved) ENDIF IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN DEALLOCATE(IceFloe_DataData%InputTimes) ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes_bak)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes_bak) +IF (ALLOCATED(IceFloe_DataData%InputTimes_Saved)) THEN + DEALLOCATE(IceFloe_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyIceFloe_Data @@ -36316,24 +36316,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -36344,10 +36344,10 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -36649,18 +36649,18 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -36705,18 +36705,18 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -37141,20 +37141,20 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -37188,7 +37188,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -37215,21 +37215,21 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -37315,18 +37315,18 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMAP_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input_bak,1) - i1_u = UBOUND(SrcMAP_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input_bak)) THEN - ALLOCATE(DstMAP_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMAP_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcMAP_DataData%Input_Saved,1) + i1_u = UBOUND(SrcMAP_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Input_Saved)) THEN + ALLOCATE(DstMAP_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMAP_DataData%Input_bak,1), UBOUND(SrcMAP_DataData%Input_bak,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input_bak(i1), DstMAP_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMAP_DataData%Input_Saved,1), UBOUND(SrcMAP_DataData%Input_Saved,1) + CALL MAP_CopyInput( SrcMAP_DataData%Input_Saved(i1), DstMAP_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -37343,17 +37343,17 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta END IF DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes_bak)) THEN - ALLOCATE(DstMAP_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMAP_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcMAP_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcMAP_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstMAP_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMAP_DataData%InputTimes_bak = SrcMAP_DataData%InputTimes_bak + DstMAP_DataData%InputTimes_Saved = SrcMAP_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyMAP_Data @@ -37416,18 +37416,18 @@ SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg, DEALLOCATEpointe ENDDO DEALLOCATE(MAP_DataData%Input) ENDIF -IF (ALLOCATED(MAP_DataData%Input_bak)) THEN -DO i1 = LBOUND(MAP_DataData%Input_bak,1), UBOUND(MAP_DataData%Input_bak,1) - CALL MAP_DestroyInput( MAP_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(MAP_DataData%Input_Saved)) THEN +DO i1 = LBOUND(MAP_DataData%Input_Saved,1), UBOUND(MAP_DataData%Input_Saved,1) + CALL MAP_DestroyInput( MAP_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(MAP_DataData%Input_bak) + DEALLOCATE(MAP_DataData%Input_Saved) ENDIF IF (ALLOCATED(MAP_DataData%InputTimes)) THEN DEALLOCATE(MAP_DataData%InputTimes) ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes_bak)) THEN - DEALLOCATE(MAP_DataData%InputTimes_bak) +IF (ALLOCATED(MAP_DataData%InputTimes_Saved)) THEN + DEALLOCATE(MAP_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyMAP_Data @@ -37672,24 +37672,24 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -37700,10 +37700,10 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -38072,18 +38072,18 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38128,18 +38128,18 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -38656,20 +38656,20 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -38703,7 +38703,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -38730,21 +38730,21 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -38813,18 +38813,18 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input_bak,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input_bak)) THEN - ALLOCATE(DstFEAMooring_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcFEAMooring_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%Input_Saved,1) + i1_u = UBOUND(SrcFEAMooring_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input_Saved)) THEN + ALLOCATE(DstFEAMooring_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input_bak,1), UBOUND(SrcFEAMooring_DataData%Input_bak,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input_bak(i1), DstFEAMooring_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcFEAMooring_DataData%Input_Saved,1), UBOUND(SrcFEAMooring_DataData%Input_Saved,1) + CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input_Saved(i1), DstFEAMooring_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -38841,17 +38841,17 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD END IF DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes_bak)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstFEAMooring_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstFEAMooring_DataData%InputTimes_bak = SrcFEAMooring_DataData%InputTimes_bak + DstFEAMooring_DataData%InputTimes_Saved = SrcFEAMooring_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyFEAMooring_Data @@ -38907,18 +38907,18 @@ SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg, DE ENDDO DEALLOCATE(FEAMooring_DataData%Input) ENDIF -IF (ALLOCATED(FEAMooring_DataData%Input_bak)) THEN -DO i1 = LBOUND(FEAMooring_DataData%Input_bak,1), UBOUND(FEAMooring_DataData%Input_bak,1) - CALL FEAM_DestroyInput( FEAMooring_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(FEAMooring_DataData%Input_Saved)) THEN +DO i1 = LBOUND(FEAMooring_DataData%Input_Saved,1), UBOUND(FEAMooring_DataData%Input_Saved,1) + CALL FEAM_DestroyInput( FEAMooring_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(FEAMooring_DataData%Input_bak) + DEALLOCATE(FEAMooring_DataData%Input_Saved) ENDIF IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN DEALLOCATE(FEAMooring_DataData%InputTimes) ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes_bak)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes_bak) +IF (ALLOCATED(FEAMooring_DataData%InputTimes_Saved)) THEN + DEALLOCATE(FEAMooring_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyFEAMooring_Data @@ -39125,24 +39125,24 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -39153,10 +39153,10 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -39458,18 +39458,18 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -39514,18 +39514,18 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -39950,20 +39950,20 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -39997,7 +39997,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40024,21 +40024,21 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -40126,18 +40126,18 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input_bak,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input_bak)) THEN - ALLOCATE(DstMoorDyn_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMoorDyn_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Input_Saved,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input_Saved)) THEN + ALLOCATE(DstMoorDyn_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input_bak,1), UBOUND(SrcMoorDyn_DataData%Input_bak,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input_bak(i1), DstMoorDyn_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%Input_Saved,1), UBOUND(SrcMoorDyn_DataData%Input_Saved,1) + CALL MD_CopyInput( SrcMoorDyn_DataData%Input_Saved(i1), DstMoorDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -40154,17 +40154,17 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl END IF DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes_bak)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstMoorDyn_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMoorDyn_DataData%InputTimes_bak = SrcMoorDyn_DataData%InputTimes_bak + DstMoorDyn_DataData%InputTimes_Saved = SrcMoorDyn_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyMoorDyn_Data @@ -40229,18 +40229,18 @@ SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg, DEALLOCA ENDDO DEALLOCATE(MoorDyn_DataData%Input) ENDIF -IF (ALLOCATED(MoorDyn_DataData%Input_bak)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Input_bak,1), UBOUND(MoorDyn_DataData%Input_bak,1) - CALL MD_DestroyInput( MoorDyn_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(MoorDyn_DataData%Input_Saved)) THEN +DO i1 = LBOUND(MoorDyn_DataData%Input_Saved,1), UBOUND(MoorDyn_DataData%Input_Saved,1) + CALL MD_DestroyInput( MoorDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(MoorDyn_DataData%Input_bak) + DEALLOCATE(MoorDyn_DataData%Input_Saved) ENDIF IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN DEALLOCATE(MoorDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes_bak)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes_bak) +IF (ALLOCATED(MoorDyn_DataData%InputTimes_Saved)) THEN + DEALLOCATE(MoorDyn_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyMoorDyn_Data @@ -40487,24 +40487,24 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -40515,10 +40515,10 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -40889,18 +40889,18 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -40945,18 +40945,18 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -41477,20 +41477,20 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -41524,7 +41524,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -41551,21 +41551,21 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -41634,18 +41634,18 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%Input_bak)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input_bak,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input_bak,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input_bak)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOrcaFlex_DataData%Input_Saved)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%Input_Saved,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%Input_Saved,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input_Saved)) THEN + ALLOCATE(DstOrcaFlex_DataData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input_bak,1), UBOUND(SrcOrcaFlex_DataData%Input_bak,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input_bak(i1), DstOrcaFlex_DataData%Input_bak(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcOrcaFlex_DataData%Input_Saved,1), UBOUND(SrcOrcaFlex_DataData%Input_Saved,1) + CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input_Saved(i1), DstOrcaFlex_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -41662,17 +41662,17 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C END IF DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes_bak)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes_bak,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes_bak,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes_bak)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes_Saved)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes_Saved,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes_Saved,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes_Saved)) THEN + ALLOCATE(DstOrcaFlex_DataData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOrcaFlex_DataData%InputTimes_bak = SrcOrcaFlex_DataData%InputTimes_bak + DstOrcaFlex_DataData%InputTimes_Saved = SrcOrcaFlex_DataData%InputTimes_Saved ENDIF END SUBROUTINE FAST_CopyOrcaFlex_Data @@ -41728,18 +41728,18 @@ SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg, DEALLO ENDDO DEALLOCATE(OrcaFlex_DataData%Input) ENDIF -IF (ALLOCATED(OrcaFlex_DataData%Input_bak)) THEN -DO i1 = LBOUND(OrcaFlex_DataData%Input_bak,1), UBOUND(OrcaFlex_DataData%Input_bak,1) - CALL Orca_DestroyInput( OrcaFlex_DataData%Input_bak(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) +IF (ALLOCATED(OrcaFlex_DataData%Input_Saved)) THEN +DO i1 = LBOUND(OrcaFlex_DataData%Input_Saved,1), UBOUND(OrcaFlex_DataData%Input_Saved,1) + CALL Orca_DestroyInput( OrcaFlex_DataData%Input_Saved(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(OrcaFlex_DataData%Input_bak) + DEALLOCATE(OrcaFlex_DataData%Input_Saved) ENDIF IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN DEALLOCATE(OrcaFlex_DataData%InputTimes) ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes_bak)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes_bak) +IF (ALLOCATED(OrcaFlex_DataData%InputTimes_Saved)) THEN + DEALLOCATE(OrcaFlex_DataData%InputTimes_Saved) ENDIF END SUBROUTINE FAST_DestroyOrcaFlex_Data @@ -41946,24 +41946,24 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Input_bak allocated yes/no - IF ( ALLOCATED(InData%Input_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input_bak upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - Int_BufSz = Int_BufSz + 3 ! Input_bak: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_bak + Int_BufSz = Int_BufSz + 1 ! Input_Saved allocated yes/no + IF ( ALLOCATED(InData%Input_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input_Saved upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + Int_BufSz = Int_BufSz + 3 ! Input_Saved: size of buffers for each call to pack subtype + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input_bak + IF(ALLOCATED(Re_Buf)) THEN ! Input_Saved Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input_bak + IF(ALLOCATED(Db_Buf)) THEN ! Input_Saved Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input_bak + IF(ALLOCATED(Int_Buf)) THEN ! Input_Saved Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -41974,10 +41974,10 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes_bak allocated yes/no - IF ( ALLOCATED(InData%InputTimes_bak) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes_bak upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_bak) ! InputTimes_bak + Int_BufSz = Int_BufSz + 1 ! InputTimes_Saved allocated yes/no + IF ( ALLOCATED(InData%InputTimes_Saved) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes_Saved upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes_Saved) ! InputTimes_Saved END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -42279,18 +42279,18 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%Input_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input_bak,1), UBOUND(InData%Input_bak,1) - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_bak(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_bak + DO i1 = LBOUND(InData%Input_Saved,1), UBOUND(InData%Input_Saved,1) + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input_Saved(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42335,18 +42335,18 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes_bak) ) THEN + IF ( .NOT. ALLOCATED(InData%InputTimes_Saved) ) THEN 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_bak,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_bak,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes_Saved,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes_Saved,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%InputTimes_bak,1), UBOUND(InData%InputTimes_bak,1) - DbKiBuf(Db_Xferred) = InData%InputTimes_bak(i1) + DO i1 = LBOUND(InData%InputTimes_Saved,1), UBOUND(InData%InputTimes_Saved,1) + DbKiBuf(Db_Xferred) = InData%InputTimes_Saved(i1) Db_Xferred = Db_Xferred + 1 END DO END IF @@ -42771,20 +42771,20 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%Input_bak) - ALLOCATE(OutData%Input_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input_Saved)) DEALLOCATE(OutData%Input_Saved) + ALLOCATE(OutData%Input_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input_bak,1), UBOUND(OutData%Input_bak,1) + DO i1 = LBOUND(OutData%Input_Saved,1), UBOUND(OutData%Input_Saved,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42818,7 +42818,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_bak(i1), ErrStat2, ErrMsg2 ) ! Input_bak + CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input_Saved(i1), ErrStat2, ErrMsg2 ) ! Input_Saved CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -42845,21 +42845,21 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_bak not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes_Saved not allocated Int_Xferred = Int_Xferred + 1 ELSE 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_bak)) DEALLOCATE(OutData%InputTimes_bak) - ALLOCATE(OutData%InputTimes_bak(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%InputTimes_Saved)) DEALLOCATE(OutData%InputTimes_Saved) + ALLOCATE(OutData%InputTimes_Saved(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_bak.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes_Saved.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%InputTimes_bak,1), UBOUND(OutData%InputTimes_bak,1) - OutData%InputTimes_bak(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%InputTimes_Saved,1), UBOUND(OutData%InputTimes_Saved,1) + OutData%InputTimes_Saved(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF From 47ef53ed56e2a560c3836222f5c1bcc186d015af Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 11 Dec 2023 15:17:13 -0700 Subject: [PATCH 112/232] ExtLoads: true-up the r-test pointer (no changes) --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 4d36d8101c..9bdec5a01b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 4d36d8101cd7d6b3f7169c6d412251b8257f32f2 +Subproject commit 9bdec5a01b88ac825277ecb323f642c5b6a977d6 From d4dae7c8c0c5c76d1d08ed8f20bd489271c7022e Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 11 Dec 2023 15:25:13 -0700 Subject: [PATCH 113/232] ExtLoads: rename SS --> SubStep / SAVED SS is also used for steady-state solve. To avoid ambiguity changing as follows: - STATE_SS_PRED --> STATE_SAVED_PRED - STATE_SS_CURR --> STATE_SAVED_CURR - _SS routines --> _SubStep --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 6 +- modules/openfast-library/src/FAST_Library.f90 | 30 +- modules/openfast-library/src/FAST_Library.h | 6 +- modules/openfast-library/src/FAST_Mods.f90 | 4 +- modules/openfast-library/src/FAST_Subs.f90 | 758 +++++++++--------- 5 files changed, 402 insertions(+), 402 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index d9fd1cb20c..53f5b4a407 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -944,7 +944,7 @@ void fast::OpenFAST::solution0(bool writeFiles) { FAST_CFD_Solution0(&iTurb, &ErrStat, ErrMsg); checkError(ErrStat, ErrMsg); - FAST_CFD_InitIOarrays_SS(&iTurb, &ErrStat, ErrMsg); + FAST_CFD_InitIOarrays_SubStep(&iTurb, &ErrStat, ErrMsg); checkError(ErrStat, ErrMsg); } @@ -1177,7 +1177,7 @@ void fast::OpenFAST::prework() { if (nSubsteps_ > 1) { for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_CFD_Store_SS(&iTurb, &nt_global, &ErrStat, ErrMsg) ; + FAST_CFD_Store_SubStep(&iTurb, &nt_global, &ErrStat, ErrMsg) ; checkError(ErrStat, ErrMsg); } @@ -1203,7 +1203,7 @@ void fast::OpenFAST::update_states_driver_time_step(bool writeFiles) { if (!firstPass_) { for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - FAST_CFD_Reset_SS(&iTurb, &nSubsteps_, &ErrStat, ErrMsg); + FAST_CFD_Reset_SubStep(&iTurb, &nSubsteps_, &ErrStat, ErrMsg); checkError(ErrStat, ErrMsg); } } diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 0482eecf4e..2c8ce3a2a6 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -804,24 +804,24 @@ subroutine FAST_CFD_Solution0(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CF end subroutine FAST_CFD_Solution0 !================================================================================================================================== -subroutine FAST_CFD_InitIOarrays_SS(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_InitIOarrays_SS') -!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_InitIOarrays_SS +subroutine FAST_CFD_InitIOarrays_SubStep(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_InitIOarrays_SubStep') +!DEC$ ATTRIBUTES DLLEXPORT::FAST_CFD_InitIOarrays_SubStep IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT -!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_InitIOarrays_SS +!GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_InitIOarrays_SubStep #endif INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number INTEGER(C_INT), INTENT( OUT) :: ErrStat_c CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - call FAST_InitIOarrays_SS_T(t_initial, Turbine(iTurb), ErrStat, ErrMsg ) + call FAST_InitIOarrays_SubStep_T(t_initial, Turbine(iTurb), ErrStat, ErrMsg ) ! set values for return to ExternalInflow ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -end subroutine FAST_CFD_InitIOarrays_SS +end subroutine FAST_CFD_InitIOarrays_SubStep !================================================================================================================================== subroutine FAST_ExtInfw_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, numElementsPerBlade_c, numElementsTower_c, n_t_global_c, & ExtInfw_Input_from_FAST, ExtInfw_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtInfw_Restart') @@ -1242,18 +1242,18 @@ subroutine FAST_CFD_Step(iTurb, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Ste end subroutine FAST_CFD_Step !================================================================================================================================== -subroutine FAST_CFD_Reset_SS(iTurb, n_timesteps, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Reset_SS') +subroutine FAST_CFD_Reset_SubStep(iTurb, n_timesteps, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Reset_SubStep') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT - !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SS - !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SS + !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SubStep + !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Reset_SubStep #endif INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number INTEGER(C_INT), INTENT(IN ) :: n_timesteps ! Number of time steps to go back INTEGER(C_INT), INTENT( OUT) :: ErrStat_c CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - CALL FAST_Reset_SS_T(t_initial, n_t_global-n_timesteps, n_timesteps, Turbine(iTurb), ErrStat, ErrMsg ) + CALL FAST_Reset_SubStep_T(t_initial, n_t_global-n_timesteps, n_timesteps, Turbine(iTurb), ErrStat, ErrMsg ) if (iTurb .eq. (NumTurbines-1) ) then n_t_global = n_t_global - n_timesteps @@ -1264,26 +1264,26 @@ subroutine FAST_CFD_Reset_SS(iTurb, n_timesteps, ErrStat_c, ErrMsg_c) BIND (C, N ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -end subroutine FAST_CFD_Reset_SS +end subroutine FAST_CFD_Reset_SubStep !================================================================================================================================== -subroutine FAST_CFD_Store_SS(iTurb, n_t_global, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Store_SS') +subroutine FAST_CFD_Store_SubStep(iTurb, n_t_global, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_CFD_Store_SubStep') IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT - !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SS - !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SS + !DEC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SubStep + !GCC$ ATTRIBUTES DLLEXPORT :: FAST_CFD_Store_SubStep #endif INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number INTEGER(C_INT), INTENT(IN ) :: n_t_global !< loop counter INTEGER(C_INT), INTENT( OUT) :: ErrStat_c CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) - CALL FAST_Store_SS_T(t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) + CALL FAST_Store_SubStep_T(t_initial, n_t_global, Turbine(iTurb), ErrStat, ErrMsg ) ErrStat_c = ErrStat ErrMsg = TRIM(ErrMsg)//C_NULL_CHAR ErrMsg_c = TRANSFER( ErrMsg//C_NULL_CHAR, ErrMsg_c ) -end subroutine FAST_CFD_Store_SS +end subroutine FAST_CFD_Store_SubStep !================================================================================================================================== END MODULE FAST_Data diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 51269339f0..5427cdbacf 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -30,14 +30,14 @@ EXTERNAL_ROUTINE void FAST_ExtInfw_Init(int * iTurb, double *TMax, const char *I EXTERNAL_ROUTINE void FAST_ExtLoads_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_ExtLoads_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, double * vel_mean, double * wind_dir, double * z_ref, double * shear_exp, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_CFD_InitIOarrays_SS(int * iTurb, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_InitIOarrays_SubStep(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Prework(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_UpdateStates(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_AdvanceToNextTimeStep(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_WriteOutput(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Step(int * iTurb, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_CFD_Reset_SS(int * iTurb, int * n_timesteps, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_CFD_Store_SS(int * iTurb, int * n_t_global, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Reset_SubStep(int * iTurb, int * n_timesteps, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_CFD_Store_SubStep(int * iTurb, int * n_t_global, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_HubPosition(int * iTurb, float * absolute_position, float * rotation_veocity, double * orientation_dcm, int *ErrStat, char *ErrMsg); diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 5d1ba46480..a09e8f43d5 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -37,8 +37,8 @@ MODULE FAST_ModTypes ! state array indexes INTEGER(IntKi), PARAMETER :: STATE_CURR = 1 !< index for "current" (t_global) states INTEGER(IntKi), PARAMETER :: STATE_PRED = 2 !< index for "predicted" (t_global_next) states - INTEGER(IntKi), PARAMETER :: STATE_SS_CURR = 3 - INTEGER(IntKi), PARAMETER :: STATE_SS_PRED = 4 + INTEGER(IntKi), PARAMETER :: STATE_SAVED_CURR = 3 + INTEGER(IntKi), PARAMETER :: STATE_SAVED_PRED = 4 ! VTK visualization INTEGER(IntKi), PARAMETER :: VTK_Unknown = -1 !< unknown option (will produce error) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c130da47e4..8d34031ad5 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -5616,9 +5616,9 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A END SUBROUTINE FAST_InitIOarrays !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_InitIOarrays_SS for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> Routine that calls FAST_InitIOarrays_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_InitIOarrays_SS_T(t_initial, Turbine, ErrStat, ErrMsg ) +SUBROUTINE FAST_InitIOarrays_SubStep_T(t_initial, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine @@ -5627,9 +5627,9 @@ SUBROUTINE FAST_InitIOarrays_SS_T(t_initial, Turbine, ErrStat, ErrMsg ) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SS_T' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep_T' - CALL FAST_InitIOarrays_SS(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + CALL FAST_InitIOarrays_SubStep(t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) @@ -5637,12 +5637,12 @@ SUBROUTINE FAST_InitIOarrays_SS_T(t_initial, Turbine, ErrStat, ErrMsg ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -END SUBROUTINE FAST_InitIOarrays_SS_T +END SUBROUTINE FAST_InitIOarrays_SubStep_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the input and output arrays stored for extrapolation when used in a sub-timestepping mode with an external driver program. They are initialized after the first input-output solve so that the first !! extrapolations are used with values from the solution, not just initial guesses. It also creates new copies of the state variables, which need to !! be stored for the predictor-corrector loop. -SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, HD, SD, ExtPtfm, & +SUBROUTINE FAST_InitIOarrays_SubStep( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< start time of the simulation @@ -5674,7 +5674,7 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD INTEGER(IntKi) :: i, j, k ! loop counters INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SS' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep' ErrStat = ErrID_None @@ -5698,22 +5698,22 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (p_FAST%CompElast == Module_BD ) THEN @@ -5731,23 +5731,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO ! nBeams @@ -5769,23 +5769,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_CURR), SrvD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_PRED), SrvD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyOtherState( SrvD%OtherSt(STATE_PRED), SrvD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_NEWCOPY, Errstat2, ErrMsg2) @@ -5807,23 +5807,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyOtherState( AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState( AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD14_CopyOtherState( AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN @@ -5839,23 +5839,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState(AD%x(STATE_CURR), AD%x(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState(AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState(AD%z(STATE_CURR), AD%z(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState(AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL AD_CopyContState(AD%x(STATE_PRED), AD%x(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState(AD%x(STATE_PRED), AD%x(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState(AD%xd(STATE_PRED), AD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState(AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState(AD%z(STATE_PRED), AD%z(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState(AD%z(STATE_PRED), AD%z(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState(AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState(AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompAero == Module_AD @@ -5876,23 +5876,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_CURR), IfW%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_PRED), IfW%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyOtherState( IfW%OtherSt(STATE_PRED), IfW%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompInflow == Module_IfW @@ -5911,23 +5911,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyOtherState( HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF !CompHydro @@ -5947,23 +5947,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyOtherState( SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState( SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SD_CopyOtherState( SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN @@ -5979,23 +5979,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyOtherState( ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompSub @@ -6015,11 +6015,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) @@ -6027,11 +6027,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END IF ! Initialize predicted states for j_pc loop: - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%n_substeps( MODULE_MAP ) > 1 ) THEN CALL MAP_CopyOtherState( MAPp%OtherSt, MAPp%OtherSt_old, MESH_NEWCOPY, Errstat2, ErrMsg2) @@ -6052,23 +6052,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyOtherState( MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState( MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL MD_CopyOtherState( MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6087,23 +6087,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_CURR), FEAM%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_PRED), FEAM%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyOtherState( FEAM%OtherSt(STATE_PRED), FEAM%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_Orca) THEN @@ -6119,23 +6119,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_CURR), Orca%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState( Orca%OtherSt(STATE_PRED), Orca%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL Orca_CopyOtherState( Orca%OtherSt(STATE_PRED), Orca%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompMooring @@ -6155,23 +6155,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyOtherState( IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompIce == Module_IceD ) THEN @@ -6190,23 +6190,23 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END DO ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_SS_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_CURR), IceD%OtherSt(i,STATE_SAVED_CURR), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Initialize predicted states for j_pc loop: - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_PRED), IceD%OtherSt(i,STATE_SS_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL IceD_CopyOtherState( IceD%OtherSt(i,STATE_PRED), IceD%OtherSt(i,STATE_SAVED_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO ! numIceLegs @@ -6214,11 +6214,11 @@ SUBROUTINE FAST_InitIOarrays_SS( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD END IF ! CompIce -END SUBROUTINE FAST_InitIOarrays_SS +END SUBROUTINE FAST_InitIOarrays_SubStep !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Reset_SS for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> Routine that calls FAST_Reset_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Reset_SS_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) +SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -6227,15 +6227,15 @@ SUBROUTINE FAST_Reset_SS_T(t_initial, n_t_global, n_timesteps, Turbine, ErrStat, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_Reset_SS(t_initial, n_t_global, n_timesteps, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + CALL FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) -END SUBROUTINE FAST_Reset_SS_T +END SUBROUTINE FAST_Reset_SubStep_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 -SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & +SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL @@ -6306,22 +6306,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_SS_PRED), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyContState (ED%x( STATE_SAVED_PRED), ED%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_SS_PRED), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyDiscState (ED%xd(STATE_SAVED_PRED), ED%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_SS_PRED), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyConstrState (ED%z( STATE_SAVED_PRED), ED%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_SS_PRED), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_PRED), ED%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyContState (ED%x( STATE_SS_CURR), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyContState (ED%x( STATE_SAVED_CURR), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_SS_CURR), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyDiscState (ED%xd(STATE_SAVED_CURR), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_SS_CURR), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyConstrState (ED%z( STATE_SAVED_CURR), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_SS_CURR), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyOtherState (ED%OtherSt( STATE_SAVED_CURR), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6339,22 +6339,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL BD_CopyContState (BD%x( k,STATE_SS_PRED), BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyContState (BD%x( k,STATE_SAVED_PRED), BD%x( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_SS_PRED), BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_PRED), BD%xd(k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_SS_PRED), BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_PRED), BD%z( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SS_PRED), BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_PRED), BD%OtherSt( k,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyContState (BD%x( k,STATE_SS_CURR), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyContState (BD%x( k,STATE_SAVED_CURR), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_SS_CURR), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyDiscState (BD%xd(k,STATE_SAVED_CURR), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_SS_CURR), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyConstrState (BD%z( k,STATE_SAVED_CURR), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SS_CURR), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_SAVED_CURR), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6386,22 +6386,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL SrvD_CopyContState (SrvD%x( STATE_SS_PRED), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_PRED), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_SS_PRED), SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_PRED), SrvD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_SS_PRED), SrvD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_PRED), SrvD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SS_PRED), SrvD%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_PRED), SrvD%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyContState (SrvD%x( STATE_SS_CURR), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyContState (SrvD%x( STATE_SAVED_CURR), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_SS_CURR), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_SAVED_CURR), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_SS_CURR), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyConstrState (SrvD%z( STATE_SAVED_CURR), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SS_CURR), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_SAVED_CURR), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL SrvD_CopyMisc( SrvD%m_bak, SrvD%m, MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6421,22 +6421,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL AD14_CopyContState (AD14%x( STATE_SS_PRED), AD14%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyContState (AD14%x( STATE_SAVED_PRED), AD14%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_SS_PRED), AD14%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyDiscState (AD14%xd(STATE_SAVED_PRED), AD14%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_SS_PRED), AD14%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyConstrState (AD14%z( STATE_SAVED_PRED), AD14%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState (AD14%OtherSt(STATE_SS_PRED), AD14%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_SAVED_PRED), AD14%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyContState (AD14%x( STATE_SS_CURR), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyContState (AD14%x( STATE_SAVED_CURR), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_SS_CURR), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyDiscState (AD14%xd(STATE_SAVED_CURR), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_SS_CURR), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyConstrState (AD14%z( STATE_SAVED_CURR), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState (AD14%OtherSt(STATE_SS_CURR), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_SAVED_CURR), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN @@ -6451,22 +6451,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL AD_CopyContState (AD%x( STATE_SS_PRED), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState (AD%x( STATE_SAVED_PRED), AD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_SS_PRED), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState (AD%xd(STATE_SAVED_PRED), AD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_SS_PRED), AD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState (AD%z( STATE_SAVED_PRED), AD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_SS_PRED), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_PRED), AD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyContState (AD%x( STATE_SS_CURR), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState (AD%x( STATE_SAVED_CURR), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_SS_CURR), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState (AD%xd(STATE_SAVED_CURR), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_SS_CURR), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState (AD%z( STATE_SAVED_CURR), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_SS_CURR), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState (AD%OtherSt(STATE_SAVED_CURR), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompAero == Module_AD @@ -6484,22 +6484,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL InflowWind_CopyContState (IfW%x( STATE_SS_PRED), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_PRED), IfW%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_SS_PRED), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_PRED), IfW%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_SS_PRED), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_PRED), IfW%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SS_PRED), IfW%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_PRED), IfW%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyContState (IfW%x( STATE_SS_CURR), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyContState (IfW%x( STATE_SAVED_CURR), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_SS_CURR), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_SAVED_CURR), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_SS_CURR), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyConstrState (IfW%z( STATE_SAVED_CURR), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SS_CURR), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_SAVED_CURR), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompInflow == Module_IfW @@ -6517,22 +6517,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL HydroDyn_CopyContState (HD%x( STATE_SS_PRED), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_PRED), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_SS_PRED), HD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_PRED), HD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_SS_PRED), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_PRED), HD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SS_PRED), HD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_PRED), HD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyContState (HD%x( STATE_SS_CURR), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyContState (HD%x( STATE_SAVED_CURR), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_SS_CURR), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_SAVED_CURR), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_SS_CURR), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyConstrState (HD%z( STATE_SAVED_CURR), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SS_CURR), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_SAVED_CURR), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF !CompHydro @@ -6551,22 +6551,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL SD_CopyContState (SD%x( STATE_SS_PRED), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyContState (SD%x( STATE_SAVED_PRED), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_SS_PRED), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyDiscState (SD%xd(STATE_SAVED_PRED), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_SS_PRED), SD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyConstrState (SD%z( STATE_SAVED_PRED), SD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_SS_PRED), SD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_PRED), SD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyContState (SD%x( STATE_SS_CURR), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyContState (SD%x( STATE_SAVED_CURR), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_SS_CURR), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyDiscState (SD%xd(STATE_SAVED_CURR), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_SS_CURR), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyConstrState (SD%z( STATE_SAVED_CURR), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_SS_CURR), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyOtherState (SD%OtherSt(STATE_SAVED_CURR), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN @@ -6581,22 +6581,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SS_PRED), ExtPtfm%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_PRED), ExtPtfm%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SS_PRED), ExtPtfm%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_PRED), ExtPtfm%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SS_PRED), ExtPtfm%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_PRED), ExtPtfm%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SS_PRED), ExtPtfm%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_PRED), ExtPtfm%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SS_CURR), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_SAVED_CURR), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SS_CURR), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_SAVED_CURR), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SS_CURR), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_SAVED_CURR), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SS_CURR), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_SAVED_CURR), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompSub @@ -6615,22 +6615,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL MAP_CopyContState (MAPp%x( STATE_SS_PRED), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyContState (MAPp%x( STATE_SAVED_PRED), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_SS_PRED), MAPp%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_PRED), MAPp%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_SS_PRED), MAPp%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_PRED), MAPp%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SS_PRED), MAPp%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_PRED), MAPp%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyContState (MAPp%x( STATE_SS_CURR), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyContState (MAPp%x( STATE_SAVED_CURR), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_SS_CURR), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyDiscState (MAPp%xd(STATE_SAVED_CURR), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_SS_CURR), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyConstrState (MAPp%z( STATE_SAVED_CURR), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SS_CURR), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_SAVED_CURR), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_MD) THEN @@ -6646,22 +6646,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL MD_CopyContState (MD%x( STATE_SS_PRED), MD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyContState (MD%x( STATE_SAVED_PRED), MD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_SS_PRED), MD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyDiscState (MD%xd(STATE_SAVED_PRED), MD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_SS_PRED), MD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyConstrState (MD%z( STATE_SAVED_PRED), MD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_SS_PRED), MD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_PRED), MD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyContState (MD%x( STATE_SS_CURR), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyContState (MD%x( STATE_SAVED_CURR), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_SS_CURR), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyDiscState (MD%xd(STATE_SAVED_CURR), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_SS_CURR), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyConstrState (MD%z( STATE_SAVED_CURR), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_SS_CURR), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyOtherState (MD%OtherSt(STATE_SAVED_CURR), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN @@ -6677,22 +6677,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL FEAM_CopyContState (FEAM%x( STATE_SS_PRED), FEAM%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_PRED), FEAM%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_SS_PRED), FEAM%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_PRED), FEAM%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_SS_PRED), FEAM%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_PRED), FEAM%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SS_PRED), FEAM%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_PRED), FEAM%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyContState (FEAM%x( STATE_SS_CURR), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyContState (FEAM%x( STATE_SAVED_CURR), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_SS_CURR), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_SAVED_CURR), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_SS_CURR), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyConstrState (FEAM%z( STATE_SAVED_CURR), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SS_CURR), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_SAVED_CURR), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_Orca) THEN @@ -6707,22 +6707,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL Orca_CopyContState (Orca%x( STATE_SS_PRED), Orca%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyContState (Orca%x( STATE_SAVED_PRED), Orca%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_SS_PRED), Orca%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_PRED), Orca%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_SS_PRED), Orca%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_PRED), Orca%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SS_PRED), Orca%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_PRED), Orca%OtherSt( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyContState (Orca%x( STATE_SS_CURR), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyContState (Orca%x( STATE_SAVED_CURR), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_SS_CURR), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyDiscState (Orca%xd(STATE_SAVED_CURR), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_SS_CURR), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyConstrState (Orca%z( STATE_SAVED_CURR), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SS_CURR), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_SAVED_CURR), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompMooring @@ -6741,22 +6741,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL IceFloe_CopyContState (IceF%x( STATE_SS_PRED), IceF%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_PRED), IceF%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_SS_PRED), IceF%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_PRED), IceF%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_SS_PRED), IceF%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_PRED), IceF%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SS_PRED), IceF%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_PRED), IceF%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyContState (IceF%x( STATE_SS_CURR), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyContState (IceF%x( STATE_SAVED_CURR), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_SS_CURR), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_SAVED_CURR), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_SS_CURR), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyConstrState (IceF%z( STATE_SAVED_CURR), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SS_CURR), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_SAVED_CURR), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompIce == Module_IceD ) THEN @@ -6774,22 +6774,22 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL IceD_CopyContState (IceD%x( i,STATE_SS_PRED), IceD%x( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_PRED), IceD%x( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_SS_PRED), IceD%xd(i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_PRED), IceD%xd(i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_SS_PRED), IceD%z( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_PRED), IceD%z( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SS_PRED), IceD%OtherSt( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_PRED), IceD%OtherSt( i,STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyContState (IceD%x( i,STATE_SS_CURR), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyContState (IceD%x( i,STATE_SAVED_CURR), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_SS_CURR), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_SAVED_CURR), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_SS_CURR), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyConstrState (IceD%z( i,STATE_SAVED_CURR), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SS_CURR), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_SAVED_CURR), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO ! numIceLegs @@ -6804,11 +6804,11 @@ SUBROUTINE FAST_Reset_SS(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST, m_F m_FAST%t_global = t_global ! y_FAST%n_Out = y_FAST%n_Out - n_timesteps -END SUBROUTINE FAST_Reset_SS +END SUBROUTINE FAST_Reset_SubStep !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Store_SS for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> Routine that calls FAST_Store_SubStep for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Store_SS_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) +SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -6816,15 +6816,15 @@ SUBROUTINE FAST_Store_SS_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CALL FAST_Store_SS(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + CALL FAST_Store_SubStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) -END SUBROUTINE FAST_Store_SS_T +END SUBROUTINE FAST_Store_SubStep_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine resets the states, inputs and output data from n_t_global to n_t_global - 1 -SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & +SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL @@ -6868,7 +6868,7 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Store_SubStep' ErrStat = ErrID_None @@ -6894,22 +6894,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), ED%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyConstrState (ED%z( STATE_CURR), ED%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), ED%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (p_FAST%CompElast == Module_BD ) THEN @@ -6926,22 +6926,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyContState (BD%x( k,STATE_CURR), BD%x( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), BD%xd(k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), BD%z( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), BD%OtherSt( k,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -6959,22 +6959,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), SrvD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), SrvD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), SrvD%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), SrvD%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL SrvD_CopyMisc( SrvD%m, SrvD%m_bak, MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6994,22 +6994,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyContState (AD14%x( STATE_CURR), AD14%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyDiscState (AD14%xd(STATE_CURR), AD14%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyConstrState (AD14%z( STATE_CURR), AD14%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState (AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD14_CopyOtherState (AD14%OtherSt(STATE_CURR), AD14%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN @@ -7024,22 +7024,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyContState (AD%x( STATE_CURR), AD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), AD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyConstrState (AD%z( STATE_CURR), AD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), AD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompAero == Module_AD @@ -7057,22 +7057,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), IfW%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), IfW%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), IfW%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_CURR), IfW%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_CURR), IfW%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompInflow == Module_IfW @@ -7090,22 +7090,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), HD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), HD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), HD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF !CompHydro @@ -7124,22 +7124,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyContState (SD%x( STATE_PRED), SD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyConstrState (SD%z( STATE_CURR), SD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SD_CopyOtherState (SD%OtherSt(STATE_CURR), SD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF (p_FAST%CompSub == Module_ExtPtfm ) THEN @@ -7154,22 +7154,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), ExtPtfm%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), ExtPtfm%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), ExtPtfm%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompSub @@ -7188,22 +7188,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), MAPp%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), MAPp%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), MAPp%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), MAPp%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_MD) THEN @@ -7219,22 +7219,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyContState (MD%x( STATE_CURR), MD%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), MD%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyConstrState (MD%z( STATE_CURR), MD%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), MD%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN @@ -7250,22 +7250,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), FEAM%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), FEAM%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), FEAM%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), FEAM%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), FEAM%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompMooring == Module_Orca) THEN @@ -7280,22 +7280,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyContState (Orca%x( STATE_CURR), Orca%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyDiscState (Orca%xd(STATE_CURR), Orca%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyConstrState (Orca%z( STATE_CURR), Orca%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_CURR), Orca%OtherSt( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL Orca_CopyOtherState (Orca%OtherSt( STATE_CURR), Orca%OtherSt( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! CompMooring @@ -7314,22 +7314,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), IceF%x( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), IceF%xd(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), IceF%z( STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), IceF%OtherSt(STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF (p_FAST%CompIce == Module_IceD ) THEN @@ -7347,22 +7347,22 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_SS_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_SAVED_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyContState (IceD%x( i,STATE_CURR), IceD%x( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyDiscState (IceD%xd(i,STATE_CURR), IceD%xd(i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyConstrState (IceD%z( i,STATE_CURR), IceD%z( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_CURR), IceD%OtherSt( i,STATE_SS_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_CURR), IceD%OtherSt( i,STATE_SAVED_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO ! numIceLegs @@ -7382,7 +7382,7 @@ SUBROUTINE FAST_Store_SS(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, end if end if -END SUBROUTINE FAST_Store_SS +END SUBROUTINE FAST_Store_SubStep !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. From 875a38d747c0a5ce2c28abfba6e62d23df1c5e04 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 11 Dec 2023 17:15:05 -0700 Subject: [PATCH 114/232] ExtLoads: move FAST_Solution and new routines FAST_Solution now calls - FAST_Prework - FAST_UpdateStates - FAST_AdvanceToNextTimeStep - FAST_WriteOutput revised the interfaces on the above to make them the same as FAST_Solution. Also imported newer stuff from FAST_Solution to these routines --- modules/openfast-library/src/FAST_Subs.f90 | 663 +++++++-------------- 1 file changed, 214 insertions(+), 449 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 8d34031ad5..7e5a6ffb64 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -6254,7 +6254,7 @@ SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST 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(ExternalInflow_Data), INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -6280,7 +6280,7 @@ SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep' ErrStat = ErrID_None @@ -7383,6 +7383,121 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, end if END SUBROUTINE FAST_Store_SubStep +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!! driver programs do not need to change or operate on the individual module level. +SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + +END SUBROUTINE FAST_Solution_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine takes data from n_t_global and gets values at n_t_global + 1 +SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter + INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed + LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed + + INTEGER(IntKi) :: I, k ! generic loop counters + + !REAL(ReKi) :: ControlInputGuess ! value of controller inputs + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + + + ErrStat = ErrID_None + ErrMsg = "" + + n_t_global_next = n_t_global+1 + t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.a: set some variables and Extrapolate Inputs + + call FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) + !! ## Step 1.c: Input-Output Solve + !! ## Step 2: Correct (continue in loop) + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + call FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + !! ## Step 3: Save all final variables (advance to next time) and reset global time + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + call FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + !---------------------------------------------------------------------------------------- + !! Write outputs + !---------------------------------------------------------------------------------------- + call FAST_WriteOutput(m_FAST%t_global, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +END SUBROUTINE FAST_Solution + !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. @@ -7395,15 +7510,15 @@ SUBROUTINE FAST_Prework_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CALL FAST_Prework(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_Prework_T !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine does the prep work to advance the time step from n_t_global to n_t_global + 1 -SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, & - ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +!> This routine does thde prep work to advance the time step from n_t_global to n_t_global + 1 +SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -7420,6 +7535,8 @@ SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, S TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -7468,6 +7585,11 @@ SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, S ! the previous step before we extrapolate these inputs: IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) + IF ( p_FAST%UseSC ) THEN + CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.a: Extrapolate Inputs !! @@ -7481,7 +7603,7 @@ SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, S END SUBROUTINE FAST_Prework !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_PredictStates for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> Routine that calls FAST_UpdateStates for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) @@ -7492,15 +7614,15 @@ SUBROUTINE FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CALL FAST_UpdateStates(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_UpdateStates_T !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and predicts the states and output at n_t_global+1 -SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, & - ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +!> This routine takes data from n_t_global and predicts the states and output at n_t_global+1 +SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -7517,6 +7639,8 @@ SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -7554,8 +7678,6 @@ SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, 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 - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) - ! set number of corrections to be used for this time step: IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder @@ -7570,14 +7692,17 @@ SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, END IF !! 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) !! !! STATE_CURR values of x, xd, z, and OtherSt contain values at m_FAST%t_global; !! STATE_PRED values contain values at t_global_next. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7586,18 +7711,49 @@ SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## 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, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## 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 + if (p_FAST%UseSC ) then + call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + + if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then + ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file + call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + END SUBROUTINE FAST_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- @@ -7612,15 +7768,15 @@ SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CALL FAST_AdvanceToNextTimeStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_AdvanceToNextTimeStep_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data -SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -7634,8 +7790,11 @@ SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_F TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data @@ -7750,6 +7909,7 @@ SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_F CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF + ! SeaState has no states ! HydroDyn: copy final predictions to actual states IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -7848,6 +8008,7 @@ SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_F END DO END IF + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! We've advanced everything to the next time step: !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -7869,42 +8030,44 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CALL FAST_WriteOutput(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & - Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & + Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) END SUBROUTINE FAST_WriteOutput_T !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data -SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +!> This routine writes the outputs at this timestep +SUBROUTINE FAST_WriteOutput(t_global, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + REAL(DbKi), INTENT(IN ) :: t_global !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + TYPE(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(ExtLoads_Data), INTENT(IN ) :: ExtLd !< External loads data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(ExternalInflow_Data),INTENT(IN ) :: ExtInfw !< ExternalInflow data + TYPE(SCDataEx_Data), INTENT(IN ) :: SC_DX !< Supercontroller Exchange data + TYPE(SeaState_Data), INTENT(IN ) :: SeaSt !< SeaState data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -7920,11 +8083,11 @@ SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, B ErrStat = ErrID_None ErrMsg = "" + !---------------------------------------------------------------------------------------- !! Check to see if we should output data this time step: - !---------------------------------------------------------------------------------------- - - CALL WriteOutputToFile(n_t_global, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & + !---------------------------------------------------------------------------------------- + CALL WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7933,411 +8096,13 @@ SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, B !---------------------------------------------------------------------------------------- IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global + 1, p_FAST%n_SttsTime ) == 0 ) THEN - - if (.not. Cmpl4SFun) then + IF ( MOD( n_t_global, p_FAST%n_SttsTime ) == 0 ) THEN CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) - end if - ENDIF ENDIF END SUBROUTINE FAST_WriteOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST -!! driver programs do not need to change or operate on the individual module level. -SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< all data for one instance of a turbine - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & - Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - -END SUBROUTINE FAST_Solution_T -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code - TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< External loads data - TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data - TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data - TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< Supercontroller Exchange data - TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed - LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed - - INTEGER(IntKi) :: I, k ! generic loop counters - - !REAL(ReKi) :: ControlInputGuess ! value of controller inputs - - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' - - - ErrStat = ErrID_None - ErrMsg = "" - - n_t_global_next = n_t_global+1 - t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) - - !! determine if the Jacobian should be calculated this time - IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian - - if (p_FAST%CompMooring == Module_Orca .and. n_t_global < 5) then - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT ! the jacobian calculated with OrcaFlex at t=0 is incorrect, but is okay on the 2nd step (it's not okay for OrcaFlex version 10, so I increased this to 5) - else - m_FAST%NextJacCalcTime = m_FAST%t_global + p_FAST%DT_UJac - end if - - END IF - - ! set number of corrections to be used for this time step: - IF ( p_FAST%CompElast == Module_BD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps - if (n_t_global > 2) then ! this 2 should probably be related to p_FAST%InterpOrder - NumCorrections = p_FAST%NumCrctn - elseif (n_t_global == 0) then - NumCorrections = max(p_FAST%NumCrctn,16) - else - NumCorrections = max(p_FAST%NumCrctn,1) - end if - ELSE - NumCorrections = p_FAST%NumCrctn - END IF - - ! the ServoDyn inputs from Simulink are for t, not t+dt, so we're going to overwrite the inputs from - ! the previous step before we extrapolate these inputs: - IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_SetOutputs(p_FAST, SrvD%Input(1), SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 1.a: Extrapolate Inputs - !! - !! gives predicted values at t+dt - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - !! predictor-corrector loop: - 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) - !! - !! STATE_CURR values of x, xd, z, and OtherSt contain values at m_FAST%t_global; - !! STATE_PRED values contain values at t_global_next. - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## 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, WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## 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 - - if (p_FAST%UseSC ) then - call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then - ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file - call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 3: Save all final variables (advance to next time) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - !---------------------------------------------------------------------------------------- - !! copy the final predicted states from step t_global_next to actual states for that step - !---------------------------------------------------------------------------------------- - - ! ElastoDyn: copy final predictions to actual states - CALL ED_CopyContState (ED%x( STATE_PRED), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyDiscState (ED%xd(STATE_PRED), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyConstrState (ED%z( STATE_PRED), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOtherState (ED%OtherSt( STATE_PRED), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! BeamDyn: copy final predictions to actual states - IF ( p_FAST%CompElast == Module_BD ) THEN - DO k=1,p_FAST%nBeams - CALL BD_CopyContState (BD%x( k,STATE_PRED), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyDiscState (BD%xd(k,STATE_PRED), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyConstrState (BD%z( k,STATE_PRED), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_CopyOtherState (BD%OtherSt( k,STATE_PRED), BD%OtherSt( k,STATE_CURR), 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 - CALL AD14_CopyContState (AD14%x( STATE_PRED), AD14%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyDiscState (AD14%xd(STATE_PRED), AD14%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyConstrState (AD14%z( STATE_PRED), AD14%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD14_CopyOtherState (AD14%OtherSt(STATE_PRED), AD14%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( (p_FAST%CompAero == Module_AD) .or. (p_FAST%CompAero == Module_ExtLd) ) THEN - CALL AD_CopyContState (AD%x( STATE_PRED), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyDiscState (AD%xd(STATE_PRED), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyConstrState (AD%z( STATE_PRED), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_CopyOtherState (AD%OtherSt(STATE_PRED), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! InflowWind: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL InflowWind_CopyContState (IfW%x( STATE_PRED), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyDiscState (IfW%xd(STATE_PRED), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyConstrState (IfW%z( STATE_PRED), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL InflowWind_CopyOtherState (IfW%OtherSt( STATE_PRED), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! ServoDyn: copy final predictions to actual states; copy current outputs to next - IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_CopyContState (SrvD%x( STATE_PRED), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyDiscState (SrvD%xd(STATE_PRED), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyConstrState (SrvD%z( STATE_PRED), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_PRED), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! SeaState has no states - - ! HydroDyn: copy final predictions to actual states - IF ( p_FAST%CompHydro == Module_HD ) THEN - CALL HydroDyn_CopyContState (HD%x( STATE_PRED), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyDiscState (HD%xd(STATE_PRED), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyConstrState (HD%z( STATE_PRED), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_PRED), HD%OtherSt(STATE_CURR), 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 (SD%x( STATE_PRED), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyDiscState (SD%xd(STATE_PRED), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyConstrState (SD%z( STATE_PRED), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL SD_CopyOtherState (SD%OtherSt(STATE_PRED), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_PRED), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_PRED), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_PRED), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_PRED), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - - ! MAP: copy final predictions to actual states - IF (p_FAST%CompMooring == Module_MAP) THEN - CALL MAP_CopyContState (MAPp%x( STATE_PRED), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyDiscState (MAPp%xd(STATE_PRED), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MAP_CopyConstrState (MAPp%z( STATE_PRED), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_PRED), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_MD) THEN - CALL MD_CopyContState (MD%x( STATE_PRED), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyDiscState (MD%xd(STATE_PRED), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyConstrState (MD%z( STATE_PRED), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL MD_CopyOtherState (MD%OtherSt(STATE_PRED), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - CALL FEAM_CopyContState (FEAM%x( STATE_PRED), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyDiscState (FEAM%xd(STATE_PRED), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyConstrState (FEAM%z( STATE_PRED), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_PRED), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - CALL Orca_CopyContState (Orca%x( STATE_PRED), Orca%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyDiscState (Orca%xd(STATE_PRED), Orca%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyConstrState (Orca%z( STATE_PRED), Orca%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Orca_CopyOtherState (Orca%OtherSt( STATE_PRED), Orca%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! IceFloe: copy final predictions to actual states - IF ( p_FAST%CompIce == Module_IceF ) THEN - CALL IceFloe_CopyContState (IceF%x( STATE_PRED), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyDiscState (IceF%xd(STATE_PRED), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyConstrState (IceF%z( STATE_PRED), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_PRED), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - DO i=1,p_FAST%numIceLegs - CALL IceD_CopyContState (IceD%x( i,STATE_PRED), IceD%x( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyDiscState (IceD%xd(i,STATE_PRED), IceD%xd(i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyConstrState (IceD%z( i,STATE_PRED), IceD%z( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL IceD_CopyOtherState (IceD%OtherSt( i,STATE_PRED), IceD%OtherSt( i,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END DO - END IF - - - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! We've advanced everything to the next time step: - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - !! update the global time - - m_FAST%t_global = t_global_next - - - !---------------------------------------------------------------------------------------- - !! Check to see if we should output data this time step: - !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !---------------------------------------------------------------------------------------- - !! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): - !---------------------------------------------------------------------------------------- - - IF (p_FAST%WrSttsTime) then - 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 - -END SUBROUTINE FAST_Solution !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP !---------------------------------------------------------------------------------------------------------------------------------- From ac88936ad91cb372e661af4c2de24c24f3675cb9 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 12 Dec 2023 10:06:53 -0700 Subject: [PATCH 115/232] ExtLoads: remove InitOut%QPtN from BeamDyn (old change shouldn't have been included) --- modules/beamdyn/src/BeamDyn.f90 | 6 --- modules/beamdyn/src/BeamDyn_Types.f90 | 54 ------------------------ modules/beamdyn/src/Registry_BeamDyn.txt | 1 - 3 files changed, 61 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 89b63318f8..8909ca8b7d 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -824,12 +824,6 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) InitOut%Ver = BeamDyn_Ver - call AllocAry(InitOut%QPtN, p%nqp, 'InitOut%QPtN', ErrStat2,ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if(ErrStat >= AbortErrLev) return - - InitOut%QPtN = (p%QPtN + 1.0)*0.5 - ! Set the info in WriteOutputHdr and WriteOutputUnt for BldNd sections. CALL BldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 1de281c9c1..5ef2e000ff 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -63,7 +63,6 @@ MODULE BeamDyn_Types TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] INTEGER(IntKi) :: kp_total !< Total number of key points [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtN !< Quadrature (QuadPt) point locations in natural frame [-1, 1] [-] 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 [-] @@ -686,18 +685,6 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate ENDIF DstInitOutputData%kp_total = SrcInitOutputData%kp_total -IF (ALLOCATED(SrcInitOutputData%QPtN)) THEN - i1_l = LBOUND(SrcInitOutputData%QPtN,1) - i1_u = UBOUND(SrcInitOutputData%QPtN,1) - IF (.NOT. ALLOCATED(DstInitOutputData%QPtN)) THEN - ALLOCATE(DstInitOutputData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%QPtN = SrcInitOutputData%QPtN -ENDIF IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) @@ -828,9 +815,6 @@ SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN DEALLOCATE(InitOutputData%kp_coordinate) ENDIF -IF (ALLOCATED(InitOutputData%QPtN)) THEN - DEALLOCATE(InitOutputData%QPtN) -ENDIF IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) ENDIF @@ -926,11 +910,6 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate END IF Int_BufSz = Int_BufSz + 1 ! kp_total - Int_BufSz = Int_BufSz + 1 ! QPtN allocated yes/no - IF ( ALLOCATED(InData%QPtN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtN upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtN) ! QPtN - END IF Int_BufSz = Int_BufSz + 1 ! 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 @@ -1082,21 +1061,6 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END IF IntKiBuf(Int_Xferred) = InData%kp_total Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) - DbKiBuf(Db_Xferred) = InData%QPtN(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1358,24 +1322,6 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END IF OutData%kp_total = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtN)) DEALLOCATE(OutData%QPtN) - ALLOCATE(OutData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) - OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 02af619393..d6b10e5fac 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -44,7 +44,6 @@ typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType R8Ki kp_coordinate {:}{:} - - "Key point coordinates array" - typedef ^ InitOutputType IntKi kp_total - - - "Total number of key points" - -typedef ^ InitOutputType R8Ki QPtN {:} - - "Quadrature (QuadPt) point locations in natural frame [-1, 1]" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - #typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - From 2f48717e2412fe12b05de920f87c447fa3a24e1c Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 12 Dec 2023 10:07:02 -0700 Subject: [PATCH 116/232] Doc: pointing to dev r-test to include minimal working example --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 9a42b24203..6fa5fcda9b 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 9a42b2420312ab5dfd49065e7ddab6fb69dc7d3f +Subproject commit 6fa5fcda9b07760a572e8bf18377343cc6ef271c From d35e2e36221f81688ab52fc9943128e0d96321d6 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 12 Dec 2023 10:21:12 -0700 Subject: [PATCH 117/232] BD: remove kp_total and kp_coordinate from InitOut --- modules/beamdyn/src/BeamDyn.f90 | 3 - modules/beamdyn/src/BeamDyn_Types.f90 | 75 ------------------------ modules/beamdyn/src/Registry_BeamDyn.txt | 2 - 3 files changed, 80 deletions(-) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index 8909ca8b7d..35f1c75d86 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -247,9 +247,6 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I z%DummyConstrState = 0.0_BDKi - ! copy data for BeamDyn driver: - call move_alloc ( InputFileData%kp_coordinate, InitOut%kp_coordinate) - InitOut%kp_total = InputFileData%kp_total !............................................................................................ ! Initialize Jacobian: diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 5ef2e000ff..d098a848e6 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -61,8 +61,6 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - INTEGER(IntKi) :: kp_total !< Total number of key points [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -636,7 +634,6 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitOutput' @@ -670,21 +667,6 @@ SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%kp_coordinate)) THEN - i1_l = LBOUND(SrcInitOutputData%kp_coordinate,1) - i1_u = UBOUND(SrcInitOutputData%kp_coordinate,1) - i2_l = LBOUND(SrcInitOutputData%kp_coordinate,2) - i2_u = UBOUND(SrcInitOutputData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInitOutputData%kp_coordinate)) THEN - ALLOCATE(DstInitOutputData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate -ENDIF - DstInitOutputData%kp_total = SrcInitOutputData%kp_total IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) @@ -812,9 +794,6 @@ SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg, DEALLOCATEpoin ENDIF CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN - DEALLOCATE(InitOutputData%kp_coordinate) -ENDIF IF (ALLOCATED(InitOutputData%LinNames_y)) THEN DEALLOCATE(InitOutputData%LinNames_y) ENDIF @@ -904,12 +883,6 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! kp_total Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no IF ( ALLOCATED(InData%LinNames_y) ) THEN Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension @@ -1039,28 +1012,6 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%kp_total - Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1203,7 +1154,6 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInitOutput' @@ -1297,31 +1247,6 @@ SUBROUTINE BD_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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%kp_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index d6b10e5fac..db3b1d169e 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -42,8 +42,6 @@ typedef ^ InitInputType LOGICAL CompAeroMaps - .FALSE. - "fl typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType R8Ki kp_coordinate {:}{:} - - "Key point coordinates array" - -typedef ^ InitOutputType IntKi kp_total - - - "Total number of key points" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - #typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - From 7ed7c315c8d35edea4c5b14ce6cf992085d6eb48 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 12 Dec 2023 10:24:50 -0700 Subject: [PATCH 118/232] Doc: pointing to latest dev r-test --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 6fa5fcda9b..29f2c280dd 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 6fa5fcda9b07760a572e8bf18377343cc6ef271c +Subproject commit 29f2c280dd56c032d7abc5ec502d1498831e4adb From 55a2c0391be362236435246e4119a74dc44b7e02 Mon Sep 17 00:00:00 2001 From: "E. Branlard" <1318316+ebranlard@users.noreply.github.com> Date: Tue, 12 Dec 2023 14:13:21 -0700 Subject: [PATCH 119/232] Adding documentation for typical usages of OpenFAST (#308) * Starting a section working with OpenFAST * WorkDoc: more documentation to work with OpenFAST * Doc: Restructuring, update of guidelines/quick start (see #308) * Doc: typo * Doc: update of rtest for minimal example * Doc: addressed review comments * Doc: pointing to latest r-test dev which includes doc min example * Doc: fix indent in bulletlist --- docs/index.rst | 3 +- docs/source/user/general.rst | 52 +++ docs/source/user/index.rst | 72 +--- docs/source/user/moordyn/index.rst | 4 + docs/source/user/turbsim/index.rst | 5 + docs/source/working.rst | 539 +++++++++++++++++++++++++++++ 6 files changed, 610 insertions(+), 65 deletions(-) create mode 100644 docs/source/user/general.rst create mode 100644 docs/source/working.rst diff --git a/docs/index.rst b/docs/index.rst index 0b5f130b81..9dd5504e5f 100644 --- a/docs/index.rst +++ b/docs/index.rst @@ -51,8 +51,9 @@ package: source/this_doc.rst source/install/index.rst - source/testing/index.rst + source/working.rst source/user/index.rst + source/testing/index.rst source/dev/index.rst source/license.rst source/help.rst diff --git a/docs/source/user/general.rst b/docs/source/user/general.rst new file mode 100644 index 0000000000..b29f26adbb --- /dev/null +++ b/docs/source/user/general.rst @@ -0,0 +1,52 @@ + + +.. _general-reference-docs: + +General +~~~~~~~ +.. toctree:: + :maxdepth: 1 + + fast_to_openfast.rst + api_change.rst + input_file_overview.rst + +Workshop material, legacy documentation, and other resources are listed below. + +- `Overview of OpenFAST at NAWEA WindTech 2023 `_ +- `Overview of OpenFAST at NAWEA WindTech 2022 `_ +- `Practical Guide to OpenFAST at NAWEA WindTech 2022 `_ +- `Overview of OpenFAST at NAWEA WindTech 2019 `_ +- `Workshop Presentations `_ +- :download:`Old FAST v6 User's Guide <../../OtherSupporting/Old_FAST6_UsersGuide.pdf>` +- :download:`FAST v8 README <../../OtherSupporting/FAST8_README.pdf>` +- `Implementation of Substructure Flexibility and Member-Level Load Capabilities for Floating Offshore Wind Turbines in OpenFAST `_ +- `FAST modularization framework for wind turbine simulation: full-system linearization `_ +- `Full-System Linearization for Floating Offshore Wind Turbines in OpenFAST `_ +- :download:`FAST with Labview <../../OtherSupporting/UsingFAST4Labview.pdf>` +- :download:`OutListParameters.xlsx <../../OtherSupporting/OutListParameters.xlsx>` - Contains the full list of outputs for each module. + + + +Modularization Framework +************************ + +Information specific to the modularization framework of OpenFAST is provided here. These are a collection +of publications, presentations, and past studies on the subject. + +- `The New Modularization Framework for the FAST Wind Turbine CAE Tool `_ +- :download:`Example Module Implementation Plans <../../OtherSupporting/ModulePlan_GasmiPaperExamples.doc>` +- :download:`Module and Mesh-Mapping Linearization Implementation Plan <../../OtherSupporting/LinearizationOfMeshMapping_Rev18_Rev2.doc>` +- :download:`Interpolation of DCMs <../../OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf>` - A summary of the mathematics used in the interpolation of DCM (direction cosine matrices) using logarithmic mapping and matrix exponentials. +- :download:`Set-point Linearization Development Plan <../../OtherSupporting/DevelopmentPlan-SetPoint-Linearization.pdf>` + +.. - :download:`OpenFAST Steady State Solution <../../OtherSupporting/OpenFASTSteadyStateSolution_Rev7.doc>` + + +Glue Code and Mesh Mapping +************************** + +- `FAST Modular Wind Turbine CAE Tool: Nonmatching Spatial and Temporal Meshes `_ +- `FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples `_ +- :download:`OpenFAST Algorithms <../../OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf>` - A summary of the solve method used in the glue code. +- :download:`Predictor-Corrector Approach <../../OtherSupporting/ProposedPCApproach_Rev4.docx>` diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 37ec220855..d67e9a2648 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -3,48 +3,17 @@ User Documentation ================== -We are in the process of transitioning legacy FAST v8 documentation, which can be found at https://www.nrel.gov/wind/nwtc.html. - .. note:: + We are in the process of transitioning legacy FAST v8 documentation to this online documentation. The legacy FAST v8 documentation can be found at https://www.nrel.gov/wind/nwtc.html. - Much of the documentation here is legacy documentation from FAST v8. While most of it is still - directly applicable to OpenFAST, portions may be out of date. +This section contains documentation for the OpenFAST module-coupling environment and its underlying modules. Documentation covers usage of models, underlying theory, and in some cases module verification. -.. _general-reference-docs: - -General -~~~~~~~ -.. toctree:: - :maxdepth: 1 - - fast_to_openfast.rst - api_change.rst - input_file_overview.rst - -Workshop material, legacy documentation, and other resources are listed below. - -- `Overview of OpenFAST at NAWEA WindTech 2022 `_ -- `Practical Guide to OpenFAST at NAWEA WindTech 2022 `_ -- `Overview of OpenFAST at NAWEA WindTech 2019 `_ -- `Workshop Presentations `_ -- :download:`Old FAST v6 User's Guide <../../OtherSupporting/Old_FAST6_UsersGuide.pdf>` -- :download:`FAST v8 README <../../OtherSupporting/FAST8_README.pdf>` -- `Implementation of Substructure Flexibility and Member-Level Load Capabilities for Floating Offshore Wind Turbines in OpenFAST `_ -- `FAST modularization framework for wind turbine simulation: full-system linearization `_ -- `Full-System Linearization for Floating Offshore Wind Turbines in OpenFAST `_ -- :download:`FAST with Labview <../../OtherSupporting/UsingFAST4Labview.pdf>` -- :download:`OutListParameters.xlsx <../../OtherSupporting/OutListParameters.xlsx>` - Contains the full list of outputs for each module. - - -Module Documentation -~~~~~~~~~~~~~~~~~~~~ -This section contains documentation for the OpenFAST module-coupling environment and its underlying modules. -Documentation covers usage of models, underlying theory, and in some cases module verification. .. toctree:: :maxdepth: 1 + General considerations AeroDyn OLAF Aeroacoustics @@ -59,8 +28,12 @@ Documentation covers usage of models, underlying theory, and in some cases modul ServoDyn Structural Control TurbSim - C++ API FAST.Farm + C++ API + + +Additional module documentation +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following modules do not currently have formal documentation or are contributed to OpenFAST from organizations @@ -79,10 +52,6 @@ with the information for the new documentation. - :download:`Theory Manual <../../OtherSupporting/FEAMooring/FEAM_Theory_Manual.pdf>` - :download:`User's Guide <../../OtherSupporting/FEAMooring/FEAM_Users_Guide.pdf>` -- MoorDyn - - - `Official User's Guide `_ - - OrcaFlex Interface: - :download:`User's Guide <../../OtherSupporting/OrcaFlex/User_Guide_OrcaFlexInterface.pdf>` @@ -95,32 +64,7 @@ with the information for the new documentation. - :download:`Draft: FAST Ice Module Manual <../../OtherSupporting/IceDyn/IceDyn_Manual.pdf>` -- TurbSim - - - :download:`User's Guide <../../OtherSupporting/TurbSim/TurbSim_v2.00.pdf>` - -Modularization Framework -~~~~~~~~~~~~~~~~~~~~~~~~ - -Information specific to the modularization framework of OpenFAST is provided here. These are a collection -of publications, presentations, and past studies on the subject. - -- `The New Modularization Framework for the FAST Wind Turbine CAE Tool `_ -- :download:`Example Module Implementation Plans <../../OtherSupporting/ModulePlan_GasmiPaperExamples.doc>` -- :download:`Module and Mesh-Mapping Linearization Implementation Plan <../../OtherSupporting/LinearizationOfMeshMapping_Rev18_Rev2.doc>` -- :download:`Interpolation of DCMs <../../OtherSupporting/DCM_Interpolation/DCM_Interpolation.pdf>` - A summary of the mathematics used in the interpolation of DCM (direction cosine matrices) using logarithmic mapping and matrix exponentials. -- :download:`Set-point Linearization Development Plan <../../OtherSupporting/DevelopmentPlan-SetPoint-Linearization.pdf>` - -.. - :download:`OpenFAST Steady State Solution <../../OtherSupporting/OpenFASTSteadyStateSolution_Rev7.doc>` - - -Glue Code and Mesh Mapping -~~~~~~~~~~~~~~~~~~~~~~~~~~ -- `FAST Modular Wind Turbine CAE Tool: Nonmatching Spatial and Temporal Meshes `_ -- `FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples `_ -- :download:`OpenFAST Algorithms <../../OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf>` - A summary of the solve method used in the glue code. -- :download:`Predictor-Corrector Approach <../../OtherSupporting/ProposedPCApproach_Rev4.docx>` NWTC Subroutine Library diff --git a/docs/source/user/moordyn/index.rst b/docs/source/user/moordyn/index.rst index 9306aeaa96..140df93874 100644 --- a/docs/source/user/moordyn/index.rst +++ b/docs/source/user/moordyn/index.rst @@ -11,3 +11,7 @@ usage of MoorDyn at the FAST.Farm level (`MoorDyn with FAST.Farm `_), and links to publications with the relevant theory. + +The user guide can be downloaded below. + +`Official User's Guide `_ diff --git a/docs/source/user/turbsim/index.rst b/docs/source/user/turbsim/index.rst index 9a54a22ec4..da275f76ec 100644 --- a/docs/source/user/turbsim/index.rst +++ b/docs/source/user/turbsim/index.rst @@ -1,6 +1,11 @@ TurbSim Users Guide Placeholder ====================================== +The Turbsim documentation has not been ported to readthedocs yet. It can be downloaded below. + + :download:`User's Guide <../../../OtherSupporting/TurbSim/TurbSim_v2.00.pdf>` + + .. only:: html This is a placeholder for the TurbSim documentation that has not yet been converted to readTheDocs. diff --git a/docs/source/working.rst b/docs/source/working.rst new file mode 100644 index 0000000000..5860c41ddb --- /dev/null +++ b/docs/source/working.rst @@ -0,0 +1,539 @@ +.. _working_with_OF: + +Working with OpenFAST +===================== + +This section provides support for some of the typical use cases of OpenFAST. +It assumes that the user has an executable of OpenFAST available (see :ref:`installation` for installation). + + + + + +Quick Start - Running OpenFAST +------------------------------ + +In this Quick Start, we will explain how to run OpenFAST. OpenFAST is typically run from a terminal +(also referred to as command prompt or command line). +The simplest method to run OpenFAST is to copy the OpenFAST executable into your working directory, and then open a terminal into that directory. +The steps are therefore: + + - Copy the OpenFAST executable to the directory where you will run your simulations + - Open a terminal + - Navigate to the folder containing the OpenFAST executable + - Run OpenFAST to check its version + - Run OpenFAST on a given input file + +The steps are detailed below. + + +Open a terminal +~~~~~~~~~~~~~~~ + +To learn how open a terminal on your given operating system, you can try the following search queries: + + - `On Windows `__ + - `On Linux `__ + - `On Mac `__ + + + +Navigate to your simulation directory +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In the terminal, you can navigate between folders using the command `cd`. +In this example, we assume that the simulation directory is `simulations/test`, therefore, to navigate to this directory you need to type: + +.. code-block:: bash + + cd simulations + cd test + +or: + +.. code-block:: bash + + cd simulations/test + + +To go to a parent directory, you can use `cd ..`. +If the directory path contain spaces, use quotes around the path. +It is usually good practice to avoid spaces in directory and file names. +The path can also be an absolute path, e.g., `cd C:/simulations/test`. + + + +Run OpenFAST to check the version number +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Once your terminal is in the directory where OpenFAST is, you can try to run OpenFAST and check its version as follows: + +.. code-block:: bash + + ./openfast /h + +The `./` characters at the beginning of the command indicates that the executable is located in the current directory. +The command above will display the version of OpenFAST, the compilation options, and display a help message on the syntax for calling the OpenFAST executable. + + +.. note:: + + Try to always read the outputs of OpenFAST displayed in the terminal windows as errors and warnings will be displayed there. In general, if an error is displayed in the terminal, you can use the guidelines given in :ref:`troubleshooting` for troubleshooting. + + +.. warning:: + + It is important to keep track of the version of OpenFAST you are using, since the input files format can change from version to version (see :ref:`api_change`). + + +.. tip:: + + To avoid having to copy the executable in your working directory, you can place the executable into a folder and add this folder to your system path. If you chose this method, and restart your terminal, you should be able to run `openfast /h` from any folder, and this time, `./` is not needed. + + +Run your first OpenFAST simulation +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + + +The typical syntax to run a simulation is: + +.. code-block:: bash + + ./openfast InputFile.fst + +where `InputFile.fst` is a main OpenFAST input file. The extension `.fst` is recommended for the main input file of OpenFAST, `.dat` for other inputs files. +The input file format specifications of OpenFAST input files are given in +:ref:`input_file_overview`. + +We provide a minimal working example to get you started on your first OpenFAST run. +This example uses the `NREL 5-MW `__ wind turbine, which is a fictitious but representative multi-MW wind turbine, with rated power 5 MW, rated rotor speed +12.1 rpm, Hub Height 90 m, and rotor diameter 126 m. +This example is for an "onshore" version of the turbine, with only the structure (no aerodynamics), where the tower is initially displaced by 3m at the tower top. The files are located in the following +`github directory `__ . +You will have to download the following files and place them in your working directory: + +- `Main.fst `__ : the main OpenFAST input file +- `ElastoDyn.dat `__ : the input file for the ElastoDyn module +- `ElastoDyn_Blade.dat `__ : the input file defining the structural properties of the blade to be used by the ElastoDyn module +- `ElastoDyn_Tower.dat `__ : the input file defining the structural properties of the tower to be used by the ElastoDyn module + +Once these 4 files are placed in your working directory (where the OpenFAST executable is located and where your terminal is at), you can run the simulation as follows: + +.. code-block:: bash + + ./openfast Main.fst + + +The simulation should run successfully and OpenFAST will generate an output file with the extension `.out` or `.outb`. +We provide a simple Python and Matlab script in the `github directory `__ to display some of the output channels of this simulation. For more information on how to visualize the outputs, see :ref:`visualizing_input_output_OF`. +In general, if an error is displayed in the terminal, you can use the guidelines given in :ref:`troubleshooting` for troubleshooting. + + + + +.. tip:: + On certain platform (like Windows), you can drag and drop an input file to the OpenFAST executable in your file explorer, and this will run the simulation. If an error occurs using this method, you will not be able to see the error message. + + +.. tip:: + You can use relative and aboslute path to the OpenFAST executable and to the main OpenFAST input file. Input files of OpenFAST also contain filepaths that reference other input files. These filepaths are either relative to the current file, or, can be absolute paths. + + + + + + + +Troubleshooting a simulation +---------------------------- + + +.. _troubleshooting: + +Simple troubleshooting +~~~~~~~~~~~~~~~~~~~~~~ + +When an error is caught during a simulation, OpenFAST will abort with a message of the following kind: + +.. code-block:: bash + + FAST encountered an error during module initialization. + Simulation error level: FATAL ERROR + + Aborting OpenFAST. + +The lines above this message will reveal the nature of the error, and this information can be used to troubleshoot your simulation. + + + +Typical errors +************** + +Some typical errors and solutions are listed below: + +- *The input file "FILE" was not found*: As indicated, the input file is not found. Linux and Mac platforms are case sensitive, and require forward slashes. OpenFAST accepts relative or absolute path. Relative paths are expressed with respect to the file where they are referenced. + +- *Invalid input in file "FILE" while trying to read VAR*: Such errors typically occurs at initialization, when reading one of the input file of OpenFAST. It can be that the variable in the input file has a wrong type (integer instead of logical, float instead of string, etc.). Very often though, such an error indicates that the input file is not formatted propertly for the version of OpenFAST your are executing. Most likely your file is outdated. Lines are often added to the OpenFAST input files. You can have a look at :ref:`api_change` to see what lines have changed between versions of OpenFAST, or look at the `r-test `__ to find working examples of input files for the latest release and dev version of OpenFAST. + +- *A fatal error occurred when parsing data from "FILE". The variable "VAR" was not found on line #II*. Such errors are similar to the one described above. Check that your file has the proper format for the version of OpenFAST you are using. + +Similar messages indicate user-input errors (when selected options are not available or compatible). +Such error messages are usually explicit enough. You can have a look at the comments in the input file for some guidance, and refer to the user guide for more details on individual inputs of each module: :ref:`user_guide`. + +.. tip:: + 90% of the time, errors are due to a mismatch between the OpenFAST version and the input files (see second point above). + + +Typical warnings +**************** + +Some warnings might occasionally occur from different modules (typically the aerodynamic modules) and be reported to the command window. + + - *SkewedWakeCorrection encountered a large value of chi*: indicates that the turbine is highly yawed/titled. Could happen when the turbine undergoes important motions. + - *The BEM solution is being turned off due to low TSR.*: indicate that the instantaneous rotor speed is close to zero, or the relative wind speed is large (check the outputs `RtSpeed` and `RtVavgx`). + +The warnings can sometimes be ignored, but they often indicate an issue in the model. See the next section of advanced troubleshooting. + + + + +Advanced troubleshooting +~~~~~~~~~~~~~~~~~~~~~~~~ + +In some cases, simulations may abort during the simulation (*FAST encountered an error at simulation time T*), or they may run through but have empty or "NaN" outputs after few time steps (as little as one time steps). Such errors are typically due to the model being unphysical. +In such case, you might see error messages of the following kind in the command window: + +- *Small angle assumption violated* or *Angles in GetSmllRotAngs() are larger than 0.4 radians*: such warnings indicate that part of the structure is undergoing large rotations, whereas some module of OpenFAST are only valid under the small angle approximation. +- *Denominator is zero in GetSmllRotAngs()* + +Typically, when a simulation aborts or has unrealistic or NaN values, it is likely that there are errors in the model (the structure is too stiff, too soft, the inflow is incorrect, the initial conditions are incorrect, the controller is behaving unexpectedly, OLAF regularization parameters are set wrong, etc.). + +.. tip:: + The key to troubleshooting is to simplify your model. You can chose to progressively simplify your model, until it runs and produces physical results. Or the other way around, simplify your model to the fullest, and progressively reintroduce complexity. Typical simplifications include: no aerodynamic, stiff structure, steady inflow, no controller. + + + +Below are some steps you can take to troubleshoot your model, in particular trying to isolate the problem to a given module and then input: + + +- Simplify the model by using simple environmental conditions: steady uniform inflow, still water. + +- Remove the controller: Turn `GenDOF` to False in ElastoDyn, and set `CompServo` to 0 in the main input file. The rotor will spin at constant RPM. + +- Simplify your model by turning off most degrees of freedom in your ElastoDyn input file. You can start by keeping all degrees of freedom off, and progressively adding more degrees of freedom. This might indicat if the issue comes from the blade, nacelle, tower or substructure. Some degrees of freedom that are often problematic are the drive train torsion (`DrTrDOF`), and the yaw degree of freedom (`YawDOF`). The drive train stiffness and damping values in ElastoDyn are often set wrong. A common issues with yaw, is when `NacYaw` (in ElastoDyn) and `YawNeut` (in ServoDyn), are in disagreement, or, when the yaw spring and damping `YawSpr` and `YawDamp` are not physical. For offshore simulations, if `YawDOF` and `PtfmYDOF` are on, the model needs to have a realistic `PtfmYIner` present, otherwise these degrees of freedom will be ill-defined in ElastoDyn. PtfmYiner should contain the rotational inertia of the undeflected tower, and, if SubDyn is not used, the torsional inertia of the platform/TP (if any). + +- Simplify the physical models: use ElastoDyn (`CompElast=1`) over BeamDyn, use BEM (`WakeMod=1`) over OLAF, use 0 Craig-Bampton modes in SubDyn. + +- Visualize the time series outputs (see :ref:`visualizing_input_output_OF`). Add relevant displacement outputs to your model for instance: PtfmSurge, PtfmSway, PtfmHeave, PtfmRoll, PtfmPitch, PtfmYaw, NacYaw, TTDspFA, TTDspSS, RotSpeed, OoPDefl1, IPDefl1 and RtSkew. It is likely that the turbine has some large displacements due to some errors in the model. + +- Adjust your initial conditions. As mentioned above, `NacYaw` (ElastoDyn) and `YawNeut` (ServoDyn) need to match when the yaw degrees of freedom is on. If the structural is at an initial position that is unrealistic given the environmental condition, it is likely to overshoot (e.g. high wind speed but pitch too low). A common error is not initializing the rotor speed and blade-pitch angles to their expected (mean) values at the initial wind speed of the simulation, which causes issues with many wind turbine controllers. + +- Visualize the inputs (see :ref:`visualizing_input_output_OF`). Check that the mass and stiffness distributions of the blade and tower are as expected. + +- Verify the masses and stiffness of your system. The Blade mass and tower-top mass are shown in the ElastoDyn summary file. The equivalent 6x6 matrix of the substructure is found in the SubDyn summary file. + +- If you have isolated the problem to a given module, check the information provided in the summary file of this module. Most module have a flag at the end of their input file called `SumPrint` or similar, so that the summary file is written to disk. + +- Reduce the time step. The simulation time step needs to be adjusted based on the frequencies that are modelled in the system (typically the time step needs to be at around a tenth of the fastest frequency). Modules like BeamDyn and SubDyn usually require fine time steps. + Instead of reducing the time step, it is often equivalent to introduce 1 correction step (`NumCrctn`). When corrections are used the Jacobian need to be updated regularly, for instance setting `DT_UJac` to 100 time steps. For a floating system, we recommend using `DT_UJac = 1/(10*f_pitch)`, where `f_pitch` is the natural frequency of the floating wind turbine in pitch. + + +- Perform a linearization of your structure in vacuum (`CompInflow=0`, `CompAero=0`) and in standstill (`RotSpeed=0`) (see :ref:`linearization_analysis_OF`) and check that the frequencies and damping are within the range you expect. Adjust your structural inputs otherwise. + +- Generate VTK outputs for visualization of the turbine and the various meshes used by OpenFAST. VTK outputs are activated using `WrVTK=1` or `WrVTK=2`. The VTK are written in folders `vtk*` in the main directory, and can be visualized using Paraview (see :ref:`visualizing_input_output_OF`). + + + + +.. _moduleTroubleshooting: + +Troubleshooting for specific modules +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +All modules of OpenFAST require a certain level of expertise to ensure that the simulations are physical. +Guidelines for the different modules can be found throughout this documentation, see in particular: + + +- AeroDyn: :ref:`ad_modeling` + +- HydroDyn: :ref:`hd-modeling-considerations` + +- OLAF: :ref:`Guidelines-OLAF` + +- SubDyn: :ref:`sd_modeling-considerations` + +- FAST.Farm: :ref:`FF:ModGuidance` + + + + + + +Scripting +--------- + +NREL maintains several repositories of scripts to work with OpenFAST. +The scripts can for instance be used to read the input and outputs of OpenFAST, visualize them, and generate multiple simulation inputs, and postprocess them. Some of these applications will be detailed in the following sections. + + +The repositories maintained by NREL are the following: + +- `openfast_toolbox `__: collection of low-level Python tools to work with OpenFAST and perform simple operations, with granularity. + +- `matlab-toolbox `__: collection of low-level Matlab tools to work with OpenFAST. + +- `WEIS `__ : high-level Python scripts, stands for Wind Energy with Integrated Servo-control. It can perform multifidelity co-design of wind turbines. WEIS is a framework that combines multiple NREL-developed tools to enable design optimization of floating offshore wind turbines. + +The users are invited to consult the documentations of the individual repository, and discuss related issues on their individual github pages. Contribution by the community to the NREL repositories are welcome and encouraged. + + + +Additional repositories maintained by NREL are listed below: + +- `WISDEM `__: models for assessing overall wind plant cost of energy (COE), also contains file IO, (DLC) case generation, polar manipulations, visualization, and much more! +- `ROSCO_toolbox `__: tools to work with the `ROSCO `__ controller that is supported by OpenFAST + + + +Repositories maintained by third-parties are listed below: + + +- `pyDatView `_ : tool to plot the input and output files of OpenFAST, CSV-files, and other files from other wind energy software (Hawc2, Flex, Bladed). Multiple files can be opened at once to compare results from different simulations. + +- `WindEnergyToolbox `_: library developed by DTU, providing some support for different file formats + +- `FASTTool `_ : NREL FASTv8, MATLAB GUI and Simulink integration developed by TUDelft + + + + + +.. _models_OF: + +Open-source OpenFAST models +--------------------------- + +Open-source OpenFAST wind turbine models can be found here: + +- `r-test `__: regression tests for OpenFAST, contains models for OpenFAST and its drivers (AeroDyn, SubDyn, HydroDyn, etc.). This repository is not intended to be used as a "database" of models, but it has the advantage that the input files are always up to date with the latest `format specifications `_ . OpenFAST input files for previous version can be accessed via the git tags of this repository. +- `IEA Wind Task 37 repository `_ : contains OpenFAST models of the IEA Wind 3.4-MW, 10-MW, 15-MW, and up-and-coming 22-MW reference wind turbines. +- `openfast-turbine-models `_: open source wind turbine models (in development and out of date). + + + + + + + +.. _visualizing_input_output_OF: + +Visualizing inputs and outputs files +------------------------------------ + + + +To visualize the input and output files of OpenFAST the following graphical interface tool can be used: + +- `pyDatView `_ : tool to plot the input and output files of OpenFAST, CSV-files, and other files from other wind energy software (Hawc2, Flex, Bladed). Multiple files can be opened at once to compare results from different simulations. + +The VTK visualization files that are written by OpenFAST can be opened using: + +- `paraview `_ : tool to open the VTK files generated by OpenFAST, i.e. velocity fields and turbine geometry. + + +For advanced cases, the user may want to script the reading and plotting of the input files. +Python and Matlab tools are respectively being provided in the `openfast_toolbox `_ and `matlab-toolbox `_. +In the matlab toolbox, the scripts `FAST2Matlab.m` and `Matlab2FAST.m` are used to read and write input files, the script `ReadFASTbinary` is used to open binary (`.outb`) output files. +The README files of these repositories points to examples and more documentation. + + + + +.. _running_multiple_OF: + +Running parametric studies and design load cases (DLC) +------------------------------------------------------ + +Parametric studies can be run by using the scripts to read and write OpenFAST input files provided in the `matlab-toolbox `__ +and the Python +`openfast_toolbox `__ +. The openfast_toolbox provides dedicated Python scripts and examples to automatize the process (see the README of the repository for more). +The `AeroelasticSE` module of `WEIS `__ can generate input files for the design load cases specified in the standards. +Consult the WEIS repository for more information. + + + + + +.. _linearization_analysis_OF: + +Performing linearization analyses +--------------------------------- + + + +Background +~~~~~~~~~~ + +Many applications require a linear model of a system: eigenvalue analyses, frequency domain analysis, linear state space models for observers, etc. Most models of OpenFAST are non-linear, and a linearization of the underlying system is therefore required. +Linearization is done about a given operating point, which corresponds to the set of values of the states and inputs of the system (typically, a given time of a simulation). +The output of the linearization is a linear state space model (four matrices relating states, inputs and outputs) valid in the neighborhood of the operating point. + +Because the rotor is spinning, the equilibrium solution, if present, will likely be periodic. +It is necessary to linearize at different operating points over a period of revolution (i.e. at different azimuthal positions). + +An additional complication is that some of the states of OpenFAST are in the rotating frame of reference (e.g. the ElastoDyn blade states). To obtain a linear state space model of the system that is in a fixed (non-rotating) frame of reference the multiblade coordinate transformation (MBC) is applied. For a purely periodic system, the MBC can be applied to the linearized outputs at different azimuthal positions which can be combined to form a linearized system in a fixed frame of reference. +We note that the MBC only applies to 3 or more blades. +Floquet theory would be needed 1 or 2 blades, although NREL does not currently have a post-processor that makes use of Floquet theory. + + +.. note:: + Our current recommended practice is to avoid periodicity and simplify the model such that the equilibrium is constant (e.g., removing tilt and gravity). The MBC is still required but it is not required to use different linearization at different azimuthal positions. + +One of the outputs of the linearization is the state matrix (`A`) which relates the system states to their time derivatives. +An eigenvalue analysis of `A` provides the full-system mode shapes, and their frequencies and damping. + +.. note:: + Unlike a linear finite-element software, OpenFAST does not have a notion of a full-system stiffness and mass matrix (some modules have local matrices but only related to the module). The underlying system of equation is non-linear, the frequencies of the system will vary with the operating conditions (e.g. wind speed, rotational speed). + + +The sections below detail the process of obtaining a linear model with OpenFAST, and will focus on its application to obtain the frequencies and damping of the system modes. + + + + +Linearized models for one simulation (manually) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +This section describes the key steps to generate a linearized model of the system with OpenFAST. + +The steps to perform simple linearization analysis are given below: + +1. Edit the main `.fst` file, set `Linearize=True` + +2. Set the output format `OutFmt` to "ES20.11E3". The output files will be written with this high resolution, which is required for accurate eigenvalue analyses. + +.. warning:: + Because the linearization output files are in ASCII format, the results of the eigenvalue analyses will be sensitive to the output resolution (`OutFmt`). It is therefore important to set this parameter with a large precision as mentioned above. + +3. There are two main methods to determine at which times the linearization will be made: + + - using `CalcSteady=False`, the user prescribes the times where linearization is to occur using `NLinTimes` and `LinTimes` + (it is the responsibility of the user to provide times where the system is in equilibrium or at a periodic steady state, i.e. sufficiently long time); + - `CalcSteady=True` (recommended approach), OpenFAST will automatically start the linearization when the system is at a periodic steady state (based on given tolerance `TrimTol`) and will perform `NLinTimes` linearizations over a rotor revolution. When a controller is used the option `CalcSteady` will also adjust the controller inputs (either Pitch, Yaw, or Generator Torque, based on the input `TrimCase`) such as to reach the rotational speed indicated by the initial condition. The `TrimGain` and `TrimTol` might need to be adjusted. `Twr_Kdmp` and `Bld_Kdmp` can be used to add damping to the tower and blades during the steady-state calculation. These may be helpful to speed up the steady-state calculation and may be necessary if the tower and/or blades are otherwise unstable. Once the steady-state solution is found. `Twr_Kdmp` and `Bld_Kdmp` will not impact the linearization results (i..e., the linear solution will not have extra tower and blade damping). + + + +4. Chose the number of linearizations. For a standstill case, `NLinTimes=1`, for a rotating case, if the equilibrium point is periodic, it is recommended to use `NLinTimes=36` (corresponding to on linearization every 10-degrees of azimuth rotation), otherwise `NLinTimes=1`. If `CalcSteady=False` and the user sets `NLinTimes=36`, the user needs to set `LinTimes` with values that corresponds to the rotor being at 36 unique azimuthal position based on the rotor speed. + + +5. For a typical linearization, the user may set `LinInputs=0`, `LinOutputs=0`, `LinOutJac=False`, `LinOutMod=False`, `Twr_Kdmp=0`, `Bld_Kdmp=0` (see the OpenFAST input file documentation). + Setting `LinInputs = LinOutputs = 0` avoids generating the B, C, and D matrices (no inputs and outputs). + The standard set of linearization inputs inherent in the linearized system are available when `LinInputs=1`. This includes e.g. collective blade pitch. With `LinOutputs = 1`, the outputs of the `OutList` sections of each module are included in the linearized system. For instance, `GenSpeed` can be included by including `GenSpeed` in the `OutList` of ElastoDyn. Linearization about all the inputs and outputs of OpenFAST set `LinInputs=2`, `LinOutputs=2`, at the expense of having large output files. + +6. Run OpenFAST on this `.fst` file. OpenFAST will display a message when it is performing each individual linearization, and individual files with the `.lin` extension will be written to disk. + +7. It is recommended to check the regular output file `.out` or `.outb`. If `CalcSteady=False`, the user should look to see whether the turbine had indeed reached a steady state (or periodic steady state) at the time where linearization was run. If `CalcSteady=True` and a controller is used, the user can check that the rotational speed has indeed converged to the desired RPM, and potentially chose to adjust `TrimGain` and `TrimTol` for future runs. + +The linearization files `*.lin` are then to be postprocessed using the python or matlab tools provided. + +.. note:: + Not all modules and options of OpenFAST are available when performing linearization. OpenFAST will abort with error message that will indicate which options are available. Adapt your input files accordingly. + + + +Postprocessing +~~~~~~~~~~~~~~ + +To obtain the eigenfrequencies of the system the user can open a `.lin` file, extract the state matrix `A` and perform a eigenvalue analysis. For a spinning rotors, all lin-files generated from a simulation at different azimuthal positions need to be opened, and converted using the MBC-transformation. We provide scripts for such cases. + +When only one linearization file is to be used (e.g. at standstill), the script `postproLin_OneLinFile_NoRotation` can be used. Is is found in `matlab-toolbox/Campbell/example` or `openfast_toolbox/openfast_toolbox/linearization/examples/`. + +When several linearization files are to be postprocessed (in particular several files corresponding to different azimuthal positions), the script `postproLin_MultiLinFile_Campbel` can be used, located in the same folders mentioned above. +The script can also be used if linearizations were performed at different wind speed and RPM (via different OpenFAST calls). Displaying the frequencies and damping at these different wind turbine operating conditions is referred to as Campbell diagram. + + + +Campbell diagrams +~~~~~~~~~~~~~~~~~ + +In the near future, a dedicated tool will be provided to simplify the process of generating Campbell diagrams. + +Until then, to avoid the manual process of editing input files for different wind turbine operating conditions, we provide the script `runCampbell`, found in `matlab-toolbox/Campbell/example` or `openfast_toolbox/openfast_toolbox/linearization/examples/`. +The script relies on a template folder which a reference "fst" file. The folder is duplicated, files are created for each wind turbine operating conditions wind speed/rpm), OpenFAST is run, and the linearization files are postprocessed. + + +The script `runCampbell` generates either a set of CSV files or an Excel file. The script attempts to identify the modes (for instance 1st tower fore-aft mode, 1st flap mode, etc.), but a manual process is usually required to fully identify the mode. This process can be difficult and tedious. It is recommended to proceed first with simulations in vacuum, and with few operating points, to get familiar with the system. + +The manual identification process consists in changing the CSV file `Campbell_ModesID.csv` (or the Excel spread sheet `ModesID` if Excel output is used). To avoid having this file rewritten when rerunning `runCampbell`, it is recommended to rename this file as `Campbell_ModesID_Manual.csv`. The part of the script `runCampbell` that plots the Campbell diagram can be adjusted so as to use the "Manual" file. +It is recommended to use the CSV format since this is the method compatible with Python and MacOS. + +The manual identification process consists in attributing indexes in the table of modes, where the index corresponds to the list of sorted mode frequencies. + +For instance, opening the CSV file in excel, the `ModeID` file might look as follows: + +.. code:: + + Mode Number Table + Wind Speed (mps) 2.0 5.0 8.0 + 1st Tower FA 0 0 0 + 1st Tower SS 1 0 0 + +In this example, we assume that linearizations were run at 2, 5 and 8m/s. "0" in the table indicates that a mode was not identified. You can look at the file `Campbell_Summary.txt` to have a look at the frequencies, damping and "modal content" for each mode and operating point. For more details, you can open the individual CSV files for each operating point. (If you used the Excel format, these are in different sheets). +You might find that for 2 and 5m/s, the tower Fore-Aft is the second frequency, and the tower side-side is the first frequency that shows up in the list of modes. At 8m/s you might find that the opposite occurs. In that case, you will edit the file such that it is as follows: + +.. code:: + + Mode Number Table + Wind Speed (mps) 2.0 5.0 8.0 + 1st Tower FA 2 2 1 + 1st Tower SS 1 1 2 + + +The main question is how to determine which mode is which. There is no true solution to this question, here are some elements to help the identifications: + + - The system frequencies are usually easy to determine at 0 m/s and 0 rpm. The system frequencies will vary progressively from this reference point as the RPM/WS/pitch changes. Blade regressive and progressive modes will typically display a "splitting" equal to +/- the rotational speed frequency as the rotational speed increases. The collective modes in flap tend to increase in frequency with rotor speed due to centrifugal stiffening. + + - Blade flap modes are typically highly damped (significantly more than edgewise modes) when aerodynamics are present. + + - From an operating point to the next, the damping will not change drastically. + + - Tower modes are not strongly affected by the change of operating conditions + + - You will need to look at the "mode content", to see where the energy is for each mode. The file `Campbell_Summary.csv` displays a summary of the mode content. In some cases, there is no clear maximum (the keyword `NoMax` is shown). In that case, identifying the mode might be difficult. A similar content is found in the individual operating point files. + + - Visualization of the modes can help identify them (see the next section). The process can yet be lengthy. + +Once the identification table is set. Save the file, and plot the Campbell diagram. The process may be iterative until a satisfying diagram is obtained. There should be no need to close Excel in this process. + +We are aware that the process is lengthy, we thank you for your patience while we attempt to streamline this process. + + + +Mode shape visualization +~~~~~~~~~~~~~~~~~~~~~~~~ + +Mode shape visualization is currently possible. It requires a generation of viz files for each simulations, and rerunning OpenFAST to generate VTK files. The matlab script `runCampbell` assists in this process, but for now limited support and documentation is provided. + +The user is invited to consult the following example: +- https://github.com/OpenFAST/r-test/tree/main/glue-codes/openfast/5MW_Land_ModeShapes + +And it's associated documentation: +- https://github.com/OpenFAST/r-test/blob/main/glue-codes/openfast/5MW_Land_ModeShapes/vtk-visualization.md + + +Additional references +~~~~~~~~~~~~~~~~~~~~~ + +Some linearization issues have been discussed in the forum and as github issues: + +- https://wind.nrel.gov/forum/wind/ + +- https://github.com/OpenFAST/openfast/issues/480 + +Thank you for your patience while we attempt to streamline the linearization and Campbell digram generation process. + + + + + From 22f2c74758f70af6871792703aba5ace3f99be72 Mon Sep 17 00:00:00 2001 From: Philip Sakievich Date: Tue, 1 Aug 2023 21:14:14 -0600 Subject: [PATCH 120/232] Add hub and nacelle ref orient --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 53f5b4a407..2fb7c97ec4 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -2964,6 +2964,8 @@ void fast::OpenFAST::get_ref_positions_from_openfast(int iTurb) { for (int i=0; i < 3; i++) { brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i] = extld_i_f_FAST[iTurb].hubRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i] = extld_i_f_FAST[iTurb].nacRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i+3] = extld_i_f_FAST[iTurb].hubRefPos[i+3]; + brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i+3] = extld_i_f_FAST[iTurb].nacRefPos[i+3]; } int nBlades = turbineData[iTurb].numBlades; From c83011ea0faeafb53b2cc16015fbd16b8b244e80 Mon Sep 17 00:00:00 2001 From: Philip Sakievich Date: Wed, 2 Aug 2023 10:41:45 -0600 Subject: [PATCH 121/232] Add netcdf output for hub/nac --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 2fb7c97ec4..61855b3646 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -603,6 +603,17 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { param_count_dim.data(), tmpArray.data()); } } + + ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_pos"], + &brFSIData[iTurbLoc][3].nac_ref_pos[0]); + ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_orient"], + &brFSIData[iTurbLoc][3].nac_ref_pos[3]); + + ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_pos"], + &brFSIData[iTurbLoc][3].hub_ref_pos[0]); + ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_orient"], + &brFSIData[iTurbLoc][3].hub_ref_pos[3]); + } ierr = nc_close(ncid); From 8ff6282791c1e35d2c6485425b02eb03922ade2b Mon Sep 17 00:00:00 2001 From: psakiev Date: Thu, 3 Aug 2023 08:29:05 -0600 Subject: [PATCH 122/232] Make netcdf output parallel consistent --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 61855b3646..b0e24e0baa 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -282,7 +282,7 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { //Create the file - this will destory any file std::stringstream defloads_fstream; defloads_fstream << "turb_" ; - defloads_fstream << std::setfill('0') << std::setw(2) << iTurbLoc; + defloads_fstream << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; defloads_fstream << "_output.nc"; std::string defloads_filename = defloads_fstream.str(); int ierr = nc_create(defloads_filename.c_str(), NC_CLOBBER, &ncid); From 6f0b5a2b6a3547314245acdcd3a5916d90890183 Mon Sep 17 00:00:00 2001 From: psakiev Date: Thu, 3 Aug 2023 23:07:32 -0600 Subject: [PATCH 123/232] Set file to operate on TurbID --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index b0e24e0baa..cedac6163c 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -58,7 +58,7 @@ void fast::OpenFAST::findRestartFile(int iTurbLoc) { //Find the file and open it in read only mode std::stringstream rstfile_ss; rstfile_ss << "turb_" ; - rstfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; rstfile_ss << "_rst.nc"; std::string rst_filename = rstfile_ss.str(); int ierr = nc_open(rst_filename.c_str(), NC_NOWRITE, &ncid); @@ -120,7 +120,7 @@ void fast::OpenFAST::prepareRestartFile(int iTurbLoc) { //This will destroy any existing file std::stringstream rstfile_ss; rstfile_ss << "turb_" ; - rstfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + rstfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; rstfile_ss << "_rst.nc"; std::string rst_filename = rstfile_ss.str(); int ierr = nc_create(rst_filename.c_str(), NC_CLOBBER, &ncid); @@ -246,7 +246,7 @@ void fast::OpenFAST::findOutputFile(int iTurbLoc) { //Find the file and open it in read only mode std::stringstream outfile_ss; outfile_ss << "turb_" ; - outfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + outfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; outfile_ss << "_output.nc"; std::string out_filename = outfile_ss.str(); int ierr = nc_open(out_filename.c_str(), NC_NOWRITE, &ncid); @@ -282,7 +282,7 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { //Create the file - this will destory any file std::stringstream defloads_fstream; defloads_fstream << "turb_" ; - defloads_fstream << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurbLoc]; + defloads_fstream << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; defloads_fstream << "_output.nc"; std::string defloads_filename = defloads_fstream.str(); int ierr = nc_create(defloads_filename.c_str(), NC_CLOBBER, &ncid); @@ -2232,7 +2232,7 @@ int fast::OpenFAST::openVelocityDataFile(int iTurb) { int ncid; std::stringstream velfile_fstream; velfile_fstream << "turb_" ; - velfile_fstream << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurb]; + velfile_fstream << std::setfill('0') << std::setw(2) << turbineData[iTurb].TurbID; velfile_fstream << "_veldata.nc"; std::string velfile_filename = velfile_fstream.str(); int ierr = nc_open(velfile_filename.c_str(), NC_WRITE, &ncid); @@ -2247,7 +2247,7 @@ void fast::OpenFAST::prepareVelocityDataFile(int iTurb) { int ncid; std::stringstream velfile_fstream; velfile_fstream << "turb_" ; - velfile_fstream << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurb]; + velfile_fstream << std::setfill('0') << std::setw(2) << turbineData[iTurb].TurbID; velfile_fstream << "_veldata.nc"; std::string velfile_filename = velfile_fstream.str(); int ierr = nc_create(velfile_filename.c_str(), NC_CLOBBER, &ncid); @@ -2280,7 +2280,7 @@ void fast::OpenFAST::writeVelocityData(int iTurb, int n_t_global, int nlinIter) //Find the file and open it in append mode std::stringstream velfile_ss; velfile_ss << "turb_" ; - velfile_ss << std::setfill('0') << std::setw(2) << turbineMapProcToGlob[iTurb]; + velfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurb].TurbID; velfile_ss << "_veldata.nc"; std::string vel_filename = velfile_ss.str(); int ierr = nc_open(vel_filename.c_str(), NC_WRITE, &ncid); @@ -2597,7 +2597,7 @@ void fast::OpenFAST::writeOutputFile(int iTurbLoc, int n_t_global) { //Open the file in append mode std::stringstream outfile_ss; outfile_ss << "turb_" ; - outfile_ss << std::setfill('0') << std::setw(2) << iTurbLoc; + outfile_ss << std::setfill('0') << std::setw(2) << turbineData[iTurbLoc].TurbID; outfile_ss << "_output.nc"; std::string defloads_filename = outfile_ss.str(); int ierr = nc_open(defloads_filename.c_str(), NC_WRITE, &ncid); From 104ab10ba762ea5c7fa12eaecb81176427c3c9ec Mon Sep 17 00:00:00 2001 From: Jon Rood Date: Wed, 20 Sep 2023 12:22:01 -0600 Subject: [PATCH 124/232] Check if restart frequency is > 0 to avoid dividing by 0. --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index cedac6163c..851657a414 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -1349,7 +1349,7 @@ void fast::OpenFAST::advance_to_next_driver_time_step(bool writeFiles) { if (writeFiles) { for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { int tStepRatio = dtDriver/dtFAST; - if ( (((nt_global - ntStart) % (restartFreq_*tStepRatio)) == 0 ) && (nt_global != ntStart) ) { + if ( (restartFreq_*tStepRatio > 0) && (((nt_global - ntStart) % (restartFreq_*tStepRatio)) == 0 ) && (nt_global != ntStart) ) { turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); checkError(ErrStat, ErrMsg); From 1cf828bede7711b3902ad47852607d8ca7e374bc Mon Sep 17 00:00:00 2001 From: psakiev Date: Thu, 26 Oct 2023 08:28:25 -0600 Subject: [PATCH 125/232] Fix precision errors based on integer conversion --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 851657a414..e8e3e066da 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -1508,8 +1508,11 @@ void fast::OpenFAST::step(bool writeFiles) { } if (writeFiles) { + // provide an epsilon that is small relative to dtFast to help with integer conversion + const double eps = dtFast*1e-6; for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - int tStepRatio = dtDriver/dtFAST; + // ensure that the ratio is robust to integer conversion by making sure it will always truncate down + int tStepRatio = static_cast((dtDriver+eps)/dtFAST); if ( (((nt_global - ntStart) % (restartFreq_ * tStepRatio)) == 0 ) && (nt_global != ntStart) ) { turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); From b277768d5cd867cd562a31e1a07d2c871c107c86 Mon Sep 17 00:00:00 2001 From: psakiev Date: Thu, 26 Oct 2023 14:41:45 -0600 Subject: [PATCH 126/232] Fix typo, and then replace other ratio computations --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index e8e3e066da..ab495294b4 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -15,6 +15,14 @@ inline void check_nc_error(int code, std::string msg) { int fast::OpenFAST::AbortErrLev = ErrID_Fatal; // abort error level; compare with NWTC Library +int time_step_ratio(double fastDt, double driverDt, double epsFactor=1e-6) +{ + // ensure that the ratio is robust to integer conversion by making sure it will always truncate down + // provide an epsilon that is small relative to dtFast to help with integer conversion + const double eps = driverDt*epsFactor; + return static_cast((driverDt*eps)/fastDt); +} + //Constructor fast::fastInputs::fastInputs(): nTurbinesGlob(0), @@ -1348,7 +1356,7 @@ void fast::OpenFAST::advance_to_next_driver_time_step(bool writeFiles) { if (writeFiles) { for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - int tStepRatio = dtDriver/dtFAST; + int tStepRatio = time_step_ratio(dtFAST, dtDriver); if ( (restartFreq_*tStepRatio > 0) && (((nt_global - ntStart) % (restartFreq_*tStepRatio)) == 0 ) && (nt_global != ntStart) ) { turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); @@ -1508,11 +1516,8 @@ void fast::OpenFAST::step(bool writeFiles) { } if (writeFiles) { - // provide an epsilon that is small relative to dtFast to help with integer conversion - const double eps = dtFast*1e-6; + int tStepRatio = time_step_ratio(dtFAST, dtFAST); for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { - // ensure that the ratio is robust to integer conversion by making sure it will always truncate down - int tStepRatio = static_cast((dtDriver+eps)/dtFAST); if ( (((nt_global - ntStart) % (restartFreq_ * tStepRatio)) == 0 ) && (nt_global != ntStart) ) { turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global FAST_CreateCheckpoint(&iTurb, turbineData[iTurb].FASTRestartFileName.data(), &ErrStat, ErrMsg); @@ -1582,7 +1587,7 @@ int fast::OpenFAST::checkAndSetSubsteps() { } } if (dtFAST > 0) { - int tStepRatio = dtDriver/dtFAST; + int tStepRatio = time_step_ratio(dtFAST, dtDriver); if (std::abs(dtDriver - tStepRatio * dtFAST) < 0.001) {// TODO: Fix arbitrary number 0.001 nSubsteps_ = tStepRatio; return 1; @@ -2607,7 +2612,7 @@ void fast::OpenFAST::writeOutputFile(int iTurbLoc, int n_t_global) { check_nc_error(ierr, "nc_open"); size_t count1=1; - int tStepRatio = dtDriver/dtFAST; + int tStepRatio = time_step_ratio(dtFAST, dtDriver); size_t n_tsteps = n_t_global/tStepRatio/outputFreq_ - 1; double curTime = n_t_global * dtFAST; ierr = nc_put_vara_double(ncid, ncOutVarIDs_["time"], &n_tsteps, &count1, &curTime); @@ -2902,7 +2907,7 @@ void fast::OpenFAST::writeRestartFile(int iTurbLoc, int n_t_global) { check_nc_error(ierr, "nc_open"); size_t count1=1; - int tStepRatio = dtDriver/dtFAST; + int tStepRatio = time_step_ratio(dtFAST, dtDriver); size_t n_tsteps = n_t_global/tStepRatio/restartFreq_ - 1; double curTime = n_t_global * dtFAST; ierr = nc_put_vara_double(ncid, ncRstVarIDs_["time"], &n_tsteps, &count1, &curTime); From 20e0b7d39723483d3569c53db555b29881ae09ff Mon Sep 17 00:00:00 2001 From: psakiev Date: Thu, 26 Oct 2023 14:55:13 -0600 Subject: [PATCH 127/232] Sigh, more typos --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index ab495294b4..9903741357 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -19,7 +19,7 @@ int time_step_ratio(double fastDt, double driverDt, double epsFactor=1e-6) { // ensure that the ratio is robust to integer conversion by making sure it will always truncate down // provide an epsilon that is small relative to dtFast to help with integer conversion - const double eps = driverDt*epsFactor; + const double eps = fastDt*epsFactor; return static_cast((driverDt*eps)/fastDt); } @@ -1516,7 +1516,7 @@ void fast::OpenFAST::step(bool writeFiles) { } if (writeFiles) { - int tStepRatio = time_step_ratio(dtFAST, dtFAST); + int tStepRatio = time_step_ratio(dtFAST, dtDriver); for (int iTurb=0; iTurb < nTurbinesProc; iTurb++) { if ( (((nt_global - ntStart) % (restartFreq_ * tStepRatio)) == 0 ) && (nt_global != ntStart) ) { turbineData[iTurb].FASTRestartFileName = " "; // if blank, it will use FAST convention .nt_global From b0184a24c0c857f2e7322becb49c5eb0ae1fb265 Mon Sep 17 00:00:00 2001 From: psakiev Date: Thu, 26 Oct 2023 20:58:46 -0600 Subject: [PATCH 128/232] One more typo --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 9903741357..58e2549a54 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -20,7 +20,7 @@ int time_step_ratio(double fastDt, double driverDt, double epsFactor=1e-6) // ensure that the ratio is robust to integer conversion by making sure it will always truncate down // provide an epsilon that is small relative to dtFast to help with integer conversion const double eps = fastDt*epsFactor; - return static_cast((driverDt*eps)/fastDt); + return static_cast((driverDt+eps)/fastDt); } //Constructor From 554c4ce80ae5e5edc520d0b34025cecf0ad82a46 Mon Sep 17 00:00:00 2001 From: Ganesh Vijayakumar Date: Thu, 14 Dec 2023 18:16:27 -0700 Subject: [PATCH 129/232] Fix WriteOutput time written --- modules/openfast-library/src/FAST_Subs.f90 | 500 ++++++++++----------- 1 file changed, 250 insertions(+), 250 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7e5a6ffb64..3042f91ca3 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -27,7 +27,7 @@ MODULE FAST_Subs USE VersionInfo IMPLICIT NONE - + CONTAINS !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! INITIALIZATION ROUTINES @@ -42,11 +42,11 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CHARACTER(*), OPTIONAL,INTENT(IN ) :: InFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) TYPE(FAST_ExternInitType),OPTIONAL,INTENT(IN ) :: ExternInitData !< Initialization input data from an external source (Simulink) - + LOGICAL, PARAMETER :: CompAeroMaps = .false. Turbine%TurbID = TurbID - - + + IF (PRESENT(InFile)) THEN IF (PRESENT(ExternInitData)) THEN CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & @@ -103,7 +103,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules LOGICAL, INTENT(IN ) :: CompAeroMaps !< Determines if simplifications are made to produce aero maps (not time-marching) - + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CHARACTER(*), OPTIONAL, INTENT(IN ) :: InFile !< A CHARACTER string containing the name of the primary FAST input file (if not present, we'll get it from the command line) @@ -124,11 +124,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, INTEGER(IntKi) :: k ! blade loop counter INTEGER(IntKi) :: nNodes ! temp var for ExtInfw coupling logical :: CallStart - + REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps - + INTEGER(IntKi) :: NumBl - + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitializeAll' @@ -137,7 +137,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, !.......... ErrStat = ErrID_None ErrMsg = "" - + p_FAST%CompAeroMaps = CompAeroMaps y_FAST%UnSum = -1 ! set the summary file unit to -1 to indicate it's not open @@ -151,7 +151,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%VTK_count = 0 ! first VTK file has 0 as output y_FAST%n_Out = 0 ! set the number of ouptut channels to 0 to indicate there's nothing to write to the binary file p_FAST%ModuleInitialized = .FALSE. ! (array initialization) no modules are initialized - + ! Get the current time CALL DATE_AND_TIME ( Values=m_FAST%StrtTime ) ! Let's time the whole simulation CALL CPU_TIME ( m_FAST%UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) @@ -296,11 +296,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + NumBl = Init%OutData_ED%NumBl p_FAST%GearBox_index = Init%OutData_ED%GearBox_index - - + + if (p_FAST%CalcSteady) then if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then p_FAST%TrimCase = TrimCase_none @@ -362,7 +362,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_BD%Linearize = p_FAST%Linearize Init%InData_BD%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -p_FAST%Gravity /) ! "Gravitational acceleration" m/s^2 - + ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module( MODULE_BD ) @@ -413,7 +413,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (p_FAST%CompAeroMaps .and. BD%p(k)%BldMotionNodeLoc /= BD_MESH_FE) call SetErrStat(ErrID_Fatal, "BeamDyn aero maps must have outputs at FE nodes.", ErrStat, ErrMsg, RoutineName ) if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors - + if (size(y_FAST%Lin%Modules(MODULE_BD)%Instance) >= k) then ! for aero maps, we only use the first instance: if (allocated(Init%OutData_BD(k)%LinNames_y)) call move_alloc(Init%OutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) if (allocated(Init%OutData_BD(k)%LinNames_x)) call move_alloc(Init%OutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) @@ -423,17 +423,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_BD(k)%RotFrame_u)) call move_alloc(Init%OutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) if (allocated(Init%OutData_BD(k)%IsLoad_u )) call move_alloc(Init%OutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) if (allocated(Init%OutData_BD(k)%DerivOrder_x)) call move_alloc(Init%OutData_BD(k)%DerivOrder_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) - + if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) end if - + END DO - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - + END IF @@ -490,16 +490,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ELSEIF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN - - allocate(Init%InData_AD%rotors(1), stat=ErrStat2) + + allocate(Init%InData_AD%rotors(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) call Cleanup() return end if - + Init%InData_AD%rotors(1)%NumBlades = NumBl - + if (p_FAST%CompAeroMaps) then CALL AllocAry( MeshMapData%HubOrient, 3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -507,15 +507,15 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + theta = 0.0_R8Ki do k=1,Init%InData_AD%rotors(1)%NumBlades theta(1) = TwoPi_R8 * (k-1) / Init%InData_AD%rotors(1)%NumBlades MeshMapData%HubOrient(:,:,k) = EulerConstruct( theta ) end do end if - - + + ! set initialization data for AD CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -526,7 +526,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - Init%InData_AD%Gravity = p_FAST%Gravity + Init%InData_AD%Gravity = p_FAST%Gravity Init%InData_AD%Linearize = p_FAST%Linearize Init%InData_AD%CompAeroMaps = p_FAST%CompAeroMaps Init%InData_AD%rotors(1)%RotSpeed = p_FAST%RotSpeedInit ! used only for aeromaps @@ -544,20 +544,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_AD%defPvap = p_FAST%Pvap Init%InData_AD%WtrDpth = p_FAST%WtrDpth Init%InData_AD%MSL2SWL = p_FAST%MSL2SWL - - + + Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) ! Note: not passing tailfin position and orientation at init Init%InData_AD%rotors(1)%AeroProjMod = APM_BEM_NoSweepPitchTwist - + do k=1,NumBl Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do - + 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) @@ -585,10 +585,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN - END IF - + END IF + AirDens = Init%OutData_AD%rotors(1)%AirDens - + ELSE AirDens = 0.0_ReKi END IF ! CompAero @@ -665,12 +665,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) - if ( p_FAST%CompElast == Module_BD ) then + if ( p_FAST%CompElast == Module_BD ) then Init%InData_IfW%RadAvg = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) else Init%InData_IfW%RadAvg = Init%OutData_ED%BladeLength end if - + IF ( PRESENT(ExternInitData) ) THEN Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration @@ -709,7 +709,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + IF ( p_FAST%CompServo == Module_SrvD ) THEN !assign the number of gates to ServD if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) @@ -736,7 +736,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing END IF - + ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN @@ -866,27 +866,27 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SeaSt%hasIce = p_FAST%CompIce /= Module_None Init%InData_SeaSt%InputFile = p_FAST%SeaStFile Init%InData_SeaSt%OutRootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SeaSt)) - + ! these values support wave field handling Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod Init%InData_SeaSt%PtfmLocationX = p_FAST%TurbinePos(1) Init%InData_SeaSt%PtfmLocationY = p_FAST%TurbinePos(2) - + Init%InData_SeaSt%TMax = p_FAST%TMax - + CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN - END IF - + END IF + ! Need to set up other module's InitInput data here because we will also need to clean up SeaState data and would rather not defer that cleanup if ( p_FAST%CompHydro == Module_HD ) then Init%InData_HD%NStepWave = Init%OutData_SeaSt%NStepWave @@ -895,45 +895,45 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%WaveMod = Init%OutData_SeaSt%WaveMod Init%InData_HD%WaveStMod = Init%OutData_SeaSt%WaveStMod Init%InData_HD%WaveDirMod = Init%OutData_SeaSt%WaveDirMod - Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff - Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff + Init%InData_HD%WvLowCOff = Init%OutData_SeaSt%WvLowCOff + Init%InData_HD%WvHiCOff = Init%OutData_SeaSt%WvHiCOff Init%InData_HD%WvLowCOffD = Init%OutData_SeaSt%WvLowCOffD - Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD + Init%InData_HD%WvHiCOffD = Init%OutData_SeaSt%WvHiCOffD Init%InData_HD%WvLowCOffS = Init%OutData_SeaSt%WvLowCOffS - Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS + Init%InData_HD%WvHiCOffS = Init%OutData_SeaSt%WvHiCOffS Init%InData_HD%InvalidWithSSExctn = Init%OutData_SeaSt%InvalidWithSSExctn - - Init%InData_HD%WaveDirMin = Init%OutData_SeaSt%WaveDirMin - Init%InData_HD%WaveDirMax = Init%OutData_SeaSt%WaveDirMax - Init%InData_HD%WaveDir = Init%OutData_SeaSt%WaveDir + + Init%InData_HD%WaveDirMin = Init%OutData_SeaSt%WaveDirMin + Init%InData_HD%WaveDirMax = Init%OutData_SeaSt%WaveDirMax + Init%InData_HD%WaveDir = Init%OutData_SeaSt%WaveDir Init%InData_HD%WaveMultiDir = Init%OutData_SeaSt%WaveMultiDir - Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega + Init%InData_HD%WaveDOmega = Init%OutData_SeaSt%WaveDOmega Init%InData_HD%MCFD = Init%OutData_SeaSt%MCFD - - CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) - Init%InData_HD%WaveTime => Init%OutData_SeaSt%WaveTime - Init%InData_HD%WaveDynP => Init%OutData_SeaSt%WaveDynP - Init%InData_HD%WaveAcc => Init%OutData_SeaSt%WaveAcc - Init%InData_HD%WaveVel => Init%OutData_SeaSt%WaveVel - Init%InData_HD%PWaveDynP0 => Init%OutData_SeaSt%PWaveDynP0 - Init%InData_HD%PWaveAcc0 => Init%OutData_SeaSt%PWaveAcc0 - Init%InData_HD%PWaveVel0 => Init%OutData_SeaSt%PWaveVel0 + + CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElev0, Init%InData_HD%WaveElev0 ) + Init%InData_HD%WaveTime => Init%OutData_SeaSt%WaveTime + Init%InData_HD%WaveDynP => Init%OutData_SeaSt%WaveDynP + Init%InData_HD%WaveAcc => Init%OutData_SeaSt%WaveAcc + Init%InData_HD%WaveVel => Init%OutData_SeaSt%WaveVel + Init%InData_HD%PWaveDynP0 => Init%OutData_SeaSt%PWaveDynP0 + Init%InData_HD%PWaveAcc0 => Init%OutData_SeaSt%PWaveAcc0 + Init%InData_HD%PWaveVel0 => Init%OutData_SeaSt%PWaveVel0 Init%InData_HD%WaveElevC0 => Init%OutData_SeaSt%WaveElevC0 CALL MOVE_ALLOC( Init%OutData_SeaSt%WaveElevC, Init%InData_HD%WaveElevC ) Init%InData_HD%WaveDirArr => Init%OutData_SeaSt%WaveDirArr Init%InData_HD%WaveElev1 => Init%OutData_SeaSt%WaveElev1 Init%InData_HD%WaveElev2 => Init%OutData_SeaSt%WaveElev2 - + Init%InData_HD%WaveAccMCF => Init%OutData_SeaSt%WaveAccMCF Init%InData_HD%PWaveAccMCF0 => Init%OutData_SeaSt%PWaveAccMCF0 - + call SeaSt_Interp_CopyParam(Init%OutData_SeaSt%SeaSt_Interp_p, Init%InData_HD%SeaSt_Interp_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + end if - + end if - + ! ........................ ! initialize HydroDyn ! ........................ @@ -1034,16 +1034,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSE Init%InData_SD%WtrDpth = 0.0_ReKi END IF - + Init%InData_SD%Linearize = p_FAST%Linearize - Init%InData_SD%g = p_FAST%Gravity - !Ini%tInData_SD%UseInputFile = .TRUE. + Init%InData_SD%g = p_FAST%Gravity + !Ini%tInData_SD%UseInputFile = .TRUE. Init%InData_SD%SDInputFile = p_FAST%SubFile Init%InData_SD%RootName = p_FAST%OutFileRoot Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! "Interface point" where loads will be transferred to Init%InData_SD%SubRotateZ = 0.0 ! Used by driver to rotate structure around z - - + + CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1066,7 +1066,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%NumOutputs = size(Init%OutData_SD%WriteOutputHdr) if (allocated(Init%OutData_SD%DerivOrder_x)) call move_alloc(Init%OutData_SD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%DerivOrder_x) end if - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -1169,7 +1169,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name +! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name Init%InData_MAP%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_MAP%sea_density = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState Init%InData_MAP%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState @@ -1208,7 +1208,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize MoorDyn ! ........................ ELSEIF (p_FAST%CompMooring == Module_MD) THEN - + ! some new allocations needed with version that's compatible with farm-level use ALLOCATE( Init%InData_MD%PtfmInit(6,1), Init%InData_MD%TurbineRefPos(3,1), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1238,7 +1238,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%ModuleInitialized(Module_MD) = .TRUE. CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + allocate( y_FAST%Lin%Modules(MODULE_MD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MD).", ErrStat, ErrMsg, RoutineName ) @@ -1253,7 +1253,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_MD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%NumOutputs = size(Init%OutData_MD%WriteOutputHdr) if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) end if - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -1267,7 +1267,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED - Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WtrDens ! This needs to be set according to seawater density in SeaState ! Init%InData_FEAM%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState @@ -1374,7 +1374,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi Init%InData_IceF%MSL2SWL = Init%OutData_SeaSt%MSL2SWL Init%InData_IceF%gravity = p_FAST%Gravity - + CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1393,7 +1393,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN Init%InData_IceD%InputFile = p_FAST%IceFile - Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' Init%InData_IceD%MSL2SWL = Init%OutData_SeaSt%MSL2SWL Init%InData_IceD%WtrDens = Init%OutData_SeaSt%WtrDens Init%InData_IceD%gravity = p_FAST%Gravity @@ -1441,7 +1441,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ - ! initialize ServoDyn + ! initialize ServoDyn ! ........................ ALLOCATE( SrvD%Input( p_FAST%InterpOrder+1 ), SrvD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1449,7 +1449,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + ALLOCATE( SrvD%Input_Saved( p_FAST%InterpOrder+1 ), SrvD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating SrvD%Input_Saved and SrvD%InputTimes_Saved.",ErrStat,ErrMsg,RoutineName) @@ -1502,7 +1502,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SrvD%BladeRootOrient(:,:,k) = ED%y%BladeRootMotion(k)%Orientation(:,:,1) enddo - + IF ( PRESENT(ExternInitData) ) THEN Init%InData_SrvD%NumSC2CtrlGlob = ExternInitData%NumSC2CtrlGlob IF ( (Init%InData_SrvD%NumSC2CtrlGlob > 0) ) THEN @@ -1512,7 +1512,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + do i=1,Init%InData_SrvD%NumSC2CtrlGlob Init%InData_SrvD%fromSCGlob(i) = ExternInitData%fromSCGlob(i) end do @@ -1526,7 +1526,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF - + do i=1,Init%InData_SrvD%NumSC2Ctrl Init%InData_SrvD%fromSC(i) = ExternInitData%fromSC(i) end do @@ -1538,12 +1538,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SrvD%NumSC2CtrlGlob = 0 Init%InData_SrvD%NumSC2Ctrl = 0 Init%InData_SrvD%NumCtrl2SC = 0 - END IF + END IF ! Set cable controls inputs (if requested by other modules) -- There is probably a nicer way to do this, but this will work for now. call SetSrvDCableControls() - - + + CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1564,7 +1564,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !! initialize SrvD%y%ElecPwr and SrvD%y%GenTq because they are one timestep different (used as input for the next step)? - + allocate( y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) @@ -1580,32 +1580,32 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(Init%OutData_SrvD%WriteOutputHdr) end if - + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - + ! ........................ ! some checks for AeroDyn and ElastoDyn inputs with the high-speed shaft brake hack in ElastoDyn: ! (DO NOT COPY THIS CODE!) - ! ........................ + ! ........................ ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - + IF ( Init%OutData_SrvD%UseHSSBrake ) THEN IF ( p_FAST%CompAero == Module_AD14 ) THEN IF ( AD14%p%DYNINFL ) THEN CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) END IF END IF - + IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) ENDIF END IF ! Init%OutData_SrvD%UseHSSBrake - - + + END IF @@ -1638,19 +1638,19 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize for linearization or computing aero maps: ! ------------------------------------------------------------------------- if ( p_FAST%Linearize .or. p_FAST%CompAeroMaps) then - ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which + ! NOTE: In the following call, we use Init%OutData_AD%BladeProps(1)%NumBlNds as the number of aero nodes on EACH blade, which ! is consistent with the current AD implementation, but if AD changes this, then it must be handled here, too! if (p_FAST%CompAero == MODULE_AD) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2) else - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) - endif + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, -1, ErrStat2, ErrMsg2) + endif call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then call Cleanup() return end if - + if (p_FAST%CompAeroMaps) then p_FAST%SizeJac_Opt1(1) = y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL) + y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL) p_FAST%TolerSquared = p_FAST%TolerSquared * (p_FAST%SizeJac_Opt1(1)**2) ! do this calculation here so we don't have to keep dividing by the size of the array later @@ -1733,7 +1733,7 @@ SUBROUTINE Cleanup() !............................................................................................................................... ! We assume that all initializion data points to parameter data, so we just nullify the pointers instead of deallocate ! data that they point to: - CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2, DEALLOCATEpointers=.false. ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE Cleanup @@ -1843,12 +1843,12 @@ SUBROUTINE FAST_ProgStart(ThisProgVer) TYPE(ProgDesc) :: NewProgVer !< program name/date/version description - + NewProgVer = ThisProgVer if (LEN_TRIM(ProgName)>0) then ! add this for steady-state solver NewProgVer%Name = ProgName end if - + ! ... Initialize NWTC Library ! sets the pi constants, open console for output, etc... @@ -1964,7 +1964,7 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, !............................................................................................................................... y_FAST%Module_Ver( Module_Glue ) = FAST_Ver - + DO i=2,NumModules y_FAST%Module_Ver(i)%Date = 'unknown date' y_FAST%Module_Ver(i)%Ver = 'unknown version' @@ -1987,7 +1987,7 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Ver( Module_Orca )%Name = 'OrcaFlexInterface' y_FAST%Module_Ver( Module_IceF )%Name = 'IceFloe' y_FAST%Module_Ver( Module_IceD )%Name = 'IceDyn' - + y_FAST%Module_Abrev( Module_Glue ) = 'FAST' y_FAST%Module_Abrev( Module_IfW ) = 'IfW' y_FAST%Module_Abrev( Module_ExtInfw) = 'ExtInfw' @@ -2007,7 +2007,7 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Abrev( Module_Orca ) = 'Orca' y_FAST%Module_Abrev( Module_IceF ) = 'IceF' y_FAST%Module_Abrev( Module_IceD ) = 'IceD' - + p%n_substeps = 1 ! number of substeps for between modules and global/FAST time p%BD_OutputSibling = .false. @@ -2070,8 +2070,8 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, end if p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' end if - - + + !............................................................................................................................... ! Do some error checking on the inputs (validation): !............................................................................................................................... @@ -2128,11 +2128,11 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%tolerSquared < EPSILON(p%tolerSquared)) THEN CALL SetErrStat( ErrID_Fatal, 'Toler must be larger than sqrt(epsilon).', ErrStat, ErrMsg, RoutineName ) END IF - + IF (p%KMax < 1) THEN CALL SetErrStat( ErrID_Fatal, 'MaxIter must be at least 1.', ErrStat, ErrMsg, RoutineName ) END IF - + ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2159,12 +2159,12 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompSub == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSub must be 0 (None), 1 (SubDyn), or 2 (ExtPtfm_MCKF).', ErrStat, ErrMsg, RoutineName ) IF (p%CompMooring == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompMooring must be 0 (None), 1 (MAP), 2 (FEAMooring), 3 (MoorDyn), or 4 (OrcaFlex).', ErrStat, ErrMsg, RoutineName ) IF (p%CompIce == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompIce must be 0 (None) or 1 (IceFloe).', ErrStat, ErrMsg, RoutineName ) - + ! NOTE: If future modules consume SeaState data, then their checks should be added to this routine. 12/1/21 GJH if (p%CompHydro == Module_HD .and. p%CompSeaSt == Module_None) then CALL SetErrStat( ErrID_Fatal, 'SeaState must be used when HydroDyn is used. Set CompSeaSt = 1 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) end if - + IF (p%CompHydro /= Module_HD) THEN IF (p%CompMooring == Module_MAP) THEN CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when MAP is used. Set CompHydro > 0 or CompMooring = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) @@ -2177,7 +2177,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompMooring == Module_Orca) CALL SetErrStat( ErrID_Fatal, 'HydroDyn cannot be used if OrcaFlex is used. Set CompHydro = 0 or CompMooring < 4 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%CompSub == Module_ExtPtfm) CALL SetErrStat( ErrID_Fatal, 'HydroDyn cannot be used if ExtPtfm_MCKF is used. Set CompHydro = 0 or CompSub < 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) END IF - + IF (p%CompMooring == Module_Orca .and. p%CompSub /= Module_None) CALL SetErrStat( ErrID_Fatal, 'SubDyn and ExtPtfm cannot be used if OrcaFlex is used. Set CompSub = 0 or CompMooring < 4 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) @@ -2192,7 +2192,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompElast == Module_BD .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) if (p%CompInflow == MODULE_ExtInfw .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when ExternalInflow is used. Change CompAero or CompInflow in the FAST input file.', ErrStat, ErrMsg, RoutineName ) if ((p%CompAero == Module_ExtLd) .and. (p%CompInflow /= Module_NONE) ) call SetErrStat(ErrID_Fatal, 'Inflow module cannot be used when ExtLoads is used. Change CompAero or CompInflow in the OpenFAST input file.', ErrStat, ErrMsg, RoutineName) - + IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%MHK /= MHK_None .and. p%CompAero == Module_AD14) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used with an MHK turbine. Change CompAero or MHK in the FAST input file.', ErrStat, ErrMsg, RoutineName ) @@ -2296,13 +2296,13 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) CALL SetErrStat( ErrID_Fatal, 'RotSpeed must be positive for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) end if end do - + do i=1,p%NumSSCases if (p%WS_TSR(i) < EPSILON(p%WS_TSR(1))) then CALL SetErrStat( ErrID_Fatal, 'WindSpeed and TSR must be positive numbers for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) ! at least, they can't be zero! end if end do - + end if end if @@ -2377,7 +2377,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%Module_Ver( Module_SeaSt ) = Init%OutData_SeaSt%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SeaSt ))) END IF - + IF ( p_FAST%CompHydro == Module_HD ) THEN y_FAST%Module_Ver( Module_HD ) = Init%OutData_HD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_HD ))) @@ -2417,7 +2417,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) ! Set the number of output columns from each module !...................................................... y_FAST%numOuts = 0 ! Inintialize entire array - + IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ExtInfw%WriteOutputHdr ) ) y_FAST%numOuts(Module_ExtInfw) = SIZE(Init%OutData_ExtInfw%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) @@ -2426,7 +2426,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) end do !ad14 doesn't have outputs: y_FAST%numOuts(Module_AD14) = 0 - + IF ( ALLOCATED( Init%OutData_AD%rotors)) then IF ( ALLOCATED( Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%rotors(1)%WriteOutputHdr) ENDIF @@ -2451,7 +2451,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%numOuts(Module_Glue) = 1 ! time end if - + NumOuts = SUM( y_FAST%numOuts ) CALL AllocAry( y_FAST%ChannelNames,NumOuts, 'ChannelNames', ErrStat, ErrMsg ) @@ -2459,7 +2459,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) CALL AllocAry( y_FAST%ChannelUnits,NumOuts, 'ChannelUnits', ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) RETURN - ! Glue outputs: + ! Glue outputs: if (p_FAST%CompAeroMaps) then y_FAST%ChannelNames(1) = 'Case' y_FAST%ChannelUnits(1) = '(-)' @@ -2469,25 +2469,25 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%ChannelNames(SS_Indx_TSR+1) = 'TSR' y_FAST%ChannelUnits(SS_Indx_TSR+1) = '(-)' - + y_FAST%ChannelNames(SS_Indx_RotSpeed+1) = 'RotorSpeed' y_FAST%ChannelUnits(SS_Indx_RotSpeed+1) = '(RPM)' - + y_FAST%ChannelNames(SS_Indx_Err+1) = 'AvgError' y_FAST%ChannelUnits(SS_Indx_Err+1) = '(-)' - + y_FAST%ChannelNames(SS_Indx_Iter+1) = 'Iterations' y_FAST%ChannelUnits(SS_Indx_Iter+1) = '(-)' - + y_FAST%ChannelNames(SS_Indx_WS+1) = 'WindSpeed' y_FAST%ChannelUnits(SS_Indx_WS+1) = '(m/s)' - + else y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' end if - + indxNext = y_FAST%numOuts(Module_Glue) + 1 DO i=1,y_FAST%numOuts(Module_ExtInfw) !ExternalInflow @@ -2540,7 +2540,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%ChannelUnits(indxNext) = Init%OutData_SeaSt%WriteOutputUnt(i) indxNext = indxNext + 1 END DO - + DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn y_FAST%ChannelNames(indxNext) = Init%OutData_HD%WriteOutputHdr(i) y_FAST%ChannelUnits(indxNext) = Init%OutData_HD%WriteOutputUnt(i) @@ -3099,13 +3099,13 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS ELSE p%CompIce = Module_Unknown END IF - + ! MHK - MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}: CALL ReadVar( UnIn, InputFile, p%MHK, "MHK", "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if !---------------------- ENVIRONMENTAL CONDITIONS -------------------------------- @@ -3113,15 +3113,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN - end if - + RETURN + end if + ! Gravity - Gravitational acceleration (m/s^2): CALL ReadVar( UnIn, InputFile, p%Gravity, "Gravity", "Gravitational acceleration (m/s^2)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! AirDens - Air density (kg/m^3): @@ -3129,7 +3129,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! WtrDens - Water density (kg/m^3): @@ -3137,7 +3137,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! KinVisc - Kinematic viscosity of working fluid (m^2/s): @@ -3145,7 +3145,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! SpdSound - Speed of sound in working fluid (m/s): @@ -3153,7 +3153,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! Patm - Atmospheric pressure (Pa): @@ -3161,7 +3161,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! Pvap - Vapour pressure of working fluid (Pa): @@ -3169,7 +3169,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! WtrDpth - Water depth (m): @@ -3177,7 +3177,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! MSL2SWL - Offset between still-water level and mean sea level (m): @@ -3185,7 +3185,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if !---------------------- INPUT FILES --------------------------------------------- @@ -3528,7 +3528,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS call SetErrStat(ErrID_Info, "Setting NLinTimes to 2 to avoid problem with CalcSteady with only one time.", ErrStat,ErrMsg,RoutineName) p%NLinTimes = 2 end if - + ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} CALL ReadVar( UnIn, InputFile, p%LinInputs, "LinInputs", "Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3680,7 +3680,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) INTEGER(IntKi) :: I ! loop counter INTEGER(IntKi) :: UnIn ! Unit number for reading file INTEGER(IntKi) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - + REAL(ReKi) :: TmpAry(3) ! temporary array to read in columns of case table INTEGER(IntKi) :: ErrStat2 ! Temporary Error status @@ -3690,13 +3690,13 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) CHARACTER(1024) :: FstFile ! Name of the primary ENFAST model file CHARACTER(*), PARAMETER :: RoutineName = 'FAST_ReadSteadyStateFile' - + ! Initialize some variables: UnEc = -1 Echo = .FALSE. ! Don't echo until we've read the "Echo" flag CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - + ! Get an available unit number for the file. @@ -3710,7 +3710,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if @@ -3726,14 +3726,14 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if CALL ReadStr( UnIn, InputFile, p%FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if !---------------------- ENFAST MODEL FILE -------------------------------------- @@ -3741,22 +3741,22 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if CALL ReadVar( UnIn, InputFile, FstFile, "FstFile", "Name of the primary ENFAST model file (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if - + !---------------------- STEADY-STATE SIMULATION CONTROL -------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if @@ -3765,7 +3765,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if @@ -3779,7 +3779,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(FAST_Ver%Name)//' primary steady-state input file "'//TRIM( InputFile )//'":' @@ -3788,7 +3788,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) IF (ErrStat2 /= 0_IntKi ) THEN CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".',ErrStat,ErrMsg,RoutineName) call cleanup() - RETURN + RETURN END IF END DO @@ -3800,7 +3800,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) ! ------------------------------------------------------------- ! READ FROM THE PRIMARY OPENFAST (TIME-DOMAIN) INPUT FILE ! do this before reading the rest of the variables in this - ! steady-state input file so that we don't accidentally + ! steady-state input file so that we don't accidentally ! overwrite them. ! ------------------------------------------------------------- IF ( PathIsRelative( FstFile ) ) FstFile = TRIM(PriPath)//TRIM(FstFile) @@ -3810,7 +3810,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) call cleanup() RETURN end if - + !-------------------------------------------- ! Overwrite values for parameters that we do not ! want to read from the input file: @@ -3837,7 +3837,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) if (p%CompElast == Module_BD) then CALL SetErrStat( ErrID_Warn, "AeroMaps with BeamDyn have not been verified.", ErrStat, ErrMsg, RoutineName) end if - + p%DT_Out = p%DT p%n_DT_Out = 1 ! output every step (i.e., every case) p%TStart = 0.0_DbKi @@ -3848,17 +3848,17 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) p%NLinTimes = 1 p%LinInputs = LIN_ALL p%LinOutputs = LIN_ALL - + p%LinOutMod = .TRUE. ! if debugging, this will allow us to output linearization files (see parameter "output_debugging" in FAST_SS_Solver.f90); otherwise this doesn't do anything p%LinOutJac = .TRUE. ! if debugging, this will allow us to output linearization files (see parameter "output_debugging" in FAST_SS_Solver.f90); otherwise this doesn't do anything p%WrVTK = VTK_None p%VTK_Type = VTK_None p%n_VTKTime = 1 m_FAST%Lin%FoundSteady = .false. - p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor + p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor !-------------------------------------------- - - + + ! Toler - Convergence tolerance for nonlinear solve residual equation [>0] (-) CALL ReadVar( UnIn, InputFile, p%tolerSquared, "Toler", "Convergence tolerance for nonlinear solve residual equation (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3867,8 +3867,8 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) RETURN end if p%tolerSquared = p%tolerSquared ** 2 - - + + ! MaxIter - Maximum number of iteration steps for nonlinear solve [>0] (-) CALL ReadVar( UnIn, InputFile, p%KMax, "MaxIter", "Maximum number of iteration steps for nonlinear solve (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3876,8 +3876,8 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) call cleanup() RETURN end if - - + + ! N_UJac - Number of iteration steps to recalculate Jacobian (-) [1=every iteration step, 2=every other step] CALL ReadVar( UnIn, InputFile, p%N_UJac, "N_SSJac", "Number of iteration steps to recalculate steady-state Jacobian (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3885,23 +3885,23 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) call cleanup() RETURN end if - - + + ! UJacSclFact - Scaling factor used in Jacobians (-) CALL ReadVar( UnIn, InputFile, p%UJacSclFact, "SSJacSclFact", "Scaling factor used in steady-state Jacobians (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if - - + + !---------------------- CASES ----------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Steady-State Cases', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! WindSpeedOrTSR - Choice of swept parameter (switch) { 1:wind speed; 2: TSR }: @@ -3925,7 +3925,7 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) call cleanup() RETURN end if - + ! TSR - List of TSRs (-) [>0] call AllocAry( p%RotSpeed, p%NumSSCases, 'RotSpeed', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call AllocAry( p%WS_TSR, p%NumSSCases, 'WS_TSR', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3934,19 +3934,19 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) call cleanup() RETURN end if - + ! Case table header: CALL ReadCom( UnIn, InputFile, 'Section Header: Steady-State Case Column Names', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - + CALL ReadCom( UnIn, InputFile, 'Section Header: Steady-State Case Column Units', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() RETURN end if - - + + ! Case table: do i=1,p%NumSSCases CALL ReadAry( UnIn, InputFile, TmpAry, size(TmpAry), "TmpAry", "List of cases (-) [>0]", ErrStat2, ErrMsg2, UnEc) @@ -3955,16 +3955,16 @@ SUBROUTINE FAST_ReadSteadyStateFile( InputFile, p, m_FAST, ErrStat, ErrMsg ) call cleanup() RETURN end if - + p%RotSpeed(i) = TmpAry(1) * RPM2RPS p%WS_TSR( i) = TmpAry(2) p%Pitch( i) = TmpAry(3) * D2R end do - + !---------------------- END OF FILE ----------------------------------------- p%TMax = p%NumSSCases p%RotSpeedInit = p%RotSpeed(1) - + call cleanup() RETURN @@ -4178,7 +4178,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... IF (ALLOCATED(InitOutData_AD%rotors(1)%BladeShape)) THEN - do k=1,NumBl + do k=1,NumBl call move_alloc( InitOutData_AD%rotors(1)%BladeShape(k)%AirfoilCoords, p_FAST%VTK_Surface%BladeShape(k)%AirfoilCoords ) end do ELSE @@ -4186,11 +4186,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S call WrScr('Using generic blade surfaces for AeroDyn (S809 airfoil, assumed chord, twist, AC). ') rootNode = 1 - - DO K=1,NumBl + + DO K=1,NumBl tipNode = AD%Input(1)%rotors(1)%BladeMotion(K)%NNodes cylNode = min(3,AD%Input(1)%rotors(1)%BladeMotion(K)%Nnodes) - + call SetVTKDefaultBladeParams(AD%Input(1)%rotors(1)%BladeMotion(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, 1, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4241,7 +4241,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S !....................... ! morison surfaces !....................... - + IF ( HD%y%Morison%VisMesh%Committed ) THEN call move_alloc(InitOutData_HD%Morison%MorisonVisRad, p_FAST%VTK_Surface%MorisonVisRad) END IF @@ -4325,7 +4325,7 @@ SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, i bladeLengthFract = 0.22*bladeLength bladeLengthFract2 = bladeLength-bladeLengthFract != 0.78*bladeLength - + ! Circle, square or rectangle, constant chord if (iShape>1) then chord = bladeLength*0.04 ! chord set to 4% of blade length @@ -4336,8 +4336,8 @@ SUBROUTINE SetVTKDefaultBladeParams(M, BladeShape, tipNode, rootNode, cylNode, i x = yc(j) y = xc(j) - 0.5 ! x,y coordinates for cylinder - BladeShape%AirfoilCoords(1,j,i) = chord*x - BladeShape%AirfoilCoords(2,j,i) = chord*y + BladeShape%AirfoilCoords(1,j,i) = chord*x + BladeShape%AirfoilCoords(2,j,i) = chord*y END DO enddo return ! We exit this routine @@ -5117,9 +5117,9 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file call SeaSt_CalcOutput( t_initial, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if - + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) @@ -7457,7 +7457,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ErrStat = ErrID_None ErrMsg = "" - + n_t_global_next = n_t_global+1 t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt @@ -7491,7 +7491,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- !! Write outputs - !---------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------------- call FAST_WriteOutput(m_FAST%t_global, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7747,11 +7747,11 @@ SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, call SC_DX_SetInputs(p_FAST, SrvD%y, SC_DX, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if - + if ( P_FAST%CompSeaSt == Module_SeaSt .and. y_FAST%WriteThisStep) then ! note: SeaState has no inputs and only calculates WriteOutputs, so we don't need to call CalcOutput unless we are writing to the file call SeaSt_CalcOutput( t_global_next, SeaSt%u, SeaSt%p, SeaSt%x(1), SeaSt%xd(1), SeaSt%z(1), SeaSt%OtherSt(1), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if END SUBROUTINE FAST_UpdateStates @@ -8036,7 +8036,7 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) END SUBROUTINE FAST_WriteOutput_T !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine writes the outputs at this timestep +!> This routine writes the outputs at this timestep SUBROUTINE FAST_WriteOutput(t_global, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) @@ -8086,8 +8086,8 @@ SUBROUTINE FAST_WriteOutput(t_global, 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, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & + !---------------------------------------------------------------------------------------- + CALL WriteOutputToFile(n_t_global, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -8223,9 +8223,9 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, ErrStat = ErrID_None ErrMsg = '' - + CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_AD, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) IF (p_FAST%WrTxtOutFile) THEN @@ -8327,7 +8327,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_A indxLast = 0 indxNext = 1 - + IF (y_FAST%numOuts(Module_Glue) > 1) THEN ! if we output more than just the time channel.... indxLast = indxNext + SIZE(y_FAST%DriverWriteOutput) - 1 OutputAry(indxNext:indxLast) = y_FAST%DriverWriteOutput @@ -8365,9 +8365,9 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_A OutputAry(indxNext:indxLast) = y_AD%Rotors(i)%WriteOutput indxNext = IndxLast + 1 endif - end do - END IF - + end do + END IF + IF ( y_FAST%numOuts(Module_SrvD) > 0 ) THEN indxLast = indxNext + SIZE(SrvDOutput) - 1 OutputAry(indxNext:indxLast) = SrvDOutput @@ -8379,7 +8379,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_A OutputAry(indxNext:indxLast) = SeaStOutput indxNext = IndxLast + 1 END IF - + IF ( y_FAST%numOuts(Module_HD) > 0 ) THEN indxLast = indxNext + SIZE(HDOutput) - 1 OutputAry(indxNext:indxLast) = HDOutput @@ -8619,28 +8619,28 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtInfw enddo ENDIF end if - - -! AeroDyn - IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN + + +! AeroDyn + IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors) ) then if (allocated(AD%Input(1)%rotors(1)%BladeRootMotion)) then - - DO K=1,NumBl + + DO K=1,NumBl call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - + IF (allocated(AD%y%rotors(1)%BladeLoad)) then - DO K=1,NumBl + DO K=1,NumBl call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%BladeMotion(k) ) END DO END IF call MeshWrVTK(p_FAST%TurbinePos, AD%y%rotors(1)%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%rotors(1)%TowerMotion ) - + end if end if @@ -8656,9 +8656,9 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtInfw end if end if END IF - -! HydroDyn - IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN + +! HydroDyn + IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%PRPMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_PRP', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) call MeshWrVTK(p_FAST%TurbinePos, HD%y%WamitMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%WAMITMesh ) call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonPt', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%Mesh ) @@ -8783,7 +8783,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtIn ! Blades IF ( p_FAST%CompAero == Module_AD .and. ALLOCATED(AD%Input) ) THEN ! These meshes may have airfoil data associated with nodes... if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors)) then - DO K=1,NumBl + DO K=1,NumBl call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%rotors(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), & y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%rotors(1)%BladeLoad(K) ) END DO @@ -8826,7 +8826,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, ExtIn ! END IF IF ( p_FAST%CompHydro == Module_HD .and. ALLOCATED(HD%Input)) THEN - call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%WAMITMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, & + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%WAMITMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_WAMIT', y_FAST%VTK_count, & p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%WAMITMesh ) call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonPt', y_FAST%VTK_count, & p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%y%Morison%Mesh ) @@ -8924,7 +8924,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface', & y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) end if - + ! Blades IF ( p_FAST%CompAero == Module_AD .and. allocated(AD%Input)) THEN ! These meshes may have airfoil data associated with nodes... if (allocated(AD%Input(1)%rotors) .and. allocated(AD%y%rotors)) then @@ -8961,10 +8961,10 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! Substructure ! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! END IF +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! END IF ! HydroDyn @@ -8973,13 +8973,13 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, & p_FAST%VTK_Surface%MorisonVisRad ) END IF - - -! Mooring Lines? + + +! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) if ( p_FAST%CompMooring == Module_MD ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) if (allocated(MD%y%VisLinesMesh)) then do l=1,size(MD%y%VisLinesMesh) if (MD%y%VisLinesMesh(l)%Committed) then ! No orientation data, so surface representation not possible @@ -9216,13 +9216,13 @@ SUBROUTINE WriteInputMeshesToFile(u_ED, u_AD, u_SD, u_HD, u_MAP, u_BD, FileName, END DO ! Add how many AD blade meshes there are: - NumBl = SIZE(u_AD%rotors(1)%BladeMotion,1) ! Note that NumBl is B4Ki + NumBl = SIZE(u_AD%rotors(1)%BladeMotion,1) ! Note that NumBl is B4Ki WRITE( unOut, IOSTAT=ErrStat ) NumBl DO K_local = 1,NumBl CALL MeshWrBin( unOut, u_AD%rotors(1)%BladeMotion(k_local), ErrStat, ErrMsg ) - END DO - + END DO + ! Close the file CLOSE(unOut) @@ -9465,7 +9465,7 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S LOGICAL :: SkipRunTimes INTEGER(IntKi) :: ErrStat CHARACTER(ErrMsgLen) :: ErrMsg - + IF (PRESENT(SkipRunTimeMsg)) THEN SkipRunTimes = SkipRunTimeMsg ELSE @@ -9488,10 +9488,10 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) END IF - - + + CALL FAST_DestroyTurbineType( Turbine, ErrStat, ErrMsg) ! just in case we missed some data in ExitThisProgram() - + END SUBROUTINE ExitThisProgram_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -9587,8 +9587,8 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CLOSE(y_FAST%UnSum) y_FAST%UnSum = -1 END IF - - + + SimMsg = TRIM(FAST_Ver%Name)//' encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) if (StopTheProgram) then CALL ProgAbort( trim(SimMsg), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) @@ -9733,8 +9733,8 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD ErrStat = ErrID_None ErrMsg = "" - - + + IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & ED%y, ED%m, ErrStat2, ErrMsg2 ) @@ -9822,13 +9822,13 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD END IF - + ! Write output to file (do this after ending modules so that we have more memory to use if needed) CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - + + END SUBROUTINE FAST_EndMods !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calls the destroy routines for each module. (It is basically a duplicate of FAST_DestroyTurbineType().) @@ -10137,8 +10137,8 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if END IF - - + + call cleanup() contains @@ -10341,10 +10341,10 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb ! deal with sibling meshes here: ! (ignoring for now; they are not going to be siblings on restart) - + Turbine%HD%p%PointsToSeaState = .false. ! since the pointers aren't pointing to the same data as SeaState after restart, set this to avoid memory leaks and deallocation problems - + ! deal with files that were open: IF (Turbine%p_FAST%WrTxtOutFile) THEN CALL OpenFunkFileAppend ( Turbine%y_FAST%UnOu, TRIM(Turbine%p_FAST%OutFileRoot)//'.out', ErrStat2, ErrMsg2) @@ -10500,7 +10500,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, ModeNo = p_FAST%VTK_modes%VTKModes(iMode) if (ModeNo>iModeMax) then call WrScr(' Skipping mode '//trim(num2lstr(ModeNo))//', maximum number of modes reached ('//trim(num2lstr(iModeMax))//'). Exiting.') - exit; + exit; endif call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, p_FAST%VTK_modes%VTKLinTim, nt, dt, p_FAST%VTK_tWidth ) write(sInfo, '(A,I4,A,F12.4,A,I4,A,I0)') 'Mode',ModeNo,', Freq=', p_FAST%VTK_modes%DampedFreq_Hz(ModeNo),'Hz, NLinTimes=',NLinTimes,', nt=',nt @@ -10614,7 +10614,7 @@ SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, VTKLinTim, nt, dt, VTK_tWidt else ! All simulation will use VTK_fps cycle_time = 1.0_DbKi / DampedFreq_Hz - nt = NINT(VTK_fps) + nt = NINT(VTK_fps) endif dt = cycle_time / nt From be10599741c6771ae327a82788dd631470cf92c9 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 15 Dec 2023 14:36:29 -0700 Subject: [PATCH 130/232] cpp interface: update documentation (doxygenclass not working) --- docs/conf.py | 9 ++++++- docs/source/dev/cppapi/README.txt | 3 +++ docs/source/dev/cppapi/api.rst | 3 ++- .../dev/cppapi/bibliography.bib} | 26 +++++++++---------- docs/source/dev/cppapi/index.rst | 11 +++++--- docs/source/dev/cppapi/zrefs.rst | 8 ++++++ docs/source/zrefs.rst | 6 ----- 7 files changed, 41 insertions(+), 25 deletions(-) create mode 100644 docs/source/dev/cppapi/README.txt rename docs/{_static/references.bib => source/dev/cppapi/bibliography.bib} (91%) create mode 100644 docs/source/dev/cppapi/zrefs.rst delete mode 100644 docs/source/zrefs.rst diff --git a/docs/conf.py b/docs/conf.py index 85c5e70a2b..b220b9666b 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -66,6 +66,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): 'sphinxcontrib.doxylink', 'sphinxcontrib.bibtex', 'sphinxcontrib.mermaid', +# 'breathe', ] bibtex_bibfiles = [ 'source/user/aerodyn-aeroacoustics/references.bib', @@ -76,7 +77,8 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): 'source/user/fast.farm/bibliography.bib', 'source/user/hydrodyn/references.bib', 'source/user/servodyn-stc/StC_Refs.bib', - 'source/user/subdyn/references_SD.bib' + 'source/user/subdyn/references_SD.bib', + 'source/dev/cppapi/bibliography.bib' ] autodoc_default_flags = [ @@ -89,6 +91,11 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): mathjax_path = 'https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML' +## Breathe Configuration -- for cpp interface +#breathe_projects = {"cppapi": "source/dev/cppapi"} +#breathe_default_project = "cppapi" + + # FIXME: Naively assuming build directory one level up locally, and two up on readthedocs if useDoxygen: if readTheDocs: diff --git a/docs/source/dev/cppapi/README.txt b/docs/source/dev/cppapi/README.txt new file mode 100644 index 0000000000..bb8b3a62a2 --- /dev/null +++ b/docs/source/dev/cppapi/README.txt @@ -0,0 +1,3 @@ +2023.12.15 ADP + +We don't currently run doxygen on RTD due to some configuration issues. So the doxygen content for the cpp was manually run and stored (really not ideal and should be fixed). diff --git a/docs/source/dev/cppapi/api.rst b/docs/source/dev/cppapi/api.rst index 063d97d035..96fdff067b 100644 --- a/docs/source/dev/cppapi/api.rst +++ b/docs/source/dev/cppapi/api.rst @@ -4,7 +4,8 @@ C++ API Documentation OpenFAST -------- -.. doxygenclass:: fast::OpenFAST +.. + .. doxygenclass:: fast::OpenFAST :members: :protected-members: :undoc-members: diff --git a/docs/_static/references.bib b/docs/source/dev/cppapi/bibliography.bib similarity index 91% rename from docs/_static/references.bib rename to docs/source/dev/cppapi/bibliography.bib index 34192e55d0..266ce94238 100644 --- a/docs/_static/references.bib +++ b/docs/source/dev/cppapi/bibliography.bib @@ -6,7 +6,7 @@ %% Saved with string encoding Unicode (UTF-8) -@inbook{churchfield2012, +@inbook{cpp-churchfield2012, Annote = {doi:10.2514/6.2012-537}, Author = {Churchfield, Matthew and Lee, Sang and Moriarty, Patrick and Martinez, Luis and Leonardi, Stefano and Vijayakumar, Ganesh and Brasseur, James}, Booktitle = {50th AIAA Aerospace Sciences Meeting including the New Horizons Forum and Aerospace Exposition}, @@ -20,7 +20,7 @@ @inbook{churchfield2012 Year = {2012}} -@techreport{beamdynManual, +@techreport{cpp-beamdynManual, Author = {Wang, Q and Jonkman, Jason and Sprague, Michael A, and Jonkman, Bonnie}, Date-Added = {2016-12-07 23:35:57 +0000}, Date-Modified = {2016-12-07 23:37:15 +0000}, @@ -29,7 +29,7 @@ @techreport{beamdynManual Title = {BeamDyn User's Guide and Theory Manual}, Year = {2016}} -@article{martinez2016, +@article{cpp-martinez2016, Author = {Luis A. Martinez-Tossas and Matthew J. Churchfield and Charles Meneveau}, Journal = {Journal of Physics: Conference Series}, Number = {8}, @@ -39,21 +39,21 @@ @article{martinez2016 Volume = {753}, Year = {2016}} -@techreport{fastProgrammersHandbook, +@techreport{cpp-fastProgrammersHandbook, Author = {B.J. Jonkman and J. Michalakes and J.M. Jonkman and M.L. Buhl and Jr. and A. Platt and and M.A. Sprague}, Institution = {National Renewable Energy Laboratory}, Month = {July}, Title = {NWTC Programmer's Handbook: A Guide for Software Development Within the FAST Computer-Aided Engineering Tool}, Year = {2013}} -@techreport{aerodynV15Manual, +@techreport{cpp-aerodynV15Manual, Author = {J.M. Jonkman}, Institution = {National Renewable Energy Laboratory}, Month = {April}, Title = {AeroDyn v15 User's Guide and Theory Manual}, Year = {2016}} -@techreport{naluDoc, +@techreport{cpp-naluDoc, Address = {https://github.com/spdomin/NaluDoc}, Author = {Stefan Domino}, Institution = {Sandia National Laboratories Unclassified Unlimited Release (UUR)}, @@ -61,7 +61,7 @@ @techreport{naluDoc Title = {Sierra Low Mach Module: Nalu Theory Manual 1.0}, Year = {2015}} -@techreport{fastv8AlgorithmsExamples, +@techreport{cpp-fastv8AlgorithmsExamples, Author = {Michael A. Sprague and Jason M. Jonkman and Bonnie J. Jonkman}, Institution = {National Renewable Energy Laboratory}, Month = {January}, @@ -69,7 +69,7 @@ @techreport{fastv8AlgorithmsExamples Title = {FAST Modular Framework for Wind Turbine Simulation: New Algorithms and Numerical Examples}, Year = {2015}} -@techreport{fastv8ModFramework, +@techreport{cpp-fastv8ModFramework, Author = {Jason M. Jonkman}, Date-Added = {2016-07-21 19:25:11 +0000}, Date-Modified = {2016-07-21 19:26:24 +0000}, @@ -79,7 +79,7 @@ @techreport{fastv8ModFramework Title = {The New Modularization Framework for the FAST Wind Turbine CAE Tool}, Year = {2013}} -@techreport{fastv8, +@techreport{cpp-fastv8, Author = {Jason M. Jonkman and Bonnie J. Jonkman}, Date-Added = {2016-07-21 19:15:10 +0000}, Date-Modified = {2016-07-21 19:28:31 +0000}, @@ -88,7 +88,7 @@ @techreport{fastv8 Title = {FAST v8: Changelog}, Year = {2016}} -@techreport{fastv7, +@techreport{cpp-fastv7, Author = {Jason M. Jonkman and Marshall L. Buhl Jr.}, Date-Added = {2016-07-21 18:11:47 +0000}, Date-Modified = {2016-07-21 18:13:07 +0000}, @@ -98,7 +98,7 @@ @techreport{fastv7 Title = {FAST User's Guide}, Year = {2005}} -@techreport{fleming2013, +@techreport{cpp-fleming2013, Author = {Paul Fleming and Sang Lee and Matthew J. Churchfield and Andrew Scholbrock and John Michalakes and Kathryn Johnson and and Patrick Moriarty}, Date-Added = {2016-07-21 18:05:29 +0000}, Date-Modified = {2016-07-21 19:30:03 +0000}, @@ -108,14 +108,14 @@ @techreport{fleming2013 Title = {The SOWFA Super-Controller: A High-Fidelity Tool for Evaluating Wind Plant Control Approaches}, Year = {2013}} -@misc{MPI-3.1, +@misc{cpp-MPI-3.1, Author = {MPI Forum}, Month = {June}, Note = {available at: http://www.mpi-forum.org (Jun. 2015)}, Title = {MPI: A Message-Passing Interface Standard. Version 3.1}, Year = {2015}} -@misc{hdf5, +@misc{cpp-hdf5, Author = {The HDF Group}, Note = {http://www.hdfgroup.org/HDF5/}, Title = {Hierarchical Data Format, version 5}, diff --git a/docs/source/dev/cppapi/index.rst b/docs/source/dev/cppapi/index.rst index 916f5c0f14..b6f6c49fa1 100644 --- a/docs/source/dev/cppapi/index.rst +++ b/docs/source/dev/cppapi/index.rst @@ -14,7 +14,8 @@ The C++ API is defined and implemented in the :class:`~fast::OpenFAST` class. An All inputs to the OpenFAST class are expected through an object of the :class:`fast::fastInputs`. -.. doxygenclass:: fast::fastInputs +.. + .. doxygenclass:: fast::fastInputs :members: :private-members: :protected-members: @@ -22,7 +23,8 @@ All inputs to the OpenFAST class are expected through an object of the :class:`f The object of :class:`~fast::fastInputs` class is expected hold a struct vector of type :class:`~fast::turbineDataType` and size of the number of turbines in the simulation. -.. doxygenstruct:: fast::turbineDataType +.. + .. doxygenstruct:: fast::turbineDataType :members: :private-members: @@ -30,7 +32,7 @@ The object of :class:`~fast::fastInputs` class is expected hold a struct vector Use of C++ API for Actuator Line Simulations -------------------------------------------- -The C++ API was developed mainly to integrate OpenFAST with Computational Fluid Dynamics (CFD) solvers for Fluid-Structure Interaction (FSI) applications. The workhorse FSI algorithm for wind energy applications today is the Actuator Line algorithm :cite:`churchfield2012`. The Actuator Line algorithm represents the effect of a turbine on a flow field as a series of point forces at **actuator points** along aerodynamic surfaces. The use of Blade Element Momentum theory in AeroDyn is modified to interface OpenFAST with CFD solvers for actuator line simulations. The CFD solver becomes the inflow module for OpenFAST that provides velocity information near the turbine. The calculation of the induction factors is turned off in OpenFAST and AeroDyn simply uses look up tables and an optional dynamic stall model to calculate the loads on the turbine based on the inflow field information received from the CFD solver. The induction model should be turned off in OpenFAST by selecting :samp:`WakeMod=0` in the AeroDyn input file. OpenFAST lumps the line forces along the blades and tower into a series of point forces for the actuator line algorithm. :numref:`actuatorline-viz` illustrates the transfer of information between OpenFAST and a CFD solver for actuator line applications. +The C++ API was developed mainly to integrate OpenFAST with Computational Fluid Dynamics (CFD) solvers for Fluid-Structure Interaction (FSI) applications. The workhorse FSI algorithm for wind energy applications today is the Actuator Line algorithm :cite:`cpp-churchfield2012`. The Actuator Line algorithm represents the effect of a turbine on a flow field as a series of point forces at **actuator points** along aerodynamic surfaces. The use of Blade Element Momentum theory in AeroDyn is modified to interface OpenFAST with CFD solvers for actuator line simulations. The CFD solver becomes the inflow module for OpenFAST that provides velocity information near the turbine. The calculation of the induction factors is turned off in OpenFAST and AeroDyn simply uses look up tables and an optional dynamic stall model to calculate the loads on the turbine based on the inflow field information received from the CFD solver. The induction model should be turned off in OpenFAST by selecting :samp:`WakeMod=0` in the AeroDyn input file. OpenFAST lumps the line forces along the blades and tower into a series of point forces for the actuator line algorithm. :numref:`actuatorline-viz` illustrates the transfer of information between OpenFAST and a CFD solver for actuator line applications. .. _actuatorline-viz: @@ -51,7 +53,7 @@ The CFD solver is expected to be the *driver program* for actuator line FSI simu A conventional serial staggered FSI scheme that can be constructed through the C++ API for actuator line applications. -OpenFAST uses different spatial meshes for the various modules :cite:`fastv8ModFramework`. We define the actuator points to be along the mesh defined in the structural model (ElastoDyn/BeamDyn) of the turbine. The user defines the required number of actuator points along each blade and the tower through the input parameters :samp:`numForcePtsBlade` and :samp:`numForcePtsTower` for each turbine. The number of actuator points have to be the same on all blades. The C++ API uses OpenFAST to create the requested number of actuator points through linear interpolation of the nodes in the structural model. The mesh mapping algorithm in OpenFAST :cite:`fastv8AlgorithmsExamples` is used to transfer deflections from the structural model and loads from AeroDyn to the actuator points. To distinguish the *actuator points* from the Aerodyn points, the OpenFAST C++ uses the term :samp:`forceNodes` for the actuator points and :samp:`velNodes` (velocity nodes) for the Aerodyn points. The following piece of code illustrates how one can use the C++ API to implement a strongly coupled FSI scheme with "outer" iterations for actuator line applications. This sample piece of code sets the velocity at the :samp:`velNodes` and access the coordinates and the lumped forces at the :samp:`forceNodes`. +OpenFAST uses different spatial meshes for the various modules :cite:`cpp-fastv8ModFramework`. We define the actuator points to be along the mesh defined in the structural model (ElastoDyn/BeamDyn) of the turbine. The user defines the required number of actuator points along each blade and the tower through the input parameters :samp:`numForcePtsBlade` and :samp:`numForcePtsTower` for each turbine. The number of actuator points have to be the same on all blades. The C++ API uses OpenFAST to create the requested number of actuator points through linear interpolation of the nodes in the structural model. The mesh mapping algorithm in OpenFAST :cite:`cpp-fastv8AlgorithmsExamples` is used to transfer deflections from the structural model and loads from AeroDyn to the actuator points. To distinguish the *actuator points* from the Aerodyn points, the OpenFAST C++ uses the term :samp:`forceNodes` for the actuator points and :samp:`velNodes` (velocity nodes) for the Aerodyn points. The following piece of code illustrates how one can use the C++ API to implement a strongly coupled FSI scheme with "outer" iterations for actuator line applications. This sample piece of code sets the velocity at the :samp:`velNodes` and access the coordinates and the lumped forces at the :samp:`forceNodes`. .. code-block:: c++ @@ -96,6 +98,7 @@ OpenFAST uses different spatial meshes for the various modules :cite:`fastv8ModF :maxdepth: 1 api.rst + zrefs.rst Implementation diff --git a/docs/source/dev/cppapi/zrefs.rst b/docs/source/dev/cppapi/zrefs.rst new file mode 100644 index 0000000000..3e5b907356 --- /dev/null +++ b/docs/source/dev/cppapi/zrefs.rst @@ -0,0 +1,8 @@ +.. only:: html + + References + ---------- + +.. bibliography:: bibliography.bib + :labelprefix: cpp- + diff --git a/docs/source/zrefs.rst b/docs/source/zrefs.rst deleted file mode 100644 index 0bacbc412e..0000000000 --- a/docs/source/zrefs.rst +++ /dev/null @@ -1,6 +0,0 @@ -.. only:: html - - References - ---------- - -.. bibliography:: ../_static/references.bib From 111c3b3d74499b7b785fc9b532502836c39b1478 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 15 Dec 2023 14:58:34 -0700 Subject: [PATCH 131/232] cpp docs: convert pdf images to png --- .../files/actuatorLine_illustrationViz.png | Bin 0 -> 81706 bytes .../dev/cppapi/files/css_actuatorline.png | Bin 0 -> 10902 bytes docs/source/dev/cppapi/index.rst | 4 ++-- 3 files changed, 2 insertions(+), 2 deletions(-) create mode 100644 docs/source/dev/cppapi/files/actuatorLine_illustrationViz.png create mode 100644 docs/source/dev/cppapi/files/css_actuatorline.png diff --git a/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.png b/docs/source/dev/cppapi/files/actuatorLine_illustrationViz.png new file mode 100644 index 0000000000000000000000000000000000000000..3efc1e2598f89afd25d083a65edc394f6732a8d8 GIT binary patch literal 81706 zcmYJa1y~gA`vyvPH%PN|Er>`70!u8-(xEg`N-8N`OS5$6Qqqmm9U_8+gfuAKEqI3S z_dn+hv$NN=%goOEzE9lu{X7HL(oiDAqr*c%K_P@HLtrQ<=o~00sCGD5z$b;bN7%p{ zvz0PT9R(5zn9{Oqcm_j3KSx%>$R|d@9FnsE=M3n=FN9rTq?MFY@rV|yV2nX zHSu}SyE^1~uJUu=qr>)_>X*%uKd=h5w+;|JrQvZnz7MI)`Q8{j;QosXK`ZRNKm`m!HVyBQzV81vW-J2-RF4pn6UX|O zpR4KTN)}Y@m-yUCk-`@KdE52Q?1z z9j;AAJ27)yU;Ej7ZF*s3+I}vRi*0Wn@yG6yXgr6}`K><~2IB$4 zdjGp+@QId>W$&=E|M%7aBiyLLiFzxN8RG$0C`+|>^I56lTexx8wbK2z$-K?ntT@wH znQL7I4;$G_Zkyu&`{iKEzv^u?sN9UoA1-9;G4*yonUAuItf-hcm#2F`8P+HneqXRW zWi_}Qwxm@MPj?x?FOpTf!J?bXTx8r@Y?0#l&int*U_R4^k{ZVo7TSreO}Fh)IhZbP z6l*~O{45&I1$40%CFq+DMX&JFQ!)78oIr5n?odHvSb8C`2K&hA#+Ze1b?YKD%*du%!$02 zCURHVS+f!DjLs}>WCh(_(;?W%5|;c#&a-t=8rj9|RNQ6|e_j|o6-H3_T8@tYZ!Gyt z3z1N9as(_&|Jz+5C~rwtGp=};ghIg$@%3DzJO*kYAxDim-q&N2M{A&;TcD_d2T>l( ziBUtyOR=#L{I}_l@AemG6E7pls%NVv=KiFeYan58JC+H*(7bvrgs? zOMKxKj`s+yZf|5q+loG95kZi>uruD3`s~1jsdUt{BQcev?QDyTZ$?iQncLb zXs3w=Cn%rtwG$n*tQ$E&P!!<>j$yb+3mn#~NO_5n@WTJvx_O$UEK`9%pplWiYG+m= z6Jj48f*4w6eAE*LKW=Iq6ar_yEZ_oMXwVQZmcg{0fHrTV3I~-d za+h015Q#e@=K`{!yM$14bCV=;aj|6JVE=Q&UX=e|xGF60iyZMvM7VK)kW;4R;yq)e z6ygU^L^f9#iTNq87%kA4H5M{WdwpVnP9D5ny1oSl3@{ivBfqr%5XaDqDl4I0MqLXWxlUKiO@m0*aG>M~R6k2GiqS5~Xwn3_8 z<1Qes_5Llqk~S@>8FKWn=|?o{Hc5eHAPJ^UZv4|xGa5K-$J$_=mX!3%yxcSJKNGMx zwfGAk31tHzS=ca*f^%iL^bSl+`#nu&M2)Rm=p&nBROc+Nc z)2mp7lXjzg(Pl^D4adDneHMh&e{s|L)c;@JX5xP6-h=3#5f_MBp=Vf%w;y2J>KV2-6Q|jFi*6m!Su^qyedN zvqmqzv=+8);z9p1^L|7gYR^!Q{2M^7kZarz(AKw**2oJ}mL4b|YOGhB+}$9y#N;Mb z=fQtFc{^MCU%S%P#ExD+I_Qn%T=lD;jrK`pPCrW2e>OR$S>~B`1^m3C>eIz4NS-R{ zx}ISDrnOH=;Sek}qAc{~4`Y{MR&_!@xUVauWaTUv5+Rir*QkK1#h9$wsGiIzqw{)| z2@yHW&dR~_ZBNd-40fk0G;_uF5;e1kAExc^RJ_Q{X(B{{JB5*2e>P%Deq(W(D&MJM z4_nQMv-FE`A*~sBwVPmhIcv;_3tUKp@3;?S=qtLX1Iq^efn=r-Wk|I77*T&i~ zGVK|C-ae#_FWb<3(9s;jj2~yuq++!boX#9}Fb)03Y9(=k-F7KV#%mA88G_3=dLbrU zO}EFGuMO6aQ1V0{*M-+uME&X4bKOBtX)tQ~mlSUd>NN*dqy5TniXD@gbo8;%u|pEk z-^4gZSev=gF|4VwrkyX?wv){r=OUwzcXvE7?gI@pyF$LC@#)@6lGy(gk@HEgFgH*4 zI`)$K+3L#n;b@r<Qy_hir<+%y$1C5yY3S>&|4+wWxoB zzZmUoS?*pIk3@$^F-0sr`y?wYRmGKz*? z62N`q*}S%gg}%0x#xe-g(3H?DEG&FqUM51Zb9PoTF?oVwK9PP5i7QKB)_u zdnv*}>Y1DquN<0K96jkT-pCo2tdVmh6*b4Pk*g(qH${TVY?62^p=u+08}Vx4k0!Rn z@!uXK_lBNZ{%b)&a*G2^`6 zSh(Ml%-C8E z8SWcA=zVCU>67>3PY;s`42nH^E*@n44p%(aZfcwd^6u}6q}mSt1&ulMFqm{D3Y~Wz z1Vl@=+@oK9+;evQZSa6EIG~P7_v(24HAnJ! z2#wHVn&dEbsrv|3;kFjS8EH*Obh^iHttkZ8!pUvc^K@AinBR#hqxRx6Rwj92qGGa3 z;a~^GKQF~#7P-MB4bC{=#wD*l#m!-x`AC5O0^|4&Fye z;vo1r)O=x@JB4zih2h&t1sr^B)iXemu9a?EcILkNTtCC)y@ za{Ckw0;BVGO`vY_um@YOvqcOdzAd9CcWZkQ2#f>O*uTP-i!waf)?s~#-^YBXaSohpW*!I z3^=n+r}+Ne`*mhdo$3*%&w6pjWC+JD(>)P^*N4aHYi0<6_$=EK`#kc3Jlrkvw`4pi z*1jX4ol+2FKPGRTn~X4&AZS>H5ArWTjZ8LqdF&=d8COG;mDQleMfNnlhIi2FH>h5VeB*4H|Hxyl7RuYTSu_* zuG16ZwZz3ai(h%peL+XgLrj+p-7WqXce)+ZH4tL~Dcwq=1}p{!23Gg#O%|)O?eVtP z5Wq#bgD)>XI4w5w+bD`s3W2}JcRh@X`mKf#ul8Uwjg}q#`4c#|H-0_0aT19WeLSEg zJsg{^rq4eT$_f%EAsRTP-_{D@3kRp$#e`<0TmG~xOIF1}EHREDqWDVePIFJiP4U;lzUx$lRcdYd&o}bxBD*Sa zGoqk|;U%G?1cI~%ies#-V8m_mti0B8?XBo^O(*3|@Z)mQGzOEP0omz=?VLj!qEP7Zhd)cibd&0H3%0Q4a0*ev`c%wI=9 zQDwB-NmcOV`)+$e(FX;b#3#zE>$-!q$^GiBUPP;2fn+2qvg8GYI0+owQ~o1$?EN9i zxFL~T!wJMJLbBUlB#AU!$uRA_71jRSB4;7!;c(v7%SCID6W7-kZa5JVBy(PyEnPI zx_agv$1~7~)`T3Wi5D0Hkb|fbQ=6Mbot9b?NmE<{r7dBX#ny#(P&}u4Wb&1~jwhlc zZ#H%$vM1R*|SVCJjmGjVHGO3B5=)5PX!HLwu=`dAl{vT z;s=g(3Dy+(cWNrA@(+jJ`w5TKBLRP%nA>WSORm7YM^XLu9=dknQ|Ej2ZhxT(|L*c2 zWWcg#uIu5w)b(lzayb%;d(c&#l$cB*-(Q%35M}|*6O9%6*ke?I>`CvkLC@GQC|0N5 zt5BJqJU9Ius5}yJyei1dTs{F=GLWMvBO4(}))7C5YOL{y54)cc;Wnzt@KxMJ>yv&fA;qJ zW~&yzPfZC6xcf*k@|ktgcioITAAgr8E+{F%%KP{C_vFF?4_Xy8MsTI%~NGznccC_Z0-^~Bj#*1@O12yFS0SQ8?bMf}JMk34d5F83n9ab;iw`^`d z(n!+OrVzB4d^QflLY9wo2)vx1T-epcq>)CR9n@EEGv;!4&=SA+S1FFZ$JzhviPLgB ztx3x}1tle=QG?p5Dt?>Ofdt8EICP#IK_AA~Cw+Xi4G!nbpjaP>ZP%t>Cy#$ z&V(FGBX^ilIA;P;M3CBRD8VAAq=}@mzU;Be!Ihv9sG?+fvqC*~p;dE2K=~o{NOkM? z&vTji6WPkIK06gd7GijsS&R-xm+#_gd1)z|l@$nKkN*8( z|7XzbtiB@5E%da;aXtwl<;Q|I@6oOd{bp+d>F8MZ!V87e#o`5NlOrnhc||tUtjt^>Sy7Bl4COQybw$V!%%bBZBTHSr3It;`lXOQa<2}!vo<|vZ%05CXHq9(2 z7rqO%Wze?6e<_-$a$7Ml624D~uzS5ZtXn=vY< zU!R}-CfRXKo4NKB&I4mJ34-K_#tNF6o^8?Rfw&(NN+Lz7CcETjAEu@vO!!c{WmH+U z&`6$DUZ9?ov~cQq7CkJ&yJB^N1w2D$&kw_Zl-;i$%d|W&5HX4qJ&JuNp+g%zYkd)8 znc1K|q%b%c?Qy|pt4vV)n+SbyM*$Fa9P8}IKzQ*UOhaH;Z_V9#I%kGCw8g|-XQ+%w z2Ex9`^XHF=V54Fy!)|ywUG4Ek_PCI#AcF>e+6X86P;Lua?Oo0d8UaTRb~}M{CMX#p z)Xd&!l!*9#;k8}dT?7m%Wa+-LXOufi-W zt$<1TS!abU#i*%b1v}J)BzZH_(5M9U^z=;M0o>!!av0+|-z1fG|1_Le5=(Y~Jt9;F z$q(khn7&S{Vr{(PdXXW*-ZpAz2Sa=kgbM(UKdHqAQu)XXj#eQf4YE(w#h2?r?iDYP z1)a4`gH+WZ%&g4za~W1x+dHy%iHt!2L0_a7Se&IA0>vs{>suPIXI!9N38tYNv^LuLGaN$ zEc(KO6TPcxf?}c~0SkUaUO-TP9BT91#nd#TMQcbVuomjj`Mac;h8=wYTa$`V$m$gf z+(7|pYY4xxG$Y1oWVcV^<6-8Nt54i#JLfOZl`~F&DhGOf5fOqSNO#U$f}k0Vd>7(E zrK=4tX2O0*WR6WfOPt=k+&j)qgM#l*d4sgelkiCuo8o10^p=*+4{~T9(ot5q**FNy zBXF^>asZ(2o#YK8N`2~G*w$tQ(Gqp~8CYe~B1|p_dc=E}cFEBtASH_^6_s-bWr{|& z@&`AK9W*xtE1PLWHg#k4)rN2*LwSG#hw;eg)*Z?`5EmMn9C;oK9d`W!N#yP(F0P)} zZcT|1Rq2+N#Db>CW}#z2eXPj8HsvH2o>;->qOuN0DYxXZUmfhTXmYM)VjhF^24R7b zjx_VgQGjrry$T{9U=HSwh5|%{X6F@Y3z6D^m#*q<9QfQLN`ogND|FN_*2z#Vc1B%R zmf$NXOx8r4$R3<;b}Gs4+<7GBGLb(q@JUE1G9TzUnJigZ&shp+ZB2x2bSnw9r$dz^ z;q-0!^>6hS>_e+B>F9WQF3OBU{FpCWCi%=@C6%Fy#)VWns_&#vR)T8rCn9m>;Uv)m z$GgiNE^Rr6t>&all$3zx9Ax1qgxlqBVq#MFW`c2lx#NlBY-LZ9rnC_W+H+EEDNA7^ zVDc{jsn3Mlzt*Wes$U$t8#BzROPfSROY2+1NQ`4xoJh z{(bs$XH@-4OLpY9&6z=V^gf~LQ5|%8sPt3+Ln-1NOQY)?*@U0SPM`cr}=tJ zNzX&RCgqK&Uh<@J4VBRz4^`c?q8@|j*s`? zbpG^NFuorm`8yIbY@TNCtem= zhVXy}M73`OF2`@OBj}Xv?jr;)HgA|GjU6B%PykaASh%?0a5UgP_r-SEnWAhz8QeS8 z)hj3{AXQBj=&R7HDl0D!>*+=W3#&;J5D{5g_dhR>#3dmnt9AeVE!pZXFeDZJsn&wp ze(Q=PM0?t6G#Emt5#gN{ECY2=dk-Vy6fkXPSVQTxn9UYHp4JE%aS9u;jCEAyf|DnQ zp83G6(3I6%V8J+%QHH#%&xR0}DGt)p!%Cv8iA{_W1>C^~sfRXdDp6Ig-*@MV9QjbM zg_ljjM`E#=d~km3?jG+yomihP*P%HlVx`(7#S0Sxi(y0$5GZLfRlnNnJ+T@(9$JwJ z^FG_Qc)v&YHLHu{{riiUVz3&Wn$z6X{^Oz`*i~z-hT?QBM@QmL#;gi)2ReF27bZKj ztd$#XQuEcuM_$>!V?V1RP*>&I)t9JaVMiPK(A%?9p=_^mU0f16XhvZvL;7;PSb%Vk z7eqn3KpylLemm{k^Q6ieGE1*E{c>@ON9(z|TdHK)VHBVGd4gmWT@3^ih;zu`A3Ko6 zk5>f;op;|C7o(F(HP*J$%myD?RtArUaV&#`FhW=e2#9*DMS5);3V+)Q#xY7pjYi># zh>mwJG_{z|pHd!sRhSEBsC0m^u*UO~gQ+Vjp#|SQEKJVN!@qs|=9;l5xpG7FEk_dj z(@fO+z1g*8-y?>VfmD<*77pasKh>^>^{yUiS*2WYhlpyQ@fO%7NOhAx@rDW`?l7Yu zkeg){H|;uGWG+gw^$d5tS0~5}8k}$pMHEabLCRsU8nDtN_0k5{#yx}A9b|O*AAhfLUaQh!6Yn@l^*jLN$#NpxL$FnBRMPI%= z@x9#d*&0hDB?u#dD+;Zj_1TGZuhkaa`4DU5Nra7#;sLS-@sGXT+7Ac(c1{k#T^y!Gf?DB+tvXlO=M55W2v_8Y0>7K3+9% zme{~hB(dOyLh2=|@ztBioXg}ok`sm*1j@tFtK2MZ5DAvw(yqRWpuI!7KE87`x)|4J&I5vOn*_hkk?DUrK5k8POQ!tm<)%(msG)s@oPl1&bQlx!; ze!jXp!)w^-H<0|TqZ{lGfN}44Pq)V%gGQ`-Tbcu&5E2q1sXlT2pRNjM2!P(w%xy81 zA|sT+=g*Ew{gFQB*NigU*q7arpL-`TG#Mlbl1Jl&Mh@42jQB*?&~SPux!zq~^f)xJ zDWd9NxU}*9pd&9XvWNHnPt2Q_t+n^QwOf2lOb+iZjn>mskAy zUW}>D!u(xUpOz*nW<};gl3vUO<%ff#OT%xh*S;5&x(0LRGrRg~S)#A3bDP|@@G4E) z(1Ko~q}79TCQcRZptaU%MzFXNoo`bUyzF78NiFkI$xJXaHmUxZWg8q_5W5GY`>KuA2_xUD$K zk<|lUp&NcZ67x55#F~Y@A~tGMht)uz3&v_vGZV_|{*3^}di*5OIZ5<{>=q6hQRN%7 zGB?M;vO*D30b7;eyNytAv*Vih*FF7W`kJ)LnC#`E?5n+=hHP}REtN<-#948|_=STa zp0eWR9+zGDJV#$LI+Ehew`^2o_eJjObZoU+Lw*{X<8|Y?XNF&?eja?_Gi)WPs@em0 zR1-b5{Tlk~-O##1bgkDUtKUhqS@-ZT&LxvrAa!m4YUxDwVA)E%Azyf%InF)$Yr`sA zz#7)3kg7i$ek-Wui8A0*3G^ZbrQQNQK6e)2Obbu3gonVkTOj1cIXLj%0%v5a8Uu-$Fl-2MA3h=lbv3nwOSz3an0NvTFoKc~!v zk#23}Ie`K;ceS2c20)f50Yx%*8cwbH$4Zz~8Fy08ROHQ7rPa2qid#%K`zb?WrVD$0 z%TN;sZXRh6FbAt2zN~o|1j2~gyF+=U?YChKIoLW8rgA^LmC3?-(Q8xdAR9LPYDb36 z7F+LHEOXqE?)EuKd&U%!d;4Vz3MH^Tikk#7o6}KcT=|`sI6W)(_j4}m{kZKnvnF2m z7ju)pei0T4Jv==;Q(8NV?*)PckQsJ7x{sI!faqz_A`=3{SF6c&_H;>4#?0T%z`ElB zCe$56`}DYn*dOKN$B&PfIoWlrS=*iY^ryp{{9zJhFqnl#j3_%OKjejhH&PWvnX{Q=!#^uLu(s4vsU}t&ZNSy{A5G-5~nAW%d^{jzKaUU}x=rPkF`Mw+SrkxVT~+brB^- zqMtA|O3^>wqqlmLlXE2DQc|Ya*=IzU%&vq#hSZitZ3BY{^(@gfd8S(u0H((=$;7?z zU6^z&Mt?Q;Ina(GQJF$s-jy)6?_Jp9f!h4_9XhIEB~?24T7>gbYh1uxOF&OJ;n4s# zlUHOIyDb+zhKyF7A;oha9~FL5dDMcubTt(6>c2z0g=X;FDy~K|_90Qk$3Xe&9LPOTN)0Q!bvV5znX(-Ry`zEUBn(GnT^Xu=OHDT zTWtWlQu@g@hn+XyzF2ye_7`O8B z)Y*<3R~pvg>CHT=op&Zf-2Z~P4?RN;Mw{4(n~%nc@P;iJ#nC` zFGA@r%?YM?Q@Zw6dFT&|zJ$5xQva4G_xJZ+t344~1_oxkZ>`f;m6@DNw$p0A*ErV8 zF$ra$6c?BIvv2I|S3@t+u2YH^BJWj%)mxe4dfA0h*$P|as<72#Q$%M@?-WspP~L>j z?_&t1lSxn@s3J8f0iNj#|^^H@Jw!w-nJM6@0dj2%<9bF6AnO)|^Vp`?TSwMLXQo^w1*y+)@&k=*X@C&|IV?$=KhKqP)#)-LD-a4N)xpoOh?ma2oA+-Ar~k`*Z+j+Yi2)${1$z^ z|GO(NHT5P*8bQ`~ZOQXX6Of^k7P>HKJehzd7?miGkhG~#)rEx3NrPi?HnOySk?7I$ z=o6{i+dGRoW6}-OFG&$!3MGEU4ssJnx@UefdUN`5T~`4@Sw?5mWq0HG>LAt)Clt>6$cj3$zRcSu-J>xhm-uWa7{`ov3b1 z0s>fQpT*w~S4lKQIl(?A^QfWlxg*NUVkaoy%3R&ihO)>{K`4@jnG!Agh=^yl zs0PgppHi>Ar+}ENCgNJp;@@fUeE&WoHaG_Prg8LR+WX~@78aN;ws!F#@w@aGR#_3MtP4qvl@ zFGroxNt~L!dkmpHb`WN8_)BwwP!d1}YBeRg{_AhL_c{FeWk+~Lg+rxb8=f8`adk#a zq@tB;K&m0Zq@fz9W`shY~+WREf#f&(@~C*fMaK8rzJE)>wP-ut0T(opH43f0%>w zkv0NoJzzd6UV0+x>;BeI7-}7qi~>&uI$Ep>(J1EC`JUUqr5+FqSB`Q)2}5@gAlfxn zFY>Tg^gyt@u=;H|ilj6a5%{dOX|2{)yZ|;Lj56+kL>D%`6R)1=)^c*8k1%r26bg8d z%a#maT+_lyhCx{Uul@W;4Jl8!><6+D+CA+ zM-pj+t*C_)Uu2N1V0idF>p$K&HZYwSK={ORh+1C}{d`O1@#<)xdzGYp+2Z{CvS82W zx%BLi^t?8-4V%X-H%V`TTGRaXayOR3NqauDyheG_i^~6!| z?|$#)zs8wDAdDtve=A2uDHzw2QYr8X(yBu%UJsfQ^I#}QFj6My%k@WRS$2gG*o05` zZ$G_0FO?1hGVlJ!3q8}%9<+BW{!iH0*iZ^-0Ih)rzpzH|aPwV@36N+Xxo%$s5x{9J z78>n=Bpi=aO?xCrkL)N2o3R_6SPG?UCI0O9#Kz5Uvu+arcq}hJM#5vMcrC7&L{ga; zMf6H4{H1rCd{j?M)IZ6-eM|U~`w_3;MQp50q7+UxQVrONSSngE^d@pq@f+inj$y`; z&`bEy0NQK>TgF&akSu2jUimLT^#mGBBDc4#6#=}no` z&1wd*N!5lco1XZeT=j}_|Mnc86P7nX%k+t$5NE+ywLdKvg{p%iw~jT!94oPFb)>htt_{K7@4Qr za~d(jDt!R>6A<~ho~&c;FJAHNe~{c3X?e^lhOI876`vey9cFkcjhpcL`ufB^ZWDaV zlZ?MiTXZcyBLip_4@F&o2uj?BxoF0!$Ab3S2TMhr7bwBGSsllBN*j~ZypfR*v0BD#YU^-(WD>s)iO(uUyET)FK|&g zR14fDc~x!fk;#{S%|x*7GU%wlbUBa?Hg4{3Xnki2eJV}+QpY5mu6gg!*8($PUcj-&bFg5u%f z=pT`48Xwk>YksojOvTLgr++JHoXE@my^BWy^k?VCyX0d*)M*h8o#5n{r+7Oih0~fN zIJsQsBZ}eHB2u~=MOHjIzt0Fmro@DV(w%A-a&Z44Fo=gE%P0bLbKLS%tv^s_e!xX0 zK0Q$x3p*!wOZim-Iy-5v^iH2*HroEaoBf)PiFoJwv)WMOQniHo(0OKzO{2k&60NQJ zO+$yJ&|ykpa18k)N(L(S2H&;Jq6Y^#01vj8&J$j6T_cK7y9 z9a(j1o+)v&GF$-XlJ`Tdx2Kwf9`EAq9 zNe~GynYA2TqtJk$O87)njT?qWF*8(5pbV83ruwz^s%WFlc7+Tn6v?qdb|aoN9r!YJ zClW{FvMIEW<$S3Xw_yfP1vQC1)aT1n*ICs~A(kBs4p);ckSb{sc_s)KcE_Mx_>wep zU1CJ1{QETTymXT~5BzUvi5ab=W=c(xrPoR_idNWbcW&-_4$bN77LZd3oDVu;&UlyK zjP0h~h}gg@vcnBwv5rA4bGsqnyc70W?g6&}$a7)Qtk=+m;Q6~t3v(A5%6HTnITDx= zeQ~?HbYC-m#3-ny78Z1(sz0>_7-R3j2LNHF7&bYu%N2m-3Ydu)Btjnn0H9vG-i)$` zl1sAyxQaQnf4qub^!$=={WkWAn1_o@uJt|uqwE(UN{rqF zRgSY7qnyhG13}-_5?qpwI-v*zP^l^cK-cto4DTj<#QMgKCLR(MmTmB!o}rUH^EPtD z@d}faE$86H-9!4gEzP*?`4w@mUA_4`)fZFq8dK8jClk5=B3KK4${57i$a!Le#EsJ8 zK@OW1qBn-d+UXOJgjqdhuZXaifqIMsu9Ps4D*Mzui- zzkV4hlepMV@M!>ux*uy7E4{2%_G;%VA7|TmdtAx$Q5dp4_LGXooj8jeuym2gIldVZ z?!{3m5;`X)cwBR$FN8CCl&xMTX#UrIN9&VA(lG#_qyF%vW7^~!7?qi|j{L8$H_+vZ zlAw|e%FDv(l$?WVewIiX`#!+ZwNp7s{w6C5a$h2Px^h3gnt=ZT|goF!S6Q|Q}$jAdD zN0fKNlF9uLUdlNuO$hRrOtPfSnof~^-h=7$vhI~hqlvt3>x7ubd1bFqabrpx%e0iA z#S|g^Z_pIgXjDR6#9{!=J6q~K9?+>E=6_Bj@ZmMa#2NP)l^o7j4)U*5z$^-+lWQC* z7U5o8T$GjPguid8RC=%X%yv9CiCN55X&tyk=Yzio{b9HJ#EXc|&exCCt`mA0({;|^ zZcCv)+t>&qtb$h84(eoBtEq;reyatzKWBj(i4)#SLr>rP$B<;r1@hsQZ38Y~nE>J% zpzdm={iNSizkf_X3*;_I|Jx*{qNexH0ELePFI>oKTg~t9MqYYtNubQ_Wc=}zs^FSV z-YvzWs^GVyYL;1FjKM{1+1to&G^owSVcf_Le-0eV1I}1DaM4(pIZ#kFH*ug6yne=x z2oTThFfMb=3wYX_Lu3i(7G9`Qb7dg*ZT7^;2Glm{rFr0AWwj6EhE#23qDE{cK<}D^`9zV(FH{Sv^v4QOE zwsdiKs#JkjM5SZ6K&g^00I2uu{`C=+?o!F^KbS2)|2wOt>UFc zEr_!S26_Np>o_UzFO8$ILC6MC2?T4}^uvTjhs#+cl&1C+tFXblF}ovZIiCiT=Pa zAw?>vIYhw5F^G2S{Xx2`d^u2Dpm-~ z#l20#JgiNf(f^Od^}Rm<5y9%}TA!HLDl?GvBdeXUK6|%M!aQRPUVJ{Xw`1$kvWw=Z1h9B2d*Di%=H#o+3+PQ=?htaY8b!1 z1xr{v|4bpwW-l%FxOj7>yl!$zYH`|_^#l7N{C1=<$eNG6^osl8?FcyT&p`)VFyLkk zoQ1=~%L{g#bxQwgTWREr@8IY#DeNpQ76){-p|W5Awg&7CwiAOzfRG93fZwvkLmXed z^4i)mZ~-Xkqe>@6HjwWrhSaW09|vc|l$E)xO>K<ezQy~&Yf z3dMEh?s*v?qo{Pxs=fk|otpdzfQ6W35b#9M*R@w>OjVui4jY>}Td&?m@!i)eZm3*a zS*M4L#A;Hsq=5D<*WI;ZVy?kd^Z+n67cp5auYks;NM~`@fBpdhRbz<5d6n!~&wPz9 zUc%~28hY@7L?6P+&b^LarImze)0jjx_)up#9<~1tsnja<2``dRwsgri9EyHLe~y?? zH0?*re_7UbJBhN;r+RwCD_R}jJZk=f?xn5S$3!o%YdlGaWlp)aC(N{Vt89VBnbz|R zwwo_fA|f$$-9JM?945_9J=^11b*>wO0J9b4(qc@4AM?IqCa*?QGdRD9tazVkLTMv= z^5(+TWK-J(i%9*)9tPVF3|y6Ptnk%;JEk1aLI}i6<#Zv*qr)(SOmIS^58qS2={lYVQTIIO+60#}jdWlWq2*Q!kCY=20cPu=c3X0K%RGTjkHSJmbHiXoO zfSk?u>N5eSW={ADQ}-XcB~MT_yU@nz%sW8o$Og(4L=l8k(U<~hPu#afta^GC?ChN6 z0GSFf#U59Bsg#ssUHx@H66N#CRRYuW18w4fyh7Q2Jr(^}#mLD?11c4;xZRGAAz(Tn z*{?rv+ct1lBe%W1A{4cB4uS@p6wmfKFhXRnm4;T&;#p}3qD6i{L;Fb2iM@pWFesX> zxQqG!#bEq+uI+am6k#r!rP{GYU_-Fu>}t9Zfop%!0Cd#>Rb@?kB~Nh*p&m;rwGx6O zpWm~;I_+Wygekp=KS?nH><5{%!2)9MJ#+pmBwC;;`sir;3!=^35~)j3}vbp(4D<3Mi9vB9^!z=Xlg-L z3cQUl>enwP#u@1!+x;U7)<_A6(V0Pvy=f$XqMY63Lh9Ug&w;ZB;PNn)c>i}C`z2?)RrZ}q2Vy+{bcgoO8pA_FMs-vk~LzuB2$Pk-j9zk7xp zGpKW3*=xO8zOokUe+uRbqGGeX7c(Di+D?|Tlj-wd<|OSH$y+`4hOewJ7I>4QJ!Z8Rg3q24#(UT?t8cL>EL^?jspZ?k)0!TGImQ9w%2O>Y6MEQ)`X;i5M2TRnS)VcpA zK1pKwCq~K9T2X-}kcJ+z%n}oa)qO@G#Wdj39}fsu1d43g8c$3$uz`s!(X1J)oL6r> z>b!HE=(y@Jk71HD)!=jzH7RdNwdiHhu@auF1)fd;I<_QFT!Lhy&`6TjZ&N93+hM@b z<-l8EV@e|YD{g~UnriW9W#5#9>3=^+KNn}LJ{@nzV299Xh%K}Jz?6R-&6PA*Ad*M*Y%I6E^vX6dYs=O?4QzLUS+6TW!vZ0Yqg0;od+^$nnuD7vT) zNUERaK3j;=o=ingglvdC^3dH(<4U71L{tr!GtZiUY?P)$7XzH5#YOPt7ZyNQEy^1t z1A$JF0v4w5h>rl_s$HxqtMJ$e`<>Sl`{dU(P@xT3SglNl5)i~(gW>W1KHMPnVOb~2#LDAm7;_wObH0fo%b!yh@E;?CgGmMQpYOz{H>YSXaJZ1~!g(ucbLEZ4~b58c2oe38KKaJz3`!LqJvy_nhJAIb2k`1%`nepoatn5Wp$5n!PMJ0Mhi|M?RI<>&QJ zE1;u0V&Zq-e8U^p-D&Rql`bX#3l48g<2`KRaQ+YzI2$%%UaB zzVM>Z0fd86QPB@4f(;;jC@2wqL@kTBd4j+cWwJa+x*~*y*CQsLHFkl5b(&<>hW41(Efp>Ds@Wa6v|jlY&{q2pq4W!^k!)L zhE&v@zLaI>(?(5I<{F5ci0Ce3vW>=^?53%3EJ26!^(Na+W`h2zL%touL(0D&L0YMV zWa0nJu9Ho_edYb7`7K%XwN8TGC)S36j13%It;?~b#juf-Uw^t#>lMK|IT}V9zqWM| zQlg&=qj9(Mzs5xuKybq3u3P^7>ss%<@f5OBB(K!R-`#rxlmv;B=3|=nX8RoK@(b#4 zIg+?HMqB}H7cjr?fcY_9ci*jD#Rvbkf`ejS(@S{ZqzSz0MUJHbjck@4fQqRKvTjVb zc$Q^Rm%ipEj*4=BA98$$UXEi*c=3ZIYtYI=Byf#Xrgseo&^|2d(uXfs-nA6jEK8A~ zg%(kK@%%^i`&-@+P~clV(M|EmqUE4LuvF`Gt&p!m6X*5@Qu$4eH}Z5>wZEUmUd2neyb>}&7QNgjOE2xmv}P1P1>O|xC%~@7vqiNEu~Fj zNl9AYgImZk(-T>B?}a#@qXAe9=&K{h8pn$xX)e<_2*Jfe_X{_S^L(^G?RnIZjer;L%JJLTBIAKq(mC-I^Vt5=lI8ZguVCLbB;O2JI{W!pU{w_ZG?h)`Fn2m z@87?B%Ebe?IZ*ms@;e{6=zXNa!hAvX-EY&>W4sYGV;=r(M?y9fT}0iyS@?7#-iI8h zW)&ye?JIFN7kh6iV+C7ze?L2<)$e~( zSdcI@atxX)+u$**RLcD3w64bJMqZ9-M)_#WuZowQE#IZ;^Ev#nEOB>DtwGInt`i?Iv4Od7fI!ug{Zy#gh&HL(0l;I#i zs)~@I@!YuCJNtCvL)L4C@+y@>hDH+{`V!2tY=je#l<9?t*X{ zA{T#8T&_f~Hgi9&27ms1pyfo{ZzU}v=FAeHMu#i;B;j9Cq9wzlhl-9~i7AMiyqO!v z07_oh58j+}y{~?V%RrJBLJS&gEOy69sB+*WvJC0c%kTdhLDLkWa{4MpRHyQRl}OJ5 zDhXvx;*%T_KW3OUDHjwwD#i=CNGnk{2(RkOj5M@zG)=xQjOIwGyHJ177t|4 z_4j#qT~x?Tw)gACi!w_|w>91r-8&O+z4l-IOaUE2rL_wod*ei3*4{-Cfv_Kz}z3gkb42 zs~8(Rfw=xA`*}%}Ui+FZv@dh;WiycnS)@8%pKBd%(14k9{r=`XXtS72ags)2d2|in zPA0joiQ_X=+&z?-;VmW2*ihnlHevDAzA#^Ej#TQIcyfq=ef-b41bnn%~w36YCr(9}NKX^`TD5d12K+Ymwx!TWi z%WyEfTi6-%C2y@ow!Re};d-{=CRAtE3lHhJy*$K;9^@jQXo=7+Q!4;7%{LRdgPFW< zpulfebtp#@MT88dN<5in&BmaJ80eKomPC=1esBYhA)_u=Owf`S))B`bA(X0rkyHIZ z4-RFy`=ZkuIhVap9zbD!LE^gNwf6};u{4694w2;|#z*9(w!SkScTL@ni#)bWLXX;b zos=%(eXl$;<-^9v^hHfh-Z!5QsgK00Nl;S2@~7Bzs`5pagv?9CVp-xqRxhg549}7~ z>Qq?@jcK=t4ED?NDq@Vyfk?d5 zn=NYpkMI8Vo2{EQ8E(dhF+pQxT`m_tfR0a}&E}Wm%U=$<;4_~20s+i=dY*eM2ZDb` z%ZaETzh}W?HL@E=KRV?#MRHsmR@xUj?B8?@J0H%Xv8womN42>A*f{J2G@c-rh=9ny zd6OaNk%5-HUX36AO*zv+u@4ztwLXQ95yGR=zImK{JdKAks^I;uK)&5ohoe|Nd88U@ z23dHrK$A2=Lw8J}BFc;+4P=!TbA&^2rRcV$<>e{{1-+QhVfItRP^l2iyQ-(xZ_AZm zSct2f&W;RWGwHww9xARZpdXZ{JP+U6TucQ2d;CC{I|!0rR)!2752wyc!Z-@iD1^H! zOS4Jzh6M}+`Q8isqCoB#q@m3p=W?{5yI`~71y|q1^HDHI$O{)+GzzHj4~5Ei*u{WXxvNY^WLRjclVqb+U}<2 zs`{*}*lFs}yr+LX5?Jn|#WF{_!IEd`V*Ur~bGz=1E=OFl_r}k$9t~1~Piit2A{_4S zfm&$E`#cU`TV57zjo=VtB4w}>3LL!zzu(w6j*L?4bEBj)KN}DL3K<;TFYKvzl2L7K zLXe)AQil60b^jm*x)8wzQm)MlO9wWlbNYf58uCapGiMZuoKs+UG&14f2)~f zY|Y2q*E;xYk@h|6e3^BBlSAvvt!4+_R6JMymFZ;Ol7tMXl5!YoJUHMshs7Vc!Tc?_ zXgIF#ZQbVm%>}HZoRXyU5u=0*sMetL)@_xoyZt)rL+9+T27Sxbh691!KJy@xDdT+BaRA{Q6u`LW~Vo;O6MV17CgP5R)^VT zoa@G0&dC{x1kqgJ)p~52%>FFz$~>kty37{%wenD0&@eD@AU9 zheHO6oS(tN$o#58zLsg!e@ZdP1c%UTen!_xrU^k^WboXM}9}C`D5!Xl5qL z=!S-dTJ@wD~E6yG0Qt5loqAQfETL5Oh)S*ep%y>1mY^ z>9S7(C#OuBR*J>!?M=xOz4Wk{IPHi_adXt(u=LF_il3oET=xFi@}WUmd~VR*0Vkva zU6lCaSv(aY=v)N6kAQxQJT@%-AatY)xO6VSuXV=3K$5O#4l+lhxp}S1lM5F=(R?0;NjAB>90PJ-rQ=Qd z)k%Fp8cO?9!`<0c23WL2`mYNs%sEK$N)X9O6#~;n3_gp|7^t*vAIz+p@O(gXOeEQR zopK{efNWGQso+BxqsTi%OOr%hrGCJ`1QC;ciNdro?Tc8Cwp2D&Zsu1}6Hd1m;e6~W z>A&NnL^qhwUQTMP#Am16SeRg$O2&Y&|2A_bq_rVii5&?cm;qdOqjq=95Gc8zH$D-k z5#q$~Dd>>Fg@zA=$jQrZEhgwAYUcL!kl>Q6d;&6+^RHvBER0%%D%i#S)BWTN?1cpu zZd^!V7VErukN8;R0s%jN&i!h?YP$9c-P>?(;{rj6!U=!Scp7#2kU(ldoXgGKy%1P0 z)WvSBDw=Jk%{FaS&c||00$R}=hhEt};XXf~4iYthmWtsESD@oyg+qxifq2np`?b%k z-s+#?&I_Cj8~QP=6YT~xm0lj#7zNcPL~k6LO2upkRMpPyO{>T^3fA5_cwt)n-I^H+3_-B`5hf@I+wi2!8VsB-4f(Ms1R_8yx3v*YG1Mm;orx4` z?jtc>8g#YhPl-Ye%5435H^HxtcS=)bFysgLe))lvD}hN(dgwC_cqKIzv@+l9apbHH zk)vozaM+&~*1LxmniRf|0jL83vY=^j>QBfYd-oqn_-)tv?&K=a7 zzv`{g-Ty3)_Q4YolSU}Id~Z?WF%h$86=uqCAt2!U~$)39+pA?I<9^H4V>VTw*{AGo)NjI~3 z?^4cb_QFgZ6^uUxUnd1<-^YFV zFLv1_mL5(93uU9h7{S0jvx%gXBT0tN&QL+3#|06LB|(?OylJd*^s5emB0gNOoe0&S zdfn=gXRLqUc;?jbL3xZkOB#ulpDrZ-b3KpwW(vugQt^w#(N{_C2l*9e)0Div>PeQ? zX_0SUF)(ko={U8%mYz#~z4YOSXmq$|_41$3(;6YJW3#M7G6gCa+Hk>k zC?Gktesve+m*)oWOb&c@DHmG15#8DWjXWd60e9py!y&0Y1D z2b+u-aEAdam-)d3C|=+Oy78WdpMJsTmQf+XLa7`^Es%zVnEr5KXK>si!WRM92SlRx zg4^i$Ah5Rwe3dPQ$JG1}%ba zQe&`n07j5J=0b+L(1pNaIjE{kq$aWu!KaTcx(t8HmN=&uw0#5L>yol?LOU2p7IEMl z6>ta%E~>A~RHkXOXrlQe#KN!G)*^&ZDTJ@1s86<%tJLE@>gW2~U|?iPqToEwfjROo z59bjeuptI;N&-^Eo9oA`Ze&P4U#>U{X)HDP;G-cxkdVSbf^2F=IHKVsXSf~wloz|j z0TG)t???=7{OJ%##kq?BC4DjzPj}L0VJ&I0#Wn{snwyGAsg>C>m4-W%z8i`fL1%kX z4hT2c9y3a=N9*Y9k(KP!zwd;mx02>4ReRbO(G};Ql0IT&;3GP zCpN2Ib=ch7eh}8uG&aVBfK&w=C#v)UkV!0@C$lle36LZ65TYu$?Evr#2;EqeVnzq- z8MsVN7D)upVuoIQ4GFYmA)VO&Kz+tn-QJEI$jZ;<^uqyeYEn)Ox1SDe`#ecujLtB{ zEzvvf%E6GJ$=$G7Iq#p0-(S~GZAJ>$`M6qp;C;?eVOXC33I}A3bWYRW!Dv`r^1F2* zzHXh^Vu~0Hd~^LDZ*=n7+V(TV9KG)m;DDJnC@f4Mk~(DlHkM+!V<8ySdu04Zwcf}$ z(Q>t(qgvpf{B`_KCc_*6Vf%mEPID?j8T8)=;`1#wQ)kt72XJV*9e zaO_ohu2Qv_H4{x8UYZin+j3*igpWR?_=)JIpO_L}JeU)6g4xV{-qVFYWB}XBuUq`` zlgH^gNYnlehGMO(7<+DgZw5^{NVNxD5OG*~dLl9u;oMzOs$6oD#DWNPVO<@?%8Do` zVIcwb;OJjj34OR*>&yDtq+e%2kj7?=)UW_9h?yCbIF@d-VKzx=J>B1!%T?2HiN(nkH zJkoN(iBghR+PMzp$#_(hLAXwwmzVt7`!XlC4 zwzSj^A+^rE@N7o4RF^kDgijEmj9mUt9{%Ctq7RJFACRm`zW6vK$N=8P?Y$%zSnBBL zZ1e;MgORt(m9a-EIF&FUbOx(<@{v~1aByc<8@ET5mX-#MHvyy%Fu!o&RpUy8WvEE< zR@dVzC9iMs#u{2xV@T1yK#t}w@WH@GH0mqhq1~>*5LAq1;yJ;sd5v$N{BxX@IW@;$ zkpVqX@k<7|hK)8A8UH7y1m>ON=Xr-CSSvTd#f>fwoFoi{K-7yOU_D)aKT&8mr1I-I z7SKYrRzLoML+Op$`KGC@jSxJAqSv>O8(5Gd(Ll$dxGOM91cPdPbtHT5&WSUoZK>5* z9OXp;VPx@VCf&YQ8DRI!9UiGAYWnbjih(!iQDXBvsdAf6^j#3*cA+esOcs8G+({fdU>q3_P?DXVe#pLdzd$IP`jVVd8;up}tfKBR4a$ zt+KLd2zT@(KPSoynzug~`q~hssU-yPrA(h7W*_<~$z@8u!-s#*ddn%Vwn@tb@>DT} z3@ioyb_^Sd@5A(zlFNzFqsL~*H0|dO8ETG6IHA@LlPwlBP`XlTb7CjpOc(mMLPdNH_8ZN?MJ6>`a&0#kj1QdRx;Q2ySFM@0`u!}#8 zPMCeo=qc%vMgba!(T~PtA4_e#cdJK%W%ckt2;+BJ9cY-iN9Anp4hfAWw7fjf{ZG?* zdDmj~!^Ug`ImGI%+@_$4t)!py($Z3 z?P^ylA=wGjLY{ovKT;~6sqYdDWjLPqL(csez#Ltzj9V;#D*EGB#K^vf1bSSO_g^x- zD^4mLXk=60S9CDz8wxeiI!eyaX&JU`HSpEMAmLmlrW?_HcgiDfHOpX2c*|#KxEm$L zsb356Sau07cd)WT^nctl?Hf%l1DQuK4uprWh+ft%9@#oN4vuH?uDiB^8&A1Y1}Usk zAs1)!ANgpG^}_S51{h25SK9|x@c%}F!iIW?Sv`G-@#5#oRiC$KIo5P#i>QheBbCb} zUh>dgmDM3c?Na)?u@X#dLm!5Xbu9Rouf^IbC;<=wC0 zQ<(MzVkrG#nB|p~1E9>@aBnx~BF@M|?Jo|<$xJ5&^Xq4jUtl~2B2k~bCp5gFO3b3S z*B+WjT)kP@dw7Y_+mq_L!iBFa3u#*|g1-bKW9)Z0+j$ zV4G{Yx8}o~b9=FZ&JKJWFKvEg86N>uqmWoWON#t1siYy^`E?I+&3K-=lU;;e5u8N8o<%ZjE9YYG1R zc3W+QkzkrH{kcfTj$Ou5UDd{av!tXg70bFej+of37bGE^ovC(~-+k4eoScL#beoQ@ zZMVMPJN;(*h#O7#qyP4@xxj8{JjI_9paAH)(7^U4`U(zA9LxYsF(t z*4X&@>fP!UkCv7klQ<>bD|`WeML~fsbyt}}O$@9%oG!QL55B(THEu$K1Xwb0ip0cM z_eBuH!9-W}(!kqx{^!Uv(%^{UZP81d)MU5nMS>Rw_|`M7h3P`o-{O!%wMqgYgHyTS zPO%#PxOzbWgFA{$Y&FfBNONtpU=6&W1O2gl9Qh!Kw7P6=XX>;r?Z}v#Qle}CKPC~a zn0Q;wRsPn9=Il=$%hBl_{jUy!tM5(8Kp}#M6_OB?GYaEW0LzsK5I{;yaDx%I&a3ze z&eK(x%wOeSOfoH*xY?xAY0S1DB~L|ov9p)gP=>Y_()3ShJ)VA9+b}p|?uOS?yqc*o zfcyJa&$WHE&FY(EGT78(0jzF^PL%+sXP;>*Um|sUJLndBh5q}3cP-sgYQ9Ztqx4^1U_+q0TwV?GmuBbka*r7>YD})!kAxx>B)ws zM-t@A%8d_UL4FMnCOjGJX*A!_C3^W~wYQlG3JZrbO@uX>RZK8t7j#gRbTK2|1&+mx zbJh274T3?Lm9IRIwRL^Ylk;SN^X*UPl?li=jAw8M%dT5w&_yiG4EYB|{L$zIzHWeE z90sfdn%4iFv>A4 z$=Jtq(AAjhi=j5XIsJ7QwJC+O>jK%^}Y%3=C ztvE)1YEw^HcGUP?aNcakyW-knBIb)mTK6VK`zyntsP;Y{C5EDn*(9<}Zew7ep&){B zf}Hj7t}zGE_^!&uFFg~lXX+x40u)}`)RpgyVLl_E4wRUnAxKM7x%sF+8BG4|Ht@sG zK%F0ucsCFt%8qYYcqIRFCflmhQ20|~D=@O-kdpM91%&%sA-*RowZnaN61Pjl!~dRc z?o5ZbYmcZj1D8IE5AIJLyuCVFr-kgk)~N0@UUXX058^CaDJ6M$l2QzqTIl5eQJyAV zQ3Op7I4%%-Di<0+$Si8Rh0i-{+B}*zo*%EB2V|cFb6uUA4~nBYq>jaa7L~L zK+pIgP-x$%m1kL@e@ZP31-RDLIs46QB!!;VN2)S1seGI ze2*l$kf44-tRG{dqgI5cIgml@cF9cQmg?g&(f2>B`c=1;SKy{+3KVhBRw)QJ%F}RT z#9niY97%KGBf<49cyMffZ^p{6-(>dLZO9t}$0AbMOo=oaxI5r9RplxlS2`?*u>kJZ z?#KH+4WSfd?ol*%VkW}bCJMB0^C(a6s~Agro7ccN_A^zvjtw_>(BY>WJ@2B`N8CL5 zAgN1?ivvXhf=DI8q{7sE{E(ax+wK(A^w}ofoqIi|c8bxqK{^>qIK_B%{5vi#e3*I( zQoK5qrj52ZFl|}W0Ce48f&=sdIUr6}Ik&IC2AeT*v?3Jo)y|(WFm}Q`p&T10+3V~j zwe(4GN-*ZqO1p>UM6PIw34Ab;3e+NrwRAGQb~&?&STlJRo z0EVX}*cuVWGYC6$mp{xKuM5QOFqvogP(@_B;AEmfl+)M}kJI=z&Vk>{1TGlq_tP#* zGb0DykF(D4f9g>Vk%V^UIh!wbREWrK4~dzPZ*)E_rP^p?YgdNmZ_BC87R(hZzy7^` zE)>d&li2uGNrmE^o_ch^c>14;WuHbIkVI`7T4yc5w+t1LoQQv)hZqC(>B}}wXrI}L z$n>AZCUkJ7jEC667nH~A@O>&9i~Vgy)G`adja+4z0&n-4sU%{6rdBv7BCJS|;yrKw zWvTt&_RcTC5-Y97b__dK@oy1jqyN#(oY1vP`wUSq)1|TfTd6!zN;rCm1O!d8k!-!u zWGD$djkJZ;6567sP;WOfF~f7Fl5w4Ab1hoCu|XX8;6Q|7mwhM4tQ*z?z8;SCP#?q5ST&T-qU$o(fY+9Kd0oCGK<55oeMT z$W}#0VS{s{&gJ3ugG>>QN_LuP(niCCSadM*zoM#RF*f~L;t!XXD)0NaZm6zV7*K&#mH5M#w-6j-%S$#WfCLPO_s-~{PDEBMhevz zgHfWz*;1Z6{ae(oh1PG z1ob0q3OQ@R`#VI;f~Np$15fcMjnvOK#Sj}q($>iS{l2>XvPp5=p7Uqlg;X%zl5nel z55WhQ_Dg4i;QcpTbU{p|v+;I_ARcFAPF8dNgo}yx zio^(85@&+50e3WaFj5I;R@p#ahe{_(Mqi6TTA_Gr6bHAW8zq&R+3M!&-x0!T(v^Ysj(H<}d%VK5140%L2?vM!XTO~w!_0$XZWlDp? zEyvUrGaj7CImM`s%=ETMy^g%f@aUMLw%nL=nHgF?L7pNaB?hlCQc78WEF9+1*aVa% z>oV(e#Mf%}eDC1yh>2YX08mJo9Uk0B)V1eoS*|z`5z63|ci{^TU{Zh#xTBfe^Y2n%t0C(#OqQkXoP|^v`uNP zoU>BmH1kHnZm&-u6=fphoKBWiGVzdBU1OliI(M2ilhm3T+IFFL&`~z$`?@hMwPH@= zoN;s|9Wlx8?KG2&5A9fy%3mjV7#}w>ti@mPzL$xB3orK^C0rT?ScQod0I2g;ljK~& zE>f}eT1SQOHKu5XGzVFW7LU03>xJJ&W4lI0aN=*@j0ddj2Tf20Fq0fB%XwCm%E&07 z{Rw1KZ;Np7Lt|lJgMVLiEzHtzg6kM4Wie)D7`0`;$%}Lw1#vke`#Gmz)p4}Fh~wMubX`nJs1== z!~jtcY!H9CzxdtihiUI*5D(*K?YMHwdxR;XE8)Efv??A#WZtmk)~|Ybe=y(O`yU9B zK{_|1m^2ynd{9JkK!w)j6qv{XICIk=C1{WN_7=(IJs*%wW5|q+TdW6Z7AVymi|N+- z&C;YhDrY>UW)kt$WyTO4`2;6e1vb8HFbL??oQU$UQ^J1C-eg-OCU%yA$lbOvX8N{(S%#cdAEGPa8i-p)1%>RWk^0S zL6T^Tp$@)A*!BBnz=Nu>J5b!icqJvS$P&${O`59}-AH?IJoi4U{3grlt*Ss={^vsY zySPuXF}Rhcbt)CYm}GA2lt!V{$@qaZRLW41TKuvw#9pE7YbcPMA*%<$GHM`9(4m z$?NHP>ak|!XzpkT4qli=5HyI>XCpf5QY;S}3=Tc-&xS!74%CSZ0FdPlyh(CO#0;EP zekWeJ@_Qx9pm79?6j+-=FrGnoS+}5~d6`n!witZ1x{CJ0EaDAK z+F|-NmC%~9LS)kWuexQ&v$Y2E%CE#3=9$wZOQAd=^e=LgFe3YF3L_T#kju!dyOARb z7t(Zssm?AH?1XrBMn8)NCMb;9s%t&c*aaoEVhbr|E&8z@aceSL0upSBbE^^fTt|0b zqXSq{+?EnME`sz_V$8s^V*hrjUML_91g<^)^C%&VFOUF4o-rxm9xjTJKlVvDZ_)RQ zY)Wm0Y?>I9c#aCF;@VQFXm#Qen4n0V9GC`JhdRM&k|qs>g!C$Ma8(S=EMAIn<;8)c zE${k7>4U`VvYYv+3pOA z3&0q_X*D6{EYzt+IHRU7gM!0_Yu!e1fvKr}c9R<)MfOIQj0mgWQ_DPG&z^>kF(m-n ztC@rwFo{^Vk-$Jgw}Zj?vaMkAtfbT^C?OyUS#t2AAVx85S)b%y>eJcC8v}L6fWCX4 z4Zl|tO-heUQi6>&rZ1PPVjP&^r3VicUfWcR$Xbgfm%R~_VII@ z=3->TbkKHT-~QYzOvK^ZjxYWhqP4!*#BuE-)>v)w>4gP-{{Y;_87X;dn}Hl zvJ5`OiB9|yZgN*5#fy011r8k;Jib~X5f=i?pa5zZ(tgs02asuuag?D89at3V1koz| zy_!N6S{(dpts|NawsSFb33EBDtbzskfY^cDX=~U>3{qq1?P^7<+KJS1rC~A&sZy$z zNwSCe`==R_QW2hpm=BRijF%Ww4Q*{qiV3Rr331`sqrBU9WA>(WYI}vgO2QRoua$?= zl-Zc6tT!X9gA541ul)H!hAJYa04fE|wD#qu}!eDjVCfIfcJ73nv5gUC1|us~G| zTA48k6;7dW7(xG*z-E_|48|#1(fW*6Cm1x zQ9_taEzcE;8ccIe%Lv)=`g@6OcKY`jFj%{pc7-9uvnI02*bb%oNf%qmq+l8CaAkbw z2e3qI@{o$($y)eTjSI=PxS_2(SGsjPf>9KzF|{U zgj%pDZezw~;p{k$RROK23(!ILdW1K3@I_GjJ#pDRde5VGfBD=}Zoyi2YFm#yQP9EO;&*g4RO z{*gdS%$+DbmBM8G`IF{U>2C%`g|Osjz$?qL^6p5~4S$L_9&+03tQA+N&PirTeB+qFo*lws)BBP~_`#(GqdCz{|wLq47o zZQdb?64+}dp{%T2A!}|%OayX8q~TZ;K!F0k4521Rp(e(R*#M{mKubc;ji&~HOG0I6 ziarLdUNv~UzW@fcA9!aaAdF>XaN!drX( z6k`oNCQxBuZOLJvdOg58+BI_gJeBOVIkvS*Nkkv2;ZH`R(J4`a0)s)eib+EvyH7}r zKAD4ibWT4;LS06Q!mU1gkanD6AnP*5%Ae2_V)I! zbMBRb_9exs>Dacr?)>|kux%t5sF8a}h04p?n%;;BjW0EKZZ&h!8%X6D{U?ImcX4*w zn}U2j5Isbfhxf=Z>Rx!&=e-}TXUE8dJomD6Y*AJtMP4X(S-C5ME(jjQv~Y;Tax6ai zv68R*T9&Eiv{0~fXyZ>xM@kmXP5Obp!H^Z$xnjnI0&tTiUS8N>)^3m^;)R5aO)&(F z0o)=y@F$Zfuq+N4y7>zGA@C2Jjjj5EIGCr?Qm1~0vlswEhXIi|)tdxE@c*2U=_RRM zlva+|6b&zE1YhlQ?`yK9J1R9^zN%vUOgVTQ>1sUGXn0sZs{JdN2pl}Ip;L`!)EIII za@EG6%%n;>V|Ge1PJcxs7!A<*zK%M@*S{r+_<5&r=*yfTeAp|P?T{dc_!HuY*<^3} zS7IyU#%I2Go5=s2tw}(bAbM0S15%g(I8$J8+&p$dbQK2eia`rACQ_!77MBMhzngD) zTbJ{ugJe#BK<6UkD^1H`B!J!gEq1r{J5@-)`B@Ib<%cHEtL1hej-U2ktzoBsiv)}` zlaCLM%TKFU8(&NxSink#iu9p;glCKlS=l@mT7CmE-?AF1O4uU{x9+V44zkSF1#}Xb zO4}tj}4d=qm;N4VvB95m<$SbxJ(szlKM@?{%Zc9EOLq` z+hvpJC*Rc{)gaeU`VZ&m=_znV0_16Cpu}pvogyZV3L@jL25H>f;lrBFsI6i3_30f} zeJ+17HeE6-54Zf%QoFp=dy>a>e952CY zuuLm35Dwzgh0}4lo9%hv(LUwdNj4n!3GrDiI4vI>Ke z-Zll4;j6VjCm`SeA*tu{ZEemI#vW$>j!4!~dK>p+JrA(eEsqzQV8gSSTonixcuNn+ z#G`7q;@}CoQcp&O^l1Vkq#OdywXniH^QCCUb)`n zmVCbAS9UX}>KCR=3T+V8Ho{utu)jEa;JG|uqILStlk!hj8 z>|gl7QG(Dh9Ah6UWTH*5hWl!}C0qvmX0qOCtAaVvz$wil$|phhm4^wr|_cO(0M z9}SedJlK!3cgLl-9MaT-zy*-R1`mMG4X)qi0H@2paXU!QMjWt|{k6EMF98&?7MCrC zA9>vYAl21x(Nx&hMwmvDH2DH>8}wq3H@(R71-p2qdDk%s;*=30Im$_6ht$oq)WH7P04gY;Y- zS|87763MCZ*JU`NXUb~-#yxF#I7_YsgaN2-5j@S)&mo^vPh^o))OEuEG5enN0>l@YF4MS1 z0(Q8~nINv?mWk?!3q17nW9PfSm9?0@qa-?M6FWw@sWf$M@}M<+y;ZF%Kk^Yg%04pW z`vAMY%%A~Upk?IPIx~HQe>0H-kJ6jjaI!u&$5Cm}iAI=BP@sX>Yeo#XRnZ{dR8Uuk zLwPeIfBHL|BJjHnUOeM1{u2-Ae+j#;R-OjBAMU!hGT-C^Jl`N}7ZO0h#>75zIlOHW zaJ`12P+t%6cg2BSg%)7&4EEE7f%jp7bAsGb(7k+S9LonmM2rM_+J!MR8L6S~nWEWS zT|S{gI8$m8SC{_)4%3dS7Xu9*414X)&4wo->Lz~ zxxt`k=%<}0ev}}f18@!GdNn3P7o3fj(o3QOEl-XRL`TPyelT}}ZR~?h{JU`}^dH>_d&D)hwvDZIt|82A;) zrhJcCOg#4qmR;_uJnyRbosSm@e71}7`u-g+O@WX!;69rJzbiP*Kyun~EcgagQRGv$ z0Ac1AA_WJ`l*#knTw{1LW+D7iI3;|3(Cy-`XQ)phR?p=j92?R-EA8Xj4?|b_%Y@?QmYZ>oYw+rQ4=8}PEtSDBsa4qi!D(fmhOb|{T%Vf5 ztcKJzI5{dZW3ZX7cqnwyD$APlHzW0unQ5J&(- zQASc{wvdbKw;UaAFE6m?bYI_0Os=gV0|p@f>LRwfHN9??A&6+A+#(~n?2Hj~0Gt~n z;NXD8=h)u#TNdIO*eL1=*xDQJtzd!+GQUjtFe5PVaVJi7fm7UL&6gkP_Ri(8Pgb8z z*I5n$V4MOEKEIVIGGG4P6}FoOQg!qBVBQISz#RS^CY(U1iPLi0OF^8;;Mzu_PiBOG zdKM{Mj_ddHp~+K}pWpLPktt;cmg0rV2xcup3;Ga62--A2-FX?euZO>!F9s^*}g zf_p8q%DMvim@raYP6idtdaDlOC1^+u&G6xmQ~BN<2~#U;_R6D8qfNg__q zGmyNAMH3oaVjQCjzaRf?J~HVrQf*KyiDN4KnM(d`Y?9vYgPa5&PGxfM7889w-vudX zVWsQL8w>y;{=X0mhlY~Ng$;JsQ|Hrwlivd?BD`OY;2qY#u7AMVFch2ZdD-L(X#6zZ z-tT}{0S;m_ZY$+_pBVDqa`<(}E*3FW>POgm5&>(U+ zEk?ci5E+d$BI;4wZ00;&#!Dj<#h<^8S*&CfP3XDK`!p258)*4xzgPGqXK=#rAFt=< z&!?9){?7xnXWs#L)^I%KFhHaN-+88PXaO77%a>u|4`+3|Ib5g3G{bCIe5 zCqFk9#X$fdZG2AscG|x7ND9b}z*=&4&xCqB3ZA=K^L`}QvNJHBELlBQ#FkTG5CQa} zP-zbj{um^9pnKQVQ4_1~UZ=+;IB1|r1q?Qjo-U3ypvYNf@UI|f8`GEfLZm8wjWaYM z)-{B(Q771HZ~s(FzK>vPCdm_>g@&r2^WCCbPcSE?d~P&Ma?q^jvsb{sl3S#0K7_4w zpg#N4ezNK9LDbgP24cXkDvjHb)XMOlKM$Y!>E6wx^LgobXmd~*mNz(BxS)BwSAN1% zOaC&fY?jdnTVavwc~2zp@gD}w1~e{DAXGyj=Hp2xS-u1nRE7&5o|+t(7jS(3yw4-B zlNS;eo?2e6RJTl$f8?bW^a7{{@FLy)I^MtF@q?NeZ7Z$m%h`4f<#1KAspL|ac<`vz z*ko>P2jd_zSWI*i2-SHtm)~#!qCdg^MU_$bKjR7A-}*S$IVVzz$oG2Qg@*oS7bh`1L%;Zg z>*(9h**Q=RIU(Yq=iq8&@Vqgc`O+8@!a5; z83iq6EkF!i&*8;edX7XFY)}IN2x6>iEUY{0+h7{PZB+yYw#e@L=%-LX=m!yvh#^H> zJkb#!XoRlIhpA`=r1WadSywpL#oI7Wb zN6im98WxpPUJU_qDFHsDJ-r}h|Qc3C?k!njb1v6l*<9}x~T#?M^ysdytu0{mPH)kQ^ z>$Rslf6JTmohV;aaF_(OI6smDOFDzH8E8*KLD&FvGbbP%7`=W&td=7bo12>rfUnPT zuo&SjfmTBeXcqr%*oB1*0bnbN0ef_VYX>|}9}d&uAe1_VcNhr#?=ux)bS9O7(?AJ;(uw~n3deIPngF!A}ne)DGP z^(#26Akb0G{+zWX<@M5t9kLMc`OC*)+8OBVjG_ES6`3BXSMsH*MmYsM&EbG?KD(As zhSrN|X<6Elxa=)2y-&6~dl5A+-zpiw!D&njMT|z)le|LWR^W-8y`EmdKl$ROqhyWI zBXeareWhrE)r4t@7)nh9n1X;w(Jc=a!vNkAQs>z^Whwzd%i)hDbDnJOH$TXobG&<0 z+E)U%7}db~u$h*<)sLEb!#O)7QRqs{K#+)Mq^P+XH`f6f>Be*N zo)f<(KC#osyQ$SjTn^K&ka*us-ty0%)h-?XZ!a9cJi!WTu!nRIP}`K<9T~`oxy>hI zL9iB7A3?obQX5>QWMEfN)#mWD(nd(~PKa4=r5r{)(v<%N!%y~XCyL5s*$1 zkrDv~$)QV1K|(^5aD#{lBHf6BDBYoSN=klfp7%Qrf9@?fbKTdy)|sD!ae!E3M8t>9 zr5J>q{(_VMfkQDmZaOsB^<+;2&ZsB0rk2mzPZuZ=A%LET=pK_eZ<%;QbmDe$%G1py z*i^LOnwLzP`Cn&ph0%uL_|DSnW#{g1bTFuege$Wm49p~D2Erh6pL{212N(EW^pLRN z^y-9Ifw_A5E_$f1_u&9OzdLt{2p<*|iEv}ZM~Z$jjHRW!Fp@CW&j`unVdCjs`!C@c zP&Kq9jH3eg!Ydl+J2*n78IKBmW+h;O6P=#Iqr9uVQlfoN|3l%k>*soDT+BE2=k;9j zH{RMfXM7Y~a*i*&OP|Wk+2726;%D(r%3_O@nCz&hM`trVqoAH&0m_DoJ~ZGyy)lNf zsGC%`Xj=TnUoN^4>-_{1n8iZowBKk)TqV>gGgzk12)T-NJi~+YQ|N{dPSAHyYSgeevf(0ueDAZ#jD4r=4K1%P+L)YS~U#~u5Yg5mj?$A;mMLmChWoM zNvZ3);y+7M-Cnc+74nXUW@nQjRR*n&{3fetAmS)CWEfFHUP5*8wCTO&QtBuCyQ)v0 zGC_ntPLGe}chb(k>BIa;VyAERs<%q;qG`P^X87MvR6$%{+X_=_#PS5MBm0VnApiY* zhSzT0YQOAa+((_&3xzYE_qkb#t(e=C=4;$TJ$Ex(lY*Ks%Z0Ys0Oai)CX_cw!9}tK zX^Bq20u2gm`|8R0%6FJ03XND#5n*4;?*Q|Xm`EIs@UFMsH61}HkhRRk7>XdwqwqRx zz1*v@_XJ`uQ`z)#Y{_5@JJyuO|3jI^OWx~TsL*9x&nI@1CK|*3B^B<2`j94umD#6w zF{DiGQTrc=cO9(#s&?!mw83kD?6baH@R`vI`((sbfjt#gw=oR zZL0dPHTB*I95Bsm1&62?-$r6)=~2rt>eD8rO=)!{-W&*@Svg+H%juvcR0jwWZ3cjF?XV?I0UaE z*k}(^!1Y}co9GpYyj)--4#Jx+E7NFg4d=i{ykgVgk-@F$iXh*CPmpHV`Cmy*h`WNR-CG=t?W7LgYx#loyM7=oKq`m9RxB{wo`7_oyzc zsS!W?`=n`gb5rlP2f<>_+&MQoj|HHSvv0Dt*Wn%0OQ;H0jJW5)K^tUrJY4?fSCUJY zXk0&<@rg5p=UruaMD-UkIL>Mh%y5`Jzc7JQwcSUAmPEut&-=3t?a?XrvQ(5goeKqh z(mR#k2ZGZn9z(Cg-Yq+b1>LMwni?Yz?4$o96>0D1Oq>65Eml)C7NyGCnKG2hX84tZ zI;lNFyQs^AS%D>i>?XyVa0RHd3Q`*`v&`m^c`SNwcR&63G-c4T^ zS}qT(yjOpy0Od9B-9xTd@n6>r#6jh+h(dYl>A{oW%l%g!AYSEb@VdclFp6yOJ-pgu zxeA9WG;}vGpnPbcr8|kig+RBOg+TDmNBpU}P$Kky69?fSt&p4Ld6NiYCKI6Uq{BmO zDb8-EyB#M17}c-CFK;lD0saD&&A901TWGF_TU6`+JR-**KK{HEe|O_BB3YeCuDsxH zr`5yHjZCqZQRPvex!fOck*E{k)%2B^xgK`#4DQ3#=OE$B+KFG>2Vxip+N5s3RfXDB z+Mn2uF)4+Rn7T3uY*FMc6$FZPB2#*=5o!%hj3ja0q;B`DgK`TY873iGlIZDMwI4eZ zqNpjE!evv6ydqv(3&~}Ct)G}u{dMPWgnLBCM`sjL?|v?USEw+oDSQ?89mFh=_$TCy zM6K>M9P|VoW|laHggeT@JU9v?we!TdCr>$m4~IQl_R6`|gPBSHQgsO-GQ!wT}k;7mi7sP7mbHzt3GV zfvG6-$$i?dv>C>JevI8qEhjh)RRIe#4_AD)?$F$>v>*+LVi?jUW@X&|ykZ-?Zt|-0 z#OQ82&jVqTu(7C7TKeW&j%pAz#Pt zu1NF0@1gA#Rn5`xE7^;L0Zjv@f$7IR4@v4Xs&6Kqi(OxL_Ge8u;*r?vH&Iz;`74=N;~p#q2o`!VE01!cuIsf95YWYmilz#-)b z=?Sp<7kX~lR-#ifpobg1`vRm3H!=s<*W7DcTYU;*wFvU0y_f}_*V8$tb#m6y{%hSi zb~^S7O<=iN?V%;YRZ#{=*bMrvrW-<-+{FI+068wdz01IY5pW1>BGNfKzG z51ib55AW?ajlG_^ zhW9S%*?X@ma!A0D_p&2;@rxibTuq`|t)p5&t5ja|{=<+_&D)(1d9pfqcgkJ=9jXai zrZT9eyw!BIN?uZL=7>@+%pJ{vkJ`uorjfIA)_DE!L>w5G?SX-V<}Z-yVgVn5n;*D{ zW*Zi~$H4*zbmN(f;z4hWA;6K|bdbvgF$LWqM2@r&Abi^qJ_x#di_h-Yz)cH5br4Pk z$z#{l=;k51F>o=?ZgIX1tNw8fO^kf9n#HJ zx@aK!@Lb$=z)kPIUa+Fa9P?Nf=TmDCe3~>1p;KvWvAL)d7NlGLk@#<)3nwNgV-Dfv+k~CyIhJ!`QH$jf%9xLAtoP5*^MVN}YJ` zXa1^&)Kg_ePMjb5rlvi^&dJXi2*G5LH=X9qh|lWpzfvE#ovu!|AY+&xVa$x;jNmqW z6rrYUvb3u}W*8>U8JqgmR@||j6-pZ6R6lKMf=Q1EhdTZ<``L!vTD1Jc(==X{C4zV|-lLJr-q5N*{F8ST6rn9>uu zHB~3RFGN6WcQ!fJJo@mj;nDNNtW~?;*zDZUQc%!BmI0#_L3l*#(q2JBIo~B!Sb2_E zmlB`)A9l{XM>)?>SQ4qB;rNqXlDth97qol-+UOEjS!g@M0%*5AxCwNZ_y_pKu_^w( zwryXCy3j6vw9HI&s=I935*d5WKXu8wRW^CE$3kbWV6&>deZjl%Qzbb}*oZI?X?{Pz z9pBWqc;GK%?J1M%DPt{!Qezt)mTX<~bsAPGlB?|VP}w@r9QPoF9SiDrh9$qLN>FG@ zP~6^JseBjl{hAxLK*=rf?G~yba#}fj)~TM&DjZv;49g zJ>iXk`R;AVv6aH!iLm#=IZor@5k_DWw7h+*4=Ki*84CinHsi3V`4ZHVqfNEwE6HAj zCtm%}UZ6eY%Rm}Bu*-oGBJ#UyRG%}nB)~8H-~q$D|6PiR(a}-U*YCJ)KL4#C3`C8G zM<>t>=u*i<;uKJZw>efX{w_-g+89*%w5vN^5SL`)>Y@ulK_|m+6>$(Jp;vQPX#crh z5PNH9;@1+c8O%t4<{^27$Py?fjijaUA#e<4Jq# zP3NReaF%M$5D> zi0J3aghOH6Vk+5#PH^Qz8Uo}jU7qq=`D~7hLNUzn=qM`{@d8M`-XHSYbwNN|g3uJq zeM3J#AO@AL*q;OiDf5z5bYUuL+KWx?*1Wo6gsPD?AZrl?0{QXcR5VSHZ9R8&VdBTA z7z;9iLMRunFt0*QnPKD`g9Du6)!Fol_uit0Q493lLHAk0SO3j%wo`!@Z8kz5o*y7* z0eaQBZwR>_2@~vAW3#jQsT^FEwxzKaP!H4^&~j#jj`D#En>ttM`m%&HRE!ow-Wz}y zoq^0OPy9Gszx8g*e*#HA*qZERAhu9R;)y}8vh5g=^8 zmKIf7dDQAI6|p3P-7!Q=zE5D0NhfQet1mWI;kx#%dY!gJHe*csyQ;yl znW3(cnK()KP~h*XH`xyXk@YS<27_@o zMk`11475moHgfrX)=zt^jC%0;*a2Mj&?$D*ctD}Y%>m9Y@Vg*s89G*!t~Ac~QbIe? zR|A+A-{$rQY>ubKN1JIAlaek@&0R{_hCXG1qYA-qFhCX;HZ%9X5bT~_o;W$D`DE|e zAN<{kyExzx><2K?o7{;s?(W3qDU~(vi;Htk6l3LvV5!8@Xongr@&qFpn@pH*QOGEk zTe8NgE)~B_()E1P{)+1$pP?ufgxR&UOrDAE5Tsf_3acRx3JZ@E_%PeH-d#g> z8f4eYQOT3`Wx=c=3AHgVMYYFH!#h1DEmuso!I!eun~kXSw*&TTFuQ0^Cj?ACmR9`N zXHfL%)2HDgz9MLMg~-UZ&`T`^hq5mBwvqc|NKy^&;~N3!r*XU`R0*1BFaHW(QAm4E zE8o3)cXnV$7h*SHG`hYEm%|)BHd^H7eR(bm7F{f`-Kq9Z%bqOK9HvsT>i-155w~hg z-lc;`+)*qlE^cfi3Wz``poZb$@G$8fC9NeVX@{|K5q%cFyeN4z(XvS==d6~t9)eXw zDq0OB<-u!?=p4|k1|hMyUVXic${am)A)GB8p-xU)CD{*AD<0ic32g7TUbWeMt{g`V zo3>pJTB+n_TUJ!KyDu=U#(Z~8p(Oo+mD?6JZ-GD|0g>FThEnLp(gV}*F#CcQ8mSy6 z(icQS+ElaQiZJEm%p@C%;H%=7m)~~~p+^#9izsYHbu2)!sS1zG8=mVN+$IbL7ux~j z7gIA(FfO#|j|XcIGqg(xSbo5^X3uKBx@ft=gA&N-J~wbMb9qQHxPE_00tv`3C)XfH zty!irc?G;=`Ai1pAQDbdzjMIzHr;U zx;D=g`IfWbkl_1gq;MnbLpK^b1WnBbE+zShCd6wNpFox$3T>={8J7&MDUiB^cPuF1 z-{AZ9AU`RIK`9Xw#Y6wGJpiXQkca<2bW)!;!dT7`LMG`bDFy%DO+aZ#d=eB9UHC_f zfaI{iy)nPz>tsFj*~5-+Z0(b~ zH<0-n8^(av!s7anC2mM{rxv~gHO{h*I@boT+{Y?fJJnU5`Ch*+n@aj$C|t1J&1q3t zfqeF71Lg=i$22liu5T*erJVf5T>)8j`M*{R)cU$RRC;3|k&hK!y-Bp`rB=w&%2^uP{%C#Q1sK=T3oBdCF8 zYJ?=u4vrKB;|%YSF4eRw8H!HS%46%#zSsC~S6*ICo^6ZB#>;QjHC*4?{c+c#H!C7^Eiy7adB3mT128llYOq@v@8su9#P@EL#Et1K28g{1viLUnzZ9s%!DpX9#RU7 zkJOhYOxcH-tr$=B=~DRbOvE%;5a-!2#iDRH7awKi>apdObXzq$jx@v@|M8_${troM zhy8lk>!u6cPnu@jhU2iH?B|-O%dIN}$svy|iC}Edvi*MpTib1-Gy7P>i&^V3zQ6II zew-B_({}2Tk92b`#*e#rz5o7znzN+}%muT7`+{&JuneVzmX;`GE>D*B`V2xSXso?M zG`4Q$vg%NP%XxRRX3!CiI#BX=eeACk!A-cBVWQs!YQ4Q5kz}mteNZXOb+X#y*#joZ zdTf_?G(AbCbbepqJjZV7AC0a0RbhwB;c)s8V3S=52AyZOD?6c@*gAcH6ryXx;4_rh zm4^k+d*;y?8m#G1Q`0W_<>u+$4f%6MX#Y&PaTHkf7SS5t{KrSKhEa}SUf1SMxA=76 z2Mz^F>EL->>ksF~lFZf^Xg4;xy4S4Yw!`82h*{2EuGY9dh-QFt(MWG?Wf{hZcSwNX z*pwJe>n(KR`fz6#Q~TLP`^YJi!tmKmIRe|-5Vj^OVmh~c_lpqS-J0a282b$=ZJnK* zN04?@R6Qh>3o0gtbnEPOiu8HrCf$1SR2OZ#16J;cupb&LYQb}o%BCcy8rKLl2A&6B ziw8Nf7L8ao@#Wg9OY)$A9o465Sh#pv-tfjK_*`=B(WArq-)RZx6m&H#Ao*gdLjLpz zo-D)^8WQUAPEJ7s^{fI6d<$8hXJn4XHL`Bpm4eUBqE`07+$GfzyV6 zeB+&r@1dKA?9L$$^FVx%Jtx!qcdrAKGrS--DS(Og^#KsD{^(2vn^O zTXesD(Ma(Va@B|1s9Gr=Hr9eWADaI&pJGECZOMmK?-3*>L41&6@?M-y?#JKiPHNw` zD=wZ<^*jwE(AKFXAdpXXZ)mvIf$7$H@rr%si2ZlPZG_83OW)k7FSeQtV>h%+CSIH! zFTrugMZh6<^7HHT=5L1P$lYazsl83{(6;+ic5R83qz5d_${@XU9OCicT15zW+b}H@lWM{Ep$k(=ggy=NDeenLCmD1YR85C;!ZH{nvS6nkDKHR>WYr z+|?5Cnr(cU_GFE@VSJni0aq*Z(YZGM{mPH9FBRpDk7&7=N`V1$*6>d`7o7I_{r{iM z4NLE1nmeDPl>X1U;j-n$q`jWm!av(3$7 z#L+HEd-g{_T}53hNFH*YSarlG;)0)a2vvrcS>=yB74a!8?h!4dXBg@?Dkaw7*GlE! z@#eVRdj5DO@N{Bjujl$@gr)cw?`68T^2aHdc9(cbA8k8cqnJ{>d>xTpKb7$b!tg{@ zEW(VPHoANcRG+(m{E%U3$w|AD;m6Qy{MG3m88S(|z)<5+Q;u#VQu+Bc7^xv@UBgI3 zwoJ}ICeRIY;wc5}is)N8$FqSPFpAqW^~x~*bOBB&!luq z_h9Iy$@#y*P#i?#emfBaFMCYywlVm?#6$f~)s)9iy6s(%{fwZ<2B}5LjSs>9d^>(j z@g5Nrl>5qF1(oKl2s5WFaj^WuU);kzA2SFkf8fOf+NDT!_VB(q9nS05z1whTSZ%|$ zMwe2QlHqNMF6e$?<4@Oo(k1K&bm=d?i1T4C?mxsIWWHm{=qIMAA$jo0MI;pBvuj-c zSz})e#|65*kRr2r$M-@=R`ljA{F3sQ&jovnF3WV}iOUFlad@57Fj=V+7Tfm+JLiA! zQ0(ENRN2`b3O5kRPV+e zU6vnFLMr+9lh&gWRFaf(} zMko~x{F7my%e9VuACQuNIi@=0j1uP;RrI<;bwRx)J&% zfl4<}BzR%_gcsdM4Ay+~318g^VhFwHw@cM~OP-7xnjVk+G^*K~mdF;)nyt66*Td5B z>4EV463Z3#tk1F~P7B5|4=FeWpqh23Lyb%^cIA^tS0Y^=+WqP}D2w~T+LwS+ryc!+ z5I9YibC9~_*>d6EvE3oO0JD$iz+uP*uJJ*;>B&}-I(z-v8;D4)LELZI#X%y~okTaM zzR(~*fTXB!G4^&>I&`1FZ;1vKuV{`9|KxF0m6K|^=!))2T`?!!P?AR?cRkmB}S z`?o21p4g)4p@-&bhlY&8ken1rSuPyh$)`8Jl|?=vaEZfrsT8~=RvD3`7C^H}JBSKX z6_2Q+ZC%lH<)+_!h9)5=YUGDTCXz4C$Q*;&Bi}49pC9)+?QgtkcIoF2+D!Xd?C5T@ z&hLWSzM$@Hi`;h6mnZpKJBB&Q9Rp9!^ZrKMwiU6uAjRc@Jo6)$rBddfYZ8}-b~~`v z&@_Dc0>&ww>vn)LQ*;s8SymecyYws4u+d4Y6 z)ThzgA3xPDyiV6w)zXSdI=F+y@PU?zDT-4EejF`>Nn}5CrzR#PIr#cgAka^1!|5fs+?hzkyid zcfWP|^ayqm^svMj1phV3l5UZ>-_t;ATkD=#@w;r)$RpE=WQZEY#KpBep%kmnW63z~M)eOPW)P##BMeY7c{#%?Ps zDH(BL@r8({rj}?+5OeyD7%mOA?{`BiuR|ggebLHqb81Q(YP_pfUaISuyiF$*Qp^jUYqbX9**W1QpM|W6GfG$ zrJBkS@$z%z>C^p8yTCh5)xQgW1AD5-rCGZuY;yrNPk0^ta+<*oQ>!0F4$JLbkXkqZo45v%BRLN)$tS7>Oiz zT1uy-W6~0!Zwrr%*@H1*K1;U8e(i&cMS~x&`Cd69Kj_FZc!B6XoH)syX2KP_U484& zi$iXj)^{kim~_Sdu862 z-Nl3{1aH_h2g|~{!4pX}^VIj&bRFx)ZL_$zs)$;4Q6KGh zMsaaPJTl()EQ^Pa5cuswa3rJy6U_|*#v2|#UUZC$6U-;*5b`UFE4X>9GdDm;#gL0L zddfa6y$C^FMj-lqY+O%#|7DimVp)r48%$Eq^Bb^XW*pMHV`?V#!t%)sS5IxWyFZtT zp;THCPi#m47V1)M`{{KG?U_r09}RLh^>;-xBV$+V8ot2e=s(CmDCc8Jf^JD^et)#@ z_TZknTweG54_4zciJxo42v){q_@nysbs&@uWerJUmH81CvD&vqFgJqb;iRKDg*{JS z&4`EldO8w2Vj$W7W1XZLQoZ*>q91o;TpTA4kF#alh`CKtK+}eejO(`O`p%;$Q5l)o zwl)=oqwyu}w&TnD;d`yPxTnh>A&pi@vDj^AIb$_}zh4 zh_Dw^!RP*+ONX*? zeJ9w>2PKmkS?>V^>Ld%<#ZuU9jfC3+T?&A$(pvU5H!)jW4tzc=?Km{Hrp6-!&CQAs z9z&iZ^`IS8!`1F1<-CQ@aL4FHhlE@#yEm#@k}V`)c)oLI3UW2*&$p_a zPysBjJ2?qBWPOW16XB|aYBbvb?VIypV?w@PO{?-9tl@ zvC+{_5|iJie#bQ<@?~f8+~|Cs{jw8kCMh*kHiH;u;t1FZZuGEUG?RsC7EcE9lo|~3 zH=9rY2|{v;+zmKZ(1*bS7^^tIAym>hdE!qQ0w(XhEd+?^>}Xp9*h7682T@S(rXbi# zD=Io>Z+roFewa3AqMlU3!UDOVg#-PB2X%%qP#I7nfmD5_fA^X0TNPd;Vce?QeU%`q z8h8Ag_zexN1r_&k5fN5iXGn^;ZpXLRXg>%nmAv>=2*q<~G&!wL2c4IP{_yi}d`TU7 ztxIw!8p}3hXl5cEpB}3Tr6NT#e=->Q(_oFkx^0)lBDbFt?GzfsS4NEb3b1*QV!=`S5y1uZG!YD|vd*|KMTqF6IWn9vB zUV_eDX6~ZTG*WcEYEy>ypT?+@|4^7^R0zZuyyb&m6q}mLhVO`7?M8Ju+j_>zWkP%H z5yQI)8iFE3+xL?^Bo8VAm-A76$xUU|(m{#jG6EP9MMW`mzQP(Sy%&C5g<_2z|2thn zODmJO&=#^eGZO=KpO9$^v%_VWvsjd$W@eFg8fqa`w1e^qce;uURfOs_q>8e($xTLP zI;;|^2<0C?3{$$*vF^O2XNy*M{z!}*C;P>yeOmywCEBRz9NJG21 zuqB#TVL%L(YEJh@!OwEsTG>&(dsiNm#i`ny-v3-)MBrmDcwwgVrhg_H4_pSpvw=dpTPRjF~^z`g(FaOv!20EG2j{d9gJ3Kl<&y}z?H?e7y zNs7roYVyVSH4t>W`XMtD9WI*~HoG#CV>R1O9U-$Zkd*m+l_2^fs$qD@25ZBmbV1Hw zZnBK;wmVX6H0gc*TS9Bo2&Y-%mo)9aF<*b@rj-%Dd`S<`fr@~vk0>(9(fz9N zbFr(`HzAZVJ`s{*+bgoSm$g(NoNpjaFhG$U6-K2m;qLlWRyP_ZgT+^uYb-G2M8oRH zLx{tsEXCpA=fN0ux*-l-bb$)Vad8AoTcMncfJbWFd|3R1If0Ec9&SAjEH#;6XC&fT zrn8|gTRdii+$3u}`-cgEqs<#(&V2t(6dQ6Xg6OPiCTetkV)=_`L#dHvZP z(&Rf~toZe-MG5djP*tHzIpZLrMnGkGox|cd&PmtBv6HhiZQblqYFav_@}t2<(EJdS zkT{^fvQHj#@Jh2a>HfP2UA2!_+Fs=E+Z8`AY6)^RZxw&>ir`7P+v7~G?FYy+pr@g= zJ}XO)JyTZ=*>M!p@LrjjR7dgGcnHZOq5aSAc$9gFDJV$#12SWg-?M2%C5wMirI%-| zeQWgm!0B{6i$%-KtZ_W;^kZV^b}PLyOX|+!7eQybN#vF(d>#Fg;w7;jLCo#HQD=?p zM$Y;+gsApOg{KEDzJi-~#y@IG3^x3+nu85hvPi5aqX+HdJF0oLu)Dw^;}?h^G~1em zoR3&=C&Jo=cXqs^cK;?NKp_ck5~#{#sgIu|ic3C|#|1_n$!oCoi;=R>wa@Ry@<~23 zQ)TCmU;e6)I5gw~5(0-{_BcOHvqN{c(w^K2@gK93#Fo!RMYB7@u`Xo9WD+A|aG!m5 z9U7+9lFI4+MDwc0DResV?yJZ2XhpJZUVEH6{%`cJOOY`m+1i%QzK zjCgWV{{6!-PsVkn2;hAiFS~Q#z(~QZgot1*DEUnA=ui|Mz1T?^i2Z;eil-ziH@CC5 z7vDDYfxLg?AvfBRJTcK_)+iIqk*&8_*K#3Pl=@!Rqij8RG3^gOBv3rg>`{fe1_a;G zEot0%dAb3Ag}MZF7X$i*_Kx(7j1h9%S>bg4{_uIB5?&e5gcs9t_N7G)vT8%lmspn2 zHI0Z7+_C}J70b3m0%xb9O1FCn`Yw)(ch9e}a%bz&o2I7r>5exAuwWM{T1XXluwEfB zCtmzG@9Y!_p-D6#jA%2Zuc2m&fyP~qpd;ni5-W-pbvIN7G(^t2C*8dqUk4$3uMaXmdiw6a+JBE>f*G5!`I`B=R0IM7-Ul5EHJ+~X)6z4x!g>MN zOBE1-SPR;;#T>=>QR*W<^2&`-L)AW+ZoMDMn{kw>u+wd<*elEVG}s-6N4nkz4Tki- ztX3$YDl_d4d_%wn2m+Ec2J)~~o?mmWu|%xrj083^=P^Aftx5^!EB~?(7pLP~Ly=Y{ zLC>(1H8c?p`%Xc18Nu7UPgL;gRb|T!xQybOvWDU5g7o*KdY=rz#Fo6L(wWg+KYM-l-om~ttRB-!4-W1^r0lRScCgI&h zf`gsAB=ZE#O{B~<6UM1yt#53oNG=_hIXW$(U?U7Zo0{tu4n4dN2iyL*(ne-E>+|Zi zBJSP%f208DRY0?Z=ry{V5T1Ma@6{Du%h}A1ch@!Z`2@RjN3+B~krlp~lLMSyg{p_O z*6X*#mtOSs5xh2`d})z8f3jq1o}O$Jbulnwlti>Vlg+^EFxYfjL}jU?IyW1s>?99o z_;hwQhH~Y*m|TC^lRvLj%U!c-n&O838^NiR^3r*}*PY|FaPaGSSOjaHK0CjWofoIV zt9FHI!>_7*?z?mYT7wegS!WE!MHG~5R2U=qcDiLc|MjQ1-!A0rOwmX+@4b~=772pG z^A4r+8>ML@(DaP>t>N(X^>2mVWuWyj7-M6tJCch;ZXWZre zKDEzTL`DWP9Jy-nzR2+VfV!bh3a69Dw1A3f($|e2!&F)V)Lpy1Jfw##nqt|b_#_(a zXJV;fAc7kGm?^jrrvn#I$NIXh$d40tgw%w28SrD}JQr${Rk$I0w< za>b%J>OH!;Ed0B((XsL{QR7E-oXkPNM+B?=;B1pNSGt>9X-w(F6eGXlB zoztIZV!Qa3W;_80hjS00Pe?eJ0SBA~?0D0}Y9HwFB~OaG>y#KnlY^QJMRXC5Tdef+ zU9A}o|2QWfX$DI7*+vtyTl|cKY|MlU)z@Ev`lXwo$8X}x^^no&xu+Fe4rrqajyy2E9-?1N}OyyRFaqdXbx#35it>7lru1zSPAHuIY@7EnAN*^J_u6|Kj9ECFDv!Bxz{Stzy^U?W&v!D&PrI#`oWvesEs( z7=)XEu0mt`(9BHIQi@d=RFW+2$!&rj%G8Ls%;+kW%~_1@W32>q-q;6Q*DgI?I+TV@ zbtdvZt015L|5!9lOeoFw7iIXMbUJ3R(h|!E2|EcHd#d()>*a;py?f|7CU1yOTM&Qs z@48>WApco_Y6^Q*&wq6E^zBge;eBy9Rt$A}?95FO6}}j?B?FR~Hn{1mF5eHGEmh?t z35*f}@dfhYIv9>b-5%Wc@#+{1ETg0wx|AvNG3qK5s)@S(?d`UhMZzvAyE5+kPgp;BBlqfv1FP}KadWNoMtqN(&t=mXOA}LaXvAgc=tqkTQJf3-Y z^K&fYwN_BA?sYDOsw*(}04Np?Db``e26~(%Kg9szOLV1S?c$1AEpTmBlj|35Nrcl+ifF5xfxVtc7)D_z zluArVVc;w&WV@~s-?IT-KrHN(Mf~Mh{i(ZBA%j}`?$}m z>Z#D(Tu|>VCnqPPvj7QW2+uLo&-8v~m2m`+G+|<%nGjXPa{^X|#Gvhe)cyxst>9B( zBg8~|y5OVPD$=j_roR=+PuhWXKWJon~5gUKEIzvP&8?$l}PM*5yR5y*H%(b2EhU7Dq|bUuGK zT4!(!7(i3l(z?U)k7X$e(0PWmJ}US%nCUuD+&DUK#e3a8F=rTe78%7BAuuB<2c%FM zgsrsA~3WW&_#=@td}IK0gv(SWnomY2tjz#!SP)Sn@u;L?*nLp60PKB7S_ z#pAXrce>ty9*c^j-{pGT2^?xp zZtfm@ebWgXmYKn&L>m>zu_jd+Y|-^k)vWmUeDr)5ykqg!cAbPNauZKDWEo9J*8J$x z)6;1gUbSv`ZDSW)K6e$PTY43&O=Y&G!-G;U!Whz~{ZIr=?vV&urW^#0247yAcT0J5 z=67edJ~3>SFjgdzy+Cv*?9=TL|Np8*NyCxfy>G<9ipmqeetT?wGg&U-UEOEv5Eujp zjXkP;xR}lfAUUB+`JHj#krxn2mx2OZ~qWx+S}BuP!J*HJvD+A1d?a z4R`n=a;6Hs^{fsK1X`gtAt`7Fw3WwS<`(ALBGEBGkZ=PJ@v}@$>%ay1ioY{>rhnVJ zH71~BX7rt<$%oayzpNc8>{sk~Ccc82jx*VqkT*x=_5l0PIQj^&-8PSDXb5Yr#7gPo z($^_l*!RbI5~M#Z^#-B*{{EO^qJf@cpdW>rT1T&|i$vahOjgDV8NIk$-mT+o*yRgf z#&T?Y{P5!i)X2AnW-k~j@i;gJD9FcjUicBneocX`@_aW&N!iztxT^6WLRSo5<)H}& z#K0HDYJN|@Etek76CXYHU$xJO#y!3~9A!2gF({qX>|kXDX4S^#0g#nEjH=pHB$1D! z%A;r1zK|ips4LW;RuUAxsY;=DQCwl3S(B$q()1aSU73gD-&yuH-&jhzC`7r;z4Mjc zo9ci$IM8haHbEGOz330?a<1_kvuB~3GpVt0FcReX55opm(1 zIoPNORP3p>ji{VISc14dWqz&Y5(lm)#o5PuUC1sZxI>19f3HaAI6Vn_8B*|eL)aJa zCSafyfoe*&yIOWYw0?s4dT7iUkf5Mo z^o@ACG~)}qdiMfq={!Z)l;MIS*U@sT`1*4}k|orbx3=QHaXQhBsK?lN=K0z4?%w|4=vLP9QE;a$6AZ-w8(~QU&2- z(#DECF|p64S;YDzOheEW_4(GZ;!QQ}zc*czi>{JPr~$X^=uiV(H>}8zQD&IzPguiR z34JQUbc#$BADDAF`8)7}HgRJ7P^8EUTZdd8ynV+5l)0$VI2i_Aw5ix)F(LQqt`z}T>L z?`eavUm^b&=8rLsobT+M<+uk$JhaDNgWEIXH9^w0L0i`Ztn2a3?VgehD6Uvnu6KzF zg2JY<`P7{;XtTP0qw5g zhAjn|WK=Y-kzsqw<0Pr!ScV@gdtZuU8{Wxs?o6{x^mG0?!%d24MY})-=MH84{67^I zDniMU5Z~Vjq_Im=}aHnSstjzx2HeXFGQ2g$MaW~@~SRI zJB!8Pv5cd(rtCBxKBNRnI;T84_xoZy(SU~D*?&wdEImZRjj>?)VR-cDk@nr6Cl@g$qW#A23x|V|&cvOvEzVFR{wCT0V`srVry7jx5gx?~_2Zku>xz4KB3@*gDrg zO}*H1=Qs}{Qi!Pzamf83_{|)IU}@R z`&B3C#=-9he*~>Q&BOT73Hw{M=Zu`W71hik3Fgk`+tOhNK3I#0P5Th)t%;TTo$Kp2 z)jIjuC=d4&E#mM*TU-Jd<*Gd;X0+q_xkp{B*Zgq38b4DyY9F%x3JokxREc`Ce0)82 z38SJZ1xd}OISoeRBIWQ?>IvdkY2-n!Z4?xPUU+x;B~!Fmo>FPy;tmZ{p+PRdH@|-| z!;M!3?%}*u6M{bSiAarB--Z^}qRe+CclMrQv&h{*4-}uyQ6=e!@~!lAqizTu65M?K~W# zFoFK)-|A`3g3Pz*bEK~@TK;|aN<6&93E#zCsR6ltfp-=@bd#UY7RnNePwD~|AQkD$ z(LRVhTZmPV?=MEoQ~O?vR()Z(D_|8JdeRfxxj9k0BK5hp_8LgP+aX~dEiD7Z^%6XG zJx~P>0fxp_|Khdv-Vn$5(3e)7glN#Vp1FlOI#R5eQe+@*-HOoFvp)MPI(trJ1aY?ydTHU=EK3^nJYjM=jb68*^?iPo2qS5Bg;F}AjKOVX&?b=la#Kw>-n+XJgEHvd9vyTARr%p z`-k@ol%Hu!jK97Dl#-Vmk36RPQR9zQ&q3S8Xl@rFjsdAOh|>1KjSNn6ma69@ygM05D#CwV()r8<;mN|Psb?Pdbq z@apv7E$AZ(-ozdQe5coPAKJ9gUkQ3IUK-M3scky{kIAgkaiM`tST(b3(!`ibPcKoG zD$H4qNCjEGt9FM_EdU|+m{ol$K(6dA`HI|Ves;sK5xXNBS0$=*)*tTmuAN2%9x1b` zS|i4-q@-sqIB6NGoSdvwWigyAO<#T$aCUMZuy%So`*Mp@k#w-G+)@PU>M}ut7+}+fd9BLaM06KQHXM(O$>7HL!1`pLw#*!z`797Fijf^wvwFL%Uf^Oxnrx-@yGd)KRe0T*Ns zOJ{Q}WP^%l0-#He*5gh>-~GXhl&@Mph!4EWo}+yGLJ$HtfP|P!k-R@Te|fee{YP}p zyK>-~{bDJKeqeP~1m6e{Lfx+Fs@R>PZ|1Z^6qlun0I-ap=V1&s(e z7nb5-AOnQwO;n*2!-@CW&k}S~a?HX48xm9D?3*1R$v;MhFj?z#hMFG8KJB8i>^|w_ zxvPwZpziQZz2?H@b$HF0T#aB%{QVS-vt8i1;5%9*Jt~TI^SsC3<@kc? z&uvP6zZx%-xBDj{QE5wt&N%V&+t1}_$$9M)nd5#LUGr*iSZI&>Unod-j{L|R9$`o1 zZB9l_9!^!HhTo?;(DB8xkq>EOcW^irm>ync^f|wOcpRcE9`XuYx1L|NI09i$OloLo z4~gMO#ZSI*WPzTcMr?~dz`U?IRcD?MfT_ow4rMgL57`~=@@hP7I=jOk?|2q4GyBHV z6VxuwmS!8ecg3{t`737_J9E(u#p-IRv5`-_b548=J>j6~P|6Q=;D4UqOw3Zhp!qG^ zBuMTI#!|jAg|*k|yMKhMdTtzt5Vf5Cse1ot<2Im!!50j3t)0I)g&KGB%#t2wkiiY6 z<>gh?XEJ8=SFS+&Q6*u}g)aB?!d}bHB64D`U&tur`bLw2+O2DK&M)a-j6}EU)b{iA zjAv!JdepIr=9!qNwMB^CDKNws^mt5A)l^N1N&fyIQM|nA8CTTRu>p?9w%}ot*=GbB zC;N5Yp((*(tLG`S0^y_g_=0senpb2a!kMaATj z-QF>S*iln1y$fgMRSIBd_V)G&w9_=HZWXcvdcaJW!Y|a4i?>IF=AZ%6qYDjL=LLeh z>Fkt5CyEkSsKR8IC?0%}T>D*^GbL#fli4)%yUgsQ-oW(4QLo;8O|51Z=YIHiE zvkx$D0Lt>)t-PAT|MUxYbiJ^Sc>a9!Wyo3ZFl&n3(NHW7QF2$y)l^HN5OqiB)$!GQ z6pgL2R8H58JhJ)I<2l1$zdH&0Ny951nlWWK!i;!P$lcnw{khGi)hzGr$>#Lh z*5@rtcA-}umW%AXKG(Taq_S_^xM4_zvqVX`x|W?{VWVf|NN9w7mg$23ob`o?$+&fV zQm|s&TXVAr=QBnWJ2}3pHrMM6`f|n+R`zDir4Ik7;v;mzoczwYIWeiR*e7+G*wN)Nv>?^Y17NYZ>4_=!_%{w~Lb!62lPE-2wvAB{9Sd-HmjEbVx`uLwAF8gM_q54c*-#9fBf)V8DC% z{?>cfV$Fho=5pgX=j^lh=XtJSIiv|wnS5wCfB@+;fV6XuKTPwE`u^%wPr_r9x@;A) zR}X{#0Mpx}=c(pG%?|($pqQs505%*;Al*>z(Za@;&3~!Fm7kteST=76L`FlkFt6PY zxoOrF3p?~etB&^sm>HOT)eK0vg7)lgS_j{*@nd6Iz@L=#+pw`rMKJp@yVnJTntv&d zEDtMTLeCPfA+6(9UFooUWxe3=@V9)3RcK|pQ@yGEM3oX{Eu(_XZZ}z!zilX@Lj4o8Ep|@w#r!VK{@-!9|v!j@yPYSCah-BTq_sabJS@95=X|@*S`})c(&uea! zHJ360*6%S;G1RjW1Gr1_OEq$F43jS(cR3p^Z~%CWyk1DsOOC34__fni#O90_7`*Q<#pyK$ zXOv%LV=$YuypToHVf{;}=!V>L4?KAOngh{^&&Ee&CIT17U!_!|(oL1p_b>tL@K0eut}emvpcHs88gb2#d7E6ciMsbntGs zIAyxuALhP!3}{qOGCk9X1*bMKge(+}J^5bbMh*xn`fu(d`&}lz0*Lzas18=~CHd0r zSUA(N#<7HV9T4-isl{`okKSkHHJ z!x;E`C;6z2e_x>!mP@f7!HuMk(Evu!0bKslo2^lWlrB{2PFlxV2>l5RO*i7Q3v7s&=IHSUZ0G+J22# z?+?LzyR|gFi0Rc#4BZ2FU!1QHSQrGotr%G9J$vnuTovxjidY%~fiFdVN2et1k0EZK zZn9^NF=c-Hj7R7^Wlz2l?R@5*gfyYhBmsg0QGl7)uzbaL2ZR!{ltBg#t|QUI_l_W9rWn?1nz^W|QZ z(9+Ku50HmAl;78y#sqHxVI06rZUtm&{Li{TsT`e`)3I7Lp6PD+xDM51uBmkE;MB2< z>Ny)B>t8vHXa3I>4Ql7W!dknO_yy4BItSFkwB6p%rpNYDWMAB{J>F8sBz^x_!H$Vb z<;qgZax;X@0_tbLj_I1M1mT9u@@~pO%SGIdvDb`p0C_>q5*VZaks4^40?-C;XpR*< zwbAOhCxJ+#QrV(;{9Y>bBMe;I=(|zIc<9ZaN_3sQ=V(ez-8Z|iVC~WMH?!w2CZK+z z=%4}46S%x?TRE^Rr*pY%cmgK|46VQ}wCUB^S#gr-mLp(k8>S5)dGWcOG}ELBEt9Kf z;qW}Z#A~OgyRWFmCkRkLhpZAMqqZNu5c-{zWj4HfxNllfYWet)yr2zG)@W7~%Dlj- zD03k>sW}Vw5~*u+HQGt?lH-Y#nc7lv61av1vQTIN!4;I51lAZZjS7;TS;*=wx@S6; zx`9M+I+C9}L}3|iQ{E~9>jq%f)$mQa$6Xb>@AkIzlqMR@l*YwgMPSGLfe0@#E?g_- z=0@-9`a7lEsJo6aMFo%dwj8*bIc{!g*g2*rOA#`TakPcYr0pZM?4S3$V(rUaIzR6M5Wj&T*>mBh@zv^%4V82b$*$ zqLyzddzR5c*?kIG(RO`h@5a*YE#NokYS~UcnRYR^1*s__PqY@wt3lFkm!&r3pPhKZ zHcMIVm2l2>DH8r27+bUnIyk%!)qfp86~+#X;(LN!sXwIP2aMzgO-1yUBZoYG60<`u!L??N@smSmW!0`W>!f$=TfxAKk1H&xqxeHe(-$|T7pGo|!YECG z1MKvophX^*Qk!uaEp;?QAd;h!@6yx|bmRmHIYTM`x%07r|CeDLcW9W+1b@a*WVL`K zywiXrJ{~{8KTS(11w(TJvyw^UwZi%KcA_TJslPU)!JMgw7UO^bRU3C&hc1Y3+t5 zVYGAuqT?kFo8_$gaHy89i zVl=J6Pw5SrRRQaf+(1d8&L%_y28>BSRRR28MCokWK!>lykdVUW64H1aRK+Jzs3=ul zLx*8mMpE8_+{RKiI-R&~Rug@it|Lu&u&T?hm%2bd@(@73nx;>O$t05kd!B$#7tnoQ zeA;Y7Pj1l%b${&&$l1!o?(8<=}!T%j;x|rJyj(Cn69A0FU>8 z;kF-0ygO*=162z9NusG1zTZ)`PlJ5LeXL8{zSBNm0j$Qeqw}e)=|Aw$OuqR;Q7|(A z$4W)ROHgI3RRRRRTiW(aC-Wd2kDy$z1m6DUVK!Y@)*l#0+U`i7smKA+3Q*PJ+J4{A za}P7zy1z3Fsn-yNDxR#dwjM=r(ewn`d?mMq%Fmhp_ zXh4nt0y)cHo9D3E(A9RiCn*;oNN}|Lw$=UUa8wgLAaUOM%MQ%$+?EWFfE9bon%osW zU}Nw);nz0e&wj*&g8&y2unE9u_B!2w0dP_Ro2VhxO)R5LqfS{;_e&Y90)j*Cj{%WS zp40MHR(olT(bUu}QPoft$0-?IO>|BLM=b}S;kL2++(1kDNwqNnAB+pGaMoaR=JRQ_ zjWCsXPsDRn*0Xs6QS|MNJJDAmHK1hH{;YIgYddoSqb>$l-s2rjVERQbjc z1*28zt_MTr5BpJhZbU!5n{Y6jEcxMz&~Iwo?6xYK;kzo$as=WdIcL~{S(KQB95wZ# zG%zUvOr)U1;mgmz>Hx)}fQ)Ll?a%KxX=flI`0$3%=kC~*ICflL5N zRj3hWV>k72b&lle>sCJ9fPrtIaU>J}UxQ-wWP5DJS!WfJn2#i0-!HaWYqf|ZC+Vrv zvVKfjM=)@hSoUk$KuTt-F`&UFeCZmCZ#1qyd3G$g>uhqO&;B?!tT72C zd&(?Yn;ak|+~-WwtENUSGuH3l+yGFGH5ly+QmH?A+_`Z$6X_LdXzhyB$QDNths|f^ zBbHlxV(htM0M;0=pKj}>Cpo8i`|_J0H79mRG^cT(2k4|St`_P&5WuB&RgrLz*X@zL z@R9vWLNgXa{?*Y%n5f9uBc+jW%kL!_jjseVR6#7C!|5I1$QJPV>NlRoihVfpy@|^z zP{INCs}gn}K#X%Arg;c^IVDn39*+FK-2Ug(uzo#bQ{OgAS&#ZR}^KCK` zW;QsCHzCp!tt?aMms+_^Fe$iA$?*oQps=Om_^f!Q_YF_(R4=C{Jsf%J_QOH>O0e!Q z-K*Jn%YX$F%a%mG_qkXoeKm3+6}z)k`%Tren){>5^1<>m<|ream|Wi%1Oy3M7NaSt z4c4Pj(v!0YVlu1E%+EX2s%8U7Yj8?wCm(A>VOJLw5CFz+Kdr7QPg9-#i4@p!qAkm! z5afu`Bsn2yFRcHk_XDnL$$coCkDqefY_U99=_GY25Br3Tc+I%0TOUZZBB6!x zdXLBD{pUkfjNXAHU7`UL26|>iyfAzB6&6N+lZVsNft2z`$aiEN4HlLnx8>z7@gt%V z$e9cWF2-Ln1Jd^=|0}lve7fGQt!o}NrE1Iyy4O>x<)qa>D@Ps^j!Xvy(QeO1m#*|H zllDSLMXyUns#xZzDQ``yJoT{hwZuR-Z)3V3(No!v_@$X2nO||ZGchl;VJIp;cZ@co ztWvmV&@rQ#Sjyv>1Yxu*t6*z2vPQ@{eut!|X_T`38geOE%yWi0)3*Nf>>A5Jq%|C5 ztJ9Mk?(XbVntFMATYM>&_d7hPaPcSUy}iW%NVty#Rg<9W#k?e7oTrdNK=CU*b+sI| zZt0ab%n+S7)Ox)%88Qk2vZ=plb6sHU?(__Ir)yLBw&t0=Sx`iH8WM|PwC(a**r$!J z#bLY@hRr!Egc zf&;oNw$#6>p5X`TKidGeLOAXx0Lb~&?a9XTd0zzpRdPQj`70uqo2v+1|4RMS^hV(D z%9pZ6;x(0TKFK7`K@RL*EPHZ7m{1kGe9H-*OIpOIZaVALUYOTurAY9+4o^)suXj>3dX!xM43)17qWA~L(W{fnkAxC5g0eA2Knh^$wV8)AijZvOD*-(NC|lM za^w~5*j&4><;p)=dw|i=!vURBPj|P{&5gPaTUw=jey9VoS05v$FIdV?=KUgd0Yim$ z^nmKrnD@w`LJWs*Oq?4PHE*GP!KqmwLiY=Qz%}D%Y{aNl=2`i?QbsUUT92sHG;#JYFBPw>HEajjjg&Qj!B9%vmv+ zc0w%oW276OwX^5^2tBz@h3L*A+56Az*kqfPpcsaP(++BoMG}lz8O(9zpjZ|LHJ9J7 zG5$Lbf&@#AU<5QI-gC8#Rl9$wG;NQ&2{knWDQ{w#|7Ifq@lf@A(0qgNw<#G!>$rJ_SyCR?3NmxrNHI~W!XT_gK+B8*L6gW zqrz)G49r5_^%B<1zOMS~9<)q$tkl4f{zN$V{XKg~mWo9cbf=2U(MfB9GTl8$dGX^q z!8|jA1^CBG3b__oyV>?cF+sur8{1obTy-5`vaHwA zfEoo~VT5-<72v`+MM(eDi=>_9dkpreCxhP96Ins&i^MpAP|2^JBS%r$hB(#U`hyZ#&b5trkDtr^;JXZ`1nRy@8|1Ru-*+N^LhbZhs5e_2#tut5)7s zc%Q!aGbsKwY@F?+(0>hRXR}-CXyfu4MH&-zVc^&U%h*=Sv8uuE1NTvf{2>Q!#~%mK$H{IGH8VyI;a z&M}>zCX!6zD{INhC1YvlfzC(;RcikMgCJ0WB zM!KonQOPK)2|q=|inZ-Alg@sSWMMU8vRx-r>G`Bk)fH zgOB6=Lg^tI&+qh{eccjH4aZ%@{F+i?+nshCrVAVHYLf+s(86?HV^>DG{9QSHA%s__ zV?oY*3RMFw(w$o+yPZ`}b{C@XbFq+MXu~GiANUm+T9Ev?9&-2bRh*7s|-NmK+~K z?7_soQ3?*^O=u%V-@%5naoaR-_+rb8nw$d#g|O;1BCNTQ?tVAm(0Tgzmv3i@lBJfJ zacT~~GRMkNDR~t_`Q;#(Jds(yy?c}`2lyk zo@~S??T^Iyr>dBiva9V6wBisptaZfh(pjD|&DO+~L=37j?&^I&k?k)a4o~Y`&x#<$ zN#%%%lLemY?!=AT$^$d)s}&mT_tD^D#jwP|qsRMMiKp_g;AE3JqRE*iZK)-XgRT*v zMLb*`*{aWc`FyzU^2d-(2Vs;8!o8Qe3nJ`i_f;Lw!=g#CF%=xC`(^HoH&=Zu2`~Q> z%H1fuBqBue*V%cs0Y(GODAn<-Hh7=^_32hZ?mlvqAfn}j9-}Y}oAYhFZipnNtzEEFff5PG<+f;hZemZn$%>L~J1RTG(s zqt;7ftCV90yptJtOez*n^?JI7D$R&2jJ@RQjnwk*%Z3+xE?%nwy@p|7e<6j`-);6U zY!qZRg-^{+jno{}_T?Vj7>R$27R@-rH`r2180{VDN5)RQ_0Sa9>QX?CCj$Y&m;;Wq zW%-rr91ocz|EmIyY4EJH#IB4e&om83Eu3F{gDDC0?y50ii!5#lX&SMm$lCe?H~VVi z7zGs)Ia$kp0>ogHxSvQh1p{v$l-9O;p(;d)DGZTOgK`_gouXLwJc&r$^GkG6)_i5R zsX`rW<~&ZKpa+{IPK{kjxicbGR+H=3P;5w_ib*ZK>$YfxqG1ISQj2w1=kY=T2Mjws zOJ^XfWLM@{_i6D@s(25guwoZgnBcqjq*>;O--1q7DXBRc>_%NAJl04{<9?X3fowla z{pZO^uDu@RZdDkPN4+54ZBV*96^*LVm?v;G6@!_nL!i3ao`@)B=khB%1_grg`Re+2 zM&<>qfCVUGwhNs?^VQb~WX_O34i+$J6zom+su1@8rxpu$$gjzz(L{dztUPIe_VGyH zQ7gv&duWBDp!4!vUMb5Gf9F2L7e@u#T3$v(g+2;HrL=1G5UH^}289Vkt7@<}5`$AA zgP&9y%A0eY_Xs^*IJ6!2o8x|j`If#-^pSvLPx`u^E~_Zzy_y_4xnTWv!}ptkxgdq8 z_vgChwY7@}XqXvfTo9QADwbM9t6-&WiA+u=5)fDbfWrC#?9|jY;aAgA50V9Hyfq$+ zX;fS<9mj&)Se#Wq4QUD{*m$FUm4(Gg44FYTC$phg3`(rptbpFU6-bE%2bM5_=1IPfflUx$;rQmZt6~7SZKfQM&yzZT2shP7@dDN9+tgCVVsE z49XZ2Y<_m4uoD&eL4v12sQ7$g@LHZyW^I-7x~mEx%>OL6-2`N*E=)v_A98%dgoiUb zo+T=Tdc;D#2<(a+pRJ>6;#oX=mVDgEoss;2CA{fH3}|09k`e?7Kf)gf)Rog#Zo8k9 zvI@SzegkD+0ByD8#V#PtaM%?bEf?RpkG(Y0K1%_U7j$@qp~>`KbVny8vy(*1GB7N# ztp>ZV@NRdqXuLJO?`d+^CEXQ9Tbx?r_O#g6-R?ICm4Bu=G%A^XtX|Yy4J~@ zd3r{}4HI)kCnmQP&T~G*(CJLGIch<$&-1mlb@$zrQ~|K;#QQX988!Z5V(=h6U0e>C zU@AfLCe$^@P26soaogo%oqWT=&#z&>m41Be`mVnOgVcI&7PtOkVLs&FBFw}#=T}Wm z_AJBPEvX*ll|0(#w$tBLQCj)H+Xw=SfWc_eKkG7w`ZQ?)<=c&*?6uWaq?xE zbtrIbTvS|ddKMDaDn#mK7nI*JIi(${vVjdvdM`EK^pX@IIO>2?B`Nx$bf_%v8BwFz zArsTmN3A5_T!>_oBzLn$aHTOYU1dpgCE@N+m0vPJ3ty`Zez(YI{QS+zZ>4tv=5m0L z{&fFuw4uz)R0$9vPNn=cr<;Bg_EY;5{(W#rsB!7n73KET`A1XVsGOk+W#ufVC}oO* zc5)9!Y%~(itWWM7ak!bP=}&8aMra;*q-3G6YV}`?(ztMkh1EHk3O{vV@UQ-JKIA?T z3Xc_Lu$cds1XcvOOzF{K(~f8r)@g>6R(YJbs~GSXwVhiNqV>v9?sDT;%ws5T8!W8zGG)&zRK~Etg zRlXFip_tlV!I4dTD&{Mx4G|D`2Ik)ih881;$pU10-0iyadM59YPZmg|0rkpb_S3oO z22BMYW_p2024`N{v6bDGXSqDsbYS0hQEkWwO+ysaFP(=5zU*#)lpxESYuM`W;=r*fW$8R6vr@Kfv=<<)(TqkY-6!YewZy)=#Yl6yov1_%Km`alfoeTW0B$WDVou~F9XKvz;Zn!N-?{f zg|UxD&6pilarwc8yjsxnX8~KKIc1w5GzCk`BsD$D;)2)+WtGQ~i!&iasE}Hl@Q#I5 zP)%)Y&1|OVne!X4`KQ6PT!X7XH=^wkVfEZ-9;Y;4@+aS7WR$$1(1bLDQG{;(IOPVR z`TXj~zdmGY)yBc)@ApDP(HwLGI2RM00HsOd!{2kU#nJZ}+5=j;9T0ZpriVnG^=u9b zi9GlF^iYIXFh81Km3bpGGaC^@90tTCF=u_Y>ZSG+`%|_5of`gC56eG6;$bh@NSzK? zY196~4;_t@F{d}X+Gu-OM}j^*2P?IV-$?)DtTRf^ZoQ_$i17E#SALlsmltb37@x(i z2ju)18J3jx%LOXDXB59xJC^lCPS+(bKiN{#_$XL7b)cNsPbJKZ(_t8puw31z$i;>> z`YH!-6(YRIQdIDFiO51*4*>(1JYWj#AGu|QgcjCx6ESE?11^%|TV^pMDn4ET+>qiH z4gzQfFTWTnTFekca)^y}5$g%wEPV!BN_Mkqt0G70Fyg;g4NI}=OJY`<^)EWN0ViE? zP9ML;INWbF)$)SRK?Y2|$}chfPk$);khd$gqF*H#Ic+)`7pD@Qp=w0#!{NJJ+?w+q zrA&$nU$uyRlF92WsoqWvy14SxHVT)Cu7mSS_nFvBb@r#NPGVgb9Vz#VV-Brf$Zd={ zL_k0&hS)OTjenTqVPQ!lFb)(M`eVmfD|;{MRcA^IO~7aer16y&6p22>S_YcPGDBuT z#6)l447sC>X3s*UOR%FM00%5dHC|57I%F=-3xkWVF^MGS4~8c`jDgc*^n&iOl3-y) z<34~>9os9EM)%N}-7GGDm?BS;_;XT*+BC?U0^T{|E?7pe%SuYa@{o)v z4#L*}W=6iZMU&!E^Uy|6v|76a-_rQL{W%0k71Q@{-A8mUq=be7Ay2E%*a zgEU8=FHmBVfLNn~DMZ>zpZJDO3=c*sosn#B4-mVsAxec!5lQq`&R*m(Tt!9o_}-eR z2tP?yHdbCI1u6m>36yH`;B9k8Y7}hUIQ6}%g(=-S9?AE_#E$~RSh(23)nS%UWrKcw zmHC@peue3xJk<(EiSB`lB+6f~onxSY(0)q223%{vIGI^o66Uao8vys$~ z4L+`=p}<&bFJN?T0qApma45<(XQF}zkB3&umjfy>G`yar5rl&~S`sl6_d|Ed(q?U= znVPYQ<)^>A^4`m@syZLEsi8Q6%6eQ{;QSN49Sr{p8@Nv*O*Nl>3 z^3wDSX3wIyh#$cd5>-`IkuMR%0Dh&wkub6(u2PFSl~Y-bvuy5QDf3nL z%e1__m9gIpYy<mko5=V5DD5bcp$Dj5o zTNT0qCyVBl`^s(ZxM9YW(NIwc;`ad`x(5@5LP08w422gW_aRlhB12%T(p|GTC)2^? zPzDZ(l0C><=8Cl3`Hl)^f}EH`I@ggkxju4MHU#&zKA8j>y0 z{ZZ9pmzl*~W6vXezUdeYeo=X0k2qO7Nli~N7*&vRh;$*%U#Nv&wNTCSCgR7H5o!-1 z{CH2Cb51tCn+>&}usD9A%0dkPc011V`E*TQ)Om^Z7Mq`@QVAuU{oy%iKuMy)c z6v>5&t#cBEhs)xiH>!0tp#>TrK;IjkIKe!W>fn3^ln}+izDecsSGbv3I zMzx1zXw>k~g6~JrpkJ>TzFnOn|7YaYY?3?n?p+-u9E6f)|KwDKcD=_gTn&snM1TxW zGgxeMzBAfuJwEu_@j}+(bI_g6hXwwQQDcM*&zgUIt)cvQ-irnoJ{PJKvfUkzOx|UP zY71pg?h+3P`luRO6NYrCdE+16)pre!x@ipTwUikMXOWX9M$l+^OG}%<|EW~eHgcCj ztn#U;Kh|Put^9w2G@=^Bw7Va|{O?BBJE;%vqR++Oc0MJZs_B6Wc8} zJFq|c0@2BXW6QBR`!}TV%~h2J>Cq^U3!lEcG*Zz5HREOqvKJY~6c3|^l6@G;&(eU= zkAVxVxtZm(^NV3>rxq>vz_f?zgjcMw)E%uKc*yw#d*4-5h{LS@PK`qS7do96X-05% zq%Hy#F3od11sWPsh@F=heB=Txp=a@nubrEQ~ zDA@E6O$2sj>nbZqx=6#@>O+7j8beem^7}>UzuCoZ3>h|NB#Ai@eH6;DX6giPO-^dM zy@-;j0RnNKooL^l4DKq8=!eRJ4bb}2mZ3@sCJl}T6CLs}OBTAXEfyLC`@3Phtu*Dw zClK$a_=J1DBZeTpJf@HsjFg;^lFjH;l8E#ua=J1`2IN8Be{vn;&bPF3N!S^WpIB0A z@gbett?NEULygbs8n;5rxYoAr+g$}Uu03;X*i?SCg8D~WuXOqtY7V|`(`9B>N5ho$ zPsABcoCY1ADZIr>OdU;fS!ngvI+J}ogGaZ>^iS?dAf*udwwF*^9;&ZovCz)RriJB zIAunwt_*|+A}SqaNgy^fg(1b)+#q%m`j{L@4ihHd+RKqADC}z$ z%@&>4Irh8Hp+wT8K*iC-z>X=d_M|v9&~w1~^YwScq;^=H-7jThf3%)y;{T>lSkdp& z*m@b+*f`hZe_OCJlZ_$@4hy4fwAwt<;Pwu20t2OCHY@NI95@flm7J27LrlH?aKhN7 zlm-Pzma?OiJ_c>X;oH#)p~^OvFckaJ5A^Bue~VqT2`BXghnOGo!S8wYF}|}Ok4pbg zQV&#un#|`_iz}&13==#HvrH~97;hhf&Mq{nw6Z$-SNEh>0Dua17EqzR1YEj^1ZE3H z{KjT2!)8Zrd`K*Y@sOC3##QGUo8~J=G(HF_^j+wy3eD0gXK2Td*>rWBxA-5;@ngSy zQ)7+X_#B`D$`vEcJv4`3)JK(NDIuWOV{cWtQ@}Y)9C~v_YMQ^222)7MWv~$EPiCn3 zG~pHE_SLUmhnaVTV*Y*pLr%eDTqNC>W4uoj9iVssmQH}p{@Ak6t$j^ycZdDet@`E1 zaF_}%z-Q*A83Fi+k<~t!^lTyOi#*E3@1dO?WUW;`CnrWxMJHv-sw5%UoT3(SNxCP9 z;uyt3X^pmSAQ%k~1H7iHm%N7)&VvR26zNAbLEtbHX(AmXCi`k55}nPJCQg&zl~s51 zzzk(&el3iQ{~6G_%w_6#OUb!n0yDNsa6N&yh}~kt#2i5lYF8HoImwh^*uqnhVx!r? zUm)CE2hT6%oyH{A+~oS)l)JD&!t(NQCk|(V%0l+^V4b8dVvabGrj;ovRA|hiLJTJ4SMxZL?RHCSX*JoY!Wy!q9 zMJOneB~XZr&beCNlLJ=CM!_$|TL*%g0Uu?#^Rw1%?w&?EX1o55pJ9(Kt~}KblL|uB zAOWGVqs4&&Fr-;UL)!@A0Wd3KGvLNzX+s`c@vKlIJ&F8tL0tEXS)C3Y;l8(&Eh>XI z^9Sy+&VMw=wQ?6Lx#ozTokXkVSZL0MMFwV}lZjQDHX_k&1-Y8*u=2(m4@^tSjG>XO zZc$zlL3*{;$bP&!<{_qr;&a0ZMc9TC{Myzid~U_HSkbiRzJMeDC2_(jK==eeGc=F$ zMW8jsBhKoPMKw34^{9`f;pC;M_-5&LIOgQh-|mz*Z2}Pc`qIIwpl3KS+Cj^~+^42* zbEAGjUR7l5ifWZAt1SGJ!qh}z)IecmXV2O7Ub&g`0aD!r6S>Rr1`rfD9x6r}wnk<7 zeOXm-sD`SRtmnG#=FVnTv461ZD;w7u^Z2`DV}9WueR;WzrP?b@rMaWgsbU$bjIy5o ztc%a}_<=Xol9^&CNH`Ugs)Lkym}F&W1cQwwh{j*q!pc#KMmW((2J;I6oeP6VG_!v} zgUD02%ksrlm92jY(KB71VIL8`FO^b&=f(|yqERewULEQNC{a@%MBjf%_^uC`C-R|6 z&0%4~B&a7lSEFveQc|xC>MR!*9B>^Ef@!MUO&}afs?tl4TsEkMZ(X$JIf|+^y9#3s zP}nihiV7hRQ>9)^yZoqHG$7+Cje{A92h&*xZ}PAJ>;3BF?pdZrC1{pJg=ABZpoxH2 z-?djXG`sl2c;o*-5=7(?B~Erpo46XO`!@Z7yPy zM3jpM&3`hvAlikEBGNX3G8xiZR&K1|24ZZq=q9P_pAz%g9PV0=GYL%^x6sj#(N{I& z9-Fr*NJ{p?c$9y?d2-t5xp{Lt?dDKU>L*34_qFpa7J^lBwT1G%PaGjN^?w@Qa*2XA zz0^DtBM|JG<1ej((%@&wW%xiXNkUj$E5#4cQx6ppSuooBhrPvqD`p(ku|!2L%R`tU z6!(+*t}r4CSn8f6#8U}}fp+}>WN0I!mD|}irEhgx+p`D|5Q-oZAnf_)w(vycMfSbh za+S!~DB{EJ=MkLiDT166A(3UTeFpZ0ttXSq!dGOQ^z3UFz)}}1r?oKI z((BwSU+uDxJsAjZ$_;w%pos`q!|R7I5j+`9q9zd4S74(>ZqNqQfeEg$jjq_0Rhy|2s> z9lo}VmO%t*f2R|kWP_DrhGhgJg)<_sx!ge>rO1)+NI!#l4DswnB9cSCBS^#^`w);# zcK>tUW;GCnZ?vtFe#h?48^LsLaV1oxzR0z6#&T_NA0sy zW?+DE$>A!{9erE;0Zhna-t&1B%7-!NN$Fq8rWVvyK9C%{@{(rF{ah}TO=ecOW1@V; z&-lgoT9i@18SwGMB#K=b1YqI~WtFB}w(t>Qj1Cd<>9rA+Fan5Urq1oF+6YCbX?lu@ zjuabg#S87UW^4|MYwe7M%jbqJQj{ktEbykeHwXa`YvN}hVOGwzrGyMK&7C;wLK);RkE(P4g<)9cA;pyeyIu-B3*ajrUcA3z;^ z?86L_1rU7v!}0o3K;jmMO32xbne}(pzfyN<$({YK*3mX~VNsiYuhasPlC6W-LK1fQ z%al^T6q3_s!u&#eW_gP_5|*}6-H-TuEh!{8GYbg@EzHGGe26HUd}AufjY+14wLleQ z2*UV@V3v8(e0?-$J?&)_2E=-dJetdaQ-6(`%TeF9Dw>msZ;ttzIO;UrTCc~FnSN@H zFqQ;q5D=vy0u?dQZ6bNVKoYV3dtS-sgfSAcE~6t3$fa=0iv}nJ#f}4^%Vp%|7T$4-lT+o219&^2y#Zge@W&3#pYzYP#R8h|Xj2JAoVhha18j7UI00O0-% z15D@WC_vCqp(VJUDvJXvKnq@I z_>r6zIF}ZvMY1#%vPu4YN$y?v3qIz^bX+A6v#Kt1^pF{+l_^#GVXl;H$YRCeR%D+G zB3c5o|L7@cngm=2MPBSk+cOI&6K;t|+0i&2G}+^11`%BzBVXyP^`@Da;Q3wBB&R_w z1~SR7JsEWBHti8gj7p*+J#ngoQj=m6v@n4c8o{2V8fMKZ!w;p;ZC#J=l>uAoPI_og zdqlo=P=c0rQ&Z1l0e4nfSvl54&TjLs;T7s*!gUznpTzsr=C%e_v*ilE5mFij2(~U% zZI7{gIXStZat$^G;B(PTC;<%MI4qazO+(Mzf0%aBr)mBEo7h89s35AS?Y9RZ(cGSM zaAeA*RQuU49Q z106z(;B)k!?Q}jG<5javc%(vmc{yVzW*>Wln_P_MD+S-H`qGE06-t4M!%LTN2SWhXrn%F142@XuK2=fkw3M^){yCDm|5+exX)K< zb@jyL?X|TS!2DN2$kt$G40LJ%8q7RCdO-aB2>>uL=ziOhybT0IfWmG0@AoxuCROf0 z1DH9!f>|BEp>Sg2!odAfY0Dp(-+j19)upEqN1@n^*bGV&d9mRyBxCzNFOSW=D=gBB zE4+1K>)nw=D1`3O^H>ilNELQtE=#pY;97ndxTy-@S!%A-e;{ZTQG3Q3RtSD#$wIXB zc42SL$5k`eQ_jqR^6Pn83><@=;U)l21AApV7?YnCSxSq3Oddc0@qJc1QoWCCd}Ui5 ztke9Lar+e)jL&Kos-2VdRsGxWI`NymybMn+?FvxDspGAO&a*ORRS}PjoOINQ7p`jd4HOZ9Y-Z-)s@RKs)kSNiit#ta0xMZ{sTAnt$cwcJU+PR8awe zwu+}DgqfmRBP2}g!ze^rCmVOsO)V+S!Z=jKF4Z&L65j*R2L!v8%o$%=XeECsjX)2n z`0_z8QJ33&uBXi`bBuTf7?T>_UOT2Td;@Cp%da+ND+!EbtcrwHliEgN@PV^!0z2 z%CuLm{dLX*EXob8$C$C99g!hfUzH|KeOo2CP4zI8n*JoG4-^i)tvY+Z?4(yz(DWBX z#AaD3?vquVHKMXpApEUQdGdwD@G*f4NBKpd2<+*L50F~5?u5rT(cXR}3?<0>@H3e&gZ zY2b+x$l}$Ti98q9A3yj8GV)ipTB)ea4TMS)S_y)E5`v%gRs2)z*nvp}s*R5l409y< z3G8MZ+1Oc*R)D_y>}r)FZI_Fdt;juDAMl7$fTjx}d85r_JZ{NRewkLKx_W=;a-NIt z-D>j!KmQWTqTH6>f9uajh|8?A8=2Yny;r*<&X~yVyy2%_9MGB3Kgu!#%4m!2--2d7 ze}J_zEQso?5<-n|LsKrqVR)>FUnVCfS2pWhi-cH#4hRN~mY6_WQHyaW7neZ*u>q{( zb^~bD{w;IDlvP4vQd0G`yWAi0URgXih1+kW_I7-0$9V9&*rt>t-|9vW4_a3iAMqeg zL;J)2t^X+em+cESjiN1Y@bhsbVl^YqM z2s}vtu%ing%_SPqhv%#s55t|@EQb*t*Sjgi1n;wObEy+fA^{wd)wWqiR-7YpU()6z z@zq|sV&y*f>8}se59KfdKE8h%Z!L@EwuLjwT>jXm zYGJO9UXBq6Y?m*WzzQ8PiPHIdtzI6gD1>~9h%gOaDyv)UuDcex>u_1XqL|Y}2wp48 z)EDgaDSMWqHyW4ou61fZ<=2Nq1kpoN?MgqJ(Kd1iz{J@SPFOtZa+VMv{mu%@5b7Utj8d z4v`OEF2Cri~)~w@yGJN zEz_U>)&4Ml3Xb-(7b0ykWBCjA7n1KLfAVP*J}*Xelf&m~7tXyFw-uxkwn@?@&Bnq7 zxIj?JPo`hpc7HOJdf55JeSTINzSF7vVj@18V(#(G(?d*ts}b`Bd?!>lKX1Dj@XmZ4 z5r{;7E+9w&3Agb4TS^o2=){b{8=+lfOCwKG4W+jNp-~ZWj7UKqyiziF?_x~TW1E1q zAf@OR@PC`Cuz}X=9ai^wg7o-uUA^6t`ANsZKC)T8LhQJ^T=pYnqwOt6nwJ#6s+}p$ zz@3BJ<`y_lj_dENH{F_}E;9zO@U%QmBFj6MP2VzH+}?6?it-Ure;DxK0Gar%in|YQ zZ&arc3z1<{QDO9YXPR0g2xS)pf~GM1z7rVfO#`pVKRpGw3{qLn3@C#;L6_v!m zBD=I67&RL|hGSsAb6Lb1t8Hdsu%%gBh2mFlfsUTEjiI)8IatjHnG-WQ@g!W9XKGQnTqeK?8<-z%TF z(`DHy6=fvxXUOqYsq$eAC_pOF8Qih$M~6Nq(_ka|QwXkkv16=RINs*e5~hV)8OaiY z?IbygsEYnm7KV4+)U4)8ER4qi$yh}-?REM%{=v^JOp;o?^mo1T1ZxhdX6JOXpCUNk zS1?6e%0S8G1gN11`rgv0eac~EB4>(R&dxX5JfHJu7l-MGF-t1Tb^)K`h3d}oFYCT_ zLvlU(Wel;2`H92{`H6!-tMWmAyJ9|CER@>rUw_*7Qt1YPrx_2W{USygMYiFl;9K<( zB^V)MJAI6#yZ?))m*-1H8+7V0Q80@DIFK#de|dl_GVE5Tcfa;L1D)RB&*V4zqcy+J zURacS_;=5cqsr;S-I=7)H|^Z z@sQxeL6%P(e_HkI36O$fSfO`!y`+Q@G0)-y9b04p_#Mz%)cR>5c9!@3iN5UmezGnVqQ32eenb0p_~naFwJ_m} ze^SA}-@oqNwK_r%k%4)c1Prnm1Wfzl3v&JQ9K5r$_>=p_3b>XQe~f|8J3Fd9Bj8e) zp9}ZwiMpz5r7W|2C^O8U_S;~>HD}N64fH3EDDPW)E8sJwAW+bIn=Ge9K!b|%aY~X* zmOXC&J4#dPo_&tsGcB>mg%J?tS{KleXn)4y|LS_{sHna_YIrDV8HVl}x=T`G=oE&K zlt#Ld?g57G7HI+L7EoyqlNa`{JPMs{{N zR@|~%zcNQdvHn6|%B3c{O!z11eFB2_fX^CBltW$^E!!=Tkt$MIvlUw4GYHc;_u&H& zT_wOV4lsIlu<(rptbdWElyB+8woo2Gy=mo9m{mUx50x}D@U!`!R&)USB*40@`m?py z99v?J3hgY}0bh0Y*L#Eh2TDcW%RFP%J5{2;DT`)T#0{D<@kMO3Bw?IG#pT6z(s1{>+} z9+z=14j(-#cq4t@Jt6)l{z_^+ti~jB;3`@tUy5{SO~*U~?!O|9W=}(G{J<7>f7%LB zCWwULAmBP`{Ug8VDAzhjPU@Fa;TcY!w7>{vLDf;{w{OrH8W8sFD78FP69Z>qJ*t`&LtxJA;FpN+4GXB0{rSeMO9HrmkEfm;YUpEDJsU_PK;>I5?&Sn^(ECWS(Ezp?Ej#$EgMg3@i~rT=G`E)CJ$& zpG5Qh5okNBPT5)+=WlArS$L%_xe$8Rec45Qf@)Y0+CnJHa~3b41??#tO~3a5EqfBB z)iVsNu|mJ*+Me=YS1rUS>-<|i4tFS|s2jWA*ikK#L;7Et5`03#Qz}X2tq~A6CMvB^ zVziEsMu+K{kYNc`;6#@?96m$L9fSIt0y&y7VVJEKJjzZEATPwE+`s%O zu_U5iU6&}jj*EK!0ezlkyK$HOTFFKI40O*-j615_&;Ma`A2xMMm2u)7HFw9KuDpnX z#Ive&jel_`tXBe)!j#PpuGyfH=S$F=&Y>NCVw~he_B5mtagy>+TgAq72)=~XjX*_b zV%Y`&Mc)K8ZI3?vS~-iJBl6uc#&FVW=)(5BP^IaEiN{CGpB^8ThF{gc zU{n}RIk5=_F~|`#IT6K{#mM1!0wQ@{uR4vqbhv0TP&g8R4cHz72!DqSpjbC-bk|Nc zSRZZUwE6db{cl1@kY8DKH8EgU0hlZvnO=vYoQ?E@9B5f#q3<)jRIa!&$w}g_Sh&$bGF<8a9o_!7)J9Lt%FR5*qidlKq9B+^ynIM_9m`eObS;eZmQR+h9YE6>W)1BB$IZT2fN-Z=^X3p2~ zrG?yc!E;+zGK`8y2RRI7L6gH0k2y-86r+V))>@iPFO&|?BhxgLP70uXh1EVHNCy~Q zy~9RnpaJ+I%4iGF3Ro(4q1B`5d*`KVQUH%~TFrerw$@N26EaV@;KsPG%5>mSyJ}H` zZyB+ixhm~L{P7Y)Lv#%Of%fVHVg{_z#&c)F)d&8tfUN9+1g5S~~0Umr#8x_ZbU1BR-<$e^Ism?6?Y{PWOB(NsmorBM& zLS~%o(bEJ|^I@87wNkm$jP!SIK2f{Zbbia5DL&#AQZ;stu7MEZ9!!J~VhElBpRjz{ zHqWSoi8r)uB`xqJT&emG*kMdtGFQf1aZsK&fsV$R0)0F{N2vc{cg%+s;N%&TVQMM% zO)u}X436@T2Am_rcL^UpeBi{bDv?}`4a4c*6aW?1)xBRC*yO;#OR<4x=Q7%h_30}0~-f|qveQpEcW8C+cUd7Q{&C=V#_v! zAsVW|YuN6brhEyk)U^mj4-cA`vvTD;0Zn3Km!!dT_yM(?KG;T|FP4K%W5#cG)UKe6 z?T=pK!~)Es#BZuG%P$5s<<0}yRtc3N(9xP+j5Nyn|PNdAmlb!e|@XWO;N20>&f9E3;gx4y&Hko=ZpXFSrb(XL$7P zX%Lfg&<_GUa|@zabe;L+p0>@I%-8x9CT-wPq=ufDg!lk z{dNV>(4DavpgdYnsn7Tv&a5W>drP>Y@NrAtXksD^Ck{u9EtQHvDa4t5nCOt(HLQZ( zuUHZdH%_mR(aG$Ciw4hk%+KjW3E2Ej1}DvrcBe&oQ%h1|TC-u<9XA>?1H3K| zMrJk|h&@k0_Sdr@_<-%8V=W@JIUVt7k3)!srRwM)5*()=H1?02HVdj?W#hqPKpO2SZ=Jrx&~rl8F}zRdJgP{MZ=W#3m{~H!FmY7@w5o zXFY#zmI*~n5OEQnD9G{5kUO!8%$0g!1#Q68Il(7vBiOM&8vU&qkm(}T7J2i{W86R# zP)sRxf_`vgBSqd3udwhhb|jd)CXmd4)aB0>AjB3!h%^tCsK4J8BX)PK(^^$PWoajK zMx7FqkjtpW!^qwRZ>aG|9(7bXkH8$hp#8iv1(6iTr}r>CP|Rj37yfk}A9>Sp6>i(o zJKj+8=NNQ}w&cD3jzF0UP?Zg${1)|-?m zKt9#!N43^e>>e7ZN)%Db4BCjQyyBpv*o4bq;Rx34e)e-O&l+`sIe@HW?#WIsk)G)=`=D@>=Epu=-#bQkEl|2ERo`RlVeGV5}N2F`BoNY6(NJ}RU5J`vMT7=P^%xVu9 z{Jk!!O8M9+iK5VAtH@Uo2wGWX$b7qxs1V|$eHl#8uG|7vVw@Jiv$eq5i*m?sA@O26 zT(W)7SmvxEyK;Z-Q%?hvdk?S^(b>K;V6f5-4^9chV4>;j3S??qpE$Bx4&QZ(pPy#; zBC6gv?;F;pK0*gWD(BK&Gzj3A@yM7Tj}JRZ&Wq$l1^~?qSU5PO#j5zToJv* z7c@^xJ0j%Zlx~b)_g=cA_pzr_2ACbtjw~wX;KwMgYRF-V55p3mLD-_b{Ts>(Z;-#+ zVPZ5c(nwT%S3%!mkEW4>UQIf@x|+7q!@#LN-Q+<0*{lt3+9)vt@^9Eg>IPU_W3{MN zrOa*CN{A`s{YHaYF~mG%f3K#VF7i4^6+k*lqX- z6Bz>qQ)5gQ(%K4z!`^4FstljAu<-D8eq#eXiml4wen7s4viF%C$PF_!hCI4MwBA4ZA1G{CmUCbK8sE=)a>rNKO6bJ?Z}ls|dJy(cfvYH;*3*!?xuH z3VLmc7)753iOefR6jZ-!i-)p?s$|Vh&3wj`_inCG@urYVtoo&i@R3j1t?$M+ls#L{ zc}vrdorV0(&Q$EukeC^j<&b*{q_(cu8XfpkRhy3IK`HFxknU|f>|0x}vy}(|H=m?< zR!#!PnN>Z;jp->ZN;bOsNliMsj}`kzEVbok?h!?aUL#XEcDlgCTtd(a5w}UF6%Jv%Hu*$-8a$*KkxT&#ylM%NmHPaH{ zY2Qkg2&g^w+P1^h{A@{gdGE?)-6<-lrhfh+aZBV#SP^a5pi%T}PiKM)6M>kT^3ZOJ zMd8^1$%xb`Blma2tbO^ysCt~3j;Orq-52bb)Za5(r63%vDtm=e_YYd-h{kBGsMhYw z3&F|K`6f!(mi>>-tnVcsb`%AE4uAjbsW1o4P9&|$-ceHA&{-7OF?*G1km@TK`ZU^7 z2+0wtBlvW&kFp?x7&VLm{!VPQhUUvu_ZGO@7Cd4i{fIsi0?F~AZY6xozi#rw&L;?5 z>N-|uHOs3xoSMH!;|2LtlPzn&gTLu9HoNM@O6OMO1|c3Fe%7?$nU3ro5vFQwv5m^g z7TES>V>WE#eO>#t(vI-3K4|&0li-bp<|$>5Uz;76NtltjWt~f|ruut9#KHM>XmUODjguPY%AJ&z|J?8Ws%Z zO)?mok^S;h>ZQyXRihNuYvDiNvJiV`?Nxz!BM57L72b;^BAVr`QIxv9nv$FJ;&-jecY{@xAwk09H znEi)`df2DdS~i4BYc2{^NwiHf*kc515s2K^?%Bwtx3503SWgy@Tz!F3lj6W=(M1~I z&6unbxc|HJeIjkmH;B@&*tcoVFjG_CCRggfOLL|P7k#UNv|Yh59i2CTRQ$mddxSik zW0Y#>_Vj3w)H~gYlHu7K<6nbAwaG)@I;(A{92Z^~?I%S03;4P`YvI|RtjV_Ptc+F% z9O;sRCtsK9jLfb5e#|olW}bf8|I82s&T5;s{TlbrxN=q6uqBYYdU7g={5}8H3}=wjxk1O-sJTK-uB7;hsshTgTT1_kjdYIzl1fM@CpYF-@NW_W*eMthg-UI#4R1Eb}uvW(?+wO}+g8 z4fd`Gk_8zdstUr$(ySNj zyakWWUa*@OLS+S5Y?BU|XE`fZ zB2*P9V2a)pFGuC*sX5fvfqSL{oMTXI8{l z#pKdsLiOQRTb#;qo71|3*qetbEYhHD}R5$T6?oe)@>N@c22>H}>kE%hR;;@V6xB|1co#U(9e42VFU^F)f|=gwcn`D^m8yOFcmu+nS1N4Ki*thO+xJXW8g=7V8t!J zj(B-(Vr{1H1jFc9YBZEIoo|&A;Pn8Sn$U-IlE^&a=bM1eHb|GW<}nmCpGFd^W{o>{ z3uUQl42{NaGvZMy@usH-cU$z2Df6V04DXhgRpSEw)6`!BoyGE%u%1u2Vi;vH{J_|S z3JRV;;zRzZ97p}VW}y$`i6TGrJ z6HbxVx^-(=kc)_dO9{m%Jd{SWW}>3oWWuqe#UE*_{7mNTsAR6;46JFoWkwxtblH67 zK$4(8j2#NtTw!il9u1>bIxLUvE3dL#hFcRTYrycgy6FlH-KAac2P{?*jG72D;~J;* z!+xbeIZn6tcZHye-#bOGhWBhCAdepv6ejU4k7#QN<2$uzc$=#2b{^QB74J03U0&}g z)%r#Wrbp6u;sF>ej=#${I?8NF@-+e^TrewMb3%r|6qS?)K>Z97I|fsoPvX}iK83+1 z|Eh`tvM<5XP4*MiK(yp*X1n!Jyc1CZ!1L5+JfqD*V`tlek>TR%7{j*~^*ps}5)96) z>$<(4byUquehst|20th4iBJ@YfAY**!p+zdE%f&-`|)_?t0CZ#@zCjR9;A)PG0Ez*@lb(oyas9R zFLy{~2$T%PNQFms9QB@is>tyLF9{Lr$+Qi< zyyl2FLEVdy(RcX#n}Z0OF%;~j^PQTOw)WBk6^+znYL~!^h#J#1UggmDt$~*-9*rM( zEp8Xb-=Zmv(lw)VkP2k!%2iX-M8OYDN{X9JzJ7h3?rp4LMUNp&uG8jTMz6$Y-eM=% z`eCV4Aht901Fgv4e6nMsOoGs#fn!U)SF~tpRKnnc{Ais;9we`;=DogG6EI|M0r}^? zF5e&GoWOcfMde{oU(B(i-K5yikD;Mv#!V)#j;@Y&r#(_$iiO>vuRQ}913%C!Ag_*9 z`ZM0hhRaCSlrrjg)92fueyAh~_CeQqU>TE}Po+SKPdHNbICTWKO=2=oL2T593s+n7osJf4t1P&Jl~pNeH3!3_vTe|vbAt!3km~j6`qy5p> zP%q)jyX&y&rr(O;IO1;)1H!v%lA}unTlr;(VH^ND4aUK-p5RRtcBBokkt)}JV|{kT zf_195d%5cV5ujJgbMl%r53=h0>x-&mY}Fz&N4v5|;c9jqk)0{iAwg6ApUhT`0(-oP4pyY5 z|IXm=nR(&C(kPJ}%qw#Q;V>{zpF`wiZuHM@m;i?>l35M)!?#|m!RMc0P7dI*pexJI z%ira}m_P5wi&AqXXyS}NT2>uRKzN_+6lbJc7n4A=)&I38SKR&)-_j77^YRUsUg1nS zB+T_Ue0^-T$Q{0w{_FLP0RiWUEWn(Y&Cys5cXO}I$T3?eY+l`LVFJn3RuEc?Cl1z1 z=s9P9zXeq>Z_k;^#7~5DdrsUm*qkL7zTE&AP>vm; z1eI&;cs&93_@rw6Pr}Xw`0jEhx6g^fXe+3%D#|MS4y9J<8{JG6Z+~#@pgr9YW7Snu@N+q$*lm8xKi^W!t5(V=Wpd zQ!WBt#vcoZ0_i3_e_kve1xgGL0(s$@Ppsi;Lj9LdRUgX^;n6?c zhRb4C{HAMQl;FJnTZm2r1!cF=_e)7$i8Gi7HU0FbYBClk&KIO9p=x1jZ(m&{#zY(( zpn=#w96g}*n-6L_FAGaxU0g@T)aMypond=?bQQDu5khl(#BeJhbGy^PEGmf(^1n_J zJK5+7BQN@My7qRvz2JC;KQvLw?LD!d?41-&DKhMOMeI1wxqdMF=xajQpX0i>x0~x| zpkJZC{oZcAYdQY?T_$1DEClQR`d7p9u8Z8iwABl zez@+eZ5R&M@gJP7d2%0R(zg;eT-N~>1x=`SB0b--&M(u4>lXXGNCVdB{yBEGhiJE4 zU;Xk9bbqI2VzzT~PU-2(kk!MWtn^ojyFVuL$v0$v^X^}>#rZGRh>oi9rjkVHn2FR7 zEq+@473|X!Po^~qquh^`76An~fX0@pbY-O^a6wf^dx}tir10)!)naSM;*K)x{($26 zdv_1A=?~z0Db{log7o{`8?W>j6h4?}3~Vmm9e5$&PEt91CgEvoQl4jHSDP2>_mJu| zz_)U(=bnM*c8~q|`snY}-mUOci-`5h58+8EG7mxiw{a8g*N00@7$~Y7Ku<=I*8~1z zdE*<_nb?h)wmFf3EZ4ex>woMTDu+2A_zfHxK64KP=%WE*oG#13XRD1?7{GvYP!0V3 z09mF#!v21i)i1OH@oZlnK+JUc$aXmB^)hnxqY&a377lChq(0Gxw=d9ZJjkj)?BqS) zgwMLUdz04qN<`QT74Pf+8rj{-JMTG1uPU`H{R?JGp?v_N^|#_qes@CMoIx^@n6kNX zW;%ENy=dURZjxC_qQtyrAI|02%Klt#d zlUpZ~A><&B`DVS7c~iIE+H7*^FSqZ?xEABdxD(GRG;$u~UjYsk8$$By(5E*OX8^PI zc&{v_6d)4-kJYyV^5n>k^0BNZfgM10m>eAT_;C>;MMJ4mKeOyE*JQ9f-?p6e54O(Q z8{~~4=Nftr_%*}0y6d3%i@RubtQZZFm3)^uMYrSDmRH)!Hp} zY0oIgLS%q$f$JupmOYA#%LrW1XNOiav*Xr&*h$yb>gdf@eB!9aX}Rn|T(sjg+NPqd z-by-)cViN^d%*2+HPADl^!J|i%b(+;yDguyCjPS^ zhKrDM3)|`R1zv!Q^04CEh6y2;sI0p<6Cd-L%0bFa5D1IPw>DL;% zT<-v7T3{D8t@FfsJSb~4=R@e9Kp^lnywG7v^+Wu^x&00mSq9#me6%d&w%uBvpl1>K zoyKtuR1%V5k{;uq)UfpEj$ElzH7?BN3jX#1pRLyE3%z}nG6HzUy9*7e zxv?_)2k?GQT=WBzm8te)ah`WuPCVUz^u%{|Q?`CPe~nGve)6px5mgp{%<>+ei}jpk za~rOEC4(AT`c;X8H^AcRsl@`n!>n?yNzn>|GR%xlF@}aA1;2o}Bnf>W+UgdK- zJA?y4*v*>IXd?x+?mTqOSim!2RT2!GGgkYzfi)Qa!j%qOHtj@|^xw%EBO07Ry&kL| z{1B_v0HUTg1;9-GcHG*JPt^sBAZ3_vk|$oeaAM6qy)6(Ul3A4_akp~~+16TmhR6UH zNzlMlF`3M`P+5P#uG9Hg1<=#2f6kSf9xoykeRH|;)6{Q=EH$6>aUpejzNQ%B#{nat zXa@98E1wY}CRtmNhDILKjs1V+e+ZCd>~|4!eS9}o(zR2$2AiwG%gV;I$duE%{`DDN zzxOx@T&>2$WnPhoggmKI{*mxRF(e54z+{yX!D4rUK%JaWb&{zX zwC#eVdrj1_Edn}Ioc^x@9(!IpR2HuZzZ1I&cr<80ETb=9@xuYcgjr%lFmXoCxbP(s z=uqIVdRze+IjCzEv~xCQpq1%NVWK@>SGpC0$--LE$Xm_95!r+HrT`vvr23ThUq>knoinqEDyplmhN0!n(|hL;`v{xY zPx#dZ?B%C3Vy4B2mnJ1S{Q4z7`^61v|5+ZIR&_b@Z*v7GPa&(HXpVKF@i!jIwT)T* zeD>1^eTcV-f}^^?GQ_*6Ay4{iXYjndhi|>Lt`m{DK~CszS`abjoSzT#!dzl9i8gHf z4hzhpi%e4`!=C(iFMYaNny%JDYieq&!_ScMCMDZ^<*%MagNldZ81LLxxTy&59U{PZ z@;K2`B7XEMmyVY~fmCU*+n#x034yu~b7$^@RVgOK>xD@IRP+Xj-}nmn zz910QROecM678Zvo1pLS{c~{`^Vse=oX@x3L@2UBB-T;ZO%QmDrkeb5f#Qsafvg|@ zlp9bg&f!zl^-=!~;QxAg=j1OMS!#THRjcw82n1sFQ8Mzeweqo(wDGb7UO++uLc+X) zLcD^a`a*(|qGFN)65Ij;k^%zTEJUgQR{>XdTSxnV|964(&<-A;0LTCN4?d2rcHTZ# zt{(sIGDFVUXFwTdR2dIjdr4JCxSco5-Pg_5(d{|R-5(?_@Q6>uU-*##H}K`eU0Do# on&kigw4t4sx1+loNJmkbSCCJ*%i!-h@N1BolD1+!%rf%-14W-~A&MaAy-XNghoN zXe`m}QZgm-x%>P=q8wzrV(U@5)?N%E^v58UXhAxJil9hzV~2>#p^;%S5U4+w;#+SX3~$h&M6Q$c-CwT&1IZ2BmNEC&(D*; z{!dv5^kX>b5oq*&R=C$sAsN}>i_aAOX0GVo_fEj>jg9?NPD6l`r>or?y|=>2aX*{D zA~Mhm9%CFUzR#pgGTTz4c)<7c?&RG2tJmlKT(vj1=*KqXNxEKk8kbHx+#GR-0Ozq9?@2P~^({I5Kg38oTa8<1vw z9c#KgWe6sA@4CIVSKW_~< zeJGsZe3!w^w zlTWP-(S6B89<@kIE&p~`1%_;QhFx5#E)g+?XM>`SaJMOYCA!RzY+~{Z#iK?H@li%AqE4>@cIrJnjUVhXdxGggN1^o-F=#4H@l;V7K%_0(9O85v%JW=HWNtiRgE?~kte&tiNqveUEYw31 z+eC{7sXg!s@3YM!`AKf9zZNz2l_av#VB~B})1hQqUVSU9R0}o0B{{E%H0P4i3zE@n z9zK7){OQ1JWMgxtJ`j12E%z9tWS2<+clAK`{RdRi{{v`&JMwPmnFn4!-SPzjh5vyZ zh!^TM{}8MH9(@#9{u@==)Bd5%y)Xzm75CtB4?;GvPM42y0;eViW`VZOe zjTQe>hQ$oub3^z`?HIP?hbEAEToKlRP(Fkj>0x2@M#kExbh?3N6tUU z-Qldl7JE7gA{v3KKoC$y1j(-y$t;4cWGqwmVvmxC zUAkNn>f2TlURLJvguX9H&1}5j2vhbdgUXlqtoT`cQV6A=g_QuX(Z`!3RBg|_xuqC~ zGl*#5ov2cLP|rM(ARe;ZYMSXozLs3-{0&8Hzjq^Wic|lJaE{hibygEJUldyz$rI3g z%_!=Yv~A99v%NxKMQOVwD8+3aYjREE_!ohP;r3T3vCnMGjQuQQkUeUCAg=vaYQRwJ zd)SxdF%QGg;U)4Y;fTU0yxXN!I>_#gVRu;`$=wa=!HgRlvL(fh;w$0J}LghH)9_Sor_(V`IvipJbJQj#s9 zZ+H%6)h!@Pn)eye@E8M8mNYqm$FC26pkP+L$!W4{Ou>IAUmA~EVY@ck8I>ALy*_Zh zVfHDk<8AECoLyh7xfPumtxn-&n*dj2*%=bfAFKNLi*OU}g&DWnY>I8)lDgg+mnJ~Z zxNW+y>VL~eFFMfiozr&O&v*LeT9f%EG^m*%A}sNjH2(m-`lP{DatMcR(hdp8BS2Fq zrSbBae1ML7BT{i4rLiUWv9R%{>(aSc(@Y7I{-_5VoGThnptj4TSgcV6xDTeb;WGEB;cSH*QC zA_fzI97dHk>fZ!GqQQA9)J=5jDVN{+gh}MIG|~+VBozIq>Q~Zxsc6LG>xJv5T1Lgi z+F>9|G7W48KE0rHf0ME4;*Izlo7E*?{uiCj%ON2oOy7P2@g^z8;ko~)v{~hIN`;1( zF6oI$0>)!raLjkO900cJ#YO4eK%5QR1dG`NnZbFOfJvtpTn4?4BtY?NOW@_WlhwZ= zOfR%uWq&bybv(XS-`&coswp%T$m*N4kcI2Nv?+Vt=yh!Fq9ExCF<=W72`R~Q9G%_| z7Vd6_9QwffjU@<)z44D8scqs67!<&M*~-xrkjWQ-6iy}s@s~1(1!I*3T=a~P%r?`w z3COrOe&&Z4k|v;nN>mA&QG=Ju6PE?B^)9&$voso~sGe!}hRSv_(7H90k=8+D3HO*& z?(Q{fJr)SR<;J>=!T?C&x|!KiBGyg;6^M%&+zVa|HbK)jiLcrI$^H0K^`FsTB&R0F ztV)%_rdfZ~;Tk90I(e3w>J*Y^l;9-O>lf5c|06-?xGq69Yd9&L!pvLXifmLL1_v?P ztj{dZ-Z@BI-by|mdPw=Sss2%j`1{9)>iFZRWZiQREog^DctPqcni!p#J)AX`b6^e% zfQDt^;zk)?PYFR`#t*x8tQ9TU;BIs$A<}H@i9q(qE0cuy+au-T4Sl|lttDv1Mo zC|_Xf-Ev2eX^ldYPuVQeO_nqFrZBgH#*{r_ayZ}vCKHcH`^y98KIUBSVm^WtQ;?p) zrp)5@D=Bkch1r1d$8~7zpGO1H59Sgs?%T}Z^npS$TqoeN($(^8pMLMur3D3h%_mo{ zF+rP{LuUQ-;C_pMJ`2Py|7Nkz8oPJ&$(C!Xc8R1(93iL6FVH!b7rdB*W_f1e6dtIc zTIdfB7w(_YQ5lrqVQ@EzVx0yT2QgIPpgCxO6CPvrgamUQvAm)m4U#&pY1$RS=-x80 z(Yv$a$Q)UrS8~mGD48`v2H}cbR%hFYn?-{yKs%l^E@TPdB5vf5N5Jrem9lmPDd^lA%bG4U^i7r1(9nC=CfboEeG#EbuImN-p1Q z!w&a>TQhyO0ylGha#i=o8szp4$Q-`DY@Yl1^Gzv}X!#O?=GSZfuM_zn7q&;|ZIEoS zg0Jn)c}Qn}-;7cHwN5EdRi5yQf)Vnp{3$_;bjaEp%nBiP^>Ijc=uz59t!K%W#AbNt ztml14EPn9$Yh%M)mLN;Z&CwP11Oxst1R}n;Trg>P=aMC(>CRnKrAJKhkoG zPLYvm0K^+Vl7G#o7-{uK-cOkGb zo`-HJ0mM6fPVrQiuMq0rS6b=;rg>Z@w>G zGe#9fIf2hKZUB;(UH@b?Q!k_O?Vf3}ChOSEYXjY66qlI^Z5XbCL9>f=nmB&#KD5?k6~OPJPsljo9@ z&yVW8ok!N@s;~p}9{06GhaKXgnHmhfj*rh_?*6sSF4MkhD ztJK&3T2n<)VzVlY=@mD*#u)=5Lo0TN$dz2Vo7_Z)g}e8Ij_R8cau8BAKRJ5?fLGs- zvOh`fQq2MUbh2EaN93;<`?~dniCk*-LD5S{qrBy{Fs9kD3isgYBL`5*z(e z`t!k1VVI0?M9eJ|kMA6gc8dDSJEgo+E^nn&s_#A#!SIHAF-(@fGS6$N>(qtY#xrKQ zRpj@aNbirfq+sU5OG`7x5)3j$GfOPbd9E~CkuSppG%v>J-pUV%%8V?4$@*XpNXK%~&Ni-dc3?;6bD#xg-c#i5g>8RfQ!259>EgOsz z;fIfLFD~X6IOzs#!)nCHZ~y3>*jEnUMAw6nzr(!Dq|m!^)|~DQ#T@%Xn?)VAH+z%Q zvhMMr3L-w0dk)MD9kr{fK59LCZ^Bco6Re&jA5HM>Xw)<2{9!gI&C`(Qvm}tx%2eg{ z582q+3=E0jx2r|d4_#qpt*|1-Xd1ZHwf0^&gQSa;SY>}sL3Bd669t>qI z)~d_=66%q2u?izUYjR(SnZ#YaVp!@Rh_jDtb1pd@&YhaKWU?x1dCf1HBQ-cvi1p#_5~_j?!AUH{ty?H1X4vLL?Su|#+H z6eJc5~3n}(Ntmw1LVBmAJ1012^M^3EME@t7b2TJr2nc}h7Ch!&G#I|uzu*Q-{d}} zysy&T^C8Jn){G*h(-~?akdb-zKf%wNAg=P-IOuW zt|@Mor7Q;|dWNp)2$)6e688fJWjf)+HNUM=ZHnKb+RkKP9uOdmneagAeScm~J>m8-6&P4baDkKcnZ|(GOqhNY3CVT?PS@o{;=FwuKIU_RJ2rUkw zQZkjiJYyStnT7HE52P>+`J6I{<%y^!VSt|RYo2vsw4-ms#Fcu!cKKIF7FD{L`?fdQ z`qoX(4KQ32scFRB&%5hi3l=UXhs%i)0P(L>RLs_3v#vcs(G1DfJ1x(am_jGIwL5Rz zKRUYWoC(hLdDnQ}ICpdI3%4cJuOoGgi>_SoMKH~iPyj*rhIM0E61%T09t+Ch9ABsF z!;C)o&!l!I-eKMuQrCB6Yur5xiN9~7Psm8;MZtBMqq{>G+l(Lbx>3N}lTcUSv@%RW zwPj=FhG*2ABqqPY8H$xWZ46kDp?x<-W?*hXT-^crj4Yadx5-WUxe{CQp^qj(;FZ8e z@eko9h*w`N(R!zLu=t-kYN&zMvzva!(CZ;OtW~iK*It>*xq_?1m1KA)f}ZwJ8`@FE zCPl_@=t$DYEZgzchD^Em4W%5cxY@hY8%(|qqLkIe93BH!(Hh&GD8H%{)@RJ2aXaFe zqFqtDq5xjd4RNVD#6jURU-$qC@PDR?)r3dmN~k?Hvn|P|R(7{o#+bbh(Wc+Xw(wJz zTLMZIob_KGoKDzawCQMAKK5ms47eGaS7h`@S8r12fPcw_EhO@ssO%W|;QUwWNSH)q z1OY~fp_n0upOci%4h;I}h>DMmNB{Pt1`#wCz!qY^j`~txt-+?asoUD|C-}g(V?Qlc z)v3uJp_6FBJ2os)4S5$sn5%|dnG}+l-)ebfS})O?{~A+oS90ekrh_WvpvyqXBSLW* z17Ha4J0nOGM`4Datr!+k1N0Tiz&ozAs1GQG_xb3`gb(~GbHD1Voej!HeJ+Il$mZ#W z&yaoLNveq^5#PMSkd@5j%Ol?q(+uA{8j^Y3yIRNav$3ws*RLSRIqRDjd35|5oS!%Z z`3qLf`dtc7?5zjQraI>iTuF^}+v!_JL4+FKdJ2RbVh(TFcQE_FH#~HiCcli%$8a7) zl=o|tp7{)!@t8M7uV`Hhni0!1j$R62(wADyZBfST$X^^S+^xHM+kSEj&`?vStq0$N zlU1diRjgZ5z~{*NiwBdz`RY)+u?|h7Tv}JwxW*}p!jbqkVXkq69X11cII+akjY`-Q zEfM?yk#89(y$p7CT)@=l#aZmiGMcJ*Q~08}>e$_aow;S}xujbx_*f?jmL}r86h}#I zH+w^ExKB|hG9jc}pd->k+pwb-K8vpFQOC9dib_J1_dw@8(Tp*!Q~kg4&);sq=_+HY z%vTjo&p!UX$=~NZ|F^!Dc*><#uLlQTo2;}^-;`BC%#&MLV1y=P?z)!0Zuosrfjd7f zN|c1A9L}OjavD>Y5GU;1aiyI+6iP%fR={1dz5rUPA*C?$%L{rVt1Qa-m~Fqt*k#hN z%_)}inq#b4&<(0M+bf-xUPT}I)6%h8a>p7a_j1u55$+~~@f#bH^Kxw_BWdfKvLol| z<`i&!Pc`F6a3wMsy}I>{_{@>Bw1sr57Xz6*=No7sXd8BIp-Zr8^wbIt=_2s3}XD7}NmGhhAYNF-XoKT!Er;v%sg|V$R$Zo%m_ddNajQHtW zf5qJtTj=_|`0Avc&--BtZMQ<)Vt+*Pw5CHUMFZryn@VNCfIj7`AH2EVvhwxyO-3Rs zhD&_xz*KMr>*tc_>t4d|+ga4_Z0K^&jEr+59aWAhMz1Q^EkEoMB8DOjZl=zE_E7v7 zzj<%6bgn?wCKBvOt+YdTkbOy8E^R=8L6~h+w+%kirYuAzM87hyM492Y+faLv z&<}9|lyh^L6pCK>b{r;$Z|Yoeo(X2_PPt&M~I(lpAlb~@$K}^PehwO`a|9@WQ!+YS+XL{iEORdQVjGR6K;$)lfz5+X61u^ zp?s6$+j%+XUz^&5;H*tPR$!x0WGuarXtuEhf^JWZ_VVpP_QNxP0Hhcw3YN9W%5iZ& z%htKq$!iR`se?g3qx(=aMN!cyPpOH;VY5; zb@HZPch^p0e(7dst1EJ+J0;F%9(o>`PT!>DE@clA*~sNtmP>1)^KZ$@58-GesN zc9HPxw^yQ0Q!qmJu@1U-qYe^`D-p9I+IpzuJAT_`+$<*A>u7~x^>wc|bTtYH{wtPr zb(}oWJ=63Ed4=<*!#1BKhSFGcT(iBf58*#hexAyuJZ4}b-_A^tm85I^JjXG5-M0mS z03(WS^yuZ(nU+Tg3l7@z`fjuUH8NT5x17--ukXu}!Xorf>RX@g=uH|}sI>z?#w=IJ z6D!RZFme-MFdhGUnE%hAJzC|?6gRDppI|^+S}xz070Hw6svPJ4_19xu;#4o5q< zOnW5CZKJr$lv<` zdXeNvH~R$mKIJOR!$oQGP_yHHSqQKMuRhHqWT|~GSm;BgT8snZFady1wU%yjPu%=n zp2=c|j6C2b!vxy+|Li&$#;C{_^QvNjeJ-FkZF+z9oVrs%lRs^Q6Mvb#{-A@G+o|oL zhEeon<1mQbTxeR}W+AIKL_vgd!B8!PT^kSXl&1Wxj&)FWB? zZ4H_HYregBroP^7(P#!#oGcE{h=({};d=ea-l)ET4+SYh?H3R^aG0gC?r6x5XAeUh6)5(M$ z&=4*q&x{>%*s!&Lis`s8`7j@zQa_peh^P&ki?d_0G#~5x@h~^amHw{#2^P&fl*~zjG%0+pW1Vs!7O+-A!d4cN7ogwPTP5v|D{RK~PVj@;am zg4kz#)R04Lk)GowD#(d-Z|4k{;6d9st}m}H-R&)2?((c-`NFRb@pkE zhjuylEtfOS?hMwhMjDpzC*9G{E?P3?^rx|0*%PvdqFo6>oOpYVB2(E{`b9L!DTR6R z_n-8*Yay)JWXz^q42omE!1mXaHCq3`8{e&)KOC}Kl$62BRr6T!xtTaKy5+jmQ&0d8 zDqKQ5Oj{KLwa0JO_T!s=ooB=LJ0~nr*9zWh_f&c=x>rIj$<|RqoS4d<;7jNuKN-d-`>3!J7e`a|HYI(U>r_%}OQ_dMJ6 zelOFjm!DaD@~Ah><_5Y82Iv}ia-Oeui(dO~a;M?17~SnGrUxqDir(5?Ia-*n!eX67 zZ5L~x;dDdC!oO*G@}b70rJ9S?lv`N1RBFhecF*8}Zl5ttbWXZgQU?7GWb&aMg&$Sa zSWzGwaD%dsZD~))x^o-)b+B02g4NQ^^4{Wxj9@yHYDM~X!L#qra}4tS=Wxh>p9cA_ z(4<41Xz1?7Qk5fnC+Qr52zT~K$?Ii$jR>{Njb@f^ugPnz&b3!%B1Y@|zBWHNh5Rr} z)%=Fh%%_XJ0JO!rdF1r}O7=A8|19679PgF&CIzZEc7|wFs7T^?=jgW0q08gLrpCTJ zq<0%WGt+S>VYG-H)xJp^B8AuXEf%F%4RZ9|pCR?*I1zh>VR3`Z(Gq6zg?qf=zIxVe z1W4ZAX4;Et*^tm z@TIbbkKb8k_3XRA?)-W7Q#9Tp>fN68P`W#Ni6Xz9qsx4*XD6s|)T*^79}WrXD}V{T z<+11Q^A;ALwZsZZ!22fXG#A2?f8>Z;QVAgu)GdXR*|hqqNPHIs@Wy5A4q;QeBiIRxbCHO^zihah3!4zI6>{ty`j3S~d8a8d$g}cQLgr7FO~F z6HjmjZ*Kg|sM@X`xtm|{_X-k6c<^4g)i3;7ZW5IS)oCP{9m`7^T96Hbther257*eW zjq8oVh}%sj9sh3OKvx`CLJ6t9iPrnu{(THbw6v#4tLWdX#)tMWcCL(*PYRzU&ZU48 zNql%D5=^|(5dPdGYoM4zK=|jIF{hv~Qv>!}@1V=y`G$6$Mt1cD-w-V)JMG3AUwPjd zd0Xn2o_h|_X7wB%&g;_&>#?H88JF@#2$J_GpPh0lt(I;#{B#I9-M9HW8EUILwfJUL zoEg3V!ws<26VTBp4k4#2J$K!hhKLoQ6sh}8^IPTC_5qNhEH}|{W8b1xUjmUsauMxS z8;Ruh&5*H2VW>V6b)jymPquSbumg|)y>igwqbN=dk)Ne1fBAvcR|y`&OT2y##8oHB zBKn<6HXdCxVON zD;C3ikJUxksjd|vqSSLdQgFIE+yiFSImnIN#uY~AMNZZmqIA|4em-w&puuRbX^5uE zWZfFy-2?z??-mTJH&M($P-r$C)K$Z2}LYSbF;}lwiV|K-G2z~ z3{5>oQLn>VMIZbBj`V+VcXe=Q&ql7`HOcdHUDn4zOU+j0cF$pm_gXK)|3bN5e)Rs} zoWSD$3X}iuK>Gg|iMBhe2Tt$U`!lwAz=M-dT&1;L%}rb_1k9W*zze_yCIEx=k{SQs73>_$t>1e6?+V{vO@)IqF#pdCuGV%IF0Lkaj{m#P zuKtA Date: Fri, 15 Dec 2023 15:02:52 -0700 Subject: [PATCH 132/232] cpp docs: update note about doxygenclass and doxygenstruct being disabled Also move references inline --- docs/source/dev/cppapi/README.txt | 5 +++++ docs/source/dev/cppapi/api.rst | 3 +++ docs/source/dev/cppapi/index.rst | 13 ++++++++++++- docs/source/dev/cppapi/zrefs.rst | 8 -------- 4 files changed, 20 insertions(+), 9 deletions(-) delete mode 100644 docs/source/dev/cppapi/zrefs.rst diff --git a/docs/source/dev/cppapi/README.txt b/docs/source/dev/cppapi/README.txt index bb8b3a62a2..c623c166fb 100644 --- a/docs/source/dev/cppapi/README.txt +++ b/docs/source/dev/cppapi/README.txt @@ -1,3 +1,8 @@ 2023.12.15 ADP We don't currently run doxygen on RTD due to some configuration issues. So the doxygen content for the cpp was manually run and stored (really not ideal and should be fixed). + +doxygenclass and doygenstruct are commented out in the following places. When doxygen is working, turn these back on. +api.rst:8: .. doxygenclass:: fast::OpenFAST +index.rst:18: .. doxygenclass:: fast::fastInputs +index.rst:27: .. doxygenstruct:: fast::turbineDataType diff --git a/docs/source/dev/cppapi/api.rst b/docs/source/dev/cppapi/api.rst index 96fdff067b..c1313d08e5 100644 --- a/docs/source/dev/cppapi/api.rst +++ b/docs/source/dev/cppapi/api.rst @@ -4,6 +4,9 @@ C++ API Documentation OpenFAST -------- + +FIXME: **doxygenclass** is needed to render the class structure + .. .. doxygenclass:: fast::OpenFAST :members: diff --git a/docs/source/dev/cppapi/index.rst b/docs/source/dev/cppapi/index.rst index 2b6ba46af4..85d7d6e698 100644 --- a/docs/source/dev/cppapi/index.rst +++ b/docs/source/dev/cppapi/index.rst @@ -14,6 +14,8 @@ The C++ API is defined and implemented in the :class:`~fast::OpenFAST` class. An All inputs to the OpenFAST class are expected through an object of the :class:`fast::fastInputs`. +FIXME: **doxygenclass** is needed to render the :class:`fast::fastInputs` class structure + .. .. doxygenclass:: fast::fastInputs :members: @@ -23,6 +25,8 @@ All inputs to the OpenFAST class are expected through an object of the :class:`f The object of :class:`~fast::fastInputs` class is expected hold a struct vector of type :class:`~fast::turbineDataType` and size of the number of turbines in the simulation. +FIXME: **doxygenstruct** is needed to render the :class:`fast::turbineDataType` class structure + .. .. doxygenstruct:: fast::turbineDataType :members: @@ -98,7 +102,6 @@ OpenFAST uses different spatial meshes for the various modules :cite:`cpp-fastv8 :maxdepth: 1 api.rst - zrefs.rst Implementation @@ -206,3 +209,11 @@ The test for the implementation of the mapping procedure is as follows. OpenFAST :width: 100% Variation of torque using different number of actuator force nodes in `OpenFAST` for the same number of velocity nodes. + + + +References +---------- + +.. bibliography:: bibliography.bib + :labelprefix: cpp- diff --git a/docs/source/dev/cppapi/zrefs.rst b/docs/source/dev/cppapi/zrefs.rst deleted file mode 100644 index 3e5b907356..0000000000 --- a/docs/source/dev/cppapi/zrefs.rst +++ /dev/null @@ -1,8 +0,0 @@ -.. only:: html - - References - ---------- - -.. bibliography:: bibliography.bib - :labelprefix: cpp- - From 2f7bd6f7df1f1404adf57b5f18ecdb25b66e867d Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 15 Dec 2023 15:53:40 -0700 Subject: [PATCH 133/232] OF: added `NumStateTimes` to registry for sizing arrays of state derived types --- .../openfast-library/src/FAST_Registry.txt | 120 +++++++++--------- modules/openfast-library/src/FAST_Types.f90 | 119 ++++++++--------- 2 files changed, 121 insertions(+), 118 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 07a57f7c18..ed586e5b11 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -68,6 +68,8 @@ param ^ - INTEGER SS_Indx_WS - 3 - "wind speed" - param ^ - INTEGER SS_Indx_RotSpeed - 4 - "rotor speed" - param ^ - INTEGER SS_Indx_Err - 5 - "err in the ss solve" - param ^ - INTEGER SS_Indx_Iter - 6 - "number of iterations" - +# Size of state derived type arrays +param ^ - INTEGER NumStateTimes - 4 - "size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED)" - # ...... Data for VTK surface visualization ............................................................................ typedef ^ FAST_VTK_BLSurfaceType SiKi AirfoilCoords {:}{:}{:} - - "x,y coordinates for airfoil around each blade node on a blade (relative to reference)" - @@ -429,10 +431,10 @@ typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Arr typedef ^ ^ DbKi InputTimes_Saved {:}{:} - - "Backup Array of times associated with Input Array" # ..... ElastoDyn data ....................................................................................................... -typedef FAST ElastoDyn_Data ED_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ ED_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ ED_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ ED_OtherStateType OtherSt {4} - - "Other states" +typedef FAST ElastoDyn_Data ED_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" @@ -447,10 +449,10 @@ typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with # ..... ServoDyn data ....................................................................................................... -typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ SrvD_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ SrvD_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ SrvD_OtherStateType OtherSt {4} - - "Other states" +typedef FAST ServoDyn_Data SrvD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" @@ -464,10 +466,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn14 data ....................................................................................................... -typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ AD14_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ AD14_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ AD14_OtherStateType OtherSt {4} - - "Other states" +typedef FAST AeroDyn14_Data AD14_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ AD14_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ AD14_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ AD14_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ AD14_ParameterType p - - - "Parameters" typedef ^ ^ AD14_InputType u - - - "System inputs" typedef ^ ^ AD14_OutputType y - - - "System outputs" @@ -478,10 +480,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... AeroDyn data ....................................................................................................... -typedef FAST AeroDyn_Data AD_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ AD_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ AD_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ AD_OtherStateType OtherSt {4} - - "Other states" +typedef FAST AeroDyn_Data AD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" @@ -494,10 +496,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtLoads data ....................................................................................................... -typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {2} - - "Continuous states" -typedef ^ ^ ExtLd_DiscreteStateType xd {2} - - "Discrete states" -typedef ^ ^ ExtLd_ConstraintStateType z {2} - - "Constraint states" -typedef ^ ^ ExtLd_OtherStateType OtherSt {2} - - "Other states" +typedef FAST ExtLoads_Data ExtLd_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ExtLd_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ ExtLd_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ ExtLd_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ ExtLd_ParameterType p - - - "Parameters" typedef ^ ^ ExtLd_InputType u - - - "System inputs" typedef ^ ^ ExtLd_OutputType y - - - "System outputs" @@ -505,10 +507,10 @@ typedef ^ ^ ExtLd_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" # ..... InflowWind data ....................................................................................................... -typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ InflowWind_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ InflowWind_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ InflowWind_OtherStateType OtherSt {4} - - "Other states" +typedef FAST InflowWind_Data InflowWind_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" @@ -532,10 +534,10 @@ typedef ^ ^ SC_DX_OutputType y - - - "System outputs" typedef ^ ^ SC_DX_ParameterType p - - - "System parameters" # ..... SubDyn data ....................................................................................................... -typedef FAST SubDyn_Data SD_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ SD_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ SD_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ SD_OtherStateType OtherSt {4} - - "Other states" +typedef FAST SubDyn_Data SD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ SD_ParameterType p - - - "Parameters" typedef ^ ^ SD_InputType u - - - "System inputs" typedef ^ ^ SD_OutputType y - - - "System outputs" @@ -548,10 +550,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... ExtPtfm data ....................................................................................................... -typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ ExtPtfm_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ ExtPtfm_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ ExtPtfm_OtherStateType OtherSt {4} - - "Other states" +typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ ExtPtfm_ParameterType p - - - "Parameters" typedef ^ ^ ExtPtfm_InputType u - - - "System inputs" typedef ^ ^ ExtPtfm_OutputType y - - - "System outputs" @@ -562,10 +564,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... SeaState data ....................................................................................................... -typedef FAST SeaState_Data SeaSt_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ SeaSt_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ SeaSt_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ SeaSt_OtherStateType OtherSt {4} - - "Other states" +typedef FAST SeaState_Data SeaSt_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ SeaSt_ParameterType p - - - "Parameters" typedef ^ ^ SeaSt_InputType u - - - "System inputs" typedef ^ ^ SeaSt_OutputType y - - - "System outputs" @@ -578,10 +580,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... HydroDyn data ....................................................................................................... -typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ HydroDyn_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ HydroDyn_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ HydroDyn_OtherStateType OtherSt {4} - - "Other states" +typedef FAST HydroDyn_Data HydroDyn_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ HydroDyn_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" @@ -594,10 +596,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... IceFloe data ....................................................................................................... -typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ IceFloe_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ IceFloe_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ IceFloe_OtherStateType OtherSt {4} - - "Other states" +typedef FAST IceFloe_Data IceFloe_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ IceFloe_ParameterType p - - - "Parameters" typedef ^ ^ IceFloe_InputType u - - - "System inputs" typedef ^ ^ IceFloe_OutputType y - - - "System outputs" @@ -608,9 +610,9 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MAP data ....................................................................................................... -typedef FAST MAP_Data MAP_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ MAP_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ MAP_ConstraintStateType z {4} - - "Constraint states" +typedef FAST MAP_Data MAP_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z {NumStateTimes} - - "Constraint states" typedef ^ ^ MAP_OtherStateType OtherSt - - - "Other/optimization states" typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" @@ -624,10 +626,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... FEAMooring data ....................................................................................................... -typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ FEAM_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ FEAM_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ FEAM_OtherStateType OtherSt {4} - - "Other states" +typedef FAST FEAMooring_Data FEAM_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ FEAM_ParameterType p - - - "Parameters" typedef ^ ^ FEAM_InputType u - - - "System inputs" typedef ^ ^ FEAM_OutputType y - - - "System outputs" @@ -638,10 +640,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... MoorDyn data ....................................................................................................... -typedef FAST MoorDyn_Data MD_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ MD_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ MD_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ MD_OtherStateType OtherSt {4} - - "Other states" +typedef FAST MoorDyn_Data MD_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" @@ -654,10 +656,10 @@ typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" typedef ^ ^ DbKi InputTimes_Saved {:} - - "Backup Array of times associated with Input Array" # ..... OrcaFlex data ....................................................................................................... -typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {4} - - "Continuous states" -typedef ^ ^ Orca_DiscreteStateType xd {4} - - "Discrete states" -typedef ^ ^ Orca_ConstraintStateType z {4} - - "Constraint states" -typedef ^ ^ Orca_OtherStateType OtherSt {4} - - "Other states" +typedef FAST OrcaFlex_Data Orca_ContinuousStateType x {NumStateTimes} - - "Continuous states" +typedef ^ ^ Orca_DiscreteStateType xd {NumStateTimes} - - "Discrete states" +typedef ^ ^ Orca_ConstraintStateType z {NumStateTimes} - - "Constraint states" +typedef ^ ^ Orca_OtherStateType OtherSt {NumStateTimes} - - "Other states" typedef ^ ^ Orca_ParameterType p - - - "Parameters" typedef ^ ^ Orca_InputType u - - - "System inputs" typedef ^ ^ Orca_OutputType y - - - "System outputs" diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 06aa8e9627..f404c8acea 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -81,6 +81,7 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_RotSpeed = 4 ! rotor speed [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Err = 5 ! err in the ss solve [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Iter = 6 ! number of iterations [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumStateTimes = 4 ! size of arrays of state derived types (Continuous state type etc). (STATE_CURR, STATE_PRED, STATE_SAVED_CURR, STATE_SAVED_PRED) [-] ! ========= FAST_VTK_BLSurfaceType ======= TYPE, PUBLIC :: FAST_VTK_BLSurfaceType REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: AirfoilCoords !< x,y coordinates for airfoil around each blade node on a blade (relative to reference) [-] @@ -427,10 +428,10 @@ MODULE FAST_Types ! ======================= ! ========= ElastoDyn_Data ======= TYPE, PUBLIC :: ElastoDyn_Data - TYPE(ED_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(ED_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(ED_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(ED_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(ED_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(ED_ParameterType) :: p !< Parameters [-] TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] @@ -446,10 +447,10 @@ MODULE FAST_Types ! ======================= ! ========= ServoDyn_Data ======= TYPE, PUBLIC :: ServoDyn_Data - TYPE(SrvD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(SrvD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(SrvD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(SrvD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(SrvD_ParameterType) :: p !< Parameters [-] TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] @@ -465,10 +466,10 @@ MODULE FAST_Types ! ======================= ! ========= AeroDyn14_Data ======= TYPE, PUBLIC :: AeroDyn14_Data - TYPE(AD14_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(AD14_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(AD14_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(AD14_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(AD14_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(AD14_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(AD14_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(AD14_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(AD14_ParameterType) :: p !< Parameters [-] TYPE(AD14_InputType) :: u !< System inputs [-] TYPE(AD14_OutputType) :: y !< System outputs [-] @@ -481,10 +482,10 @@ MODULE FAST_Types ! ======================= ! ========= AeroDyn_Data ======= TYPE, PUBLIC :: AeroDyn_Data - TYPE(AD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(AD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(AD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(AD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(AD_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(AD_ParameterType) :: p !< Parameters [-] TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] @@ -499,10 +500,10 @@ MODULE FAST_Types ! ======================= ! ========= ExtLoads_Data ======= TYPE, PUBLIC :: ExtLoads_Data - TYPE(ExtLd_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] - TYPE(ExtLd_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] - TYPE(ExtLd_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] - TYPE(ExtLd_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(ExtLd_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(ExtLd_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(ExtLd_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(ExtLd_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(ExtLd_ParameterType) :: p !< Parameters [-] TYPE(ExtLd_InputType) :: u !< System inputs [-] TYPE(ExtLd_OutputType) :: y !< System outputs [-] @@ -512,10 +513,10 @@ MODULE FAST_Types ! ======================= ! ========= InflowWind_Data ======= TYPE, PUBLIC :: InflowWind_Data - TYPE(InflowWind_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(InflowWind_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(InflowWind_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(InflowWind_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(InflowWind_ParameterType) :: p !< Parameters [-] TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] @@ -545,10 +546,10 @@ MODULE FAST_Types ! ======================= ! ========= SubDyn_Data ======= TYPE, PUBLIC :: SubDyn_Data - TYPE(SD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(SD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(SD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(SD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(SD_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(SD_ParameterType) :: p !< Parameters [-] TYPE(SD_InputType) :: u !< System inputs [-] TYPE(SD_OutputType) :: y !< System outputs [-] @@ -563,10 +564,10 @@ MODULE FAST_Types ! ======================= ! ========= ExtPtfm_Data ======= TYPE, PUBLIC :: ExtPtfm_Data - TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(ExtPtfm_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(ExtPtfm_ParameterType) :: p !< Parameters [-] TYPE(ExtPtfm_InputType) :: u !< System inputs [-] TYPE(ExtPtfm_OutputType) :: y !< System outputs [-] @@ -579,10 +580,10 @@ MODULE FAST_Types ! ======================= ! ========= SeaState_Data ======= TYPE, PUBLIC :: SeaState_Data - TYPE(SeaSt_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(SeaSt_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(SeaSt_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(SeaSt_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(SeaSt_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(SeaSt_ParameterType) :: p !< Parameters [-] TYPE(SeaSt_InputType) :: u !< System inputs [-] TYPE(SeaSt_OutputType) :: y !< System outputs [-] @@ -597,10 +598,10 @@ MODULE FAST_Types ! ======================= ! ========= HydroDyn_Data ======= TYPE, PUBLIC :: HydroDyn_Data - TYPE(HydroDyn_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(HydroDyn_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(HydroDyn_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(HydroDyn_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(HydroDyn_ParameterType) :: p !< Parameters [-] TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] @@ -615,10 +616,10 @@ MODULE FAST_Types ! ======================= ! ========= IceFloe_Data ======= TYPE, PUBLIC :: IceFloe_Data - TYPE(IceFloe_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(IceFloe_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(IceFloe_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(IceFloe_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(IceFloe_ParameterType) :: p !< Parameters [-] TYPE(IceFloe_InputType) :: u !< System inputs [-] TYPE(IceFloe_OutputType) :: y !< System outputs [-] @@ -631,9 +632,9 @@ MODULE FAST_Types ! ======================= ! ========= MAP_Data ======= TYPE, PUBLIC :: MAP_Data - TYPE(MAP_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(MAP_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(MAP_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] TYPE(MAP_OtherStateType) :: OtherSt !< Other/optimization states [-] TYPE(MAP_ParameterType) :: p !< Parameters [-] TYPE(MAP_InputType) :: u !< System inputs [-] @@ -649,10 +650,10 @@ MODULE FAST_Types ! ======================= ! ========= FEAMooring_Data ======= TYPE, PUBLIC :: FEAMooring_Data - TYPE(FEAM_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(FEAM_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(FEAM_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(FEAM_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(FEAM_ParameterType) :: p !< Parameters [-] TYPE(FEAM_InputType) :: u !< System inputs [-] TYPE(FEAM_OutputType) :: y !< System outputs [-] @@ -665,10 +666,10 @@ MODULE FAST_Types ! ======================= ! ========= MoorDyn_Data ======= TYPE, PUBLIC :: MoorDyn_Data - TYPE(MD_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(MD_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(MD_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(MD_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(MD_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(MD_ParameterType) :: p !< Parameters [-] TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] @@ -683,10 +684,10 @@ MODULE FAST_Types ! ======================= ! ========= OrcaFlex_Data ======= TYPE, PUBLIC :: OrcaFlex_Data - TYPE(Orca_ContinuousStateType) , DIMENSION(1:4) :: x !< Continuous states [-] - TYPE(Orca_DiscreteStateType) , DIMENSION(1:4) :: xd !< Discrete states [-] - TYPE(Orca_ConstraintStateType) , DIMENSION(1:4) :: z !< Constraint states [-] - TYPE(Orca_OtherStateType) , DIMENSION(1:4) :: OtherSt !< Other states [-] + TYPE(Orca_ContinuousStateType) , DIMENSION(NumStateTimes) :: x !< Continuous states [-] + TYPE(Orca_DiscreteStateType) , DIMENSION(NumStateTimes) :: xd !< Discrete states [-] + TYPE(Orca_ConstraintStateType) , DIMENSION(NumStateTimes) :: z !< Constraint states [-] + TYPE(Orca_OtherStateType) , DIMENSION(NumStateTimes) :: OtherSt !< Other states [-] TYPE(Orca_ParameterType) :: p !< Parameters [-] TYPE(Orca_InputType) :: u !< System inputs [-] TYPE(Orca_OutputType) :: y !< System outputs [-] From bfbf791f1b505a5a4ec3ca35139e617a4cccc51a Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 15 Dec 2023 16:29:27 -0700 Subject: [PATCH 134/232] Update r-test pointer after PR #1932 merge --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 169eb370ba..7709178aed 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 169eb370ba152e522c075bacc29c46676deb9e7d +Subproject commit 7709178aed58df8f5df3b86a41c275cbaac5f70e From 04202d921620ad99cb1dad8f039bda6e0236719e Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 18 Dec 2023 11:31:56 -0700 Subject: [PATCH 135/232] ExtLoads: fix name of module ExtLoads --- modules/openfast-library/src/FAST_Registry.txt | 2 +- modules/openfast-library/src/FAST_Types.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index ed586e5b11..3fe4204562 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -45,7 +45,7 @@ param ^ - INTEGER Module_ED - 4 - "ElastoDyn" - param ^ - INTEGER Module_BD - 5 - "BeamDyn" - param ^ - INTEGER Module_AD14 - 6 - "AeroDyn14" - param ^ - INTEGER Module_AD - 7 - "AeroDyn" - -param ^ - INTEGER Module_ExtLd - 8 - "AeroDyn" - +param ^ - INTEGER Module_ExtLd - 8 - "ExternalLoads" - param ^ - INTEGER Module_SrvD - 9 - "ServoDyn" - param ^ - INTEGER Module_SeaSt - 10 - "SeaState" - param ^ - INTEGER Module_HD - 11 - "HydroDyn" - diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index f404c8acea..42035af7e1 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -60,7 +60,7 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_BD = 5 ! BeamDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD14 = 6 ! AeroDyn14 [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_AD = 7 ! AeroDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! AeroDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ExtLd = 8 ! ExternalLoads [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SrvD = 9 ! ServoDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SeaSt = 10 ! SeaState [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_HD = 11 ! HydroDyn [-] From 9902d903b071485d29ed045a49a6e43857539595 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Mon, 18 Dec 2023 15:00:31 -0700 Subject: [PATCH 136/232] minor updates to comments - removed readme file that doesn't apply any more - removed SeaSt module dependence from HD (it already uses SeaSt_WaveField) --- modules/hydrodyn/src/HydroDyn.txt | 1 - modules/hydrodyn/src/HydroDyn_Types.f90 | 1 - modules/nwtc-library/src/readme.txt | 8 -------- modules/openfast-library/src/FAST_Lin.f90 | 2 -- modules/openfast-library/src/FAST_Subs.f90 | 4 ++-- 5 files changed, 2 insertions(+), 14 deletions(-) delete mode 100644 modules/nwtc-library/src/readme.txt diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 7d2b9c0766..00939dcaaa 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -21,7 +21,6 @@ usefrom WAMIT.txt usefrom WAMIT2.txt usefrom Morison.txt usefrom SeaSt_WaveField.txt -usefrom SeaState.txt param HydroDyn/HydroDyn unused INTEGER MaxHDOutputs - 510 - "The maximum number of output channels supported by this module" - param HydroDyn/HydroDyn unused INTEGER MaxUserOutputs - 5150 - " Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150" - diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 21d8555c40..54102ff6d8 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -37,7 +37,6 @@ MODULE HydroDyn_Types USE WAMIT_Types USE WAMIT2_Types USE Morison_Types -USE SeaState_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: MaxHDOutputs = 510 ! The maximum number of output channels supported by this module [-] diff --git a/modules/nwtc-library/src/readme.txt b/modules/nwtc-library/src/readme.txt deleted file mode 100644 index 607db5ced8..0000000000 --- a/modules/nwtc-library/src/readme.txt +++ /dev/null @@ -1,8 +0,0 @@ -The two NWTC_Library-related types files cannot be generated through the registry. At the moment it is a manual process. - -The NWTC registry input file gets split into two sections: one for the mesh mapping and everything else. -It's not an automatic process since you have to copy the SetErrStat routine into NWTC_Library_Types.f90, -and you have to copy the mesh-related types/routines into the ModMesh_Types.f90 file. -Originally, we also had to change some other parts, too, but I've hard-coded some stuff -in the registry source code for when it is trying to generate types for the NWTC_Library module. -We could hard-code the registry to generate SetErrStat() at some point, too. \ No newline at end of file diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index dae24ac693..f9847771ae 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -2275,8 +2275,6 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! Transfer MAP loads to ED PlatformPtmesh input: ! we're mapping loads, so we also need the sibling meshes' displacements: - MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ! NOTE: Assumes at least one MAP Fairlead point diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c7b44503a3..743bbc4e73 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1127,7 +1127,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) Init%InData_FEAM%gravity = p_FAST%Gravity ! This need to be according to g from driver Init%InData_FEAM%WtrDens = Init%OutData_SeaSt%WaveField%WtrDens ! This needs to be set according to seawater density in SeaState -! Init%InData_FEAM%depth = Init%OutData_SeaSt%WtrDpth ! This need to be set according to the water depth in SeaState +! Init%InData_FEAM%depth = Init%OutData_SeaSt%WaveField%WtrDpth ! This need to be set according to the water depth in SeaState CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) @@ -3853,7 +3853,7 @@ SUBROUTINE SetVTKParameters_B4SeaSt(p_FAST, InitOutData_ED, InitInData_SeaSt, BD n = 1 do i=1,p_FAST%VTK_surface%NWaveElevPts(1) do j=1,p_FAST%VTK_surface%NWaveElevPts(2) - InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! HD takes p_FAST%TurbinePos into account already + InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! SeaSt takes p_FAST%TurbinePos into account already InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 !+ p_FAST%TurbinePos(2) n = n+1 end do From f56dc4dcd1c2528d85776c863dcd5cb4953abaa4 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 18 Dec 2023 12:22:53 -0700 Subject: [PATCH 137/232] FAST_Subs: make call to WriteOutputToFile consistent Replace argument `m_FAST%t_global` with calculated `t_global` in `FAST_SUBS::FAST_WriteOutput` --- modules/openfast-library/src/FAST_Subs.f90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 3042f91ca3..a17b91db9e 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7492,7 +7492,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- !! Write outputs !---------------------------------------------------------------------------------------- - call FAST_WriteOutput(m_FAST%t_global, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & + call FAST_WriteOutput(t_initial, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -8037,10 +8037,10 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) END SUBROUTINE FAST_WriteOutput_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the outputs at this timestep -SUBROUTINE FAST_WriteOutput(t_global, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & +SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_global !< initial time + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -8074,7 +8074,7 @@ SUBROUTINE FAST_WriteOutput(t_global, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD ! local variables INTEGER(IntKi) :: I, k ! generic loop counters - + REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' @@ -8083,11 +8083,12 @@ SUBROUTINE FAST_WriteOutput(t_global, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD ErrStat = ErrID_None ErrMsg = "" + t_global = t_initial + n_t_global*p_FAST%DT !---------------------------------------------------------------------------------------- !! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & + CALL WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) From a05657e99bc2708d5cfb843706639432218be5f5 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 18 Dec 2023 13:29:22 -0700 Subject: [PATCH 138/232] Add check on tower nodes for ExtInflow with CFD --- modules/openfast-library/src/FAST_Library.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 2c8ce3a2a6..7da7bd732b 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -741,8 +741,11 @@ subroutine FAST_ExtInfw_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c IF (NumBl_c > 0) THEN NumBlElem_c = Turbine(iTurb)%AD%Input(1)%rotors(1)%BladeMotion(1)%Nnodes END IF -!FIXME: need some checks on this. If the Tower mesh is not initialized, this will be garbage - NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes + if (Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Committed) then + NumTwrElem_c = Turbine(iTurb)%AD%y%rotors(1)%TowerLoad%Nnodes + else + NumTwrElem_c = 0 + endif ELSE NumBl_c = 0 NumBlElem_c = 0 From b5d739ada4cf9f856367dec6acc60538e7addff4 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 19 Dec 2023 13:26:16 -0700 Subject: [PATCH 139/232] Pass Python_EXECUTABLE from main OF cmake to external pfunit cmake This allows pfunit to use the same interpreter found by the main OF cmake. NOTE: pfunit uses `PYTHON_EXECUTABLE` --- unit_tests/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/unit_tests/CMakeLists.txt b/unit_tests/CMakeLists.txt index 2535d8fad4..e88875d0b2 100644 --- a/unit_tests/CMakeLists.txt +++ b/unit_tests/CMakeLists.txt @@ -41,6 +41,7 @@ ExternalProject_Add(pfunit CMAKE_ARGS -DCMAKE_INSTALL_PREFIX=${PROJECT_BINARY_DIR}/pfunit -DCMAKE_Fortran_COMPILER=${CMAKE_Fortran_COMPILER} + -DPYTHON_EXECUTABLE=${Python_EXECUTABLE} -DROBUST=OFF BUILD_BYPRODUCTS ${PFUNIT_LIB_PATH} From 5f8f8d21b7eb296abbb1830051718ccede58661b Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 19 Dec 2023 14:08:38 -0700 Subject: [PATCH 140/232] pfunit: add check that python version is less than 3.12 --- unit_tests/CMakeLists.txt | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/unit_tests/CMakeLists.txt b/unit_tests/CMakeLists.txt index e88875d0b2..4a3b7e4d08 100644 --- a/unit_tests/CMakeLists.txt +++ b/unit_tests/CMakeLists.txt @@ -23,6 +23,15 @@ project(OpenFAST_UnitTest Fortran) include(CTest) +if(NOT ${Python_Interpreter_FOUND}) + message(FATAL_ERROR "CMake did not find a Python interpreter. Python is required for unit tests." ) +endif() +if (${Python_VERSION} VERSION_GREATER_EQUAL "3.12.0") + message(FATAL_ERROR "Unit testing with pfunit not currently possible with Python 3.12 or greater." ) +endif() + + + ### pfunit include(ExternalProject) From 7da964b6f71488c20a7d3fc523e109f09dc44083 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 19 Dec 2023 14:28:09 -0700 Subject: [PATCH 141/232] rc-3.5.2: add release notes --- docs/changelogs/3.5.2.md | 66 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 docs/changelogs/3.5.2.md diff --git a/docs/changelogs/3.5.2.md b/docs/changelogs/3.5.2.md new file mode 100644 index 0000000000..bae421240d --- /dev/null +++ b/docs/changelogs/3.5.2.md @@ -0,0 +1,66 @@ +**Feature or improvement description** +Pull request to merge `rc-3.5.2` into `main` and create a tagged release for v3.5.2. + +See the milestone and project pages for additional information + + https://github.com/OpenFAST/openfast/milestone/12 + +Test results, if applicable +See GitHub Actions + +### Release checklist: +- [ ] Update the documentation version in docs/conf.py +- [ ] Update the versions in docs/source/user/api_change.rst +- [ ] Verify readthedocs builds correctly +- [ ] Create a tag in OpenFAST +- [ ] Create a merge commit in r-test and add a corresponding tag +- [ ] Compile executables for Windows builds + - [ ] FAST_SFunc.mexw64 + - [ ] OpenFAST-Simulink_x64.dll + - [ ] openfast_x64.exe + - [ ] DISCON.dll (x64) + - [ ] AeroDyn_Driver + - [ ] AeroDyn_Inflow_C_Binding + - [ ] BeamDyn_Driver + - [ ] HydroDyn_Driver + - [ ] HydroDyn_C_Binding (x64) + - [ ] InflowWind_Driver + - [ ] IfW_C_Binding (x64) + - [ ] MoorDyn_Driver + - [ ] FAST.Farm (x64) + +# Changelog + +## General + +### Build systems + +#1948 Pass Python_EXECUTABLE to pfunit, add error check on Python version + + +## Module changes + +### AeroDyn + +#1913 ADI: memory leak in ADI_UpdateStates + +### HydroDyn + +#1872 Fix segfault in HD when no outputs specified + + + +## Regression tests + +#1886 Update floating MHK case input files + + + +## Input file changes + +No input files change with this release, as this only includes minor bugfixes. + +Full list of changes: https://openfast.readthedocs.io/en/main/source/user/api_change.html + +Full input file sets: https://github.com/OpenFAST/r-test/tree/v3.5.2 (example input files from the regression testing) + From 225c23fdf675d798d3788e345be0dfebbea45815 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 19 Dec 2023 14:31:05 -0700 Subject: [PATCH 142/232] rc-3.5.2: rename release notes changelog --- docs/changelogs/{3.5.2.md => v3.5.2.md} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename docs/changelogs/{3.5.2.md => v3.5.2.md} (100%) diff --git a/docs/changelogs/3.5.2.md b/docs/changelogs/v3.5.2.md similarity index 100% rename from docs/changelogs/3.5.2.md rename to docs/changelogs/v3.5.2.md From 5308d053d73966d4c469946961f09266128b2ef8 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 19 Dec 2023 14:37:33 -0700 Subject: [PATCH 143/232] update version info for 3.5.2 --- docs/conf.py | 2 +- docs/source/user/api_change.rst | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/docs/conf.py b/docs/conf.py index 021086c9c4..c917452dac 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -130,7 +130,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # The short X.Y version. version = u'3.5' # The full version, including alpha/beta/rc tags. -release = u'v3.5.1' +release = u'v3.5.2' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 267a5809fc..7a09d05257 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -9,10 +9,16 @@ The changes are tabulated according to the module input file, line number, and f The line number corresponds to the resulting line number after all changes are implemented. Thus, be sure to implement each in order so that subsequent line numbers are correct. +OpenFAST v3.5.1 to OpenFAST v3.5.2 +---------------------------------- + +No input file changes were made. + + OpenFAST v3.5.0 to OpenFAST v3.5.1 ---------------------------------- -No input files changes were made. Some input files now include additional +No input file changes were made. Some input files now include additional output channels: AeroDyn nodal outputs for another coordinate system, new MoorDyn output names (Connect changed to Point). From 8b07e41221c6892cbcb33bc75115eaf63924e203 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 19 Dec 2023 21:34:09 -0700 Subject: [PATCH 144/232] Option to turn off unit_tests from cmake --- CMakeLists.txt | 11 ++++++++--- docs/source/testing/unit_test.rst | 5 +++-- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index e41e2b7bb3..8f2b48a625 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -67,7 +67,10 @@ endif() option(BUILD_TESTING "Build the testing tree." OFF) if(BUILD_TESTING) option(CODECOVERAGE "Enable infrastructure for measuring code coverage." OFF) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DUNIT_TEST") + option(BUILD_UNIT_TESTING "Enable unit testing" ON) + if(BUILD_UNIT_TESTING) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -DUNIT_TEST") + endif() endif() # Setup Fortran Compiler options based on architecture/compiler @@ -276,8 +279,10 @@ if(BUILD_TESTING) add_subdirectory(reg_tests) # unit tests - if(NOT (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Flang")) - add_subdirectory(unit_tests) + if(BUILD_UNIT_TESTING) + if(NOT (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Flang")) + add_subdirectory(unit_tests) + endif() endif() endif() diff --git a/docs/source/testing/unit_test.rst b/docs/source/testing/unit_test.rst index 31c9cca58c..314cc04466 100644 --- a/docs/source/testing/unit_test.rst +++ b/docs/source/testing/unit_test.rst @@ -12,7 +12,8 @@ Unit testing in OpenFAST modules is accomplished through `pFUnit `__ structure. pFUnit is compiled along with OpenFAST through CMake when the CMake variable ``BUILD_TESTING`` is -turned on. +turned on (default off) and the CMake variable ``BUILD_UNIT_TESTING`` is on +(turned on by default when ``BUILD_TEST`` is on). The BeamDyn and NWTC Library modules contain some sample unit tests and should serve as a reference for future development and testing. @@ -21,7 +22,7 @@ Dependencies ------------ The following packages are required for unit testing: -- Python 3.7+ +- Python 3.7+, <3.12 - CMake - pFUnit - Included in OpenFAST repo through a git-submodule From db502618c3daf4de979341b5ca5a71fe43edb0a7 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 20 Dec 2023 14:23:36 -0700 Subject: [PATCH 145/232] VTK: use AD tower for visualization, if available --- modules/openfast-library/src/FAST_Subs.f90 | 61 +++++++++++++++------- 1 file changed, 43 insertions(+), 18 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 743bbc4e73..7258e3a830 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3853,8 +3853,8 @@ SUBROUTINE SetVTKParameters_B4SeaSt(p_FAST, InitOutData_ED, InitInData_SeaSt, BD n = 1 do i=1,p_FAST%VTK_surface%NWaveElevPts(1) do j=1,p_FAST%VTK_surface%NWaveElevPts(2) - InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 !+ p_FAST%TurbinePos(1) ! SeaSt takes p_FAST%TurbinePos into account already - InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 !+ p_FAST%TurbinePos(2) + InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 ! SeaSt takes p_FAST%TurbinePos into account already + InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 n = n+1 end do end do @@ -3873,7 +3873,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInData_SeaSt !< The initialization input to SeaState TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutData_SeaSt !< The initialization output from SeaState TYPE(HydroDyn_InitOutputType),INTENT(INOUT) :: InitOutData_HD !< The initialization output from HydroDyn - TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(ElastoDyn_Data), TARGET, INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data @@ -3884,7 +3884,9 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S REAL(SiKi) :: x, y REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength INTEGER(IntKi) :: topNode, baseNode - INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: NumBl, k, Indx + LOGICAL :: UseADtwr + TYPE(MeshType), POINTER :: TowerMotionMesh CHARACTER(1024) :: vtkroot INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3962,28 +3964,51 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S p_FAST%VTK_Surface%NacelleBox(:,8) = (/ -x, y, 2*y /) !....................... - ! tapered tower + ! Create the tower surface data !....................... + TowerMotionMesh => ED%y%TowerLn2Mesh - CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,TowerMotionMesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN - topNode = ED%y%TowerLn2Mesh%NNodes - 1 - baseNode = ED%y%TowerLn2Mesh%refNode - TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower - TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower - TwrDiam_top = 3.87*TwrRatio - TwrDiam_base = 6.0*TwrRatio - - TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength - do k=1,ED%y%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) - p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength - end do + IF ( p_FAST%CompAero == Module_AD .and. allocated(InitOutData_AD%rotors) .and. allocated(AD%y%rotors) ) THEN ! These meshes may have tower diameter data associated with nodes + UseADtwr = allocated(InitOutData_AD%rotors(1)%TowerRad) + ELSE + UseADtwr = .false. + END IF + if (UseADtwr) then + + ! This assumes a vertical tower (i.e., we deal only with z component of position) + Indx = 1 + do k=1,TowerMotionMesh%NNodes + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TowerRad, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) + end do + + else + !....................... + ! default tapered tower, based on 5MW baseline turbine: + !....................... + + topNode = maxloc(TowerMotionMesh%position(3,:),DIM=1) + baseNode = minloc(TowerMotionMesh%position(3,:),DIM=1) + TwrLength = TwoNorm( TowerMotionMesh%position(:,topNode) - TowerMotionMesh%position(:,baseNode) ) ! this is the assumed length of the tower + TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower + TwrDiam_top = 3.87*TwrRatio + TwrDiam_base = 6.0*TwrRatio + + TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength + + do k=1,TowerMotionMesh%NNodes + TwrLength = TwoNorm( TowerMotionMesh%position(:,k) - TowerMotionMesh%position(:,baseNode) ) + p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength + end do + end if + + !....................... ! blade surfaces !....................... From d0a338b69be6538783777b4198f250347618d31b Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 20 Dec 2023 14:25:36 -0700 Subject: [PATCH 146/232] minor cleanup - I'm not a fan of variables named with lower-case "l", so I made them upper case "L". This is less likely to be confused with the number "1" - registry now gives an error message before ending when data types contain invalid types --- .../nwtc-library/src/Registry_NWTC_Library.txt | 18 +++++++++--------- modules/nwtc-library/src/SysMatlabWindows.f90 | 1 - modules/nwtc-library/src/VTK.f90 | 4 ++-- modules/openfast-library/src/FAST_Subs.f90 | 16 ++++++++-------- .../src/registry_gen_fortran.cpp | 3 +++ 5 files changed, 22 insertions(+), 20 deletions(-) diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index c90cc0224a..5b6e03407e 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -24,10 +24,10 @@ 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 FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} @@ -35,9 +35,9 @@ typedef NWTC_Library Quaternion ReKi q0 typedef ^ ^ ReKi v {3} typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types @@ -76,6 +76,6 @@ typedef ^ ^ R8Ki DisplacedPo 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" +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/SysMatlabWindows.f90 b/modules/nwtc-library/src/SysMatlabWindows.f90 index ff266e9b13..09c931aff2 100644 --- a/modules/nwtc-library/src/SysMatlabWindows.f90 +++ b/modules/nwtc-library/src/SysMatlabWindows.f90 @@ -47,7 +47,6 @@ MODULE SysSubs !======================================================================= - INTEGER, PARAMETER :: ConRecL = 120 ! The record length for console output. INTEGER, PARAMETER :: CU = 6 ! The I/O unit for the console. INTEGER, PARAMETER :: MaxWrScrLen = 98 ! The maximum number of characters allowed to be written to a line in WrScr diff --git a/modules/nwtc-library/src/VTK.f90 b/modules/nwtc-library/src/VTK.f90 index d70345dec7..78642a159f 100644 --- a/modules/nwtc-library/src/VTK.f90 +++ b/modules/nwtc-library/src/VTK.f90 @@ -12,8 +12,8 @@ module VTK implicit none - character(8), parameter :: RFMT='E17.8E3' - character(8), parameter :: IFMT='I7' + character(*), parameter :: RFMT='E17.8E3' + character(*), parameter :: IFMT='I7' ! Internal type to ensure the same options are used in between calls for the functions vtk_* TYPE, PUBLIC :: VTK_Misc diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7258e3a830..c453c93763 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -6362,7 +6362,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k, l + INTEGER(IntKi) :: NumBl, k, L INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' @@ -6451,18 +6451,18 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW if ( p_FAST%CompMooring == Module_MD ) THEN !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) if (allocated(MD%y%VisLinesMesh)) then - do l=1,size(MD%y%VisLinesMesh) - if (MD%y%VisLinesMesh(l)%Committed) then ! No orientation data, so surface representation not possible - call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(l)), y_FAST%VTK_count, p_FAST%VTK_fields, & + do L=1,size(MD%y%VisLinesMesh) + if (MD%y%VisLinesMesh(L)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK(p_FAST%TurbinePos, MD%y%VisLinesMesh(L), trim(p_FAST%VTK_OutFileRoot)//'.MD_Line'//trim(Num2LStr(L)), y_FAST%VTK_count, p_FAST%VTK_fields, & ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth ) endif enddo endif if (allocated(MD%y%VisRodsMesh)) then - do l=1,size(MD%y%VisRodsMesh) - if (MD%y%VisRodsMesh(l)%Committed) then ! No orientation data, so surface representation not possible - call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(l), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(l))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & - ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(l)%Diam ) + do L=1,size(MD%y%VisRodsMesh) + if (MD%y%VisRodsMesh(L)%Committed) then ! No orientation data, so surface representation not possible + call MeshWrVTK_Ln2Surface(p_FAST%TurbinePos, MD%y%VisRodsMesh(L), trim(p_FAST%VTK_OutFileRoot)//'.MD_Rod'//trim(Num2LStr(L))//'Surface', y_FAST%VTK_count, p_FAST%VTK_fields, & + ErrSTat2, ErrMsg2, p_FAST%VTK_tWidth, NumSegments=p_FAST%VTK_Surface%NumSectors, Radius=MD%p%VisRodsDiam(L)%Diam ) endif enddo endif diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 8444173d83..d3cd46b45d 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -116,7 +116,10 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // verify that it does, otherwise exit with error if ((ddt.interface != nullptr) && ddt.interface->only_reals) if (!ddt.only_contains_reals()) + { + std::cerr << "Registry warning: Data type '" << dt_name << "' contains non-real values." << std::endl; exit(EXIT_FAILURE); + } // Write derived type header w << "! ========= " << ddt.type_fortran << (this->gen_c_code ? "_C" : "") << " =======\n"; From 37f7da585c7d6b505bb433ebd97ab022c4524aa0 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Wed, 20 Dec 2023 14:27:08 -0700 Subject: [PATCH 147/232] NWTC Library: fix memory size printed in some error statements in some cases, default reals were used instead of double or single, so the error messages when not able to allocate some variables could have been incorrect --- modules/nwtc-library/src/NWTC_IO.f90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 25d317c68d..57aece75f5 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -726,7 +726,7 @@ SUBROUTINE AllR4PAry3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ALLOCATE ( Ary(AryDim1,AryDim2,AryDim3) , STAT=ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' ELSE ErrStat = ErrID_None @@ -763,7 +763,7 @@ SUBROUTINE AllR8PAry3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ALLOCATE ( Ary(AryDim1,AryDim2,AryDim3) , STAT=ErrStat ) IF ( ErrStat /= 0 ) THEN ErrStat = ErrID_Fatal - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' ELSE ErrStat = ErrID_None @@ -901,7 +901,7 @@ SUBROUTINE AllR4Ary1 ( Ary, AryDim1, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_SiKi))//' bytes of memory for the '//TRIM( Descr )//' array.' + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*BYTES_IN_R4Ki))//' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE ErrStat = ErrID_None @@ -971,7 +971,7 @@ SUBROUTINE AllR4Ary2 ( Ary, AryDim1, AryDim2, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*BYTES_IN_SiKi))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1047,7 +1047,7 @@ SUBROUTINE AllR4Ary3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1084,7 +1084,7 @@ SUBROUTINE AllR8Ary3 ( Ary, AryDim1, AryDim2, AryDim3, Descr, ErrStat, ErrMsg ) IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1122,7 +1122,7 @@ SUBROUTINE AllR4Ary4 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, Descr, ErrStat, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1160,7 +1160,7 @@ SUBROUTINE AllR8Ary4 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, Descr, ErrStat, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1199,7 +1199,7 @@ SUBROUTINE AllR4Ary5 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, AryDim5, Descr, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_R4Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE @@ -1240,7 +1240,7 @@ SUBROUTINE AllR8Ary5 ( Ary, AryDim1, AryDim2, AryDim3, AryDim4, AryDim5, Descr, IF ( ALLOCATED(Ary) ) THEN ! or Sttus=151 on IVF ErrMsg = 'Error allocating memory for the '//TRIM( Descr )//' array; array was already allocated.' ELSE - ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_REAL))//& + ErrMsg = 'Error allocating '//TRIM(Num2LStr(AryDim1*AryDim2*AryDim3*AryDim4*AryDim5*BYTES_IN_R8Ki))//& ' bytes of memory for the '//TRIM( Descr )//' array.' END IF ELSE From 860cd6207697f51a953d152ef8a53af3e38b4496 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 2 Jan 2024 09:30:17 -0700 Subject: [PATCH 148/232] VTK fix: use existing `TowerDiam` instead of `TowerRad` --- modules/openfast-library/src/FAST_Subs.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c453c93763..35b402a361 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3974,7 +3974,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S IF ( p_FAST%CompAero == Module_AD .and. allocated(InitOutData_AD%rotors) .and. allocated(AD%y%rotors) ) THEN ! These meshes may have tower diameter data associated with nodes - UseADtwr = allocated(InitOutData_AD%rotors(1)%TowerRad) + UseADtwr = allocated(InitOutData_AD%rotors(1)%TwrDiam) ELSE UseADtwr = .false. END IF @@ -3984,7 +3984,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S ! This assumes a vertical tower (i.e., we deal only with z component of position) Indx = 1 do k=1,TowerMotionMesh%NNodes - p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TowerRad, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TwrDiam, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) / 2.0_ReKi end do else From 18faddf3a830e009daad22edfe5bd313174ef29e Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 28 Dec 2023 14:51:14 -0700 Subject: [PATCH 149/232] Revamped log file. Still needs runtime outputs --- modules/moordyn/src/MoorDyn.f90 | 221 ++++++++++++++++++++++----- modules/moordyn/src/MoorDyn_Line.f90 | 19 --- modules/moordyn/src/MoorDyn_Misc.f90 | 6 +- modules/moordyn/src/MoorDyn_Rod.f90 | 18 --- 4 files changed, 185 insertions(+), 79 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 6e3f63272f..c3279f4893 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -249,29 +249,29 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! ----------------------------------------------------------------- ! Read the primary MoorDyn input file, or copy from passed input - if (InitInp%UsePrimaryInputFile) then - ! Read the entire input file, minus any comment lines, into the FileInfo_In - ! data structure in memory for further processing. - call ProcessComFile( InitInp%FileName, FileInfo_In, ErrStat2, ErrMsg2 ) - CALL GetPath( InitInp%FileName, p%PriPath ) ! Input files will be relative to the path where the primary input file is located. - else - call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - p%PriPath = "" - endif - if (Failed()) return; - - ! For diagnostic purposes, the following can be used to display the contents - ! of the FileInfo_In data structure. - !call Print_FileInfo_Struct( CU, FileInfo_In ) ! CU is the screen -- different number on different systems. + if (InitInp%UsePrimaryInputFile) then + ! Read the entire input file, minus any comment lines, into the FileInfo_In + ! data structure in memory for further processing. + call ProcessComFile( InitInp%FileName, FileInfo_In, ErrStat2, ErrMsg2 ) + CALL GetPath( InitInp%FileName, p%PriPath ) ! Input files will be relative to the path where the primary input file is located. + else + call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + p%PriPath = "" + endif + if (Failed()) return; + + ! For diagnostic purposes, the following can be used to display the contents + ! of the FileInfo_In data structure. + !call Print_FileInfo_Struct( CU, FileInfo_In ) ! CU is the screen -- different number on different systems. ! Parse the FileInfo_In structure of data from the inputfile into the InitInp%InputFile structure -! CALL ParsePrimaryFileInfo_BuildModel( PriPath, InitInp, FileInfo_In, InputFileDat, p, m, UnEc, ErrStat2, ErrMsg2 ) -! if (Failed()) return; + ! CALL ParsePrimaryFileInfo_BuildModel( PriPath, InitInp, FileInfo_In, InputFileDat, p, m, UnEc, ErrStat2, ErrMsg2 ) + ! if (Failed()) return; -!NOTE: This could be split into a separate routine for easier to read code + !NOTE: This could be split into a separate routine for easier to read code !------------------------------------------------------------------------------------------------- ! Parsing of input file from the FileInfo_In data structure ! - FileInfo_Type is essentially a string array with some metadata. @@ -429,6 +429,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er END IF write(p%UnLog,'(A)', IOSTAT=ErrStat2) "MoorDyn v2 log file with output level "//TRIM(Num2LStr(p%writeLog)) write(p%UnLog,'(A)', IOSTAT=ErrStat2) "Note: options above the writeLog line in the input file will not be recorded." + write(p%UnLog,'(A)', IOSTAT=ErrStat2) " Input File Summary:" end if else if ( OptString == 'DTM') THEN read (OptValue,*) p%dtM0 @@ -468,8 +469,28 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er nOpts = nOpts + 1 Line = NextLine(i) + END DO + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Options List:" + write(p%UnLog, '(A17,f12.4)') " dtm : ", p%dtM0 + write(p%UnLog, '(A17,f12.4)') " g : ", p%g + write(p%UnLog, '(A17,f12.4)') " rhoW : ", p%rhoW + write(p%UnLog, '(A17,A)' ) " Depth : ", DepthValue ! water depth input read in as a string to be processed by setupBathymetry + write(p%UnLog, '(A17,f12.4)') " kBot : ", p%kBot + write(p%UnLog, '(A17,f12.4)') " cBot : ", p%cBot + write(p%UnLog, '(A17,f12.4)') " dtIC : ", InputFileDat%dtIC + write(p%UnLog, '(A17,f12.4)') " TMaxIC : ", InputFileDat%TMaxIC + write(p%UnLog, '(A17,f12.4)') " CdScaleIC: ", InputFileDat%CdScaleIC + write(p%UnLog, '(A17,f12.4)') " threshIC : ", InputFileDat%threshIC + write(p%UnLog, '(A17,A)' ) " WaterKin : ", WaterKinValue + write(p%UnLog, '(A17,f12.4)') " dtOut : ", p%dtOut + write(p%UnLog, '(A17,f12.4)') " mu_kT : ", p%mu_kT + write(p%UnLog, '(A17,f12.4)') " mu_kA : ", p%mu_kA + write(p%UnLog, '(A17,f12.4)') " mc : ", p%mc + write(p%UnLog, '(A17,f12.4)') " cv : ", p%cv + end if else if (INDEX(Line, "OUTPUT") > 0) then ! if output header @@ -588,8 +609,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er Line = NextLine(i) Line = NextLine(i) - ! process each line - DO l = 1,p%nLineTypes + ! process each line + DO l = 1,p%nLineTypes !read into a line Line = NextLine(i) @@ -641,6 +662,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er read(tempStrings(2), *) m%LineTypeList(l)%BA_D else if (m%LineTypeList(l)%ElasticMod == 2) then ! case where there is no dynamic damping for viscoelastic model (will it work)? CALL WrScr("Warning, viscoelastic model being used with zero damping on the dynamic stiffness.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "Warning, viscoelastic model being used with zero damping on the dynamic stiffness." + end if end if ! get the regular/static coefficient or relation in all cases (can be from a lookup table?) CALL getCoefficientOrCurve(tempStrings(1), m%LineTypeList(l)%BA, & @@ -658,16 +682,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%LineTypeList(l)%IdNum = l ! write lineType information to log file - if (p%writeLog > 1) then - write(p%UnLog, '(A12,A20)' ) " LineType"//trim(num2lstr(l))//":" - write(p%UnLog, '(A12,A20)' ) " name: ", m%LineTypeList(l)%name - write(p%UnLog, '(A12,f12.4)') " d : ", m%LineTypeList(l)%d - write(p%UnLog, '(A12,f12.4)') " w : ", m%LineTypeList(l)%w - write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%LineTypeList(l)%Cdn - write(p%UnLog, '(A12,f12.4)') " Can : ", m%LineTypeList(l)%Can - write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%LineTypeList(l)%Cdt - write(p%UnLog, '(A12,f12.4)') " Cat : ", m%LineTypeList(l)%Cat - end if + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - LineType"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12,A)' ) " name: ", trim(m%LineTypeList(l)%name) + write(p%UnLog, '(A12,f12.4)') " d : ", m%LineTypeList(l)%d + write(p%UnLog, '(A12,f12.4)') " w : ", m%LineTypeList(l)%w + write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%LineTypeList(l)%Cdn + write(p%UnLog, '(A12,f12.4)') " Can : ", m%LineTypeList(l)%Can + write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%LineTypeList(l)%Cdt + write(p%UnLog, '(A12,f12.4)') " Cat : ", m%LineTypeList(l)%Cat + end if IF ( ErrStat2 /= ErrID_None ) THEN CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -712,16 +736,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! specify IdNum of rod type for error checking m%RodTypeList(l)%IdNum = l - ! write lineType information to log file + ! write rodType information to log file if (p%writeLog > 1) then - write(p%UnLog, '(A12,A20)' ) " RodType"//trim(num2lstr(l))//":" - write(p%UnLog, '(A12,A20)' ) " name: ", m%RodTypeList(l)%name - write(p%UnLog, '(A12,f12.4)') " d : ", m%RodTypeList(l)%d - write(p%UnLog, '(A12,f12.4)') " w : ", m%RodTypeList(l)%w - write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%RodTypeList(l)%Cdn - write(p%UnLog, '(A12,f12.4)') " Can : ", m%RodTypeList(l)%Can - write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%RodTypeList(l)%CdEnd - write(p%UnLog, '(A12,f12.4)') " Cat : ", m%RodTypeList(l)%CaEnd + write(p%UnLog, '(A)' ) " - RodType"//trim(num2lstr(l))//":" + write(p%UnLog, '(A14,A)' ) " name: ", trim(m%RodTypeList(l)%name) + write(p%UnLog, '(A14,f12.4)') " d : ", m%RodTypeList(l)%d + write(p%UnLog, '(A14,f12.4)') " w : ", m%RodTypeList(l)%w + write(p%UnLog, '(A14,f12.4)') " Cdn : ", m%RodTypeList(l)%Cdn + write(p%UnLog, '(A14,f12.4)') " Can : ", m%RodTypeList(l)%Can + write(p%UnLog, '(A14,f12.4)') " CdEnd : ", m%RodTypeList(l)%CdEnd + write(p%UnLog, '(A14,f12.4)') " CaEnd : ", m%RodTypeList(l)%CaEnd end if IF ( ErrStat2 /= ErrID_None ) THEN @@ -818,6 +842,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file.') ! Specific screen output because errors likely CALL WrScr(' Ensure row has all 13 columns needed in MDv2 input file (13th Dec 2021).') CALL SetErrStat( ErrID_Fatal, 'Failed to read bodies.' , ErrStat, ErrMsg, RoutineName ) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file.' + write(p%UnLog,'(A)') ' Ensure row has all 13 columns needed in MDv2 input file (13th Dec 2021).' + end if CALL CleanUp() RETURN END IF @@ -893,6 +921,19 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL CleanUp() RETURN END IF + + ! write body information to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Body"//trim(num2lstr(l))//":" + write(p%UnLog, '(A14,I2)' ) " id : ", m%BodyList(l)%IdNum + write(p%UnLog, '(A14,A)' ) " attach: ", trim(tempString1) + write(p%UnLog, '(A14,f12.4)') " v : ", m%BodyList(l)%bodyV + write(p%UnLog, '(A14,f12.4)') " m : ", m%BodyList(l)%bodyM + write(p%UnLog, '(A14,A)' ) " I : ", trim(num2lstr(m%BodyList(l)%BodyI(1)))//", "//trim(num2lstr(m%BodyList(l)%BodyI(2)))//", "//trim(num2lstr(m%BodyList(l)%BodyI(3))) + write(p%UnLog, '(A14,A)' ) " rCG : ", trim(num2lstr(m%BodyList(l)%rCG(1)))//", "//trim(num2lstr(m%BodyList(l)%rCG(2)))//", "//trim(num2lstr(m%BodyList(l)%rCG(3))) + write(p%UnLog, '(A14,A)' ) " CdA : ", trim(num2lstr(m%BodyList(l)%BodyCdA(1)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(2)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(3)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(4)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(5)))//", "//trim(num2lstr(m%BodyList(l)%BodyCdA(6))) + write(p%UnLog, '(A14,A)' ) " Ca : ", trim(num2lstr(m%BodyList(l)%BodyCa(1)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(2)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(3)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(4)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(5)))//", "//trim(num2lstr(m%BodyList(l)%BodyCa(6))) + end if IF (wordy > 1) print *, "Set up body ", l, " of type ", m%BodyList(l)%typeNum @@ -1069,6 +1110,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! specify IdNum of line for error checking m%RodList(l)%IdNum = l + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Rod"//trim(num2lstr(m%RodList(l)%IdNum))//":" + write(p%UnLog, '(A15,I2)' ) " ID : ", m%RodList(l)%IdNum + write(p%UnLog, '(A15,A)' ) " Type : ", trim(m%RodTypeList(m%RodList(l)%PropsIdNum)%name) + write(p%UnLog, '(A15,A)' ) " Attach : ", trim(tempString2) + write(p%UnLog, '(A15,I2)' ) " NumSegs: ", m%RodList(l)%N + end if + ! check for sequential IdNums IF ( m%RodList(l)%IdNum .NE. l ) THEN CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) @@ -1124,6 +1173,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if ((INDEX(tempString4, "SEABED") > 0 ) .or. (INDEX(tempString4, "GROUND") > 0 ) .or. (INDEX(tempString4, "FLOOR") > 0 )) then ! if keyword used CALL WrScr('Point '//trim(Num2LStr(l))//' depth set to be on the seabed; finding z location based on depth/bathymetry') ! interpret the anchor depth value as a 'seabed' input + if (p%writeLog > 0) then + write(p%UnLog,'(A)') 'Point '//trim(Num2LStr(l))//' depth set to be on the seabed; finding z location based on depth/bathymetry' + end if CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, tempArray(1), tempArray(2), depth, nvec) ! meaning the anchor should be at the depth of the local bathymetry tempArray(3) = -depth else ! if the anchor depth input isn't one of the supported keywords, @@ -1143,6 +1195,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' Unable to parse Point '//trim(Num2LStr(l))//' row in input file.') ! Specific screen output because errors likely CALL WrScr(' Ensure row has all 9 columns, including CdA and Ca.') ! to be caused by non-updated input file formats. CALL SetErrStat( ErrID_Fatal, 'Failed to read points.' , ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line <<<<<<<<< + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Unable to parse Point '//trim(Num2LStr(l))//' row in input file.' + write(p%UnLog,'(A)') ' Ensure row has all 9 columns, including CdA and Ca.' + end if CALL CleanUp() RETURN END IF @@ -1207,6 +1263,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er p%nCpldPoints(J) = p%nCpldPoints(J) + 1 ! increment counter for the appropriate turbine m%CpldPointIs(p%nCpldPoints(J),J) = l CALL WrScr(' added point '//TRIM(int2lstr(l))//' as fairlead for turbine '//trim(int2lstr(J))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' added point '//TRIM(int2lstr(l))//' as fairlead for turbine '//trim(int2lstr(J)) + end if else @@ -1231,6 +1290,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er !also set number of attached lines to zero initially m%PointList(l)%nAttached = 0 + ! write body information to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Point"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12,I2)' ) " id : ", m%PointList(l)%IdNum + write(p%UnLog, '(A12,I2)' ) " type: ", m%PointList(l)%typeNum + write(p%UnLog, '(A12,f12.4)') " v : ", m%PointList(l)%pointV + write(p%UnLog, '(A12,f12.4)') " m : ", m%PointList(l)%pointM + write(p%UnLog, '(A12,f12.4)') " CdA : ", m%PointList(l)%pointCdA + write(p%UnLog, '(A12,f12.4)') " Ca : ", m%PointList(l)%pointCa + end if ! check for sequential IdNums IF ( m%PointList(l)%IdNum .NE. l ) THEN @@ -1409,6 +1478,15 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! specify IdNum of line for error checking m%LineList(l)%IdNum = l + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Line"//trim(num2lstr(m%LineList(l)%IdNum))//":" + write(p%UnLog, '(A15,I2)' ) " ID : ", m%LineList(l)%IdNum + write(p%UnLog, '(A15,A)' ) " Type : ", trim(m%LineTypeList(m%LineList(l)%PropsIdNum)%name) + write(p%UnLog, '(A15,f12.4)') " Len : ", m%LineList(l)%UnstrLen + write(p%UnLog, '(A15,A)' ) " Node A : ", " "//tempString2 + write(p%UnLog, '(A15,A)' ) " Node B : ", " "//tempString3 + write(p%UnLog, '(A15,I2)' ) " NumSegs: ", m%LineList(l)%N + end if ! check for sequential IdNums IF ( m%LineList(l)%IdNum .NE. l ) THEN @@ -1462,11 +1540,20 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if (m%LineList( TempIDnums(J) )%CtrlChan == 0) then ! ensure line doesn't already have a CtrlChan assigned m%LineList( TempIDnums(J) )%CtrlChan = Itemp CALL WrScr('Assigned Line '//TRIM(Int2LStr(TempIDnums(J)))//' to control channel '//TRIM(Int2LStr(Itemp))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') 'Assigned Line '//TRIM(Int2LStr(TempIDnums(J)))//' to control channel '//TRIM(Int2LStr(Itemp)) + end if else CALL WrScr('Error: Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') 'Error: Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp)) + end if end if else CALL WrScr('Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range') + if (p%writeLog > 0) then + write(p%UnLog,'(A)') 'Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range' + end if end if END DO @@ -1478,6 +1565,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header CALL WrScr(" Warning: Failure capabilities are not yet implemented in MoorDyn.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') " Warning: Failure capabilities are not yet implemented in MoorDyn." + end if ! skip following two lines (label line and unit line) Line = NextLine(i) @@ -1553,7 +1643,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - + if (p%writeLog > 1) then + write(p%UnLog, '(A)' ) " - Outputs List:" + DO J = 1, SIZE(Outlist) + write(p%UnLog, '(A)' ) " "//OutList(J) + END DO + end if !------------------------------------------------------------------------------------------- else ! otherwise ignore this line that isn't a recognized header line and read the next line Line = NextLine(i) @@ -1592,7 +1687,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! p%NAnchs = 0 ! this is the number of "fixed" type Points. <<<<<<<<<<<<<< CALL WrScr(trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.') - + if (p%writeLog > 0) then + write(p%UnLog,'(A)') trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.' + end if @@ -2091,6 +2188,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if (InputFileDat%TMaxIC > 0.0_DbKi) then CALL WrScr(" Finalizing initial conditions using dynamic relaxation."//NewLine) ! newline because next line writes over itself + if (p%writeLog > 0) then + write(p%UnLog,'(A)') " Finalizing initial conditions using dynamic relaxation."//NewLine + end if ! boost drag coefficient of each line type <<<<<<<< does this actually do anything or do lines hold these coefficients??? DO I = 1, p%nLines @@ -2159,6 +2259,10 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IF (ErrStat == ErrID_Fatal) THEN CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t))//" during MoorDyn's dynamic relaxation process.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "NaN detected at time "//TRIM(Num2LStr(t))//" during MoorDyn's dynamic relaxation process."//NewLine + end if + IF (wordy > 1) THEN print *, "Here is the state vector: " print *, x%states @@ -2212,9 +2316,17 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IF (Converged == 1) THEN ! if we made it with all cases satisfying the threshold CALL WrScr('') ! serves as line break from write over command in previous printed line CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') + if (p%writeLog > 0) then + write(p%UnLog,'(A)') '' + write(p%UnLog,'(A)') ' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.'//NewLine + end if DO l = 1, p%nLines CALL WrScr(' Fairlead tension: '//trim(Num2LStr(FairTensIC(l,1)))) CALL WrScr(' Fairlead forces: '//trim(Num2LStr(m%LineList(l)%Fnet(1, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(2, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(3, m%LineList(l)%N)))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' Fairlead tension: '//trim(Num2LStr(FairTensIC(l,1))) + write(p%UnLog,'(A)') ' Fairlead forces: '//trim(Num2LStr(m%LineList(l)%Fnet(1, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(2, m%LineList(l)%N)))//', '//trim(Num2LStr(m%LineList(l)%Fnet(3, m%LineList(l)%N))) + end if ENDDO EXIT ! break out of the time stepping loop END IF @@ -2223,6 +2335,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IF (I == ceiling(InputFileDat%TMaxIC/InputFileDat%dtIC) ) THEN CALL WrScr('') ! serves as line break from write over command in previous printed line CALL WrScr(' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InputFileDat%TMaxIC))//' seconds.') + if (p%writeLog > 0) then + write(p%UnLog,'(A)') '' + write(p%UnLog,'(A)') ' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InputFileDat%TMaxIC))//' seconds.' + end if + !ErrStat = ErrID_Warn !ErrMsg = ' MD_Init: ran dynamic convergence to TMaxIC without convergence' END IF @@ -2267,6 +2384,9 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er endif CALL WrScr(' MoorDyn initialization completed.') + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ' MoorDyn initialization completed.' + end if m%LastOutTime = -1.0_DbKi ! set to nonzero to ensure that output happens at the start of simulation at t=0 @@ -2460,6 +2580,9 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er IF (ErrStat == ErrID_Fatal) THEN CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn." + end if IF (wordy > 1) THEN print *, ". Here is the state vector: " print *, x%states @@ -2491,6 +2614,9 @@ SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, Er IF (ErrStat == ErrID_Fatal) THEN CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") + if (p%writeLog > 0) then + write(p%UnLog,'(A)') "NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn." + end if IF (wordy > 1) THEN print *, ". Here is the state vector: " print *, x%states @@ -2513,6 +2639,9 @@ SUBROUTINE CheckError(ErrId, Msg) ErrStat = MAX(ErrStat, ErrID) CALL WrScr( ErrMsg ) ! do this always or only if warning level? + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ErrMsg + end if IF( ErrStat > ErrID_Warn ) THEN ! CALL MD_DestroyInput( u_interp, ErrStat, ErrMsg ) @@ -2717,6 +2846,9 @@ SUBROUTINE CheckError(ErrId, Msg) ErrStat = MAX(ErrStat, ErrID) CALL WrScr( ErrMsg ) ! do this always or only if warning level? <<<<<<<<<<<<<<<<<<<<<< probably should remove all instances + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ErrMsg + end if ! IF( ErrStat > ErrID_Warn ) THEN ! CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) @@ -2869,6 +3001,9 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment longer than the limit of twice its original length.' call WrScr(trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is an increase of more than "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is an increase of more than "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N)) + end if IF (wordy > 0) print *, u%DeltaL IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN @@ -2877,6 +3012,9 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment shorter than the limit of half its original length.' call WrScr(trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is a reduction of more than half of "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N))) + if (p%writeLog > 0) then + write(p%UnLog,'(A)') trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is a reduction of more than half of "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N)) + end if IF (wordy > 0) print *, u%DeltaL IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN @@ -3090,6 +3228,9 @@ SUBROUTINE CheckError(ErrId, Msg) ErrStat = MAX(ErrStat, ErrID) CALL WrScr( ErrMsg ) ! do this always or only if warning level? + if (p%writeLog > 0) then + write(p%UnLog,'(A)') ErrMsg + end if END IF diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 index 37f406486a..190cc4d7eb 100644 --- a/modules/moordyn/src/MoorDyn_Line.f90 +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -213,25 +213,6 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) RETURN END IF - - if (p%writeLog > 1) then - write(p%UnLog, '(A)') " - Line"//trim(num2lstr(Line%IdNum)) - write(p%UnLog, '(A)') " ID: "//trim(num2lstr(Line%IdNum)) - write(p%UnLog, '(A)') " UnstrLen: "//trim(num2lstr(Line%UnstrLen)) - write(p%UnLog, '(A)') " N : "//trim(num2lstr(Line%N )) - write(p%UnLog, '(A)') " d : "//trim(num2lstr(Line%d )) - write(p%UnLog, '(A)') " rho : "//trim(num2lstr(Line%rho )) - write(p%UnLog, '(A)') " E : "//trim(num2lstr(Line%EA )) - write(p%UnLog, '(A)') " EI : "//trim(num2lstr(Line%EI )) - !write(p%UnLog, '(A)') " BAin: "//trim(num2lstr(Line%BAin)) - write(p%UnLog, '(A)') " Can : "//trim(num2lstr(Line%Can )) - write(p%UnLog, '(A)') " Cat : "//trim(num2lstr(Line%Cat )) - write(p%UnLog, '(A)') " Cdn : "//trim(num2lstr(Line%Cdn )) - write(p%UnLog, '(A)') " Cdt : "//trim(num2lstr(Line%Cdt )) - !write(p%UnLog, '(A)') " ww_l: " << ( (rho - env->rho_w)*(pi/4.*d*d) )*9.81 << endl; - end if - - ! need to add cleanup sub <<< diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index 23189361f3..7c0e26c203 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -151,8 +151,10 @@ subroutine GetOrientationAngles(vec, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, vecLen = SQRT(Dot_Product(vec,vec)) vecLen2D = SQRT(vec(1)**2+vec(2)**2) if ( vecLen < 0.000001 ) then - print *, "ERROR in GetOrientationAngles in MoorDyn. Supplied vector is near zero" - print *, vec + if (wordy > 0) then + print *, "ERROR in GetOrientationAngles in MoorDyn. Supplied vector is near zero" + print *, vec + endif k_hat = NaN ! 1.0/0.0 else k_hat = vec / vecLen diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index 7302214f9d..49c61a5c56 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -151,24 +151,6 @@ SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) IF (wordy > 0) print *, "Set up Rod ",Rod%IdNum, ", type ", Rod%typeNum - - if (p%writeLog > 1) then - write(p%UnLog, '(A)') " - Rod "//trim(num2lstr(Rod%IdNum)) - write(p%UnLog, '(A)') " ID: "//trim(num2lstr(Rod%IdNum)) - write(p%UnLog, '(A)') " UnstrLen: "//trim(num2lstr(Rod%UnstrLen)) - write(p%UnLog, '(A)') " N : "//trim(num2lstr(Rod%N )) - write(p%UnLog, '(A)') " d : "//trim(num2lstr(Rod%d )) - write(p%UnLog, '(A)') " rho : "//trim(num2lstr(Rod%rho )) - write(p%UnLog, '(A)') " Can : "//trim(num2lstr(Rod%Can )) - write(p%UnLog, '(A)') " Cat : "//trim(num2lstr(Rod%Cat )) - write(p%UnLog, '(A)') " CaEnd: "//trim(num2lstr(Rod%CaEnd )) - write(p%UnLog, '(A)') " Cdn : "//trim(num2lstr(Rod%Cdn )) - write(p%UnLog, '(A)') " Cdt : "//trim(num2lstr(Rod%Cdt )) - write(p%UnLog, '(A)') " CdEnd: "//trim(num2lstr(Rod%CdEnd )) - !write(p%UnLog, '(A)') " ww_l: " << ( (rho - env->rho_w)*(pi/4.*d*d) )*9.81 << endl; - end if - - ! need to add cleanup sub <<< From d0a75b64ba329db8fe564683b585d8c5312af721 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 4 Jan 2024 14:55:46 -0700 Subject: [PATCH 150/232] Better driver handling and updated log --- modules/moordyn/src/MoorDyn.f90 | 28 +++++++++++++++----------- modules/moordyn/src/MoorDyn_Driver.f90 | 9 +++++++-- 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index c3279f4893..e3881e7f1b 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1645,7 +1645,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er if (p%writeLog > 1) then write(p%UnLog, '(A)' ) " - Outputs List:" - DO J = 1, SIZE(Outlist) + DO J = 1, p%NumOuts write(p%UnLog, '(A)' ) " "//OutList(J) END DO end if @@ -1688,7 +1688,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.') if (p%writeLog > 0) then - write(p%UnLog,'(A)') trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.' + write(p%UnLog, '(A)') NewLine + write(p%UnLog, '(A)') ' Created mooring system: '//trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NPoints))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.' end if @@ -1730,7 +1731,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! write system description to log file if (p%writeLog > 1) then - write(p%UnLog, '(A)') "----- MoorDyn Model Summary (to be written) -----" + write(p%UnLog, '(A)') "----- MoorDyn Model Summary (unfinished) -----" end if @@ -2152,7 +2153,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! if log file, compute and write some object properties ! ------------------------------------------------------------------- if (p%writeLog > 1) then - + write(p%UnLog, '(A)' ) "Values after intialization before dynamic relaxation" write(p%UnLog, '(A)' ) " Bodies:" DO l = 1,p%nBodies write(p%UnLog, '(A)' ) " Body"//trim(num2lstr(l))//":" @@ -2162,21 +2163,21 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er write(p%UnLog, '(A)' ) " Rods:" DO l = 1,p%nRods write(p%UnLog, '(A)' ) " Rod"//trim(num2lstr(l))//":" - ! m%RodList(l) + write(p%UnLog, '(A12, f12.4)') " mass: ", m%RodList(l)%M6net(1,1) + write(p%UnLog, '(A17, A)') " direction: ", trim(num2lstr(m%RodList(l)%q(1)))//", "//trim(num2lstr(m%RodList(l)%q(2)))//", "//trim(num2lstr(m%RodList(l)%q(3))) END DO write(p%UnLog, '(A)' ) " Points:" DO l = 1,p%nFreePoints write(p%UnLog, '(A)' ) " Point"//trim(num2lstr(l))//":" - ! m%PointList(l) + write(p%UnLog, '(A12, f12.4)') " mass: ", m%PointList(l)%M END DO write(p%UnLog, '(A)' ) " Lines:" DO l = 1,p%nLines write(p%UnLog, '(A)' ) " Line"//trim(num2lstr(l))//":" - ! m%LineList(l) END DO - + write(p%UnLog, '(A)') "--------- End of Model Summary --------- "//NewLine end if @@ -2189,7 +2190,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(" Finalizing initial conditions using dynamic relaxation."//NewLine) ! newline because next line writes over itself if (p%writeLog > 0) then - write(p%UnLog,'(A)') " Finalizing initial conditions using dynamic relaxation."//NewLine + write(p%UnLog,'(A)') "Finalizing initial conditions using dynamic relaxation."//NewLine end if ! boost drag coefficient of each line type <<<<<<<< does this actually do anything or do lines hold these coefficients??? @@ -2314,7 +2315,6 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er END DO IF (Converged == 1) THEN ! if we made it with all cases satisfying the threshold - CALL WrScr('') ! serves as line break from write over command in previous printed line CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') if (p%writeLog > 0) then write(p%UnLog,'(A)') '' @@ -2385,7 +2385,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' MoorDyn initialization completed.') if (p%writeLog > 0) then - write(p%UnLog,'(A)') ' MoorDyn initialization completed.' + write(p%UnLog, '(A)') NewLine//"MoorDyn initialization completed."//NewLine + if (ErrStat /= ErrID_None) then + write(p%UnLog, '(A34)') "Initalization Errors and Warnings:" + write(p%UnLog, '(A)' ) ErrMsg + end if + write(p%UnLog, '(A)') NewLine end if m%LastOutTime = -1.0_DbKi ! set to nonzero to ensure that output happens at the start of simulation at t=0 @@ -2468,7 +2473,6 @@ END SUBROUTINE CheckError SUBROUTINE CleanUp() ! ErrStat = ErrID_Fatal call MD_DestroyInputFileType( InputFileDat, ErrStat2, ErrMsg2 ) ! Ignore any error messages from this - IF (p%UnLog > 0_IntKi) CLOSE( p%UnLog ) ! Remove this when the log file is kept open during the full simulation END SUBROUTINE !> If for some reason the file is truncated, it is possible to get into an infinite loop diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 27428eb326..b83842dba9 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -697,6 +697,11 @@ PROGRAM MoorDyn_Driver call MD_DestroyInput( MD_u(j), ErrStat2, ErrMsg2) end do + if ( ErrStat /= ErrID_None ) THEN ! Display all errors + CALL WrScr1( "Errors: " ) + CALL WrScr( trim(GetErrStr(ErrStat))//': '//trim(ErrMsg) ) + endif + !close (un) call CleanUp() CALL NormStop() @@ -711,8 +716,8 @@ SUBROUTINE AbortIfFailed() if (ErrStat >= AbortErrLev) then call CleanUp() Call ProgAbort(trim(ErrMsg)) - elseif ( ErrStat /= ErrID_None ) THEN - CALL WrScr1( trim(GetErrStr(ErrStat))//': '//trim(ErrMsg) ) + elseif ( ErrStat2 /= ErrID_None ) THEN + CALL WrScr1( trim(GetErrStr(ErrStat2))//': '//trim(ErrMsg2)//NewLine) end if END SUBROUTINE AbortIfFailed From 41810273103046a0361ffe79408070b7bdd47bbe Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 8 Jan 2024 12:50:13 -0700 Subject: [PATCH 151/232] Add option to disable inertial forces in 6DOF coupling --- modules/moordyn/src/MoorDyn.f90 | 2 ++ modules/moordyn/src/MoorDyn_Body.f90 | 20 ++++++++++++++++---- modules/moordyn/src/MoorDyn_Registry.txt | 1 + modules/moordyn/src/MoorDyn_Rod.f90 | 20 +++++++++++++++----- modules/moordyn/src/MoorDyn_Types.f90 | 1 + 5 files changed, 35 insertions(+), 9 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index e3881e7f1b..22167aee53 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -463,6 +463,8 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er read (OptValue,*) p%mc else if ( OptString == 'CV') then read (OptValue,*) p%cv + else if ( OptString == 'INERTIALF') then + read (OptValue,*) p%inertialF else CALL SetErrStat( ErrID_Warn, 'Unable to interpret input '//trim(OptString)//' in OPTIONS section.', ErrStat, ErrMsg, RoutineName ) end if diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index f520265fae..2a1b2df68c 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -522,13 +522,25 @@ SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) ! add inertial loads as appropriate if (Body%typeNum == -1) then - F6_iner = -MATMUL(Body%M, Body%a6) ! <<<<<<<< why does including F6_iner cause instability??? + if (p%inertialF == 1) then ! include inertial components + F6_iner = -MATMUL(Body%M, Body%a6) ! unstable in OpenFAST v4 and below becasue of loose coupling with ED and SD. Transients in acceleration can cause issues + else + ! When OpenFAST v5 is released w/ tight coupling, remove this hack and just use the inertial term above + F6_iner = 0.0 + endif + Body%F6net = Body%F6net + F6_iner ! add inertial loads Fnet_out = Body%F6net - else if (Body%typeNum == 2) then ! pinned coupled body - ! inertial loads ... from input translational ... and solved rotational ... acceleration - F6_iner(1:3) = -MATMUL(Body%M(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M(1:3,4:6), Body%a6(4:6)) + else if (Body%typeNum == 2) then ! pinned coupled body + + if (p%inertialF == 1) then ! include inertial components + ! inertial loads ... from input translational ... and solved rotational ... acceleration + F6_iner(1:3) = -MATMUL(Body%M(1:3,1:3), Body%a6(1:3)) - MATMUL(Body%M(1:3,4:6), Body%a6(4:6)) + else + F6_iner(1:3) = 0.0 + endif + Body%F6net(1:3) = Body%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads Body%F6net(4:6) = 0.0_DbKi Fnet_out = Body%F6net diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index a8406ef193..8dbfcd08b3 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -423,6 +423,7 @@ typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} typedef ^ ^ Logical VisMeshes - - - "Using visualization meshes as requested by glue code" - typedef ^ ^ VisDiam VisRodsDiam {:} - - "Diameters for visualization of rods" - typedef ^ ^ IntKi Standalone - - - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - +typedef ^ ^ IntKi inertialF - 1 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no" - # ============================== Inputs ============================================================================================================================================ diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index 49c61a5c56..8e8b274d77 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -996,14 +996,24 @@ SUBROUTINE Rod_GetCoupledForce(Rod, Fnet_out, m, p) ! add inertial loads as appropriate (written out in a redundant way just for clarity, and to support load separation in future) ! fixed coupled rod if (Rod%typeNum == -2) then - - F6_iner = -MATMUL(Rod%M6net, Rod%a6) ! inertial loads + + if (p%inertialF == 1) then ! include inertial components + F6_iner = -MATMUL(Rod%M6net, Rod%a6) ! inertial loads + else + F6_iner = 0.0 + endif Rod%F6net = Rod%F6net + F6_iner ! add inertial loads Fnet_out = Rod%F6net ! pinned coupled rod - else if (Rod%typeNum == -1) then - ! inertial loads ... from input translational ... and solved rotational ... acceleration - F6_iner(1:3) = -MATMUL(Rod%M6net(1:3,1:3), Rod%a6(1:3)) - MATMUL(Rod%M6net(1:3,4:6), Rod%a6(4:6)) + else if (Rod%typeNum == -1) then + + if (p%inertialF == 1) then ! include inertial components + ! inertial loads ... from input translational ... and solved rotational ... acceleration + F6_iner(1:3) = -MATMUL(Rod%M6net(1:3,1:3), Rod%a6(1:3)) - MATMUL(Rod%M6net(1:3,4:6), Rod%a6(4:6)) + else + F6_iner(1:3) = 0.0 + endif + Rod%F6net(1:3) = Rod%F6net(1:3) + F6_iner(1:3) ! add translational inertial loads Rod%F6net(4:6) = 0.0_DbKi Fnet_out = Rod%F6net diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 125834a561..713a64b0fd 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -456,6 +456,7 @@ MODULE MoorDyn_Types LOGICAL :: VisMeshes !< Using visualization meshes as requested by glue code [-] TYPE(VisDiam) , DIMENSION(:), ALLOCATABLE :: VisRodsDiam !< Diameters for visualization of rods [-] INTEGER(IntKi) :: Standalone !< Indicates MoorDyn run as standalone code if 1, coupled if 0 [-] + INTEGER(IntKi) :: inertialF = 1 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= From ddd97ca51d36cf6b318533c75a4070e406f1f3a5 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 8 Jan 2024 19:36:28 -0700 Subject: [PATCH 152/232] AWAE: Mod_AmbWind=3 add error if HR grid not centered on turbine in Y direction --- modules/awae/src/AWAE.f90 | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index beecc09957..a01fc742ed 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -817,6 +817,7 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO character(1024) :: rootDir, baseName, OutFileVTKDir ! Simulation root dir, basename for outputs integer(IntKi) :: i,j,nt ! loop counter real(ReKi) :: gridLoc ! Location of requested output slice in grid coordinates [0,sz-1] + real(ReKi) :: tmpDy,tmpRe integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message character(*), parameter :: RoutineName = 'AWAE_Init' @@ -1053,25 +1054,47 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO do nt = 1,p%NumTurbines IfW_InitInp%TurbineID = nt - + call WrScr(NewLine//'Initializing high-resolution grid for Turbine '//trim(Num2Lstr(nt))) call InflowWind_Init( IfW_InitInp, m%u_IfW_High, p%IfW(nt), x%IfW(nt), xd%IfW(nt), z%IfW(nt), OtherState%IfW(nt), m%y_IfW_High, m%IfW(nt), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (errStat2 >= AbortErrLev) then return end if + ! Check that the high resolution grid placement is correct + ! The InflowWind grid location is exactly centered on the TurbPos location in the Y direction. The high resolution grid + ! must exactly match the sizing and location of the InflowWind grid. We are only going to check the Y and Z locations + ! for now and throw an error if these don't match appropriately. + if (IfW_InitOut%WindFileInfo%YRange_Limited) then ! only check boundaries if the YRange is limited (we don't care what kind of wind) + tmpRe = p%Y0_High(nt) + (real(p%nY_high,ReKi)-1.0_ReKi)*p%dY_high(nt) ! upper bound of high-res grid + if ((.not. EqualRealNos(p%WT_Position(2,nt)+IfW_InitOut%WindFileInfo%YRange(1),p%Y0_High(nt))) .or. & ! lower bound + (.not. EqualRealNos(p%WT_Position(2,nt)+IfW_InitOut%WindFileInfo%YRange(2),tmpRe)) ) then ! upper bound + ErrStat2 = ErrID_Fatal + ErrMsg2 = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the InflowWind high-res data range exactly match the high-res grid '// & + 'and the turbine is exactly centered in the high-res grid in the Y direction. '//NewLine//' Try setting:'//NewLine// & + ' Y0_high = '// & + trim(Num2LStr(p%WT_Position(2,nt)+IfW_InitOut%WindFileInfo%YRange(1))) + if (allocated(p%IfW(nt)%FlowField%Grid3D%Vel)) then + tmpDy = abs(IfW_InitOut%WindFileInfo%YRange(2)-IfW_InitOut%WindFileInfo%YRange(1))/(real(p%nY_high,ReKi)-1.0_ReKi) + ErrMsg2=trim(ErrMsg2)//NewLine//' dY_High = '//trim(Num2LStr(tmpDy)) + call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + endif + endif + endif + end do + if (errStat >= AbortErrLev) return end if ! Set the position inputs once for the low-resolution grid m%u_IfW_Low%PositionXYZ = p%Grid_low - ! Set the hub position and orientation to pass to IfW (IfW always calculates hub and disk avg vel) + ! Set the hub position and orientation to pass to IfW (FIXME: IfW always calculates hub and disk avg vel. Change this after IfW pointers fully enabled.) m%u_IfW_Low%HubPosition = (/ p%X0_low + 0.5*p%nX_low*p%dX_low, p%Y0_low + 0.5*p%nY_low*p%dY_low, p%Z0_low + 0.5*p%nZ_low*p%dZ_low /) call Eye(m%u_IfW_Low%HubOrientation,ErrStat2,ErrMsg2) ! Initialize the high-resolution grid inputs and outputs - IF ( .NOT. ALLOCATED( m%u_IfW_High%PositionXYZ ) ) THEN + IF ( .NOT. ALLOCATED( m%u_IfW_High%PositionXYZ ) ) THEN call AllocAry(m%u_IfW_High%PositionXYZ, 3, p%nX_high*p%nY_high*p%nZ_high, 'm%u_IfW_High%PositionXYZ', ErrStat2, ErrMsg2) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry(m%y_IfW_High%VelocityUVW, 3, p%nX_high*p%nY_high*p%nZ_high, 'm%y_IfW_High%VelocityUVW', ErrStat2, ErrMsg2) From 280d6d28259243c755e4ca9c5e4502c0aff4248b Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 9 Jan 2024 16:17:05 -0700 Subject: [PATCH 153/232] VS: update VS build process to include ExtLoads --- vs-build/FASTlib/FASTlib.vfproj | 39 +++++++++++++++++++++++++++++++++ vs-build/RunRegistry.bat | 15 ++++++++++++- 2 files changed, 53 insertions(+), 1 deletion(-) diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index f587603d9a..e1b4b124c4 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -1469,6 +1469,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 2649627f6b..319d158d37 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -36,6 +36,7 @@ SET IceF_Loc=%Modules_Loc%\icefloe\src\interfaces\FAST SET IceD_Loc=%Modules_Loc%\icedyn\src SET MD_Loc=%Modules_Loc%\moordyn\src SET ExtInfw_Loc=%Modules_Loc%\externalinflow\src +SET ExtLoads_Loc=%Modules_Loc%\extloads\src SET Orca_Loc=%Modules_Loc%\orcaflex-interface\src SET NWTC_Lib_Loc=%Modules_Loc%\nwtc-library\src SET ExtPtfm_Loc=%Modules_Loc%\extptfm\src @@ -51,7 +52,7 @@ SET Farm_Loc=%Root_Loc%\glue-codes\fast-farm\src SET ALL_FAST_Includes=-I "%FAST_Loc%" -I "%NWTC_Lib_Loc%" -I "%ED_Loc%" -I "%SrvD_Loc%" -I "%AD14_Loc%" -I^ "%AD_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%SEAST_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ - "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%ExtInfw_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" + "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%ExtInfw_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" -I "%ExtLoads_Loc%" SET ModuleName=%1 @@ -132,6 +133,18 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -ccode -O "%Output_Loc%" GOTO checkError +:ExtLoads +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%ExtLoads_Loc%" -O "%Output_Loc%" +GOTO checkError + +:ExtLoadsDX +SET CURR_LOC=%ExtLoads_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -ccode -O "%Output_Loc%" +GOTO checkError + :AeroDyn :BEMT :DBEMT From acc20caade8b2f5f652aabb93992082761fa19f2 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Tue, 9 Jan 2024 16:28:02 -0700 Subject: [PATCH 154/232] Add error handling to opening line EA file --- modules/moordyn/src/MoorDyn_IO.f90 | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 271d9791d9..245c9afa1f 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -242,8 +242,7 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line LineProp_npoints = 0; else ! otherwise interpet the input as a file name to load stress-strain lookup data from - - CALL WrScr("found A letter in the line coefficient value so will try to load the filename.") + CALL WrScr1(" Found a letter in the line EA coefficient value so will try to load the filename.") LineProp_c = 0.0 @@ -251,8 +250,13 @@ SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, Line CALL GetNewUnit( UnCoef ) CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) ! add error handling? + IF (ErrStat4 == ErrID_Fatal) then + ErrStat3 = ErrStat4 + ErrMsg3 = ErrMsg4 + RETURN + ENDIF - READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first two lines (title, names, and units) then parse + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first three lines (title, names, and units) then parse READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 From 387857b1f6dbb5153a569ab70e5f547d06af492a Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Tue, 9 Jan 2024 16:33:42 -0700 Subject: [PATCH 155/232] Change default inertialF to 0 --- modules/moordyn/src/MoorDyn_Registry.txt | 2 +- modules/moordyn/src/MoorDyn_Types.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 8dbfcd08b3..6ebabf21c5 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -423,7 +423,7 @@ typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} typedef ^ ^ Logical VisMeshes - - - "Using visualization meshes as requested by glue code" - typedef ^ ^ VisDiam VisRodsDiam {:} - - "Diameters for visualization of rods" - typedef ^ ^ IntKi Standalone - - - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - -typedef ^ ^ IntKi inertialF - 1 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no" - +typedef ^ ^ IntKi inertialF - 0 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no" - # ============================== Inputs ============================================================================================================================================ diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 713a64b0fd..1e640d4098 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -456,7 +456,7 @@ MODULE MoorDyn_Types LOGICAL :: VisMeshes !< Using visualization meshes as requested by glue code [-] TYPE(VisDiam) , DIMENSION(:), ALLOCATABLE :: VisRodsDiam !< Diameters for visualization of rods [-] INTEGER(IntKi) :: Standalone !< Indicates MoorDyn run as standalone code if 1, coupled if 0 [-] - INTEGER(IntKi) :: inertialF = 1 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no [-] + INTEGER(IntKi) :: inertialF = 0 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= From f814dba80d1fa25a2aa5f7dd53aadd35877e474a Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 9 Jan 2024 17:07:29 -0700 Subject: [PATCH 156/232] MD reg test: update input files --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 7709178aed..49b70806aa 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 7709178aed58df8f5df3b86a41c275cbaac5f70e +Subproject commit 49b70806aa1d9d5dc1698075e89660cad69c38d7 From 5c67b9989365c458b036d7838727908a15e91102 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Wed, 10 Jan 2024 10:57:48 -0700 Subject: [PATCH 157/232] Replace print w WrScr and minor organize of registry --- modules/moordyn/src/MoorDyn_Body.f90 | 4 ++-- modules/moordyn/src/MoorDyn_Misc.f90 | 20 ++++++++++---------- modules/moordyn/src/MoorDyn_Point.f90 | 4 ++-- modules/moordyn/src/MoorDyn_Registry.txt | 4 ++-- modules/moordyn/src/MoorDyn_Rod.f90 | 8 ++++---- modules/moordyn/src/MoorDyn_Types.f90 | 4 ++-- 6 files changed, 22 insertions(+), 22 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_Body.f90 b/modules/moordyn/src/MoorDyn_Body.f90 index 2a1b2df68c..acf6f92098 100644 --- a/modules/moordyn/src/MoorDyn_Body.f90 +++ b/modules/moordyn/src/MoorDyn_Body.f90 @@ -570,7 +570,7 @@ SUBROUTINE Body_AddPoint(Body, pointID, coords) Body%AttachedC(Body%nAttachedC) = pointID Body%rPointRel(:,Body%nAttachedC) = coords ! store relative position of point on body ELSE - Print*, "too many Points attached to Body ", Body%IdNum, " in MoorDyn!" + call WrScr("too many Points attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn!") END IF END SUBROUTINE Body_AddPoint @@ -601,7 +601,7 @@ SUBROUTINE Body_AddRod(Body, rodID, coords) Body%r6RodRel(4:6, Body%nAttachedR) = tempUnitVec ELSE - Print*, "too many rods attached to Body ", Body%IdNum, " in MoorDyn" + call WrScr("too many rods attached to Body "//trim(num2lstr(Body%IdNum))//" in MoorDyn") END IF END SUBROUTINE Body_AddRod diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index 7c0e26c203..8fb91cf218 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1350,7 +1350,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ELSE IF (SCAN(WaterKinString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) THEN ! If the input has no letters, let's assume it's a number - print *, "ERROR WaveKin option does not currently support numeric entries. It must be a filename." + call WrScr( "ERROR WaveKin option does not currently support numeric entries. It must be a filename." ) p%WaveKin = 0 p%Current = 0 return @@ -1358,7 +1358,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! otherwise interpret the input as a file name to load the bathymetry lookup data from - print *, " The waterKin input contains letters so will load a water kinematics input file" + call WrScr( " The waterKin input contains letters so will load a water kinematics input file" ) ! -------- load water kinematics input file ------------- @@ -1413,7 +1413,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) end if if (i == 100) then - print*,"WARNING: MD can handle a maximum of 100 current profile points" + call WrScr("WARNING: MD can handle a maximum of 100 current profile points") exit end if END DO @@ -1449,7 +1449,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! --------------------- set from inputted wave elevation time series, grid approach ------------------- if (p%WaveKin == 3) then - print *, 'Setting up WaveKin 3 option: read wave elevation time series from file' + call WrScr( 'Setting up WaveKin 3 option: read wave elevation time series from file' ) IF ( LEN_TRIM( WaveKinFile ) == 0 ) THEN CALL SetErrStat( ErrID_Fatal,'WaveKinFile must not be an empty string.',ErrStat, ErrMsg, RoutineName); return @@ -1467,7 +1467,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CALL OpenFInpFile ( UnElev, WaveKinFile, ErrStat2, ErrMsg2 ); if(Failed()) return - print *, 'Reading wave elevation data from ', trim(WaveKinFile) + call WrScr( 'Reading wave elevation data from '//trim(WaveKinFile) ) ! Read through length of file to find its length i = 1 ! start counter @@ -1502,7 +1502,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) ! Close the inputs file CLOSE ( UnElev ) - print *, "Read ", ntIn, " time steps from input file." + call WrScr( "Read "//trim(num2lstr(ntIn))//" time steps from input file." ) ! if (WaveTimeIn(ntIn) < TMax) then <<<< need to handle if time series is too short? @@ -1714,7 +1714,7 @@ SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) INTEGER(IntKi) :: nEntries, I IF (len(trim(entries)) == len(entries)) THEN - print*, "Warning: Only 120 characters read from wave grid coordinates" + call WrScr("Warning: Only 120 characters read from wave grid coordinates") END IF IF (entries(len(entries):len(entries)) == ',') THEN @@ -1732,7 +1732,7 @@ SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) else if (coordtype==2) then ! 2: uniform specified by -xlim, xlim, num n = int(tempArray(3)) else - print *, "Error: invalid coordinate type specified to gridAxisCoords" + call WrScr("Error: invalid coordinate type specified to gridAxisCoords") end if ! allocate coordinate array @@ -1755,7 +1755,7 @@ SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) end do else - print *, "Error: invalid coordinate type specified to gridAxisCoords" + call WrScr("Error: invalid coordinate type specified to gridAxisCoords") end if ! print *, "Set water grid coordinates to :" @@ -1791,7 +1791,7 @@ SUBROUTINE stringToArray(instring, n, outarray) END IF n = n + 1 if (n > 100) then - print *, "ERROR - stringToArray cannot do more than 100 entries" + call WrScr( "ERROR - stringToArray cannot do more than 100 entries") end if READ(instring(pos1:pos1+pos2-2), *) outarray(n) diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 index f79d86858b..9328f4805d 100644 --- a/modules/moordyn/src/MoorDyn_Point.f90 +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -362,7 +362,7 @@ SUBROUTINE Point_AddLine(Point, lineID, TopOfLine) Point%Attached(Point%nAttached) = lineID Point%Top(Point%nAttached) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) ELSE - Print*, "Too many lines connected to Point ", Point%IdNum, " in MoorDyn!" + call WrScr("Too many lines connected to Point "//trim(num2lstr(Point%IdNum))//" in MoorDyn!") END IF END SUBROUTINE Point_AddLine @@ -399,7 +399,7 @@ SUBROUTINE Point_RemoveLine(Point, lineID, TopOfLine, rEnd, rdEnd) rdEnd(J) = Point%rd(J) END DO - print*, "Detached line ", lineID, " from Point ", Point%IdNum + call WrScr( "Detached line "//trim(num2lstr(lineID))//" from Point "//trim(num2lstr(Point%IdNum))) EXIT END DO diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 6ebabf21c5..9c4d84e6d4 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -391,6 +391,8 @@ typedef ^ ^ DbKi mu_kT - typedef ^ ^ DbKi mu_kA - - - "axial kinetic friction coefficient" "(-)" typedef ^ ^ DbKi mc - - - "ratio of the static friction coefficient to the kinetic friction coefficient" "(-)" typedef ^ ^ DbKi cv - - - "saturated damping coefficient" "(-)" +typedef ^ ^ IntKi Standalone - - - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - +typedef ^ ^ IntKi inertialF - 0 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no" - # --- parameters for wave and current --- typedef ^ ^ IntKi nxWave - - - "number of x wave grid points" - typedef ^ ^ IntKi nyWave - - - "number of y wave grid points" - @@ -422,8 +424,6 @@ typedef ^ ^ Integer Jac_nx - typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} - - "Mapping array from index of dX array to corresponding state index" - typedef ^ ^ Logical VisMeshes - - - "Using visualization meshes as requested by glue code" - typedef ^ ^ VisDiam VisRodsDiam {:} - - "Diameters for visualization of rods" - -typedef ^ ^ IntKi Standalone - - - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - -typedef ^ ^ IntKi inertialF - 0 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no" - # ============================== Inputs ============================================================================================================================================ diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 index 8e8b274d77..f5f718198a 100644 --- a/modules/moordyn/src/MoorDyn_Rod.f90 +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -1081,7 +1081,7 @@ SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) Rod%AttachedB(Rod%nAttachedB) = lineID Rod%TopB(Rod%nAttachedB) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) ELSE - Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + call WrScr("too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!") END IF else ! attaching to end A @@ -1093,7 +1093,7 @@ SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) Rod%AttachedA(Rod%nAttachedA) = lineID Rod%TopA(Rod%nAttachedA) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) ELSE - Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + call WrScr("too many lines connected to Rod "//trim(num2lstr(Rod%IdNum))//" in MoorDyn!") END IF end if @@ -1135,7 +1135,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) rdEnd(J) = Rod%rd(J,Rod%N) END DO - print*, "Detached line ", lineID, " from Rod ", Rod%IdNum, " end B" + call WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end B") EXIT END DO @@ -1167,7 +1167,7 @@ SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) rdEnd(J) = Rod%rd(J,0) END DO - print*, "Detached line ", lineID, " from Rod ", Rod%IdNum, " end A" + call WrScr( "Detached line "//trim(num2lstr(lineID))//" from Rod "//trim(num2lstr(Rod%IdNum))//" end A") EXIT END DO diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 1e640d4098..82a6096104 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -426,6 +426,8 @@ MODULE MoorDyn_Types REAL(DbKi) :: mu_kA !< axial kinetic friction coefficient [(-)] REAL(DbKi) :: mc !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] REAL(DbKi) :: cv !< saturated damping coefficient [(-)] + INTEGER(IntKi) :: Standalone !< Indicates MoorDyn run as standalone code if 1, coupled if 0 [-] + INTEGER(IntKi) :: inertialF = 0 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no [-] INTEGER(IntKi) :: nxWave !< number of x wave grid points [-] INTEGER(IntKi) :: nyWave !< number of y wave grid points [-] INTEGER(IntKi) :: nzWave !< number of z wave grid points [-] @@ -455,8 +457,6 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] LOGICAL :: VisMeshes !< Using visualization meshes as requested by glue code [-] TYPE(VisDiam) , DIMENSION(:), ALLOCATABLE :: VisRodsDiam !< Diameters for visualization of rods [-] - INTEGER(IntKi) :: Standalone !< Indicates MoorDyn run as standalone code if 1, coupled if 0 [-] - INTEGER(IntKi) :: inertialF = 0 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= From 7bdeeb35eb588aaee40c60e9dd08190f8b0d2653 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Wed, 10 Jan 2024 11:40:19 -0700 Subject: [PATCH 158/232] Removed unecessary standalone variable and cleaned logic --- modules/moordyn/src/MoorDyn.f90 | 4 -- modules/moordyn/src/MoorDyn_Driver.f90 | 55 +++++++----------------- modules/moordyn/src/MoorDyn_Registry.txt | 1 - modules/moordyn/src/MoorDyn_Types.f90 | 1 - 4 files changed, 16 insertions(+), 45 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 22167aee53..ebde8cf519 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -200,10 +200,6 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er m%PtfmInit = InitInp%PtfmInit(:,1) ! is this copying necssary in case this is an individual instance in FAST.Farm? - p%Standalone = InitInp%Standalone - - - ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) if (InitInp%FarmSize > 0) then CALL WrScr(' >>> MoorDyn is running in array mode <<< ') diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index b83842dba9..3fbe8b580a 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -173,13 +173,9 @@ PROGRAM MoorDyn_Driver MD_InitInp%FarmSize = drvrInitInp%FarmSize - MD_InitInp%Standalone = 0 if (drvrInitInp%FarmSize > 0) then ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) nTurbines = drvrInitInp%FarmSize - else if (drvrInitInp%FarmSize < 0) then ! FarmSize<0 indicates standalone mode - MD_InitInp%Standalone = 1 - nTurbines = 1 ! to keep routines happy - else ! FarmSize==0 indicates normal, FAST module mode + else ! FarmSize==0 indicates normal, FAST module mode; FarmSize<0 indicates standalone mode nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case end if @@ -494,13 +490,14 @@ PROGRAM MoorDyn_Driver i = 1 ! read first timestep data K = 1 ! the index of the coupling points in the input mesh CoupledKinematics J = 1 ! the starting index of the relevant DOFs in the input array + + IF (MD_InitInp%FarmSize < 0) THEN + MD_p%TurbineRefPos(:,iTurb) = 0.0 + ENDIF + ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) - IF (MD_InitInp%Standalone == 1) THEN - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - ELSE - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) - ENDIF + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -513,12 +510,7 @@ PROGRAM MoorDyn_Driver ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< DO l = 1,MD_p%nCpldRods(iTurb) - - IF (MD_InitInp%Standalone == 1) THEN - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - ELSE - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) - ENDIF + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -531,12 +523,7 @@ PROGRAM MoorDyn_Driver ! any coupled points (type -1) DO l = 1, MD_p%nCpldPoints(iTurb) - - IF (MD_InitInp%Standalone == 1) THEN - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - ELSE - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) - ENDIF + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) @@ -595,13 +582,13 @@ PROGRAM MoorDyn_Driver K = 1 ! the index of the coupling points in the input mesh CoupledKinematics J = 1 ! the starting index of the relevant DOFs in the input array + IF (MD_InitInp%FarmSize < 0) THEN + MD_p%TurbineRefPos(:,iTurb) = 0.0 + ENDIF + ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) - IF (MD_InitInp%Standalone == 1) THEN - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - ELSE - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) - ENDIF + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -614,12 +601,7 @@ PROGRAM MoorDyn_Driver ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< DO l = 1,MD_p%nCpldRods(iTurb) - - IF (MD_InitInp%Standalone == 1) THEN - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - ELSE - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) - ENDIF + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) @@ -632,12 +614,7 @@ PROGRAM MoorDyn_Driver ! any coupled points (type -1) DO l = 1, MD_p%nCpldPoints(iTurb) - - IF (MD_InitInp%Standalone == 1) THEN - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - ELSE - MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) - ENDIF + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 9c4d84e6d4..d4df4982c8 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -25,7 +25,6 @@ typedef ^ ^ ReKi rhoW - -99 typedef ^ ^ ReKi WtrDepth - -999.9 - "depth of water" "[m]" typedef ^ ^ ReKi PtfmInit {:}{:} - - "initial position of platform(s) shape: 6, nTurbines" - typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0, standalone mode if -1" - -typedef ^ ^ IntKi Standalone - 0 - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - typedef ^ ^ ReKi Tmax - - - "simulation duration" "[s]" typedef ^ ^ CHARACTER(1024) FileName - "" - "MoorDyn input file" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 82a6096104..c6a3e38d67 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -48,7 +48,6 @@ MODULE MoorDyn_Types REAL(ReKi) :: WtrDepth = -999.9 !< depth of water [[m]] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmInit !< initial position of platform(s) shape: 6, nTurbines [-] INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] - INTEGER(IntKi) :: Standalone = 0 !< Indicates MoorDyn run as standalone code if 1, coupled if 0, standalone mode if -1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] REAL(ReKi) :: Tmax !< simulation duration [[s]] CHARACTER(1024) :: FileName !< MoorDyn input file [-] From 677d81158346668cd5ebc1eb876b927e715e6572 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 10 Jan 2024 16:53:56 -0700 Subject: [PATCH 159/232] AWAE: revise logic to allow high-res grids smaller than IfW grids Also allow for wind along Y direction --- modules/awae/src/AWAE.f90 | 88 ++++++++++++++++++++++++++++++--------- 1 file changed, 68 insertions(+), 20 deletions(-) diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index a01fc742ed..e4f2d50358 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -799,7 +799,7 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO type(AWAE_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine type(AWAE_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AWAE_ParameterType), intent( out) :: p !< Parameters + type(AWAE_ParameterType),target,intent( out) :: p !< Parameters type(AWAE_ContinuousStateType), intent( out) :: x !< Initial continuous states type(AWAE_DiscreteStateType), intent( out) :: xd !< Initial discrete states type(AWAE_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states @@ -817,12 +817,11 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO character(1024) :: rootDir, baseName, OutFileVTKDir ! Simulation root dir, basename for outputs integer(IntKi) :: i,j,nt ! loop counter real(ReKi) :: gridLoc ! Location of requested output slice in grid coordinates [0,sz-1] - real(ReKi) :: tmpDy,tmpRe integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message character(*), parameter :: RoutineName = 'AWAE_Init' type(InflowWind_InitInputType) :: IfW_InitInp - type(InflowWind_InitOutputType) :: IfW_InitOut + type(InflowWind_InitOutputType), target :: IfW_InitOut ! Initialize variables for this routine errStat = ErrID_None @@ -1057,7 +1056,7 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO call WrScr(NewLine//'Initializing high-resolution grid for Turbine '//trim(Num2Lstr(nt))) call InflowWind_Init( IfW_InitInp, m%u_IfW_High, p%IfW(nt), x%IfW(nt), xd%IfW(nt), z%IfW(nt), OtherState%IfW(nt), m%y_IfW_High, m%IfW(nt), Interval, IfW_InitOut, ErrStat2, ErrMsg2 ) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (errStat2 >= AbortErrLev) then + if (errStat >= AbortErrLev) then return end if @@ -1065,22 +1064,7 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! The InflowWind grid location is exactly centered on the TurbPos location in the Y direction. The high resolution grid ! must exactly match the sizing and location of the InflowWind grid. We are only going to check the Y and Z locations ! for now and throw an error if these don't match appropriately. - if (IfW_InitOut%WindFileInfo%YRange_Limited) then ! only check boundaries if the YRange is limited (we don't care what kind of wind) - tmpRe = p%Y0_High(nt) + (real(p%nY_high,ReKi)-1.0_ReKi)*p%dY_high(nt) ! upper bound of high-res grid - if ((.not. EqualRealNos(p%WT_Position(2,nt)+IfW_InitOut%WindFileInfo%YRange(1),p%Y0_High(nt))) .or. & ! lower bound - (.not. EqualRealNos(p%WT_Position(2,nt)+IfW_InitOut%WindFileInfo%YRange(2),tmpRe)) ) then ! upper bound - ErrStat2 = ErrID_Fatal - ErrMsg2 = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the InflowWind high-res data range exactly match the high-res grid '// & - 'and the turbine is exactly centered in the high-res grid in the Y direction. '//NewLine//' Try setting:'//NewLine// & - ' Y0_high = '// & - trim(Num2LStr(p%WT_Position(2,nt)+IfW_InitOut%WindFileInfo%YRange(1))) - if (allocated(p%IfW(nt)%FlowField%Grid3D%Vel)) then - tmpDy = abs(IfW_InitOut%WindFileInfo%YRange(2)-IfW_InitOut%WindFileInfo%YRange(1))/(real(p%nY_high,ReKi)-1.0_ReKi) - ErrMsg2=trim(ErrMsg2)//NewLine//' dY_High = '//trim(Num2LStr(tmpDy)) - call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) - endif - endif - endif + call CheckModAmb3Boundaries() end do if (errStat >= AbortErrLev) return @@ -1281,6 +1265,70 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO +contains + subroutine CheckModAmb3Boundaries() + real(ReKi) :: Dx,Dy,Dz + real(ReKi) :: ff_lim(2) + real(ReKi) :: hr_lim(2) + real(ReKi), parameter :: GridTol = 1.0E-3 ! Tolerance from IfW for checking the high-res grid (Mod_AmbWind=3 only). + type(FlowFieldType), pointer :: ff ! alias to shorten notation to fullfield + type(WindFileDat), pointer :: wfi ! alias to shorten notation to WindFileInfo + character(1024) :: tmpMsg + + ff => p%IfW(nt)%FlowField + wfi => IfW_InitOut%WindFileInfo + + tmpMsg = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the InflowWind high-res data range exactly match the high-res grid '// & + 'and the turbine is exactly centered in the high-res grid in the Y direction (or X direction if FlowField is along Y). '//NewLine//' Try setting:'//NewLine + ! check Z limits, if ZRange is limited (we don't care what kind of wind) + if (wfi%ZRange_Limited) then + endif + + ! check X/Y limits if range limited. Depends on orientation of winds. + if (wfi%YRange_Limited) then + ! flow field limits (with grid tolerance) + ff_lim(1) = p%WT_Position(2,nt) + wfi%YRange(1) - GridTol + ff_lim(2) = p%WT_Position(2,nt) + wfi%YRange(2) + GridTol + + ! wind X aligned with high-res X + if (.not. ff%RotateWindBox) then + ! high-res Y limits + hr_lim(1) = p%Y0_High(nt) + hr_lim(2) = p%Y0_High(nt) + (real(p%nY_high,ReKi)-1.0_ReKi)*p%dY_high(nt) + if ((hr_lim(1) < ff_lim(1)) .or. & + (hr_lim(2) > ff_lim(2)) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = trim(tmpMsg)// & + ' Y0_high = '//trim(Num2LStr(p%WT_Position(2,nt)+wfi%YRange(1))) + if (allocated(ff%Grid3D%Vel)) then + Dy = abs(wfi%YRange(2)-wfi%YRange(1))/(real(p%nY_high,ReKi)-1.0_ReKi) + ErrMsg2=trim(ErrMsg2)//NewLine//' dY_High = '//trim(Num2LStr(Dy)) + call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + endif + endif + + ! wind X aligned with high-res Y + elseif (EqualRealNos(abs(ff%PropagationDir),PiBy2)) then + ! high-res X limits + hr_lim(1) = p%X0_High(nt) + hr_lim(2) = p%X0_High(nt) + (real(p%nX_high,ReKi)-1.0_ReKi)*p%dX_high(nt) + if ((hr_lim(1) < ff_lim(1)) .or. & + (hr_lim(2) > ff_lim(2)) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = trim(tmpMsg)// & + ' X0_high = '//trim(Num2LStr(p%WT_Position(1,nt)+wfi%YRange(1))) + if (allocated(ff%Grid3D%Vel)) then + Dx = abs(wfi%YRange(2)-wfi%YRange(1))/(real(p%nX_high,ReKi)-1.0_ReKi) + ErrMsg2=trim(ErrMsg2)//NewLine//' dX_High = '//trim(Num2LStr(Dx)) + call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + endif + endif + elseif (.not. EqualRealNos(ff%PropagationDir,0.0_ReKi)) then ! wind not aligned with X or Y. This is not allowed at present + ErrStat2 = ErrID_Fatal + ErrMsg2 = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires InflowWind propagation direction alignment with X or Y (0, 90, 180, 270 degrees).' + endif + endif + end subroutine CheckModAmb3Boundaries end subroutine AWAE_Init From b621edbd9c5f6e7078d73762e1c486268bb405a1 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 10 Jan 2024 17:05:28 -0700 Subject: [PATCH 160/232] AWAE: Mod_AmbWind=3 add check on z-range --- modules/awae/src/AWAE.f90 | 32 +++++++++++++++++++++++++------- 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index e4f2d50358..7ba865997a 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -1267,7 +1267,7 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO contains subroutine CheckModAmb3Boundaries() - real(ReKi) :: Dx,Dy,Dz + real(ReKi) :: Dxyz real(ReKi) :: ff_lim(2) real(ReKi) :: hr_lim(2) real(ReKi), parameter :: GridTol = 1.0E-3 ! Tolerance from IfW for checking the high-res grid (Mod_AmbWind=3 only). @@ -1278,10 +1278,28 @@ subroutine CheckModAmb3Boundaries() ff => p%IfW(nt)%FlowField wfi => IfW_InitOut%WindFileInfo - tmpMsg = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the InflowWind high-res data range exactly match the high-res grid '// & - 'and the turbine is exactly centered in the high-res grid in the Y direction (or X direction if FlowField is along Y). '//NewLine//' Try setting:'//NewLine + tmpMsg = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the InflowWind high-res grid '// & + 'is entirely contained within the high-res flow-field from InflowWind. '//NewLine//' Try setting:'//NewLine + ! check Z limits, if ZRange is limited (we don't care what kind of wind) if (wfi%ZRange_Limited) then + ! flow field limits (with grid tolerance) + ff_lim(1) = p%WT_Position(3,nt) + wfi%ZRange(1) - GridTol + ff_lim(2) = p%WT_Position(3,nt) + wfi%ZRange(2) + GridTol + ! high-res Z limits + hr_lim(1) = p%Z0_High(nt) + hr_lim(2) = p%Z0_High(nt) + (real(p%nZ_high,ReKi)-1.0_ReKi)*p%dZ_high(nt) + if ((hr_lim(1) < ff_lim(1)) .or. & + (hr_lim(2) > ff_lim(2)) ) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = trim(tmpMsg)// & + ' Z0_high = '//trim(Num2LStr(p%WT_Position(3,nt)+wfi%ZRange(1))) + if (allocated(ff%Grid3D%Vel)) then + Dxyz = abs(wfi%ZRange(2)-wfi%ZRange(1))/(real(p%nZ_high,ReKi)-1.0_ReKi) + ErrMsg2=trim(ErrMsg2)//NewLine//' dZ_High = '//trim(Num2LStr(Dxyz)) + call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) + endif + endif endif ! check X/Y limits if range limited. Depends on orientation of winds. @@ -1301,8 +1319,8 @@ subroutine CheckModAmb3Boundaries() ErrMsg2 = trim(tmpMsg)// & ' Y0_high = '//trim(Num2LStr(p%WT_Position(2,nt)+wfi%YRange(1))) if (allocated(ff%Grid3D%Vel)) then - Dy = abs(wfi%YRange(2)-wfi%YRange(1))/(real(p%nY_high,ReKi)-1.0_ReKi) - ErrMsg2=trim(ErrMsg2)//NewLine//' dY_High = '//trim(Num2LStr(Dy)) + Dxyz = abs(wfi%YRange(2)-wfi%YRange(1))/(real(p%nY_high,ReKi)-1.0_ReKi) + ErrMsg2=trim(ErrMsg2)//NewLine//' dY_High = '//trim(Num2LStr(Dxyz)) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) endif endif @@ -1318,8 +1336,8 @@ subroutine CheckModAmb3Boundaries() ErrMsg2 = trim(tmpMsg)// & ' X0_high = '//trim(Num2LStr(p%WT_Position(1,nt)+wfi%YRange(1))) if (allocated(ff%Grid3D%Vel)) then - Dx = abs(wfi%YRange(2)-wfi%YRange(1))/(real(p%nX_high,ReKi)-1.0_ReKi) - ErrMsg2=trim(ErrMsg2)//NewLine//' dX_High = '//trim(Num2LStr(Dx)) + Dxyz = abs(wfi%YRange(2)-wfi%YRange(1))/(real(p%nX_high,ReKi)-1.0_ReKi) + ErrMsg2=trim(ErrMsg2)//NewLine//' dX_High = '//trim(Num2LStr(Dxyz)) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) endif endif From ae10f784f0496854809ed0e8fd4a1e5981fd9d3a Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 11 Jan 2024 10:35:10 -0700 Subject: [PATCH 161/232] Fix typos in spelling `Boeing` --- modules/aerodyn/src/AirfoilInfo.f90 | 2 +- modules/aerodyn/src/UnsteadyAero.f90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/aerodyn/src/AirfoilInfo.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index 91cb0f02fa..1aa0aec4ea 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -424,7 +424,7 @@ SUBROUTINE ReadAFfile ( InitInp, NumCoefsIn, p, ErrStat, ErrMsg, UnEc ) RETURN END IF - ! RelThickness, default is 0.2 if user doesn't know it, only used for Boing-Vertol UA model = 7 + ! RelThickness, default is 0.2 if user doesn't know it, only used for Boeing-Vertol UA model = 7 CALL ParseVarWDefault ( FileInfo, CurLine, 'RelThickness', p%RelThickness, 0.2_ReKi, ErrStat2, ErrMsg2, UnEc ) if (ErrStat2 >= AbortErrLev) then ! if the line is missing, set RelThickness = -1 and move on... p%RelThickness=-1 ! To trigger an error diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index a0f2144368..268757ecd9 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -28,7 +28,7 @@ ! Development plan for the aerodynamic linearization in OpenFAST ! Unpublished ! -! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boing-Vertol model +! [70] User Documentation / AeroDyn / Unsteady Aerodynamics / Boeing-Vertol model ! https://openfast.readthedocs.io/ ! ! [other] R. Damiani and G. Hayman (2017) @@ -1424,7 +1424,7 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_BV ) call SetErrStat( ErrID_Fatal, & "In this version, UAMod must be 2 (Gonzalez's variant), 3 (Minnema/Pierce variant), 4 (continuous HGM model), 5 (HGM with vortex), & - &6 (Oye), 7 (Boing-Vertol)", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) + &6 (Oye), 7 (Boeing-Vertol)", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) if (.not. InitInp%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) @@ -1664,7 +1664,7 @@ subroutine UA_TurnOff_param(p, AFInfo, ErrStat, ErrMsg) end subroutine UA_TurnOff_param !============================================================================== -!> Update discrete states for Boieng Vertol model +!> Update discrete states for Boeing Vertol model subroutine UA_UpdateDiscOtherState_BV( i, j, u, p, xd, OtherState, AFInfo, m, ErrStat, ErrMsg ) integer , intent(in ) :: i !< node index within a blade integer , intent(in ) :: j !< blade index @@ -3756,7 +3756,7 @@ subroutine UA_CalcOutput( i, j, t, u_in, p, x, xd, OtherState, AFInfo, y, misc, #endif contains - !> Calc Outputs for Boieng-Vertol dynamic stall + !> Calc Outputs for Boeing-Vertol dynamic stall !! See BV_DynStall.f95 of CACTUS, and [70], notations kept more or less consistent subroutine BV_CalcOutput() real(ReKi) :: alpha_50 From 4a2a69741da07cdcf8a285f1b61f6469df3c0ef4 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 11 Jan 2024 17:16:05 -0700 Subject: [PATCH 162/232] Fix for OpenFAST/AD_InitOut variables --- modules/openfast-library/src/FAST_Subs.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 35b402a361..c809c0aa88 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -3984,7 +3984,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S ! This assumes a vertical tower (i.e., we deal only with z component of position) Indx = 1 do k=1,TowerMotionMesh%NNodes - p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), AD%y%rotors(1)%TowerLoad%Position(3,:), InitOutData_AD%rotors(1)%TwrDiam, Indx, AD%y%rotors(1)%TowerLoad%NNodes ) / 2.0_ReKi + p_FAST%VTK_Surface%TowerRad(k) = InterpStp( TowerMotionMesh%Position(3,k), InitOutData_AD%rotors(1)%TwrElev, InitOutData_AD%rotors(1)%TwrDiam, Indx, size(InitOutData_AD%rotors(1)%TwrElev) ) / 2.0_ReKi end do else From d12034480b27c23ad0e239fbd83ec0184e2fb141 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 12 Jan 2023 15:46:17 -0700 Subject: [PATCH 163/232] Windows: Replace `system` calls with equivalent Fortran/C calls Fix intermittent failure of `system` commands on Windows: occasionally the system calls would fail to finish and make the program hang or end prematurely without any error message. --- modules/nwtc-library/src/SysIVF.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/src/SysIVF.f90 b/modules/nwtc-library/src/SysIVF.f90 index 603ad6da7e..2a6304dbdb 100644 --- a/modules/nwtc-library/src/SysIVF.f90 +++ b/modules/nwtc-library/src/SysIVF.f90 @@ -193,18 +193,18 @@ END SUBROUTINE Get_CWD !> This routine creates a given directory if it does not already exist. SUBROUTINE MKDIR ( new_directory_path ) + USE IFPORT, ONLY: MAKEDIRQQ implicit none character(*), intent(in) :: new_directory_path - character(1024) :: make_command logical :: directory_exists + logical :: success ! Check if the directory exists first inquire( directory=trim(new_directory_path), exist=directory_exists ) if ( .NOT. directory_exists ) then - make_command = 'mkdir "'//trim(new_directory_path)//'"' - call system( make_command ) + success = MAKEDIRQQ( trim(new_directory_path) ) endif END SUBROUTINE MKDIR From b70f57810e6a95d9227d42e5b9532ce683b218f0 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 12 Jan 2024 16:57:54 +0000 Subject: [PATCH 164/232] Add alloc and pointer pack/unpack routines in ModReg --- modules/nwtc-library/ModRegGen.py | 604 ++- modules/nwtc-library/src/ModReg.f90 | 6800 +++++++++++++++++++++------ 2 files changed, 5731 insertions(+), 1673 deletions(-) diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py index 4af818cc1c..613409ce83 100644 --- a/modules/nwtc-library/ModRegGen.py +++ b/modules/nwtc-library/ModRegGen.py @@ -15,188 +15,178 @@ num_ranks = 5 module_header = ''' +!STARTOFGENERATEDFILE 'ModReg.f90' +! +! WARNING This file is generated automatically by ModRegGen.py. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of the NWTC Subroutine Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** + +!> This module contains routines for packing and unpacking data from a registry data file. module ModReg use NWTC_Base implicit none private - public :: PackBuffer - public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, DestroyPackBuffer, RegCheckErr - public :: RegPack, RegPackBounds, RegPackPointer - public :: RegUnpack, RegUnpackBounds, RegUnpackPointer - - type :: PackBuffer - integer(B1Ki), allocatable :: Bytes(:) - integer(B8Ki) :: NB - type(c_ptr), allocatable :: Pointers(:) - integer(B8Ki) :: NP - integer(IntKi) :: ErrStat = ErrID_Fatal - character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' + public :: RegFile + public :: OpenRegFile, InitRegFile, CloseRegFile, RegCheckErr + public :: RegPackBounds, RegUnpackBounds + public :: RegPackPointer, RegUnpackPointer + public :: RegPack, RegUnpack + public :: RegPackAlloc, RegUnpackAlloc + public :: RegPackPtr, RegUnpackPtr + + type :: RegFile + integer(IntKi) :: Unit + integer(IntKi) :: Offset + type(c_ptr), allocatable :: Pointers(:) + integer(B8Ki) :: NumData + integer(B8Ki) :: NumPointers + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'RegFile not initialized' end type {ifc_lines} contains - subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + subroutine InitRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = "InitPackBuffer" - integer(B8Ki), parameter :: NumPointersInit = 128 - integer(B8Ki), parameter :: NumBytesInit = 1024 - integer(IntKi) :: stat + character(*), parameter :: RoutineName = "InitRegFile" + integer(B8Ki), parameter :: NumPointersInit = 128 + integer(IntKi) :: stat ErrStat = ErrID_None ErrMsg = "" - Buf%ErrStat = ErrID_None - Buf%ErrMsg = "" - Buf%NP = 0 - Buf%NB = 0 - - ! If pointers have not been allocated, allocate with initial size - if (.not. allocated(Buf%Pointers)) then - allocate (Buf%Pointers(NumPointersInit), stat=stat) - if (stat /= 0) then - ErrStat = ErrID_Fatal - write(ErrMsg,*) 'InitPackBuffer: Unable to init pointer index to with size of', NumPointersInit - return - end if + RF%ErrStat = ErrID_None + RF%ErrMsg = "" + RF%NumData = 0 + RF%NumPointers = 0 + RF%Unit = Unit + + ! Get current position in the file in case anything has been written to it + inquire(Unit, POS=RF%Offset) + + ! Write invalid number of pointers at the beginning of file so we can + ! check if the file if the file has been finalized and closed + write (Unit, iostat=stat) -1_B8Ki + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'InitRegFile: Unable to write offset at beginning of file' + return end if - - ! Reset all pointers to null - Buf%Pointers = c_null_ptr - ! If byte array has not been allocated, allocate with initial size - if (.not. allocated(Buf%Bytes)) then - allocate (Buf%Bytes(NumBytesInit), stat=stat) + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(RF%Pointers)) then + allocate (RF%Pointers(NumPointersInit), stat=stat) if (stat /= 0) then ErrStat = ErrID_Fatal - write(ErrMsg,*) 'Grow: Unable to init buffer to', NumBytesInit, 'bytes' + write (ErrMsg, *) 'InitRegFile: Unable to init pointer index to with size of', NumPointersInit return end if end if + ! Reset all pointers to null + RF%Pointers = c_null_ptr end subroutine - subroutine DestroyPackBuffer(Buf, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + subroutine CloseRegFile(RF, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = "DestroyPackBuffer" + character(*), parameter :: RoutineName = "CloseRegFile" + integer(IntKi) :: stat ErrStat = ErrID_None ErrMsg = "" - Buf%ErrStat = ErrID_None - Buf%ErrMsg = "" - Buf%NP = 0 - Buf%NB = 0 - - if (allocated(Buf%Pointers)) deallocate (Buf%Pointers) - if (allocated(Buf%Bytes )) deallocate (Buf%Bytes) - end subroutine - - subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(in) :: Unit - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = "WritePackBuffer" - integer(IntKi) :: iostat - - ErrStat = ErrID_None - ErrMsg = '' - - if (Buf%ErrStat /= ErrID_None) then - call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, 'Buf%WriteFile') - return - end if - - write(Unit, iostat=iostat) Buf%NP - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error writing number of pointers", ErrStat, ErrMsg, RoutineName) + ! Check if there have been any errors while writing to the file + if (RF%ErrStat /= ErrID_None) then + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName) return end if - write(Unit, iostat=iostat) Buf%NB - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error writing number of bytes", ErrStat, ErrMsg, RoutineName) + ! Write the actual number of pointers + write (RF%Unit, POS=RF%Offset, iostat=stat) RF%NumPointers + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'CloseRegFile: Unable to write offset at beginning of file' return end if - write(Unit, iostat=iostat) Buf%Bytes(1:Buf%NB) - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error writing bytes", ErrStat, ErrMsg, RoutineName) - return - end if + ! Close the file + close (RF%Unit) + ! Deallocate pointer array + if (allocated(RF%Pointers)) deallocate (RF%Pointers) end subroutine - subroutine ReadPackBuffer(Buf, Unit, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(in) :: Unit - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + subroutine OpenRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = "ReadPackBuffer" - integer(IntKi) :: iostat + character(*), parameter :: RoutineName = "ReadRegFile" + integer(IntKi) :: iostat ErrStat = ErrID_None ErrMsg = '' + ! Save unit + RF%Unit = Unit + ! Read number of pointers - read(Unit, iostat=iostat) Buf%NP + read (Unit, iostat=iostat) RF%NumPointers if (iostat /= 0) then call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) return end if ! If pointers are allocated, deallocate - if (allocated(Buf%Pointers)) deallocate(Buf%Pointers) + if (allocated(RF%Pointers)) deallocate (RF%Pointers) ! Allocate pointer index and initialize pointers to null - allocate(Buf%Pointers(1:Buf%NP), stat=ErrStat) - Buf%Pointers = c_null_ptr - - ! Read number of bytes in buffer - read(Unit, iostat=iostat) Buf%NB - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error reading number of bytes", ErrStat, ErrMsg, RoutineName) - return - end if + allocate (RF%Pointers(1:RF%NumPointers), stat=ErrStat) + RF%Pointers = c_null_ptr - ! If bytes are allocated, deallocate - if (allocated(Buf%Bytes)) deallocate(Buf%Bytes) - - ! Allocate bytes - allocate(Buf%Bytes(1:Buf%NB), stat=ErrStat) - - ! Read bytes - read(Unit, iostat=iostat) Buf%Bytes - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error reading bytes", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Clear buffer error - Buf%ErrStat = ErrID_None - Buf%ErrMsg = '' - - ! Reset Number of bytes to be used by unpack routines - Buf%NB = 0 + ! initialize the number of data + RF%NumData = 0 + ! Clear error + RF%ErrStat = ErrID_None + RF%ErrMsg = '' end subroutine - function RegCheckErr(Buf, RoutineName) result(Err) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: RoutineName - logical :: Err - Err = Buf%ErrStat /= ErrID_None - if (Err) Buf%ErrMsg = trim(RoutineName)//": "//trim(Buf%ErrMsg) + function RegCheckErr(RF, RoutineName) result(Err) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: RoutineName + logical :: Err + Err = RF%ErrStat /= ErrID_None + if (Err) RF%ErrMsg = trim(RoutineName)//": "//trim(RF%ErrMsg) end function elemental function LogicalToByte(b) result(i) @@ -219,22 +209,22 @@ end if end function - subroutine RegPackPointer(Buf, Ptr, Found) - type(PackBuffer), intent(inout) :: Buf - type(c_ptr), intent(in) :: Ptr - logical, intent(out) :: Found + subroutine RegPackPointer(RF, Ptr, Found) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found - type(c_ptr), allocatable :: PointersTmp(:) - integer(B8Ki) :: NewSize - integer(B8Ki) :: i + type(c_ptr), allocatable :: PointersTmp(:) + integer(B8Ki) :: NewSize + integer(B8Ki) :: i - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return ! Look for pointer in index, if found, pack pointer index and return - do i = 1, Buf%NP - if (c_associated(Ptr, Buf%Pointers(i))) then - call RegPack(Buf, i) + do i = 1, RF%NumPointers + if (c_associated(Ptr, RF%Pointers(i))) then + call RegPack(RF, i) Found = .true. return end if @@ -244,259 +234,198 @@ Found = .false. ! If pointer index is full, grow pointer index - if (Buf%NP == size(Buf%Pointers)) then - NewSize = int(1.5_R8Ki * real(Buf%NP, R8Ki), B8Ki) - call move_alloc(Buf%Pointers, PointersTmp) - allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) - if (Buf%ErrStat /= ErrID_None) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + if (RF%NumPointers == size(RF%Pointers)) then + NewSize = int(1.5_R8Ki*real(RF%NumPointers, R8Ki), B8Ki) + call move_alloc(RF%Pointers, PointersTmp) + allocate (RF%Pointers(NewSize), stat=RF%ErrStat) + if (RF%ErrStat /= ErrID_None) then + RF%ErrStat = ErrID_Fatal + write (RF%ErrMsg, *) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' return end if - Buf%Pointers(1:size(PointersTmp)) = PointersTmp - Buf%Pointers(size(PointersTmp)+1:) = c_null_ptr + RF%Pointers(1:size(PointersTmp)) = PointersTmp + RF%Pointers(size(PointersTmp) + 1:) = c_null_ptr end if ! Increment number of pointers, add new pointer to index - Buf%NP = Buf%NP + 1 - Buf%Pointers(Buf%NP) = Ptr + RF%NumPointers = RF%NumPointers + 1 + RF%Pointers(RF%NumPointers) = Ptr ! Pack pointer index - call RegPack(Buf, Buf%NP) - + call RegPack(RF, RF%NumPointers) end subroutine - subroutine RegUnpackPointer(Buf, Ptr, Idx) - type(PackBuffer), intent(inout) :: Buf - type(c_ptr), intent(out) :: Ptr - integer(B8Ki), intent(out) :: Idx + subroutine RegUnpackPointer(RF, Ptr, Idx) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(out) :: Ptr + integer(B8Ki), intent(out) :: Idx - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return ! Unpack pointer index - call RegUnpack(Buf, Idx) + call RegUnpack(RF, Idx) ! Get pointer from index - Ptr = Buf%Pointers(Idx) - + Ptr = RF%Pointers(Idx) end subroutine - subroutine RegPackBounds(Buf, R, LB, UB) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(in) :: LB(:), UB(:) - - ! If buffer has an error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine RegPackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B8Ki), intent(in) :: LB(:), UB(:) + + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return ! Pack lower and upper bounds - call RegPack(Buf, LB(1:R)) - call RegPack(Buf, UB(1:R)) - if (RegCheckErr(Buf, "RegPackBounds")) return + call RegPack(RF, LB(1:R)) + call RegPack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegPackBounds")) return end subroutine - subroutine RegUnpackBounds(Buf, R, LB, UB) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(out) :: LB(:), UB(:) + subroutine RegUnpackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B8Ki), intent(out) :: LB(:), UB(:) - ! If buffer has an error, return - if (Buf%ErrStat /= ErrID_None) return + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return ! Unpack lower and upper bounds - call RegUnpack(Buf, LB(1:R)) - call RegUnpack(Buf, UB(1:R)) - if (RegCheckErr(Buf, "RegUnpackBounds")) return + call RegUnpack(RF, LB(1:R)) + call RegUnpack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegUnpackBounds")) return end subroutine - subroutine GrowBuffer(Buf, N) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: N + function DataNumValid(RF) result(match) + type(RegFile), intent(inout) :: RF + logical :: match + integer(B8Ki) :: DataNum - integer(B1Ki), allocatable :: BytesTmp(:) - integer(B8Ki) :: NewSize - integer(IntKi) :: stat - - ! Return if there is a buffer error - if (Buf%ErrStat /= ErrID_None) return + ! Increment the data number to be read + RF%NumData = RF%NumData + 1 - ! If buffer can hold requested bytes, return - if (size(Buf%Bytes) > Buf%NB + N) return + ! Read the data number from the file + read(RF%Unit) DataNum - ! Calculate new size - NewSize = int(real(Buf%NB + N, R8Ki) * 1.8_R8Ki, B8Ki) - - ! Move allocation to temporary array and allocate buffer with new size - call move_alloc(Buf%Bytes, BytesTmp) - allocate (Buf%Bytes(NewSize), stat=stat) - if (stat /= 0) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) 'Grow: Unable to grow buffer to', NewSize, 'bytes' - return + ! If data number from file does not match expected number, set match false + ! and create error message; otherwise, set match to true + if (DataNum /= RF%NumData) then + match = .false. + RF%ErrStat = ErrID_Fatal + write(RF%ErrMsg, *) "Read data number", DataNum, "expected", RF%NumData + else + match = .true. end if - - ! Copy contents of temporary bytes to buffer - Buf%Bytes(1:size(BytesTmp)) = BytesTmp - - end subroutine + end function ''' def gen_pack(w, dt, decl, rank): dims = '' if rank == 0 else '('+','.join([':']*rank)+')' - dt_size = int(dt[-1]) name = f'Pack_{dt}' if rank == 0 else f'Pack_{dt}_Rank{rank}' - w.write(f'\n\n subroutine {name}(Buf, Data)') - w.write(f'\n type(PackBuffer), intent(inout) :: Buf') - w.write(f'\n {decl+", intent(in)":<38s} :: Data{dims}') - w.write(f'\n integer(B8Ki) :: DataSize') - w.write(f'\n') - w.write(f'\n ! If buffer error, return') - w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') - w.write(f'\n') - w.write(f'\n ! Get size of data in bytes') - if dt == 'C1' and rank == 0: - w.write(f'\n DataSize = len(Data)') - elif dt == 'C1' and rank > 0: - w.write(f'\n DataSize = len(Data({",".join(["1"]*rank)}))*size(Data)') - elif rank == 0: - w.write(f'\n DataSize = {dt_size}') - elif dt_size == 1: - w.write(f'\n DataSize = size(Data)') - else: - w.write(f'\n DataSize = {dt_size}*size(Data)') + w.write(f'\n\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", intent(in)":<35s} :: Data{dims}') w.write(f'\n') - w.write(f'\n ! Grow buffer to accommodate Data') - w.write(f'\n call GrowBuffer(Buf, DataSize)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') w.write(f'\n') - w.write(f'\n ! Transfer data to buffer') - if dt == 'L1': - w.write(f'\n Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes)') - else: - w.write(f'\n Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes)') - w.write(f'\n Buf%NB = Buf%NB + DataSize') + w.write(f'\n ! Increment data number and write to file') + w.write(f'\n RF%NumData = RF%NumData + 1') + w.write(f'\n write(RF%Unit) RF%NumData') w.write(f'\n') + w.write(f'\n ! Write data to file') + w.write(f'\n write(RF%Unit) Data') w.write(f'\n end subroutine') def gen_unpack(w, dt, decl, rank): dims = '' if rank == 0 else '('+','.join([':']*rank)+')' - dt_size = int(dt[-1]) name = f'Unpack_{dt}' if rank == 0 else f'Unpack_{dt}_Rank{rank}' w.write(f'\n') - w.write(f'\n subroutine {name}(Buf, Data)') - w.write(f'\n type(PackBuffer), intent(inout) :: Buf') - w.write(f'\n {decl+", intent(out)":<38s} :: Data{dims}') - w.write(f'\n integer(B8Ki) :: DataSize') - w.write(f'\n') - w.write(f'\n ! If buffer error, return') - w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') - w.write(f'\n') - w.write(f'\n ! Get size of data in bytes') - if dt == 'C1' and rank == 0: - w.write(f'\n DataSize = len(Data)') - elif dt == 'C1' and rank > 0: - w.write(f'\n DataSize = len(Data({",".join(["1"]*rank)}))*size(Data)') - elif rank == 0: - w.write(f'\n DataSize = {dt_size}') - elif dt_size == 1: - w.write(f'\n DataSize = size(Data)') - else: - w.write(f'\n DataSize = {dt_size}*size(Data)') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", intent(out)":<35s} :: Data{dims}') w.write(f'\n') - w.write(f'\n ! Check that buffer has sufficient bytes remaining') - w.write(f'\n if (size(Buf%Bytes) < Buf%NB + DataSize) then') - w.write(f'\n Buf%ErrStat = ErrID_Fatal') - w.write(f'\n write(Buf%ErrMsg,*) "{name}: buffer too small, requested", DataSize, "bytes"') - w.write(f'\n return') - w.write(f'\n end if') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') w.write(f'\n') - w.write(f'\n ! Transfer data from buffer') - if dt == 'L1' and rank == 0: - w.write(f'\n Data = ByteToLogical(Buf%Bytes(Buf%NB+1))') - elif dt == 'L1' and rank > 0: - w.write(f'\n Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data))') - elif rank == 0: - w.write(f'\n Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data)') - else: - w.write(f'\n Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data))') - w.write(f'\n Buf%NB = Buf%NB + DataSize') + w.write(f'\n ! Read data number, return if invalid') + w.write(f'\n if (.not. DataNumValid(RF)) return') w.write(f'\n') + w.write(f'\n ! Read data from file') + w.write(f'\n read(RF%Unit) Data') w.write(f'\n end subroutine') def gen_pack_alloc(w, dt, decl, rank): dims = '' if rank == 0 else '('+','.join([':']*rank)+')' - name = f'PackAlloc_{dt}' - if rank > 0: name += f'_Rank{rank}' + name = f'PackAlloc_{dt}' + ("" if rank == 0 else f'_Rank{rank}') w.write(f'\n') - w.write(f'\n subroutine {name}(Buf, Data)') - w.write(f'\n type(PackBuffer), intent(inout) :: Buf') - w.write(f'\n {decl+", allocatable, intent(in)":<38s} :: Data{dims}') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", allocatable, intent(in)":<35s} :: Data{dims}') w.write(f'\n') - w.write(f'\n ! If buffer error, return') - w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') w.write(f'\n') w.write(f'\n ! Write if allocated') - w.write(f'\n call RegPack(Buf, allocated(Data))') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegPack(RF, allocated(Data))') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n if (.not. allocated(Data)) return') w.write(f'\n') if rank > 0: w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') - w.write(f'\n') - w.write(f'\n ! Write data to buffer') - w.write(f'\n call RegPack(Buf, Data)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') w.write(f'\n') + w.write(f'\n ! Write data to file') + w.write(f'\n call RegPack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n end subroutine') def gen_unpack_alloc(w, dt, decl, rank): dims = '' if rank == 0 else '('+','.join([':']*rank)+')' - dt_size = int(dt[-1]) - name = f'UnpackAlloc_{dt}' if rank == 0 else f'UnpackAlloc_{dt}_Rank{rank}' + name = f'UnpackAlloc_{dt}' + ("" if rank == 0 else f'_Rank{rank}') w.write(f'\n') - w.write(f'\n subroutine {name}(Buf, Data)') - w.write(f'\n type(PackBuffer), intent(inout) :: Buf') - w.write(f'\n {decl+", allocatable, intent(out)":<38s} :: Data{dims}') - w.write(f'\n integer(IntKi) :: stat') - w.write(f'\n logical :: IsAllocated') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", allocatable, intent(out)":<35s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: stat') + w.write(f'\n logical :: IsAllocated') if rank > 0: - w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') + w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') w.write(f'\n') - w.write(f'\n ! If buffer error, return') - w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') w.write(f'\n') w.write(f'\n ! Deallocate if allocated') w.write(f'\n if (allocated(Data)) deallocate(Data)') w.write(f'\n') w.write(f'\n ! Read value to see if it was allocated, return if not') - w.write(f'\n call RegUnpack(Buf, IsAllocated)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegUnpack(RF, IsAllocated)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n if (.not. IsAllocated) return') w.write(f'\n') alloc_dims = '' if rank > 0: w.write(f'\n ! Read array bounds') - w.write(f'\n call RegUnpackBounds(Buf, {rank}, LB, UB)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegUnpackBounds(RF, {rank}, LB, UB)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' w.write(f'\n') w.write(f'\n ! Allocate data') w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') w.write(f'\n if (stat /= 0) then') - w.write(f'\n Buf%ErrStat = ErrID_Fatal') - w.write(f'\n Buf%ErrMsg = "{name}: error allocating data"') + w.write(f'\n RF%ErrStat = ErrID_Fatal') + w.write(f'\n RF%ErrMsg = "{name}: error allocating data"') w.write(f'\n return') w.write(f'\n end if') w.write(f'\n') w.write(f'\n ! Read data') - w.write(f'\n call RegUnpack(Buf, Data)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') - w.write(f'\n') + w.write(f'\n call RegUnpack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n end subroutine') @@ -505,32 +434,31 @@ def gen_pack_ptr(w, dt, decl, rank): name = f'PackPtr_{dt}' if rank > 0: name += f'_Rank{rank}' w.write(f'\n') - w.write(f'\n subroutine {name}(Buf, Data)') - w.write(f'\n type(PackBuffer), intent(inout) :: Buf') - w.write(f'\n {decl+", pointer, intent(in)":<38s} :: Data{dims}') - w.write(f'\n logical :: PtrInIndex') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", pointer, intent(in)":<35s} :: Data{dims}') + w.write(f'\n logical :: PtrInIndex') w.write(f'\n') - w.write(f'\n ! If buffer error, return') - w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') w.write(f'\n') w.write(f'\n ! Write if associated') - w.write(f'\n call RegPack(Buf, associated(Data))') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegPack(RF, associated(Data))') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n if (.not. associated(Data)) return') if rank > 0: w.write(f'\n') w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') w.write(f'\n') w.write(f'\n ! Write pointer info') - w.write(f'\n call RegPackPointer(Buf, c_loc(Data), PtrInIndex)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegPackPointer(RF, c_loc(Data), PtrInIndex)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n if (PtrInIndex) return') w.write(f'\n') - w.write(f'\n ! Write data to buffer') - w.write(f'\n call RegPack(Buf, Data)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') - w.write(f'\n') + w.write(f'\n ! Write data to file') + w.write(f'\n call RegPack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n end subroutine') def gen_unpack_ptr(w, dt, decl, rank): @@ -538,17 +466,18 @@ def gen_unpack_ptr(w, dt, decl, rank): dt_size = int(dt[-1]) name = f'UnpackPtr_{dt}' if rank == 0 else f'UnpackPtr_{dt}_Rank{rank}' w.write(f'\n') - w.write(f'\n subroutine {name}(Buf, Data)') - w.write(f'\n type(PackBuffer), intent(inout) :: Buf') - w.write(f'\n {decl+", pointer, intent(out)":<38s} :: Data{dims}') - w.write(f'\n integer(B8Ki) :: PtrIdx, stat') + w.write(f'\n subroutine {name}(RF, Data)') + w.write(f'\n type(RegFile), intent(inout) :: RF') + w.write(f'\n {decl+", pointer, intent(out)":<36s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: stat') + w.write(f'\n integer(B8Ki) :: PtrIdx') w.write(f'\n logical :: IsAssociated') w.write(f'\n type(c_ptr) :: Ptr') if rank > 0: - w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') + w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') w.write(f'\n') - w.write(f'\n ! If buffer error, return') - w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n ! If error, return') + w.write(f'\n if (RF%ErrStat /= ErrID_None) return') w.write(f'\n') w.write(f'\n ! If associated, deallocate and nullify') w.write(f'\n if (associated(Data)) then') @@ -557,17 +486,18 @@ def gen_unpack_ptr(w, dt, decl, rank): w.write(f'\n end if') w.write(f'\n') w.write(f'\n ! Read value to see if it was associated, return if not') - w.write(f'\n call RegUnpack(Buf, IsAssociated)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegUnpack(RF, IsAssociated)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n if (.not. IsAssociated) return') if rank > 0: w.write(f'\n') w.write(f'\n ! Read array bounds') - w.write(f'\n call RegUnpackBounds(Buf, {rank}, LB, UB)') + w.write(f'\n call RegUnpackBounds(RF, {rank}, LB, UB)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n') w.write(f'\n ! Unpack pointer inf') - w.write(f'\n call RegUnpackPointer(Buf, Ptr, PtrIdx)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n call RegUnpackPointer(RF, Ptr, PtrIdx)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n') w.write(f'\n ! If pointer was in index, associate data with pointer, return') w.write(f'\n if (c_associated(Ptr)) then') @@ -585,21 +515,21 @@ def gen_unpack_ptr(w, dt, decl, rank): w.write(f'\n ! Allocate data') w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') w.write(f'\n if (stat /= 0) then') - w.write(f'\n Buf%ErrStat = ErrID_Fatal') - w.write(f'\n Buf%ErrMsg = "{name}: error allocating data"') + w.write(f'\n RF%ErrStat = ErrID_Fatal') + w.write(f'\n RF%ErrMsg = "{name}: error allocating data"') w.write(f'\n return') w.write(f'\n end if') w.write(f'\n') w.write(f'\n ! Read data') - w.write(f'\n call RegUnpack(Buf, Data)') - w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') - w.write(f'\n') + w.write(f'\n call RegUnpack(RF, Data)') + w.write(f'\n if (RegCheckErr(RF, "{name}")) return') w.write(f'\n end subroutine') # Registry interface +groups = ['Pack', 'Unpack', 'PackAlloc', 'UnpackAlloc', 'PackPtr', 'UnpackPtr'] ifc_lines = '' ranks = [''] + [f'_Rank{r}' for r in range(1,num_ranks+1)] -for attr, punp in product([''], ['Pack', 'Unpack']): +for attr, punp in product([''], groups): ifc_lines += f'\n\n interface Reg{punp}{attr}' funcs = [f'{punp}{attr}_{dt}{rank}'for dt, rank in product(type_map.keys(), ranks)] lines = textwrap.wrap('module procedure ' + ', '.join(funcs), 80, @@ -614,5 +544,9 @@ def gen_unpack_ptr(w, dt, decl, rank): for (dt,decl), rank in product(type_map.items(), range(num_ranks+1)): gen_pack(w, dt, decl, rank) gen_unpack(w, dt, decl, rank) + gen_pack_alloc(w, dt, decl, rank) + gen_unpack_alloc(w, dt, decl, rank) + gen_pack_ptr(w, dt, decl, rank) + gen_unpack_ptr(w, dt, decl, rank) w.write('\nend module') diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 index f0ee258bce..1381d4e5ca 100644 --- a/modules/nwtc-library/src/ModReg.f90 +++ b/modules/nwtc-library/src/ModReg.f90 @@ -1,21 +1,51 @@ +!STARTOFGENERATEDFILE 'ModReg.f90' +! +! WARNING This file is generated automatically by ModRegGen.py. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2024 National Renewable Energy Laboratory +! +! This file is part of the NWTC Subroutine Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** + +!> This module contains routines for packing and unpacking data from a registry data file. module ModReg use NWTC_Base implicit none private - public :: PackBuffer - public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, DestroyPackBuffer, RegCheckErr - public :: RegPack, RegPackBounds, RegPackPointer - public :: RegUnpack, RegUnpackBounds, RegUnpackPointer - - type :: PackBuffer - integer(B1Ki), allocatable :: Bytes(:) - integer(B8Ki) :: NB - type(c_ptr), allocatable :: Pointers(:) - integer(B8Ki) :: NP - integer(IntKi) :: ErrStat = ErrID_Fatal - character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' + public :: RegFile + public :: OpenRegFile, InitRegFile, CloseRegFile, RegCheckErr + public :: RegPackBounds, RegUnpackBounds + public :: RegPackPointer, RegUnpackPointer + public :: RegPack, RegUnpack + public :: RegPackAlloc, RegUnpackAlloc + public :: RegPackPtr, RegUnpackPtr + + type :: RegFile + integer(IntKi) :: Unit + integer(IntKi) :: Offset + type(c_ptr), allocatable :: Pointers(:) + integer(B8Ki) :: NumData + integer(B8Ki) :: NumPointers + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'RegFile not initialized' end type @@ -43,168 +73,187 @@ module ModReg Unpack_R8_Rank5 end interface + interface RegPackAlloc + module procedure PackAlloc_C1, PackAlloc_C1_Rank1, PackAlloc_C1_Rank2, & + PackAlloc_C1_Rank3, PackAlloc_C1_Rank4, PackAlloc_C1_Rank5, & + PackAlloc_L1, PackAlloc_L1_Rank1, PackAlloc_L1_Rank2, & + PackAlloc_L1_Rank3, PackAlloc_L1_Rank4, PackAlloc_L1_Rank5, & + PackAlloc_I4, PackAlloc_I4_Rank1, PackAlloc_I4_Rank2, & + PackAlloc_I4_Rank3, PackAlloc_I4_Rank4, PackAlloc_I4_Rank5, & + PackAlloc_I8, PackAlloc_I8_Rank1, PackAlloc_I8_Rank2, & + PackAlloc_I8_Rank3, PackAlloc_I8_Rank4, PackAlloc_I8_Rank5, & + PackAlloc_R4, PackAlloc_R4_Rank1, PackAlloc_R4_Rank2, & + PackAlloc_R4_Rank3, PackAlloc_R4_Rank4, PackAlloc_R4_Rank5, & + PackAlloc_R8, PackAlloc_R8_Rank1, PackAlloc_R8_Rank2, & + PackAlloc_R8_Rank3, PackAlloc_R8_Rank4, PackAlloc_R8_Rank5 + end interface + + interface RegUnpackAlloc + module procedure UnpackAlloc_C1, UnpackAlloc_C1_Rank1, & + UnpackAlloc_C1_Rank2, UnpackAlloc_C1_Rank3, UnpackAlloc_C1_Rank4, & + UnpackAlloc_C1_Rank5, UnpackAlloc_L1, UnpackAlloc_L1_Rank1, & + UnpackAlloc_L1_Rank2, UnpackAlloc_L1_Rank3, UnpackAlloc_L1_Rank4, & + UnpackAlloc_L1_Rank5, UnpackAlloc_I4, UnpackAlloc_I4_Rank1, & + UnpackAlloc_I4_Rank2, UnpackAlloc_I4_Rank3, UnpackAlloc_I4_Rank4, & + UnpackAlloc_I4_Rank5, UnpackAlloc_I8, UnpackAlloc_I8_Rank1, & + UnpackAlloc_I8_Rank2, UnpackAlloc_I8_Rank3, UnpackAlloc_I8_Rank4, & + UnpackAlloc_I8_Rank5, UnpackAlloc_R4, UnpackAlloc_R4_Rank1, & + UnpackAlloc_R4_Rank2, UnpackAlloc_R4_Rank3, UnpackAlloc_R4_Rank4, & + UnpackAlloc_R4_Rank5, UnpackAlloc_R8, UnpackAlloc_R8_Rank1, & + UnpackAlloc_R8_Rank2, UnpackAlloc_R8_Rank3, UnpackAlloc_R8_Rank4, & + UnpackAlloc_R8_Rank5 + end interface + + interface RegPackPtr + module procedure PackPtr_C1, PackPtr_C1_Rank1, PackPtr_C1_Rank2, & + PackPtr_C1_Rank3, PackPtr_C1_Rank4, PackPtr_C1_Rank5, PackPtr_L1, & + PackPtr_L1_Rank1, PackPtr_L1_Rank2, PackPtr_L1_Rank3, PackPtr_L1_Rank4, & + PackPtr_L1_Rank5, PackPtr_I4, PackPtr_I4_Rank1, PackPtr_I4_Rank2, & + PackPtr_I4_Rank3, PackPtr_I4_Rank4, PackPtr_I4_Rank5, PackPtr_I8, & + PackPtr_I8_Rank1, PackPtr_I8_Rank2, PackPtr_I8_Rank3, PackPtr_I8_Rank4, & + PackPtr_I8_Rank5, PackPtr_R4, PackPtr_R4_Rank1, PackPtr_R4_Rank2, & + PackPtr_R4_Rank3, PackPtr_R4_Rank4, PackPtr_R4_Rank5, PackPtr_R8, & + PackPtr_R8_Rank1, PackPtr_R8_Rank2, PackPtr_R8_Rank3, PackPtr_R8_Rank4, & + PackPtr_R8_Rank5 + end interface + + interface RegUnpackPtr + module procedure UnpackPtr_C1, UnpackPtr_C1_Rank1, UnpackPtr_C1_Rank2, & + UnpackPtr_C1_Rank3, UnpackPtr_C1_Rank4, UnpackPtr_C1_Rank5, & + UnpackPtr_L1, UnpackPtr_L1_Rank1, UnpackPtr_L1_Rank2, & + UnpackPtr_L1_Rank3, UnpackPtr_L1_Rank4, UnpackPtr_L1_Rank5, & + UnpackPtr_I4, UnpackPtr_I4_Rank1, UnpackPtr_I4_Rank2, & + UnpackPtr_I4_Rank3, UnpackPtr_I4_Rank4, UnpackPtr_I4_Rank5, & + UnpackPtr_I8, UnpackPtr_I8_Rank1, UnpackPtr_I8_Rank2, & + UnpackPtr_I8_Rank3, UnpackPtr_I8_Rank4, UnpackPtr_I8_Rank5, & + UnpackPtr_R4, UnpackPtr_R4_Rank1, UnpackPtr_R4_Rank2, & + UnpackPtr_R4_Rank3, UnpackPtr_R4_Rank4, UnpackPtr_R4_Rank5, & + UnpackPtr_R8, UnpackPtr_R8_Rank1, UnpackPtr_R8_Rank2, & + UnpackPtr_R8_Rank3, UnpackPtr_R8_Rank4, UnpackPtr_R8_Rank5 + end interface + contains - subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + subroutine InitRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = "InitPackBuffer" - integer(B8Ki), parameter :: NumPointersInit = 128 - integer(B8Ki), parameter :: NumBytesInit = 1024 - integer(IntKi) :: stat + character(*), parameter :: RoutineName = "InitRegFile" + integer(B8Ki), parameter :: NumPointersInit = 128 + integer(IntKi) :: stat ErrStat = ErrID_None ErrMsg = "" - Buf%ErrStat = ErrID_None - Buf%ErrMsg = "" - Buf%NP = 0 - Buf%NB = 0 - - ! If pointers have not been allocated, allocate with initial size - if (.not. allocated(Buf%Pointers)) then - allocate (Buf%Pointers(NumPointersInit), stat=stat) - if (stat /= 0) then - ErrStat = ErrID_Fatal - write(ErrMsg,*) 'InitPackBuffer: Unable to init pointer index to with size of', NumPointersInit - return - end if + RF%ErrStat = ErrID_None + RF%ErrMsg = "" + RF%NumData = 0 + RF%NumPointers = 0 + RF%Unit = Unit + + ! Get current position in the file in case anything has been written to it + inquire(Unit, POS=RF%Offset) + + ! Write invalid number of pointers at the beginning of file so we can + ! check if the file if the file has been finalized and closed + write (Unit, iostat=stat) -1_B8Ki + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'InitRegFile: Unable to write offset at beginning of file' + return end if - - ! Reset all pointers to null - Buf%Pointers = c_null_ptr - ! If byte array has not been allocated, allocate with initial size - if (.not. allocated(Buf%Bytes)) then - allocate (Buf%Bytes(NumBytesInit), stat=stat) + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(RF%Pointers)) then + allocate (RF%Pointers(NumPointersInit), stat=stat) if (stat /= 0) then ErrStat = ErrID_Fatal - write(ErrMsg,*) 'Grow: Unable to init buffer to', NumBytesInit, 'bytes' + write (ErrMsg, *) 'InitRegFile: Unable to init pointer index to with size of', NumPointersInit return end if end if + ! Reset all pointers to null + RF%Pointers = c_null_ptr end subroutine - subroutine DestroyPackBuffer(Buf, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + subroutine CloseRegFile(RF, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = "DestroyPackBuffer" + character(*), parameter :: RoutineName = "CloseRegFile" + integer(IntKi) :: stat ErrStat = ErrID_None ErrMsg = "" - Buf%ErrStat = ErrID_None - Buf%ErrMsg = "" - Buf%NP = 0 - Buf%NB = 0 - - if (allocated(Buf%Pointers)) deallocate (Buf%Pointers) - if (allocated(Buf%Bytes )) deallocate (Buf%Bytes) - end subroutine - - subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(in) :: Unit - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg - - character(*), parameter :: RoutineName = "WritePackBuffer" - integer(IntKi) :: iostat - - ErrStat = ErrID_None - ErrMsg = '' - - if (Buf%ErrStat /= ErrID_None) then - call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, 'Buf%WriteFile') - return - end if - - write(Unit, iostat=iostat) Buf%NP - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error writing number of pointers", ErrStat, ErrMsg, RoutineName) + ! Check if there have been any errors while writing to the file + if (RF%ErrStat /= ErrID_None) then + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName) return end if - write(Unit, iostat=iostat) Buf%NB - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error writing number of bytes", ErrStat, ErrMsg, RoutineName) + ! Write the actual number of pointers + write (RF%Unit, POS=RF%Offset, iostat=stat) RF%NumPointers + if (stat /= 0) then + ErrStat = ErrID_Fatal + write (ErrMsg, *) 'CloseRegFile: Unable to write offset at beginning of file' return end if - write(Unit, iostat=iostat) Buf%Bytes(1:Buf%NB) - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error writing bytes", ErrStat, ErrMsg, RoutineName) - return - end if + ! Close the file + close (RF%Unit) + ! Deallocate pointer array + if (allocated(RF%Pointers)) deallocate (RF%Pointers) end subroutine - subroutine ReadPackBuffer(Buf, Unit, ErrStat, ErrMsg) - type(PackBuffer), intent(inout) :: Buf - integer(IntKi), intent(in) :: Unit - integer(IntKi), intent(out) :: ErrStat - character(ErrMsgLen), intent(out) :: ErrMsg + subroutine OpenRegFile(RF, Unit, ErrStat, ErrMsg) + type(RegFile), intent(inout) :: RF + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg - character(*), parameter :: RoutineName = "ReadPackBuffer" - integer(IntKi) :: iostat + character(*), parameter :: RoutineName = "ReadRegFile" + integer(IntKi) :: iostat ErrStat = ErrID_None ErrMsg = '' + ! Save unit + RF%Unit = Unit + ! Read number of pointers - read(Unit, iostat=iostat) Buf%NP + read (Unit, iostat=iostat) RF%NumPointers if (iostat /= 0) then call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) return end if ! If pointers are allocated, deallocate - if (allocated(Buf%Pointers)) deallocate(Buf%Pointers) + if (allocated(RF%Pointers)) deallocate (RF%Pointers) ! Allocate pointer index and initialize pointers to null - allocate(Buf%Pointers(1:Buf%NP), stat=ErrStat) - Buf%Pointers = c_null_ptr - - ! Read number of bytes in buffer - read(Unit, iostat=iostat) Buf%NB - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error reading number of bytes", ErrStat, ErrMsg, RoutineName) - return - end if - - ! If bytes are allocated, deallocate - if (allocated(Buf%Bytes)) deallocate(Buf%Bytes) - - ! Allocate bytes - allocate(Buf%Bytes(1:Buf%NB), stat=ErrStat) - - ! Read bytes - read(Unit, iostat=iostat) Buf%Bytes - if (iostat /= 0) then - call SetErrStat(ErrID_Fatal, "Error reading bytes", ErrStat, ErrMsg, RoutineName) - return - end if - - ! Clear buffer error - Buf%ErrStat = ErrID_None - Buf%ErrMsg = '' + allocate (RF%Pointers(1:RF%NumPointers), stat=ErrStat) + RF%Pointers = c_null_ptr - ! Reset Number of bytes to be used by unpack routines - Buf%NB = 0 + ! initialize the number of data + RF%NumData = 0 + ! Clear error + RF%ErrStat = ErrID_None + RF%ErrMsg = '' end subroutine - function RegCheckErr(Buf, RoutineName) result(Err) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: RoutineName - logical :: Err - Err = Buf%ErrStat /= ErrID_None - if (Err) Buf%ErrMsg = trim(RoutineName)//": "//trim(Buf%ErrMsg) + function RegCheckErr(RF, RoutineName) result(Err) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: RoutineName + logical :: Err + Err = RF%ErrStat /= ErrID_None + if (Err) RF%ErrMsg = trim(RoutineName)//": "//trim(RF%ErrMsg) end function elemental function LogicalToByte(b) result(i) @@ -227,22 +276,22 @@ elemental function ByteToLogical(i) result(b) end if end function - subroutine RegPackPointer(Buf, Ptr, Found) - type(PackBuffer), intent(inout) :: Buf - type(c_ptr), intent(in) :: Ptr - logical, intent(out) :: Found + subroutine RegPackPointer(RF, Ptr, Found) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found - type(c_ptr), allocatable :: PointersTmp(:) - integer(B8Ki) :: NewSize - integer(B8Ki) :: i + type(c_ptr), allocatable :: PointersTmp(:) + integer(B8Ki) :: NewSize + integer(B8Ki) :: i - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return ! Look for pointer in index, if found, pack pointer index and return - do i = 1, Buf%NP - if (c_associated(Ptr, Buf%Pointers(i))) then - call RegPack(Buf, i) + do i = 1, RF%NumPointers + if (c_associated(Ptr, RF%Pointers(i))) then + call RegPack(RF, i) Found = .true. return end if @@ -252,1721 +301,5796 @@ subroutine RegPackPointer(Buf, Ptr, Found) Found = .false. ! If pointer index is full, grow pointer index - if (Buf%NP == size(Buf%Pointers)) then - NewSize = int(1.5_R8Ki * real(Buf%NP, R8Ki), B8Ki) - call move_alloc(Buf%Pointers, PointersTmp) - allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) - if (Buf%ErrStat /= ErrID_None) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + if (RF%NumPointers == size(RF%Pointers)) then + NewSize = int(1.5_R8Ki*real(RF%NumPointers, R8Ki), B8Ki) + call move_alloc(RF%Pointers, PointersTmp) + allocate (RF%Pointers(NewSize), stat=RF%ErrStat) + if (RF%ErrStat /= ErrID_None) then + RF%ErrStat = ErrID_Fatal + write (RF%ErrMsg, *) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' return end if - Buf%Pointers(1:size(PointersTmp)) = PointersTmp - Buf%Pointers(size(PointersTmp)+1:) = c_null_ptr + RF%Pointers(1:size(PointersTmp)) = PointersTmp + RF%Pointers(size(PointersTmp) + 1:) = c_null_ptr end if ! Increment number of pointers, add new pointer to index - Buf%NP = Buf%NP + 1 - Buf%Pointers(Buf%NP) = Ptr + RF%NumPointers = RF%NumPointers + 1 + RF%Pointers(RF%NumPointers) = Ptr ! Pack pointer index - call RegPack(Buf, Buf%NP) - + call RegPack(RF, RF%NumPointers) end subroutine - subroutine RegUnpackPointer(Buf, Ptr, Idx) - type(PackBuffer), intent(inout) :: Buf - type(c_ptr), intent(out) :: Ptr - integer(B8Ki), intent(out) :: Idx + subroutine RegUnpackPointer(RF, Ptr, Idx) + type(RegFile), intent(inout) :: RF + type(c_ptr), intent(out) :: Ptr + integer(B8Ki), intent(out) :: Idx - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return ! Unpack pointer index - call RegUnpack(Buf, Idx) + call RegUnpack(RF, Idx) ! Get pointer from index - Ptr = Buf%Pointers(Idx) - + Ptr = RF%Pointers(Idx) end subroutine - subroutine RegPackBounds(Buf, R, LB, UB) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(in) :: LB(:), UB(:) - - ! If buffer has an error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine RegPackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B8Ki), intent(in) :: LB(:), UB(:) + + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return ! Pack lower and upper bounds - call RegPack(Buf, LB(1:R)) - call RegPack(Buf, UB(1:R)) - if (RegCheckErr(Buf, "RegPackBounds")) return + call RegPack(RF, LB(1:R)) + call RegPack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegPackBounds")) return end subroutine - subroutine RegUnpackBounds(Buf, R, LB, UB) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(out) :: LB(:), UB(:) + subroutine RegUnpackBounds(RF, R, LB, UB) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: R + integer(B8Ki), intent(out) :: LB(:), UB(:) - ! If buffer has an error, return - if (Buf%ErrStat /= ErrID_None) return + ! If has an error, return + if (RF%ErrStat /= ErrID_None) return ! Unpack lower and upper bounds - call RegUnpack(Buf, LB(1:R)) - call RegUnpack(Buf, UB(1:R)) - if (RegCheckErr(Buf, "RegUnpackBounds")) return + call RegUnpack(RF, LB(1:R)) + call RegUnpack(RF, UB(1:R)) + if (RegCheckErr(RF, "RegUnpackBounds")) return end subroutine - subroutine GrowBuffer(Buf, N) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: N - - integer(B1Ki), allocatable :: BytesTmp(:) - integer(B8Ki) :: NewSize - integer(IntKi) :: stat - - ! Return if there is a buffer error - if (Buf%ErrStat /= ErrID_None) return + function DataNumValid(RF) result(match) + type(RegFile), intent(inout) :: RF + logical :: match + integer(B8Ki) :: DataNum - ! If buffer can hold requested bytes, return - if (size(Buf%Bytes) > Buf%NB + N) return + ! Increment the data number to be read + RF%NumData = RF%NumData + 1 - ! Calculate new size - NewSize = int(real(Buf%NB + N, R8Ki) * 1.8_R8Ki, B8Ki) + ! Read the data number from the file + read(RF%Unit) DataNum - ! Move allocation to temporary array and allocate buffer with new size - call move_alloc(Buf%Bytes, BytesTmp) - allocate (Buf%Bytes(NewSize), stat=stat) - if (stat /= 0) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) 'Grow: Unable to grow buffer to', NewSize, 'bytes' - return + ! If data number from file does not match expected number, set match false + ! and create error message; otherwise, set match to true + if (DataNum /= RF%NumData) then + match = .false. + RF%ErrStat = ErrID_Fatal + write(RF%ErrMsg, *) "Read data number", DataNum, "expected", RF%NumData + else + match = .true. end if + end function - ! Copy contents of temporary bytes to buffer - Buf%Bytes(1:size(BytesTmp)) = BytesTmp + subroutine Pack_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data end subroutine + subroutine Unpack_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return - subroutine Pack_C1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: Data - integer(B8Ki) :: DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data - ! Get size of data in bytes - DataSize = len(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_C1")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1")) return end subroutine - subroutine Unpack_C1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(out) :: Data - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = len(Data) - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_C1: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1: error allocating data" return end if - ! Transfer data from buffer - Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1")) return end subroutine - subroutine Pack_C1_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: Data(:) - integer(B8Ki) :: DataSize + subroutine PackPtr_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = len(Data(1))*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_C1_Rank1")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1")) return end subroutine - subroutine Unpack_C1_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(out) :: Data(:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_C1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1")) return + if (.not. IsAssociated) return - ! Get size of data in bytes - DataSize = len(Data(1))*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_C1_Rank1: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1")) return end subroutine - subroutine Pack_C1_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:) - ! Get size of data in bytes - DataSize = len(Data(1,1))*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_C1_Rank2")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_C1_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(out) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:) - ! Get size of data in bytes - DataSize = len(Data(1,1))*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_C1_Rank2: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_C1_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: Data(:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:) - ! Get size of data in bytes - DataSize = len(Data(1,1,1))*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_C1_Rank3")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank1")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank1")) return end subroutine - subroutine Unpack_C1_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(out) :: Data(:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank1")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = len(Data(1,1,1))*size(Data) + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank1")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_C1_Rank3: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank1: error allocating data" return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank1")) return end subroutine - subroutine Pack_C1_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackPtr_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = len(Data(1,1,1,1))*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank1")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_C1_Rank4")) return + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank1")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank1")) return end subroutine - subroutine Unpack_C1_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(out) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_C1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return - ! Get size of data in bytes - DataSize = len(Data(1,1,1,1))*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_C1_Rank4: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank1: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank1")) return end subroutine - subroutine Pack_C1_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(in) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:) - ! Get size of data in bytes - DataSize = len(Data(1,1,1,1,1))*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_C1_Rank5")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_C1_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - character(*), intent(out) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:) - ! Get size of data in bytes - DataSize = len(Data(1,1,1,1,1))*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_C1_Rank5: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_L1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(in) :: Data - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:) - ! Get size of data in bytes - DataSize = 1 + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_L1")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank2")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank2")) return end subroutine - subroutine Unpack_L1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(out) :: Data - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank2")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 1 + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank2")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_L1: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank2: error allocating data" return end if - ! Transfer data from buffer - Data = ByteToLogical(Buf%Bytes(Buf%NB+1)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank2")) return end subroutine - subroutine Pack_L1_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(in) :: Data(:) - integer(B8Ki) :: DataSize + subroutine PackPtr_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank2")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_L1_Rank1")) return + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank2")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank2")) return end subroutine - subroutine Unpack_L1_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(out) :: Data(:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_C1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return - ! Get size of data in bytes - DataSize = size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_L1_Rank1: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data return end if - ! Transfer data from buffer - Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank2: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank2")) return end subroutine - subroutine Pack_L1_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(in) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:,:) - ! Get size of data in bytes - DataSize = size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_L1_Rank2")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_L1_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(out) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:,:) - ! Get size of data in bytes - DataSize = size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_L1_Rank2: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_L1_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(in) :: Data(:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:,:) - ! Get size of data in bytes - DataSize = size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_L1_Rank3")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank3")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank3")) return end subroutine - subroutine Unpack_L1_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(out) :: Data(:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank3")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = size(Data) + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank3")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_L1_Rank3: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank3: error allocating data" return end if - ! Transfer data from buffer - Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank3")) return end subroutine - subroutine Pack_L1_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(in) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackPtr_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank3")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_L1_Rank4")) return + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank3")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank3")) return end subroutine - subroutine Unpack_L1_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(out) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_C1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return - ! Get size of data in bytes - DataSize = size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_L1_Rank4: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data return end if - ! Transfer data from buffer - Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank3: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank3")) return end subroutine - subroutine Pack_L1_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(in) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:,:,:) - ! Get size of data in bytes - DataSize = size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_L1_Rank5")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_L1_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - logical, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:,:,:) - ! Get size of data in bytes - DataSize = size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_L1_Rank5: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_I4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: Data - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:,:,:) - ! Get size of data in bytes - DataSize = 4 + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I4")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank4")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank4")) return end subroutine - subroutine Unpack_I4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(out) :: Data - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank4")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 4 + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank4")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I4: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank4: error allocating data" return end if - ! Transfer data from buffer - Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank4")) return end subroutine - subroutine Pack_I4_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: Data(:) - integer(B8Ki) :: DataSize + subroutine PackPtr_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank4")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I4_Rank1")) return + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank4")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank4")) return end subroutine - subroutine Unpack_I4_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(out) :: Data(:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_C1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I4_Rank1: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank4: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank4")) return end subroutine - subroutine Pack_I4_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(in) :: Data(:,:,:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I4_Rank2")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_I4_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(out) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), intent(out) :: Data(:,:,:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I4_Rank2: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_I4_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: Data(:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(in) :: Data(:,:,:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I4_Rank3")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_C1_Rank5")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_C1_Rank5")) return end subroutine - subroutine Unpack_I4_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(out) :: Data(:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank5")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank5")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I4_Rank3: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_C1_Rank5: error allocating data" return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_C1_Rank5")) return end subroutine - subroutine Pack_I4_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackPtr_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_C1_Rank5")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I4_Rank4")) return + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_C1_Rank5")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_C1_Rank5")) return end subroutine - subroutine Unpack_I4_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(out) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_C1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + character(*), pointer, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I4_Rank4: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_C1_Rank5: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_C1_Rank5")) return end subroutine - subroutine Pack_I4_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(in) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data - ! Get size of data in bytes - DataSize = 4*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I4_Rank5")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_I4_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B4Ki), intent(out) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data - ! Get size of data in bytes - DataSize = 4*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I4_Rank5: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_I8(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: Data - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data - ! Get size of data in bytes - DataSize = 8 + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I8")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1")) return end subroutine - subroutine Unpack_I8(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(out) :: Data - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 8 - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I8: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1: error allocating data" return end if - ! Transfer data from buffer - Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1")) return end subroutine - subroutine Pack_I8_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: Data(:) - integer(B8Ki) :: DataSize + subroutine PackPtr_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I8_Rank1")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1")) return end subroutine - subroutine Unpack_I8_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(out) :: Data(:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_L1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1")) return + if (.not. IsAssociated) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I8_Rank1: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1")) return end subroutine - subroutine Pack_I8_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:) - ! Get size of data in bytes - DataSize = 8*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I8_Rank2")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_I8_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(out) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:) - ! Get size of data in bytes - DataSize = 8*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I8_Rank2: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_I8_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: Data(:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:) - ! Get size of data in bytes - DataSize = 8*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I8_Rank3")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank1")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank1")) return end subroutine - subroutine Unpack_I8_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(out) :: Data(:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank1")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank1")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I8_Rank3: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank1: error allocating data" return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank1")) return end subroutine - subroutine Pack_I8_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackPtr_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank1")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I8_Rank4")) return + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank1")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank1")) return end subroutine - subroutine Unpack_I8_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(out) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_L1_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I8_Rank4: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank1: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank1")) return end subroutine - subroutine Pack_I8_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(in) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:) - ! Get size of data in bytes - DataSize = 8*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_I8_Rank5")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_I8_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - integer(B8Ki), intent(out) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:) - ! Get size of data in bytes - DataSize = 8*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_I8_Rank5: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_R4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(in) :: Data - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:) - ! Get size of data in bytes - DataSize = 4 + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R4")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank2")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank2")) return end subroutine - subroutine Unpack_R4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(out) :: Data - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank2")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 4 + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank2")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R4: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank2: error allocating data" return end if - ! Transfer data from buffer - Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank2")) return end subroutine - subroutine Pack_R4_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(in) :: Data(:) - integer(B8Ki) :: DataSize + subroutine PackPtr_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank2")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R4_Rank1")) return + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank2")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank2")) return end subroutine - subroutine Unpack_R4_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(out) :: Data(:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_L1_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R4_Rank1: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank2: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank2")) return end subroutine - subroutine Pack_R4_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(in) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R4_Rank2")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_R4_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(out) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R4_Rank2: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_R4_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(in) :: Data(:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R4_Rank3")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank3")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank3")) return end subroutine - subroutine Unpack_R4_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(out) :: Data(:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank3")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank3")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R4_Rank3: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank3: error allocating data" return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank3")) return end subroutine - subroutine Pack_R4_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(in) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackPtr_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank3")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R4_Rank4")) return + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank3")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank3")) return end subroutine - subroutine Unpack_R4_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(out) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_L1_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return - ! Get size of data in bytes - DataSize = 4*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R4_Rank4: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank3: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank3")) return end subroutine - subroutine Pack_R4_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(in) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R4_Rank5")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_R4_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R4Ki), intent(out) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:,:,:) - ! Get size of data in bytes - DataSize = 4*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R4_Rank5: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_R8(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(in) :: Data - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:,:,:) - ! Get size of data in bytes - DataSize = 8 + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R8")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank4")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank4")) return end subroutine - subroutine Unpack_R8(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(out) :: Data - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank4")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 8 + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank4")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R8: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank4: error allocating data" return end if - ! Transfer data from buffer - Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank4")) return end subroutine - subroutine Pack_R8_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(in) :: Data(:) - integer(B8Ki) :: DataSize + subroutine PackPtr_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank4")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R8_Rank1")) return + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank4")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank4")) return end subroutine - subroutine Unpack_R8_Rank1(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(out) :: Data(:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_L1_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R8_Rank1: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank4: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank4")) return end subroutine - subroutine Pack_R8_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(in) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Pack_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(in) :: Data(:,:,:,:,:) - ! Get size of data in bytes - DataSize = 8*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R8_Rank2")) return - - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + ! Write data to file + write(RF%Unit) Data end subroutine - subroutine Unpack_R8_Rank2(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(out) :: Data(:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine Unpack_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, intent(out) :: Data(:,:,:,:,:) - ! Get size of data in bytes - DataSize = 8*size(Data) - - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R8_Rank2: buffer too small, requested", DataSize, "bytes" - return - end if + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Pack_R8_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(in) :: Data(:,:,:) - integer(B8Ki) :: DataSize - - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + subroutine PackAlloc_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(in) :: Data(:,:,:,:,:) - ! Get size of data in bytes - DataSize = 8*size(Data) + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R8_Rank3")) return + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_L1_Rank5")) return + if (.not. allocated(Data)) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_L1_Rank5")) return end subroutine - subroutine Unpack_R8_Rank3(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(out) :: Data(:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackAlloc_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank5")) return + if (.not. IsAllocated) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank5")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R8_Rank3: buffer too small, requested", DataSize, "bytes" + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_L1_Rank5: error allocating data" return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize - + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_L1_Rank5")) return end subroutine - subroutine Pack_R8_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(in) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackPtr_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_L1_Rank5")) return + if (.not. associated(Data)) return - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R8_Rank4")) return + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_L1_Rank5")) return + if (PtrInIndex) return + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_L1_Rank5")) return end subroutine - subroutine Unpack_R8_Rank4(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(out) :: Data(:,:,:,:) - integer(B8Ki) :: DataSize + subroutine UnpackPtr_L1_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + logical, pointer, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return + if (.not. IsAssociated) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R8_Rank4: buffer too small, requested", DataSize, "bytes" + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data return end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_L1_Rank5: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_L1_Rank5")) return end subroutine - subroutine Pack_R8_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(in) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize + subroutine Pack_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data - ! Grow buffer to accommodate Data - call GrowBuffer(Buf, DataSize) - if (RegCheckErr(Buf, "Pack_R8_Rank5")) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Transfer data to buffer - Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) - Buf%NB = Buf%NB + DataSize + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + ! Read data from file + read(RF%Unit) Data end subroutine - subroutine Unpack_R8_Rank5(Buf, Data) - type(PackBuffer), intent(inout) :: Buf - real(R8Ki), intent(out) :: Data(:,:,:,:,:) - integer(B8Ki) :: DataSize + subroutine PackAlloc_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data - ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + ! If error, return + if (RF%ErrStat /= ErrID_None) return - ! Get size of data in bytes - DataSize = 8*size(Data) + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4")) return + if (.not. allocated(Data)) return - ! Check that buffer has sufficient bytes remaining - if (size(Buf%Bytes) < Buf%NB + DataSize) then - Buf%ErrStat = ErrID_Fatal - write(Buf%ErrMsg,*) "Unpack_R8_Rank5: buffer too small, requested", DataSize, "bytes" - return - end if - ! Transfer data from buffer - Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) - Buf%NB = Buf%NB + DataSize + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4")) return + end subroutine + + subroutine UnpackAlloc_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4")) return + end subroutine + + subroutine PackPtr_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4")) return + end subroutine + + subroutine UnpackPtr_I4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4")) return + end subroutine + + subroutine Pack_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank1")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank1")) return + end subroutine + + subroutine PackPtr_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank1")) return + end subroutine + + subroutine UnpackPtr_I4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank1")) return + end subroutine + + subroutine Pack_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank2")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank2")) return + end subroutine + + subroutine PackPtr_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank2")) return + end subroutine + + subroutine UnpackPtr_I4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank2")) return + end subroutine + + subroutine Pack_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank3")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank3")) return + end subroutine + + subroutine PackPtr_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank3")) return + end subroutine + + subroutine UnpackPtr_I4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank3")) return + end subroutine + + subroutine Pack_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank4")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank4")) return + end subroutine + + subroutine PackPtr_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank4")) return + end subroutine + + subroutine UnpackPtr_I4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank4")) return + end subroutine + + subroutine Pack_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I4_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I4_Rank5")) return + end subroutine + + subroutine UnpackAlloc_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I4_Rank5")) return + end subroutine + + subroutine PackPtr_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I4_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I4_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I4_Rank5")) return + end subroutine + + subroutine UnpackPtr_I4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I4_Rank5")) return + end subroutine + + subroutine Pack_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8")) return + end subroutine + + subroutine UnpackAlloc_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8")) return + end subroutine + + subroutine PackPtr_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8")) return + end subroutine + + subroutine UnpackPtr_I8(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8")) return + end subroutine + + subroutine Pack_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank1")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank1")) return + end subroutine + + subroutine PackPtr_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank1")) return + end subroutine + + subroutine UnpackPtr_I8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank1")) return + end subroutine + + subroutine Pack_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank2")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank2")) return + end subroutine + + subroutine PackPtr_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank2")) return + end subroutine + + subroutine UnpackPtr_I8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank2")) return + end subroutine + + subroutine Pack_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank3")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank3")) return + end subroutine + + subroutine PackPtr_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank3")) return + end subroutine + + subroutine UnpackPtr_I8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank3")) return + end subroutine + + subroutine Pack_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank4")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank4")) return + end subroutine + + subroutine PackPtr_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank4")) return + end subroutine + + subroutine UnpackPtr_I8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank4")) return + end subroutine + + subroutine Pack_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_I8_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_I8_Rank5")) return + end subroutine + + subroutine UnpackAlloc_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_I8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_I8_Rank5")) return + end subroutine + + subroutine PackPtr_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_I8_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_I8_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_I8_Rank5")) return + end subroutine + + subroutine UnpackPtr_I8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_I8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_I8_Rank5")) return + end subroutine + + subroutine Pack_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4")) return + end subroutine + + subroutine UnpackAlloc_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4")) return + end subroutine + + subroutine PackPtr_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4")) return + end subroutine + + subroutine UnpackPtr_R4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4")) return + end subroutine + + subroutine Pack_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank1")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank1")) return + end subroutine + + subroutine PackPtr_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank1")) return + end subroutine + + subroutine UnpackPtr_R4_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank1")) return + end subroutine + + subroutine Pack_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank2")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank2")) return + end subroutine + + subroutine PackPtr_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank2")) return + end subroutine + + subroutine UnpackPtr_R4_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank2")) return + end subroutine + + subroutine Pack_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank3")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank3")) return + end subroutine + + subroutine PackPtr_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank3")) return + end subroutine + + subroutine UnpackPtr_R4_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank3")) return + end subroutine + + subroutine Pack_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank4")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank4")) return + end subroutine + + subroutine PackPtr_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank4")) return + end subroutine + + subroutine UnpackPtr_R4_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank4")) return + end subroutine + + subroutine Pack_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R4_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R4_Rank5")) return + end subroutine + + subroutine UnpackAlloc_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R4_Rank5")) return + end subroutine + + subroutine PackPtr_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R4_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R4_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R4_Rank5")) return + end subroutine + + subroutine UnpackPtr_R4_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R4Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R4_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R4_Rank5")) return + end subroutine + + subroutine Pack_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8")) return + if (.not. allocated(Data)) return + + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8")) return + end subroutine + + subroutine UnpackAlloc_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data + integer(IntKi) :: stat + logical :: IsAllocated + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8")) return + if (.not. IsAllocated) return + + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8")) return + end subroutine + + subroutine PackPtr_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8")) return + if (.not. associated(Data)) return + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8")) return + end subroutine + + subroutine UnpackPtr_R8(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8")) return + if (.not. IsAssociated) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data) + return + end if + + ! Allocate data + allocate(Data, stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8")) return + end subroutine + + subroutine Pack_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank1")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank1")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank1")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank1")) return + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank1")) return + end subroutine + + subroutine PackPtr_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank1")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank1")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank1")) return + end subroutine + + subroutine UnpackPtr_R8_Rank1(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(1), UB(1) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 1, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank1: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank1")) return + end subroutine + + subroutine Pack_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank2")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank2")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank2")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank2")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank2")) return + end subroutine + + subroutine PackPtr_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank2")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank2")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank2")) return + end subroutine + + subroutine UnpackPtr_R8_Rank2(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(2), UB(2) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 2, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank2: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank2")) return + end subroutine + + subroutine Pack_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank3")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank3")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank3")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank3")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank3")) return + end subroutine + + subroutine PackPtr_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank3")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank3")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank3")) return + end subroutine + + subroutine UnpackPtr_R8_Rank3(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(3), UB(3) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 3, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank3: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank3")) return + end subroutine + + subroutine Pack_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank4")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank4")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank4")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank4")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank4")) return + end subroutine + + subroutine PackPtr_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank4")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank4")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank4")) return + end subroutine + + subroutine UnpackPtr_R8_Rank4(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(4), UB(4) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 4, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank4: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank4")) return + end subroutine + + subroutine Pack_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Increment data number and write to file + RF%NumData = RF%NumData + 1 + write(RF%Unit) RF%NumData + + ! Write data to file + write(RF%Unit) Data + end subroutine + + subroutine Unpack_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), intent(out) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Read data number, return if invalid + if (.not. DataNumValid(RF)) return + + ! Read data from file + read(RF%Unit) Data + end subroutine + + subroutine PackAlloc_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(in) :: Data(:,:,:,:,:) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if allocated + call RegPack(RF, allocated(Data)) + if (RegCheckErr(RF, "PackAlloc_R8_Rank5")) return + if (.not. allocated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackAlloc_R8_Rank5")) return + end subroutine + + subroutine UnpackAlloc_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + logical :: IsAllocated + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Deallocate if allocated + if (allocated(Data)) deallocate(Data) + + ! Read value to see if it was allocated, return if not + call RegUnpack(RF, IsAllocated) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank5")) return + if (.not. IsAllocated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank5")) return + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackAlloc_R8_Rank5: error allocating data" + return + end if + + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackAlloc_R8_Rank5")) return + end subroutine + + subroutine PackPtr_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(in) :: Data(:,:,:,:,:) + logical :: PtrInIndex + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! Write if associated + call RegPack(RF, associated(Data)) + if (RegCheckErr(RF, "PackPtr_R8_Rank5")) return + if (.not. associated(Data)) return + + ! Write array bounds + call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + + ! Write pointer info + call RegPackPointer(RF, c_loc(Data), PtrInIndex) + if (RegCheckErr(RF, "PackPtr_R8_Rank5")) return + if (PtrInIndex) return + + ! Write data to file + call RegPack(RF, Data) + if (RegCheckErr(RF, "PackPtr_R8_Rank5")) return + end subroutine + + subroutine UnpackPtr_R8_Rank5(RF, Data) + type(RegFile), intent(inout) :: RF + real(R8Ki), pointer, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: stat + integer(B8Ki) :: PtrIdx + logical :: IsAssociated + type(c_ptr) :: Ptr + integer(B8Ki) :: LB(5), UB(5) + + ! If error, return + if (RF%ErrStat /= ErrID_None) return + + ! If associated, deallocate and nullify + if (associated(Data)) then + deallocate(Data) + nullify(Data) + end if + + ! Read value to see if it was associated, return if not + call RegUnpack(RF, IsAssociated) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + if (.not. IsAssociated) return + + ! Read array bounds + call RegUnpackBounds(RF, 5, LB, UB) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + + ! Unpack pointer inf + call RegUnpackPointer(RF, Ptr, PtrIdx) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return + + ! If pointer was in index, associate data with pointer, return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, Data, UB - LB) + Data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => Data + return + end if + + ! Allocate data + allocate(Data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=stat) + if (stat /= 0) then + RF%ErrStat = ErrID_Fatal + RF%ErrMsg = "UnpackPtr_R8_Rank5: error allocating data" + return + end if + ! Read data + call RegUnpack(RF, Data) + if (RegCheckErr(RF, "UnpackPtr_R8_Rank5")) return end subroutine end module \ No newline at end of file From 9dd75f24de45e918139f6899fca93b333b2a4523 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 12 Jan 2024 16:59:25 +0000 Subject: [PATCH 165/232] Include ID field in Mesh --- modules/nwtc-library/src/ModMesh.f90 | 12 ++++++++---- modules/nwtc-library/src/ModMesh_Types.f90 | 1 + 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 4146c1c083..ec03904704 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1508,7 +1508,7 @@ END SUBROUTINE MeshDestroy !! separately for each sibling, because the fields allocated with the siblings are separate !! and unique to each sibling. subroutine MeshPack (Buf, Mesh) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(MeshType), intent(in) :: Mesh ! Mesh being packed integer :: i,j, nelemnodes @@ -1536,6 +1536,7 @@ subroutine MeshPack (Buf, Mesh) call RegPack(Buf, Mesh%ios) call RegPack(Buf, Mesh%nnodes) call RegPack(Buf, Mesh%refnode) + call RegPack(Buf, Mesh%ID) call RegPack(Buf, Mesh%nextelem) call RegPack(Buf, Mesh%nscalars) @@ -1587,7 +1588,7 @@ END SUBROUTINE MeshPack !! in the exact state as when the data in the buffers was packed using MeshPack. SUBROUTINE MeshUnpack(Buf, Mesh) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(MeshType), intent(inout) :: Mesh ! Mesh being packed ! bjj: not implemented yet: @@ -1595,7 +1596,7 @@ SUBROUTINE MeshUnpack(Buf, Mesh) ! the existing sibling as an optional argument so that the sibling relationship is also recreated. LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) - INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode + INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode, id INTEGER i,j integer(IntKi) :: EN(20) ! Element nodes @@ -1622,6 +1623,7 @@ SUBROUTINE MeshUnpack(Buf, Mesh) call RegUnpack(Buf, ios) call RegUnpack(Buf, nnodes) call RegUnpack(Buf, refnode) + call RegUnpack(Buf, id) call RegUnpack(Buf, nextelem) call RegUnpack(Buf, nscalars) @@ -1644,6 +1646,7 @@ SUBROUTINE MeshUnpack(Buf, Mesh) if (Buf%ErrStat >= AbortErrLev) return Mesh%RefNode = refnode + Mesh%ID = id Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem @@ -1973,7 +1976,8 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%Initialized = SrcMesh%Initialized DestMesh%Committed = SrcMesh%Committed - DestMesh%refNode = SrcMesh%refNode + DestMesh%refNode = SrcMesh%refNode + DestMesh%ID = SrcMesh%ID IF ( ALLOCATED(SrcMesh%Force ) .AND. ALLOCATED(DestMesh%Force ) ) DestMesh%Force = SrcMesh%Force IF ( ALLOCATED(SrcMesh%Moment ) .AND. ALLOCATED(DestMesh%Moment ) ) DestMesh%Moment = SrcMesh%Moment IF ( ALLOCATED(SrcMesh%Orientation ) .AND. ALLOCATED(DestMesh%Orientation ) ) DestMesh%Orientation = SrcMesh%Orientation diff --git a/modules/nwtc-library/src/ModMesh_Types.f90 b/modules/nwtc-library/src/ModMesh_Types.f90 index 1bca2c98a9..b50ab5d997 100644 --- a/modules/nwtc-library/src/ModMesh_Types.f90 +++ b/modules/nwtc-library/src/ModMesh_Types.f90 @@ -107,6 +107,7 @@ MODULE ModMesh_Types INTEGER :: ios !< Mesh type: input (1), output(2), or state(3) INTEGER :: refNode = 0 !< optional reference node (informational only) INTEGER :: Nnodes = 0 !< Number of nodes (vertices) in mesh + INTEGER :: ID = 0 !< Mesh identifier (used during init) ! Mesh elements TYPE(ElemTabType), POINTER :: ElemTable(:) => NULL() !< A table of all elements in the mesh, by type From 141be9d5992b31acc759a27f08c26549fbfab3b4 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 12 Jan 2024 17:03:18 +0000 Subject: [PATCH 166/232] Automatically generate subroutines for ModMesh_Mapping.f90 --- modules/nwtc-library/CMakeLists.txt | 10 +- modules/nwtc-library/src/ModMesh_Mapping.f90 | 867 +----------------- modules/openfast-registry/src/main.cpp | 5 + modules/openfast-registry/src/registry.hpp | 10 + .../src/registry_gen_fortran.cpp | 34 +- 5 files changed, 52 insertions(+), 874 deletions(-) diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 998bb11ec9..cc7a669296 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -14,11 +14,9 @@ # limitations under the License. # -# if (GENERATE_TYPES) -# generate_f90_types(src/Registry_NWTC_Library_typedef_nomesh.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) -# endif() - if (GENERATE_TYPES) + generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Types.f90 -noextrap) + generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Subs.f90 -subs -noextrap) # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS src/Registry_NWTC_Library_mesh.txt @@ -26,7 +24,6 @@ if (GENERATE_TYPES) file(READ src/Registry_NWTC_Library_base.txt BASE_CONTENTS) file(READ src/Registry_NWTC_Library_mesh.txt MESH_CONTENTS) file(WRITE src/Registry_NWTC_Library.txt "${BASE_CONTENTS}\n${MESH_CONTENTS}") - generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) endif() #------------------------------------------------------------------------------- @@ -151,11 +148,14 @@ if (CMAKE_BUILD_TYPE MATCHES Debug) endif() endif() +add_custom_target(nwtc_library_subs DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Subs.f90) + # Create NWTC Library add_library(nwtclibs STATIC ${NWTC_SYS_FILE} ${NWTCLIBS_SOURCES} ) +add_dependencies(nwtclibs nwtc_library_subs) target_link_libraries(nwtclibs PUBLIC ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS} diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index 440c8e193a..c0ef92fbd9 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -5760,871 +5760,8 @@ SUBROUTINE WriteMappingTransferToFile(Mesh1_I,Mesh1_O,Mesh2_I,Mesh2_O,Map_Mod1_M END SUBROUTINE WriteMappingTransferToFile !---------------------------------------------------------------------------------------------------------------------------------- -!================================================================================================================================== -!bjj: these routines require the use of ModMesh.f90, thus they cannot be part of NWTC_Library_Types.f90: -!STARTOFREGISTRYGENERATEDFILE 'NWTC_Library_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* - -subroutine NWTC_Library_CopyMapType(SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg) - type(MapType), intent(in) :: SrcMapTypeData - type(MapType), intent(inout) :: DstMapTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_CopyMapType' - ErrStat = ErrID_None - ErrMsg = '' - DstMapTypeData%OtherMesh_Element = SrcMapTypeData%OtherMesh_Element - DstMapTypeData%distance = SrcMapTypeData%distance - DstMapTypeData%couple_arm = SrcMapTypeData%couple_arm - DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn -end subroutine - -subroutine NWTC_Library_DestroyMapType(MapTypeData, ErrStat, ErrMsg) - type(MapType), intent(inout) :: MapTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMapType' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine NWTC_Library_PackMapType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(MapType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackMapType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%OtherMesh_Element) - call RegPack(Buf, InData%distance) - call RegPack(Buf, InData%couple_arm) - call RegPack(Buf, InData%shape_fn) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackMapType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(MapType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMapType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%OtherMesh_Element) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%distance) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%couple_arm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%shape_fn) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg) - type(MeshMapLinearizationType), intent(in) :: SrcMeshMapLinearizationTypeData - type(MeshMapLinearizationType), intent(inout) :: DstMeshMapLinearizationTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMeshMapLinearizationTypeData%mi)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%mi)) then - allocate(DstMeshMapLinearizationTypeData%mi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%mi.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi - end if - if (allocated(SrcMeshMapLinearizationTypeData%fx_p)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%fx_p)) then - allocate(DstMeshMapLinearizationTypeData%fx_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%fx_p.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p - end if - if (allocated(SrcMeshMapLinearizationTypeData%tv_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uD)) then - allocate(DstMeshMapLinearizationTypeData%tv_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD - end if - if (allocated(SrcMeshMapLinearizationTypeData%tv_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uS)) then - allocate(DstMeshMapLinearizationTypeData%tv_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS - end if - if (allocated(SrcMeshMapLinearizationTypeData%ta_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uD)) then - allocate(DstMeshMapLinearizationTypeData%ta_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD - end if - if (allocated(SrcMeshMapLinearizationTypeData%ta_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uS)) then - allocate(DstMeshMapLinearizationTypeData%ta_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS - end if - if (allocated(SrcMeshMapLinearizationTypeData%ta_rv)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%ta_rv)) then - allocate(DstMeshMapLinearizationTypeData%ta_rv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_rv.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv - end if - if (allocated(SrcMeshMapLinearizationTypeData%li)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%li)) then - allocate(DstMeshMapLinearizationTypeData%li(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%li.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li - end if - if (allocated(SrcMeshMapLinearizationTypeData%M_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%M_uS)) then - allocate(DstMeshMapLinearizationTypeData%M_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS - end if - if (allocated(SrcMeshMapLinearizationTypeData%M_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%M_uD)) then - allocate(DstMeshMapLinearizationTypeData%M_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uD.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD - end if - if (allocated(SrcMeshMapLinearizationTypeData%M_f)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) - if (.not. allocated(DstMeshMapLinearizationTypeData%M_f)) then - allocate(DstMeshMapLinearizationTypeData%M_f(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_f.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapLinearizationTypeData%M_f = SrcMeshMapLinearizationTypeData%M_f - end if -end subroutine - -subroutine NWTC_Library_DestroyMeshMapLinearizationType(MeshMapLinearizationTypeData, ErrStat, ErrMsg) - type(MeshMapLinearizationType), intent(inout) :: MeshMapLinearizationTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MeshMapLinearizationTypeData%mi)) then - deallocate(MeshMapLinearizationTypeData%mi) - end if - if (allocated(MeshMapLinearizationTypeData%fx_p)) then - deallocate(MeshMapLinearizationTypeData%fx_p) - end if - if (allocated(MeshMapLinearizationTypeData%tv_uD)) then - deallocate(MeshMapLinearizationTypeData%tv_uD) - end if - if (allocated(MeshMapLinearizationTypeData%tv_uS)) then - deallocate(MeshMapLinearizationTypeData%tv_uS) - end if - if (allocated(MeshMapLinearizationTypeData%ta_uD)) then - deallocate(MeshMapLinearizationTypeData%ta_uD) - end if - if (allocated(MeshMapLinearizationTypeData%ta_uS)) then - deallocate(MeshMapLinearizationTypeData%ta_uS) - end if - if (allocated(MeshMapLinearizationTypeData%ta_rv)) then - deallocate(MeshMapLinearizationTypeData%ta_rv) - end if - if (allocated(MeshMapLinearizationTypeData%li)) then - deallocate(MeshMapLinearizationTypeData%li) - end if - if (allocated(MeshMapLinearizationTypeData%M_uS)) then - deallocate(MeshMapLinearizationTypeData%M_uS) - end if - if (allocated(MeshMapLinearizationTypeData%M_uD)) then - deallocate(MeshMapLinearizationTypeData%M_uD) - end if - if (allocated(MeshMapLinearizationTypeData%M_f)) then - deallocate(MeshMapLinearizationTypeData%M_f) - end if -end subroutine - -subroutine NWTC_Library_PackMeshMapLinearizationType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(MeshMapLinearizationType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%mi)) - if (allocated(InData%mi)) then - call RegPackBounds(Buf, 2, lbound(InData%mi, kind=B8Ki), ubound(InData%mi, kind=B8Ki)) - call RegPack(Buf, InData%mi) - end if - call RegPack(Buf, allocated(InData%fx_p)) - if (allocated(InData%fx_p)) then - call RegPackBounds(Buf, 2, lbound(InData%fx_p, kind=B8Ki), ubound(InData%fx_p, kind=B8Ki)) - call RegPack(Buf, InData%fx_p) - end if - call RegPack(Buf, allocated(InData%tv_uD)) - if (allocated(InData%tv_uD)) then - call RegPackBounds(Buf, 2, lbound(InData%tv_uD, kind=B8Ki), ubound(InData%tv_uD, kind=B8Ki)) - call RegPack(Buf, InData%tv_uD) - end if - call RegPack(Buf, allocated(InData%tv_uS)) - if (allocated(InData%tv_uS)) then - call RegPackBounds(Buf, 2, lbound(InData%tv_uS, kind=B8Ki), ubound(InData%tv_uS, kind=B8Ki)) - call RegPack(Buf, InData%tv_uS) - end if - call RegPack(Buf, allocated(InData%ta_uD)) - if (allocated(InData%ta_uD)) then - call RegPackBounds(Buf, 2, lbound(InData%ta_uD, kind=B8Ki), ubound(InData%ta_uD, kind=B8Ki)) - call RegPack(Buf, InData%ta_uD) - end if - call RegPack(Buf, allocated(InData%ta_uS)) - if (allocated(InData%ta_uS)) then - call RegPackBounds(Buf, 2, lbound(InData%ta_uS, kind=B8Ki), ubound(InData%ta_uS, kind=B8Ki)) - call RegPack(Buf, InData%ta_uS) - end if - call RegPack(Buf, allocated(InData%ta_rv)) - if (allocated(InData%ta_rv)) then - call RegPackBounds(Buf, 2, lbound(InData%ta_rv, kind=B8Ki), ubound(InData%ta_rv, kind=B8Ki)) - call RegPack(Buf, InData%ta_rv) - end if - call RegPack(Buf, allocated(InData%li)) - if (allocated(InData%li)) then - call RegPackBounds(Buf, 2, lbound(InData%li, kind=B8Ki), ubound(InData%li, kind=B8Ki)) - call RegPack(Buf, InData%li) - end if - call RegPack(Buf, allocated(InData%M_uS)) - if (allocated(InData%M_uS)) then - call RegPackBounds(Buf, 2, lbound(InData%M_uS, kind=B8Ki), ubound(InData%M_uS, kind=B8Ki)) - call RegPack(Buf, InData%M_uS) - end if - call RegPack(Buf, allocated(InData%M_uD)) - if (allocated(InData%M_uD)) then - call RegPackBounds(Buf, 2, lbound(InData%M_uD, kind=B8Ki), ubound(InData%M_uD, kind=B8Ki)) - call RegPack(Buf, InData%M_uD) - end if - call RegPack(Buf, allocated(InData%M_f)) - if (allocated(InData%M_f)) then - call RegPackBounds(Buf, 2, lbound(InData%M_f, kind=B8Ki), ubound(InData%M_f, kind=B8Ki)) - call RegPack(Buf, InData%M_f) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(MeshMapLinearizationType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%mi)) deallocate(OutData%mi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%mi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%mi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fx_p)) deallocate(OutData%fx_p) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fx_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fx_p) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tv_uD)) deallocate(OutData%tv_uD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tv_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tv_uD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tv_uS)) deallocate(OutData%tv_uS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tv_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tv_uS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ta_uD)) deallocate(OutData%ta_uD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ta_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ta_uD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ta_uS)) deallocate(OutData%ta_uS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ta_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ta_uS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ta_rv)) deallocate(OutData%ta_rv) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ta_rv(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ta_rv) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%li)) deallocate(OutData%li) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%li(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%li) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M_uS)) deallocate(OutData%M_uS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M_uS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M_uD)) deallocate(OutData%M_uD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M_uD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M_f)) deallocate(OutData%M_f) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M_f(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M_f) - if (RegCheckErr(Buf, RoutineName)) return - end if -end subroutine - -subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg) - type(MeshMapType), intent(inout) :: SrcMeshMapTypeData - type(MeshMapType), intent(inout) :: DstMeshMapTypeData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcMeshMapTypeData%MapLoads)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%MapLoads)) then - allocate(DstMeshMapTypeData%MapLoads(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapLoads.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapLoads(i1), DstMeshMapTypeData%MapLoads(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcMeshMapTypeData%MapMotions)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%MapMotions)) then - allocate(DstMeshMapTypeData%MapMotions(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapMotions.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapMotions(i1), DstMeshMapTypeData%MapMotions(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcMeshMapTypeData%MapSrcToAugmt)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%MapSrcToAugmt)) then - allocate(DstMeshMapTypeData%MapSrcToAugmt(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapSrcToAugmt.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapSrcToAugmt(i1), DstMeshMapTypeData%MapSrcToAugmt(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call MeshCopy(SrcMeshMapTypeData%Augmented_Ln2_Src, DstMeshMapTypeData%Augmented_Ln2_Src, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcMeshMapTypeData%Lumped_Points_Src, DstMeshMapTypeData%Lumped_Points_Src, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) then - LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) then - allocate(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv - end if - if (allocated(SrcMeshMapTypeData%DisplacedPosition)) then - LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) - UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%DisplacedPosition)) then - allocate(DstMeshMapTypeData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%DisplacedPosition.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition - end if - if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat)) then - allocate(DstMeshMapTypeData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat - end if - if (allocated(SrcMeshMapTypeData%LoadLn2_F)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%LoadLn2_F)) then - allocate(DstMeshMapTypeData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F - end if - if (allocated(SrcMeshMapTypeData%LoadLn2_M)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) - if (.not. allocated(DstMeshMapTypeData%LoadLn2_M)) then - allocate(DstMeshMapTypeData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_M.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMeshMapTypeData%LoadLn2_M = SrcMeshMapTypeData%LoadLn2_M - end if - call NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapTypeData%dM, DstMeshMapTypeData%dM, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) - type(MeshMapType), intent(inout) :: MeshMapTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(MeshMapTypeData%MapLoads)) then - LB(1:1) = lbound(MeshMapTypeData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapLoads, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMapType(MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MeshMapTypeData%MapLoads) - end if - if (allocated(MeshMapTypeData%MapMotions)) then - LB(1:1) = lbound(MeshMapTypeData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapMotions, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMapType(MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MeshMapTypeData%MapMotions) - end if - if (allocated(MeshMapTypeData%MapSrcToAugmt)) then - LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyMapType(MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MeshMapTypeData%MapSrcToAugmt) - end if - call MeshDestroy( MeshMapTypeData%Augmented_Ln2_Src, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MeshMapTypeData%LoadLn2_A_Mat_Piv)) then - deallocate(MeshMapTypeData%LoadLn2_A_Mat_Piv) - end if - if (allocated(MeshMapTypeData%DisplacedPosition)) then - deallocate(MeshMapTypeData%DisplacedPosition) - end if - if (allocated(MeshMapTypeData%LoadLn2_A_Mat)) then - deallocate(MeshMapTypeData%LoadLn2_A_Mat) - end if - if (allocated(MeshMapTypeData%LoadLn2_F)) then - deallocate(MeshMapTypeData%LoadLn2_F) - end if - if (allocated(MeshMapTypeData%LoadLn2_M)) then - deallocate(MeshMapTypeData%LoadLn2_M) - end if - call NWTC_Library_DestroyMeshMapLinearizationType(MeshMapTypeData%dM, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine NWTC_Library_PackMeshMapType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(MeshMapType), intent(in) :: InData - character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%MapLoads)) - if (allocated(InData%MapLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%MapLoads, kind=B8Ki), ubound(InData%MapLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(InData%MapLoads, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMapType(Buf, InData%MapLoads(i1)) - end do - end if - call RegPack(Buf, allocated(InData%MapMotions)) - if (allocated(InData%MapMotions)) then - call RegPackBounds(Buf, 1, lbound(InData%MapMotions, kind=B8Ki), ubound(InData%MapMotions, kind=B8Ki)) - LB(1:1) = lbound(InData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(InData%MapMotions, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMapType(Buf, InData%MapMotions(i1)) - end do - end if - call RegPack(Buf, allocated(InData%MapSrcToAugmt)) - if (allocated(InData%MapSrcToAugmt)) then - call RegPackBounds(Buf, 1, lbound(InData%MapSrcToAugmt, kind=B8Ki), ubound(InData%MapSrcToAugmt, kind=B8Ki)) - LB(1:1) = lbound(InData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(InData%MapSrcToAugmt, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackMapType(Buf, InData%MapSrcToAugmt(i1)) - end do - end if - call MeshPack(Buf, InData%Augmented_Ln2_Src) - call MeshPack(Buf, InData%Lumped_Points_Src) - call RegPack(Buf, allocated(InData%LoadLn2_A_Mat_Piv)) - if (allocated(InData%LoadLn2_A_Mat_Piv)) then - call RegPackBounds(Buf, 1, lbound(InData%LoadLn2_A_Mat_Piv, kind=B8Ki), ubound(InData%LoadLn2_A_Mat_Piv, kind=B8Ki)) - call RegPack(Buf, InData%LoadLn2_A_Mat_Piv) - end if - call RegPack(Buf, allocated(InData%DisplacedPosition)) - if (allocated(InData%DisplacedPosition)) then - call RegPackBounds(Buf, 3, lbound(InData%DisplacedPosition, kind=B8Ki), ubound(InData%DisplacedPosition, kind=B8Ki)) - call RegPack(Buf, InData%DisplacedPosition) - end if - call RegPack(Buf, allocated(InData%LoadLn2_A_Mat)) - if (allocated(InData%LoadLn2_A_Mat)) then - call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_A_Mat, kind=B8Ki), ubound(InData%LoadLn2_A_Mat, kind=B8Ki)) - call RegPack(Buf, InData%LoadLn2_A_Mat) - end if - call RegPack(Buf, allocated(InData%LoadLn2_F)) - if (allocated(InData%LoadLn2_F)) then - call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_F, kind=B8Ki), ubound(InData%LoadLn2_F, kind=B8Ki)) - call RegPack(Buf, InData%LoadLn2_F) - end if - call RegPack(Buf, allocated(InData%LoadLn2_M)) - if (allocated(InData%LoadLn2_M)) then - call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_M, kind=B8Ki), ubound(InData%LoadLn2_M, kind=B8Ki)) - call RegPack(Buf, InData%LoadLn2_M) - end if - call NWTC_Library_PackMeshMapLinearizationType(Buf, InData%dM) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(MeshMapType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%MapLoads)) deallocate(OutData%MapLoads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MapLoads(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMapType(Buf, OutData%MapLoads(i1)) ! MapLoads - end do - end if - if (allocated(OutData%MapMotions)) deallocate(OutData%MapMotions) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MapMotions(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMapType(Buf, OutData%MapMotions(i1)) ! MapMotions - end do - end if - if (allocated(OutData%MapSrcToAugmt)) deallocate(OutData%MapSrcToAugmt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MapSrcToAugmt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMapType(Buf, OutData%MapSrcToAugmt(i1)) ! MapSrcToAugmt - end do - end if - call MeshUnpack(Buf, OutData%Augmented_Ln2_Src) ! Augmented_Ln2_Src - call MeshUnpack(Buf, OutData%Lumped_Points_Src) ! Lumped_Points_Src - if (allocated(OutData%LoadLn2_A_Mat_Piv)) deallocate(OutData%LoadLn2_A_Mat_Piv) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LoadLn2_A_Mat_Piv(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LoadLn2_A_Mat_Piv) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DisplacedPosition)) deallocate(OutData%DisplacedPosition) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DisplacedPosition) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LoadLn2_A_Mat)) deallocate(OutData%LoadLn2_A_Mat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LoadLn2_A_Mat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LoadLn2_F)) deallocate(OutData%LoadLn2_F) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LoadLn2_F) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LoadLn2_M)) deallocate(OutData%LoadLn2_M) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LoadLn2_M) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackMeshMapLinearizationType(Buf, OutData%dM) ! dM -end subroutine - -!********************************************************************************************************************************* -!ENDOFREGISTRYGENERATEDFILE - +! Include the registry generated subroutines for mesh types +include "NWTC_Library_Subs.f90" !---------------------------------------------------------------------------------------------------------------------------------- END MODULE ModMesh_Mapping diff --git a/modules/openfast-registry/src/main.cpp b/modules/openfast-registry/src/main.cpp index a38844b0bf..445fcc4700 100644 --- a/modules/openfast-registry/src/main.cpp +++ b/modules/openfast-registry/src/main.cpp @@ -13,6 +13,7 @@ Usage: openfast_registry registryfile [options] -or- -h this summary -I

look for usefrom files in directory "dir" -O generate types files in directory "dir" + -inc generate types file to be included in another file -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines -D define symbol for conditional evaluation inside registry file -ccode generate additional code for interfacing with C/C++ @@ -85,6 +86,10 @@ int main(int argc, char *argv[]) reg.include_dirs.push_back(*it); } } + else if ((arg.compare("-subs")) == 0 || (arg.compare("/subs")) == 0) + { + reg.gen_subs = true; + } else if ((arg.compare("-template")) == 0 || (arg.compare("-registry")) == 0 || (arg.compare("/template")) == 0 || (arg.compare("/registry")) == 0) { diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index 5d760e949a..696f411c40 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -188,6 +188,14 @@ struct Field else if (init_value.compare("-") != 0) { this->init_value = init_value; + if (tolower(init_value).compare("f") == 0) + { + this->init_value = ".false."; + } + else if (tolower(init_value).compare("t") == 0) + { + this->init_value = ".true."; + } } } @@ -432,6 +440,7 @@ struct Registry std::map, ci_less> data_types; bool gen_c_code = false; bool no_extrap_interp = false; + bool gen_subs = false; Registry() { @@ -536,6 +545,7 @@ struct Registry void gen_module_files(std::string const &out_dir); void gen_fortran_module(const Module &mod, const std::string &out_dir); void gen_c_module(const Module &mod, const std::string &out_dir); + void gen_fortran_subs(std::ostream &w, const Module &mod); }; #endif diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index d3cd46b45d..41da71c801 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -63,6 +63,10 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) { // Create file name and path auto file_name = mod.name + "_Types.f90"; + if (this->gen_subs) + { + file_name = mod.name + "_Subs.f90"; + } auto file_path = out_dir + "/" + file_name; std::cerr << "generating " << file_name << std::endl; bool is_NWTC_Library = false; @@ -71,10 +75,25 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) std::ofstream w(file_path); if (!w) { - std::cerr << "Error creating module file: '" << file_path << "'" << std::endl; + std::cerr << "Error creating module file: '" << file_path << "'\n"; exit(EXIT_FAILURE); } + // If flag set to generate subroutines only (e.g. for inclusing in ModMesh_Mappings.f90) + // write header, subs, and footer to file, then return + if (this->gen_subs) + { + w << std::regex_replace("!STARTOFREGISTRYGENERATEDFILE 'ModuleName_Subs.f90'\n", std::regex("ModuleName"), mod.name); + w << "!\n! WARNING This file is generated automatically by the FAST registry.\n"; + w << "! Do not edit. Your changes to this file will be lost.\n"; + w << "!\n! FAST Registry'\n"; + + this->gen_fortran_subs(w, mod); + + w << "!ENDOFREGISTRYGENERATEDFILE\n"; + return; + } + // Write preamble w << std::regex_replace(FAST_preamble, std::regex("ModuleName"), mod.name); @@ -274,6 +293,16 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) w << "CONTAINS\n"; + // Generate subroutines for this module + this->gen_fortran_subs(w, mod); + + // Write module footer + w << "END MODULE " << mod.name << "_Types\n"; + w << "!ENDOFREGISTRYGENERATEDFILE\n"; +} + +void Registry::gen_fortran_subs(std::ostream &w, const Module &mod) +{ // Loop through derived data types for (auto &dt_name : mod.ddt_names) { @@ -311,9 +340,6 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) gen_ExtrapInterp(w, mod, "InputType", "DbKi", 1); gen_ExtrapInterp(w, mod, "OutputType", "DbKi", 1); } - - w << "END MODULE " << mod.name << "_Types\n"; - w << "!ENDOFREGISTRYGENERATEDFILE\n"; } void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, From 3913c5ea8c14f5635e2e9342450d8d2f3df5185e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 12 Jan 2024 17:03:53 +0000 Subject: [PATCH 167/232] Use new Pack/Unpack routines for alloc and pointers --- .../src/registry_gen_fortran.cpp | 131 +++++++++++++----- 1 file changed, 100 insertions(+), 31 deletions(-) diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 41da71c801..91c1f393e9 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -398,6 +398,43 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, continue; } + // If allocatable field that is not a derived type, use Fortran 2003 automatic + // allocation to duplicate the source variable + if (field.is_allocatable && field.data_type->tag != DataType::Tag::Derived) + { + // If source is allocated or associated + w << indent << "if (" << alloc_assoc << "(" << src << ")) then"; + indent += " "; + + // Copy values + w << indent << dst << " = " << src; + + // If C code and field isn't a pointer, copy data to C object + if (gen_c_code && !field.is_pointer) + { + if (field.rank == 0) // scalar of any type OR a character array + { + std::string tmp = ddt.name_short + "Data%C_obj%" + field.name; + w << indent << "Dst" << tmp << " = Src" << tmp; + } + } + + // End if dst alloc/assoc + indent.erase(indent.size() - 3); + w << indent << "else if (" << alloc_assoc << "(" << dst << ")) then"; + if (field.is_pointer && !field.is_target) + { + w << indent << " nullify(" << dst << ")"; + } + else + { + w << indent << " deallocate(" << dst << ")"; + } + w << indent << "end if"; + + continue; + } + // If field is allocatable if (field.is_allocatable) { @@ -650,9 +687,9 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); - w << indent << "subroutine " << routine_name << "(Buf, Indata)"; + w << indent << "subroutine " << routine_name << "(RF, Indata)"; indent += " "; - w << indent << "type(PackBuffer), intent(inout) :: Buf"; + w << indent << "type(RegFile), intent(inout) :: RF"; w << indent << "type(" << ddt.type_fortran << "), intent(in) :: InData"; w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) @@ -667,12 +704,12 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "logical :: PtrInIndex"; } - w << indent << "if (Buf%ErrStat >= AbortErrLev) return"; + w << indent << "if (RF%ErrStat >= AbortErrLev) return"; if (gen_c_code) { w << indent << "if (c_associated(InData%C_obj%object)) then"; - w << indent << " call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName)"; + w << indent << " call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName)"; w << indent << " return"; w << indent << "end if"; } @@ -685,19 +722,34 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, // w << indent << "! " << field.name; + // If the field is not derived, is allocatable, is not a pointer, + // use RegPackAlloc function and continue + if (field.data_type->tag != DataType::Tag::Derived && field.is_allocatable) + { + if (field.is_pointer) + { + w << indent << "call RegPackPtr(RF, " << var << ")"; + } + else + { + w << indent << "call RegPackAlloc(RF, " << var << ")"; + } + continue; + } + if (field.is_allocatable) { - w << indent << "call RegPack(Buf, " << assoc_alloc << "(" << var << "))"; + w << indent << "call RegPack(RF, " << assoc_alloc << "(" << var << "))"; w << indent << "if (" << assoc_alloc << "(" << var << ")) then"; indent += " "; if (field.rank > 0) { - w << indent << "call RegPackBounds(Buf, " << field.rank << ", lbound(" << var << ", kind=B8Ki), ubound(" << var << ", kind=B8Ki))"; + w << indent << "call RegPackBounds(RF, " << field.rank << ", lbound(" << var << ", kind=B8Ki), ubound(" << var << ", kind=B8Ki))"; } } if (field.is_pointer) { - w << indent << "call RegPackPointer(Buf, c_loc(" << var << "), PtrInIndex)"; + w << indent << "call RegPackPointer(RF, c_loc(" << var << "), PtrInIndex)"; w << indent << "if (.not. PtrInIndex) then"; indent += " "; } @@ -721,16 +773,16 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, if (field.data_type->derived.name.compare("MeshType") == 0) { - w << indent << "call MeshPack(Buf, " << field_dims << ") "; + w << indent << "call MeshPack(RF, " << field_dims << ") "; } else if (field.data_type->derived.name.compare("DLL_Type") == 0) { - w << indent << "call DLLTypePack(Buf, " << field_dims << ") "; + w << indent << "call DLLTypePack(RF, " << field_dims << ") "; } else { w << indent << "call " << field.data_type->derived.module->nickname << "_Pack" - << field.data_type->derived.name_short << "(Buf, " << field_dims << ") "; + << field.data_type->derived.name_short << "(RF, " << field_dims << ") "; } for (int d = field.rank; d >= 1; d--) @@ -741,8 +793,8 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, } else { - // Intrinsic types are handled by generic Pack method on buffer - w << indent << "call RegPack(Buf, " << var << ")"; + // Intrinsic types are handled by generic registry file Pack method + w << indent << "call RegPack(RF, " << var << ")"; } if (field.is_pointer) @@ -759,7 +811,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, } // Check for pack errors at end of routine - w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "if (RegCheckErr(RF, RoutineName)) return"; indent.erase(indent.size() - 3); w << indent << "end subroutine"; @@ -778,9 +830,9 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); - w << indent << "subroutine " << routine_name << "(Buf, OutData)"; + w << indent << "subroutine " << routine_name << "(RF, OutData)"; indent += " "; - w << indent << "type(PackBuffer), intent(inout) :: Buf"; + w << indent << "type(RegFile), intent(inout) :: RF"; w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: OutData"; w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) @@ -804,7 +856,7 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt w << indent << "integer(B8Ki) :: PtrIdx"; w << indent << "type(c_ptr) :: Ptr"; } - w << indent << "if (Buf%ErrStat /= ErrID_None) return"; + w << indent << "if (RF%ErrStat /= ErrID_None) return"; // BJJ: TODO: if there are C types, we're going to have to associate with C data structures.... @@ -819,24 +871,41 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt // w << indent << "! " << field.name << ""; + // If the field is not derived, is allocatable, is not a pointer, + // use RegUnpackAlloc function and continue + if (field.data_type->tag != DataType::Tag::Derived && field.is_allocatable) + { + if (field.is_pointer) + { + w << indent << "call RegUnpackPtr(RF, " << var << ")" + << "; if (RegCheckErr(RF, RoutineName)) return"; + } + else + { + w << indent << "call RegUnpackAlloc(RF, " << var << ")" + << "; if (RegCheckErr(RF, RoutineName)) return"; + } + continue; + } + if (field.is_allocatable) { w << indent << "if (" << assoc_alloc << "(" << var << ")) deallocate(" << var << ")"; - w << indent << "call RegUnpack(Buf, IsAllocAssoc)"; - w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "call RegUnpack(RF, IsAllocAssoc)" + << "; if (RegCheckErr(RF, RoutineName)) return"; w << indent << "if (IsAllocAssoc) then"; indent += " "; if (field.rank > 0) { - w << indent << "call RegUnpackBounds(Buf, " << field.rank << ", LB, UB)"; - w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "call RegUnpackBounds(RF, " << field.rank << ", LB, UB)" + << "; if (RegCheckErr(RF, RoutineName)) return"; } } if (field.is_pointer) { - w << indent << "call RegUnpackPointer(Buf, Ptr, PtrIdx)"; - w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "call RegUnpackPointer(RF, Ptr, PtrIdx)" + << "; if (RegCheckErr(RF, RoutineName)) return"; w << indent << "if (c_associated(Ptr)) then"; if (field.rank == 0) { @@ -863,15 +932,15 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt ":UB(" + std::to_string(d) + ")" + (d < field.rank ? "," : ")"); w << indent << "allocate(" << var << dims << ",stat=stat)"; w << indent << "if (stat /= 0) then "; - w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << var << ".', Buf%ErrStat, Buf%ErrMsg, RoutineName)"; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << var << ".', RF%ErrStat, RF%ErrMsg, RoutineName)"; w << indent << " return"; w << indent << "end if"; } - // If this is a pointer, set pointer in buffer pointer index + // If this is a pointer, set pointer in registry file pointer index if (field.is_pointer) { - w << indent << "Buf%Pointers(PtrIdx) = c_loc(" << var << ")"; + w << indent << "RF%Pointers(PtrIdx) = c_loc(" << var << ")"; } // bjj: this needs to be updated if we've got multiple dimension arrays @@ -903,16 +972,16 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt if (field.data_type->derived.name.compare("MeshType") == 0) { - w << indent << "call MeshUnpack(Buf, " << var_dims << ") ! " << field.name << " "; + w << indent << "call MeshUnpack(RF, " << var_dims << ") ! " << field.name << " "; } else if (field.data_type->derived.name.compare("DLL_Type") == 0) { - w << indent << "call DLLTypeUnpack(Buf, " << var_dims << ") ! " << field.name << " "; + w << indent << "call DLLTypeUnpack(RF, " << var_dims << ") ! " << field.name << " "; } else { w << indent << "call " << field.data_type->derived.module->nickname << "_Unpack" - << field.data_type->derived.name_short << "(Buf, " << var_dims << ") ! " << field.name << " "; + << field.data_type->derived.name_short << "(RF, " << var_dims << ") ! " << field.name << " "; } for (int d = field.rank; d >= 1; d--) @@ -923,9 +992,9 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } else { - // Intrinsic types are handled by generic unpack method on buffer - w << indent << "call RegUnpack(Buf, " << var << ")"; - w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + // Intrinsic types are handled by generic registry file unpack method + w << indent << "call RegUnpack(RF, " << var << ")" + << "; if (RegCheckErr(RF, RoutineName)) return"; // need to move scalars and strings to the %c_obj% type, too! // compare with copy routine From 63fefa02421962e94bd917c5b9656df1f02d0564 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 12 Jan 2024 18:58:31 +0000 Subject: [PATCH 168/232] Update all types files --- .../fast-farm/src/FASTWrapper_Types.f90 | 40 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 32 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 2978 ++----- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 985 +-- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 788 +- modules/aerodyn/src/AeroDyn_Types.f90 | 3792 +++----- modules/aerodyn/src/AirfoilInfo_Types.f90 | 867 +- modules/aerodyn/src/BEMT_Types.f90 | 1811 +--- modules/aerodyn/src/DBEMT_Types.f90 | 428 +- modules/aerodyn/src/FVW_Types.f90 | 2787 ++---- modules/aerodyn/src/UnsteadyAero_Types.f90 | 1953 +---- modules/aerodyn14/src/AeroDyn14_Types.f90 | 3771 ++------ modules/aerodyn14/src/DWM_Types.f90 | 2195 ++--- modules/awae/src/AWAE_Types.f90 | 1962 +---- modules/beamdyn/src/BeamDyn_Types.f90 | 3210 ++----- modules/elastodyn/src/ElastoDyn_Types.f90 | 7680 ++++------------- .../src/ExternalInflow_Types.f90 | 1212 +-- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 1246 +-- modules/feamooring/src/FEAMooring_Types.f90 | 1930 +---- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 385 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 1379 +-- modules/hydrodyn/src/Morison_Types.f90 | 3543 ++------ modules/hydrodyn/src/SS_Excitation_Types.f90 | 475 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 441 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 345 +- modules/hydrodyn/src/WAMIT_Types.f90 | 731 +- modules/icedyn/src/IceDyn_Types.f90 | 1201 +-- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 424 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 991 +-- .../inflowwind/src/InflowWind_IO_Types.f90 | 515 +- modules/inflowwind/src/InflowWind_Types.f90 | 1117 +-- modules/inflowwind/src/Lidar_Types.f90 | 514 +- modules/map/src/MAP_Fortran_Types.f90 | 141 +- modules/map/src/MAP_Types.f90 | 1344 +-- modules/moordyn/src/MoorDyn_Types.f90 | 4004 ++------- modules/nwtc-library/CMakeLists.txt | 1 + modules/nwtc-library/src/ModVar.f90 | 984 +++ modules/nwtc-library/src/NWTC_IO.f90 | 34 +- modules/nwtc-library/src/NWTC_Library.f90 | 1 + .../nwtc-library/src/NWTC_Library_Subs.f90 | 577 ++ .../nwtc-library/src/NWTC_Library_Types.f90 | 1253 ++- .../src/Registry_NWTC_Library.txt | 102 +- .../src/Registry_NWTC_Library_base.txt | 84 + modules/openfast-library/src/FAST_Subs.f90 | 48 +- modules/openfast-library/src/FAST_Types.f90 | 6050 +++++-------- .../src/registry_gen_fortran.cpp | 37 - .../src/OrcaFlexInterface_Types.f90 | 370 +- modules/seastate/src/Current_Types.f90 | 161 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 438 +- .../seastate/src/SeaState_Interp_Types.f90 | 125 +- modules/seastate/src/SeaState_Types.f90 | 906 +- modules/seastate/src/Waves2_Types.f90 | 247 +- modules/seastate/src/Waves_Types.f90 | 282 +- modules/servodyn/src/ServoDyn_Types.f90 | 4844 +++-------- modules/servodyn/src/StrucCtrl_Types.f90 | 1695 +--- modules/subdyn/src/SubDyn_Types.f90 | 3735 ++------ .../supercontroller/src/SCDataEx_Types.f90 | 212 +- .../src/SuperController_Types.f90 | 556 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 1736 +--- 59 files changed, 22514 insertions(+), 59181 deletions(-) create mode 100644 modules/nwtc-library/src/ModVar.f90 create mode 100644 modules/nwtc-library/src/NWTC_Library_Subs.f90 diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 4b56e2cc0d..2473bcccd4 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -203,7 +203,7 @@ subroutine FWrap_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackInitInput' logical :: PtrInIndex @@ -251,7 +251,7 @@ subroutine FWrap_PackInitInput(Buf, Indata) end subroutine subroutine FWrap_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' integer(B8Ki) :: LB(5), UB(5) @@ -387,7 +387,7 @@ subroutine FWrap_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return @@ -397,7 +397,7 @@ subroutine FWrap_PackInitOutput(Buf, Indata) end subroutine subroutine FWrap_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return @@ -428,7 +428,7 @@ subroutine FWrap_DestroyContState(ContStateData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackContState' if (Buf%ErrStat >= AbortErrLev) return @@ -437,7 +437,7 @@ subroutine FWrap_PackContState(Buf, Indata) end subroutine subroutine FWrap_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackContState' if (Buf%ErrStat /= ErrID_None) return @@ -467,7 +467,7 @@ subroutine FWrap_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return @@ -476,7 +476,7 @@ subroutine FWrap_PackDiscState(Buf, Indata) end subroutine subroutine FWrap_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return @@ -506,7 +506,7 @@ subroutine FWrap_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return @@ -515,7 +515,7 @@ subroutine FWrap_PackConstrState(Buf, Indata) end subroutine subroutine FWrap_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return @@ -545,7 +545,7 @@ subroutine FWrap_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return @@ -554,7 +554,7 @@ subroutine FWrap_PackOtherState(Buf, Indata) end subroutine subroutine FWrap_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return @@ -696,7 +696,7 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackMisc' integer(B8Ki) :: i1 @@ -743,7 +743,7 @@ subroutine FWrap_PackMisc(Buf, Indata) end subroutine subroutine FWrap_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' integer(B8Ki) :: i1 @@ -855,7 +855,7 @@ subroutine FWrap_DestroyParam(ParamData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackParam' if (Buf%ErrStat >= AbortErrLev) return @@ -871,7 +871,7 @@ subroutine FWrap_PackParam(Buf, Indata) end subroutine subroutine FWrap_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackParam' integer(B8Ki) :: LB(1), UB(1) @@ -953,7 +953,7 @@ subroutine FWrap_DestroyInput(InputData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackInput' if (Buf%ErrStat >= AbortErrLev) return @@ -971,7 +971,7 @@ subroutine FWrap_PackInput(Buf, Indata) end subroutine subroutine FWrap_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInput' integer(B8Ki) :: LB(1), UB(1) @@ -1083,7 +1083,7 @@ subroutine FWrap_DestroyOutput(OutputData, ErrStat, ErrMsg) end subroutine subroutine FWrap_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackOutput' if (Buf%ErrStat >= AbortErrLev) return @@ -1113,7 +1113,7 @@ subroutine FWrap_PackOutput(Buf, Indata) end subroutine subroutine FWrap_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FWrap_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index c7bdc1d425..57ec7c003b 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -406,7 +406,7 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(Farm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackParam' integer(B8Ki) :: i1, i2 @@ -508,7 +508,7 @@ subroutine Farm_PackParam(Buf, Indata) end subroutine subroutine Farm_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(Farm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackParam' integer(B8Ki) :: i1, i2 @@ -847,7 +847,7 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(Farm_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMisc' integer(B8Ki) :: i1, i2 @@ -891,7 +891,7 @@ subroutine Farm_PackMisc(Buf, Indata) end subroutine subroutine Farm_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(Farm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMisc' integer(B8Ki) :: i1, i2 @@ -1041,7 +1041,7 @@ subroutine Farm_DestroyFASTWrapper_Data(FASTWrapper_DataData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackFASTWrapper_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FASTWrapper_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackFASTWrapper_Data' if (Buf%ErrStat >= AbortErrLev) return @@ -1058,7 +1058,7 @@ subroutine Farm_PackFASTWrapper_Data(Buf, Indata) end subroutine subroutine Farm_UnPackFASTWrapper_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(FASTWrapper_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackFASTWrapper_Data' if (Buf%ErrStat /= ErrID_None) return @@ -1140,7 +1140,7 @@ subroutine Farm_DestroyWakeDynamics_Data(WakeDynamics_DataData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackWakeDynamics_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(WakeDynamics_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackWakeDynamics_Data' if (Buf%ErrStat >= AbortErrLev) return @@ -1157,7 +1157,7 @@ subroutine Farm_PackWakeDynamics_Data(Buf, Indata) end subroutine subroutine Farm_UnPackWakeDynamics_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(WakeDynamics_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackWakeDynamics_Data' if (Buf%ErrStat /= ErrID_None) return @@ -1239,7 +1239,7 @@ subroutine Farm_DestroyAWAE_Data(AWAE_DataData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackAWAE_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(AWAE_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackAWAE_Data' if (Buf%ErrStat >= AbortErrLev) return @@ -1256,7 +1256,7 @@ subroutine Farm_PackAWAE_Data(Buf, Indata) end subroutine subroutine Farm_UnPackAWAE_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(AWAE_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackAWAE_Data' if (Buf%ErrStat /= ErrID_None) return @@ -1339,7 +1339,7 @@ subroutine Farm_DestroySC_Data(SC_DataData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackSC_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(SC_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackSC_Data' if (Buf%ErrStat >= AbortErrLev) return @@ -1357,7 +1357,7 @@ subroutine Farm_PackSC_Data(Buf, Indata) end subroutine subroutine Farm_UnPackSC_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(SC_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackSC_Data' if (Buf%ErrStat /= ErrID_None) return @@ -1485,7 +1485,7 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackMD_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(MD_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMD_Data' integer(B8Ki) :: i1 @@ -1518,7 +1518,7 @@ subroutine Farm_PackMD_Data(Buf, Indata) end subroutine subroutine Farm_UnPackMD_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(MD_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' integer(B8Ki) :: i1 @@ -1671,7 +1671,7 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) end subroutine subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(All_FastFarm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' integer(B8Ki) :: i1 @@ -1704,7 +1704,7 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) end subroutine subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + type(RegFile), intent(inout) :: Buf type(All_FastFarm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' integer(B8Ki) :: i1 diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 991e744710..5829bb13f3 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -301,25 +301,23 @@ subroutine AA_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AA_PackBladePropsType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackBladePropsType(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_BladePropsType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackBladePropsType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%TEThick) - call RegPack(Buf, InData%TEAngle) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TEThick) + call RegPack(RF, InData%TEAngle) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackBladePropsType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackBladePropsType(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_BladePropsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackBladePropsType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%TEThick) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEAngle) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TEThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEAngle); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -428,128 +426,67 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%NumBlades) - call RegPack(Buf, InData%NumBlNds) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%BlSpn)) - if (allocated(InData%BlSpn)) then - call RegPackBounds(Buf, 2, lbound(InData%BlSpn, kind=B8Ki), ubound(InData%BlSpn, kind=B8Ki)) - call RegPack(Buf, InData%BlSpn) - end if - call RegPack(Buf, allocated(InData%BlChord)) - if (allocated(InData%BlChord)) then - call RegPackBounds(Buf, 2, lbound(InData%BlChord, kind=B8Ki), ubound(InData%BlChord, kind=B8Ki)) - call RegPack(Buf, InData%BlChord) - end if - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%HubHeight) - call RegPack(Buf, allocated(InData%BlAFID)) - if (allocated(InData%BlAFID)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAFID, kind=B8Ki), ubound(InData%BlAFID, kind=B8Ki)) - call RegPack(Buf, InData%BlAFID) - end if - call RegPack(Buf, allocated(InData%AFInfo)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%RootName) + call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlChord) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%HubHeight) + call RegPackAlloc(RF, InData%BlAFID) + call RegPack(RF, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(Buf, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) do i1 = LB(1), UB(1) - call AFI_PackParam(Buf, InData%AFInfo(i1)) + call AFI_PackParam(RF, InData%AFInfo(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlSpn(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlSpn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlChord(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlChord) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubHeight) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlAFID(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlAFID) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo + call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo end do end if end subroutine @@ -706,182 +643,44 @@ subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AA_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call RegPack(Buf, allocated(InData%WriteOutputHdrforPE)) - if (allocated(InData%WriteOutputHdrforPE)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE, kind=B8Ki), ubound(InData%WriteOutputHdrforPE, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdrforPE) - end if - call RegPack(Buf, allocated(InData%WriteOutputUntforPE)) - if (allocated(InData%WriteOutputUntforPE)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE, kind=B8Ki), ubound(InData%WriteOutputUntforPE, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUntforPE) - end if - call RegPack(Buf, allocated(InData%WriteOutputHdrSep)) - if (allocated(InData%WriteOutputHdrSep)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep, kind=B8Ki), ubound(InData%WriteOutputHdrSep, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdrSep) - end if - call RegPack(Buf, allocated(InData%WriteOutputUntSep)) - if (allocated(InData%WriteOutputUntSep)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep, kind=B8Ki), ubound(InData%WriteOutputUntSep, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUntSep) - end if - call RegPack(Buf, allocated(InData%WriteOutputHdrNodes)) - if (allocated(InData%WriteOutputHdrNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes, kind=B8Ki), ubound(InData%WriteOutputHdrNodes, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdrNodes) - end if - call RegPack(Buf, allocated(InData%WriteOutputUntNodes)) - if (allocated(InData%WriteOutputUntNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes, kind=B8Ki), ubound(InData%WriteOutputUntNodes, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUntNodes) - end if - call RegPack(Buf, InData%delim) - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%WriteOutputHdrforPE) + call RegPackAlloc(RF, InData%WriteOutputUntforPE) + call RegPackAlloc(RF, InData%WriteOutputHdrSep) + call RegPackAlloc(RF, InData%WriteOutputUntSep) + call RegPackAlloc(RF, InData%WriteOutputHdrNodes) + call RegPackAlloc(RF, InData%WriteOutputUntNodes) + call RegPack(RF, InData%delim) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%AirDens) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputHdrforPE)) deallocate(OutData%WriteOutputHdrforPE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdrforPE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdrforPE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUntforPE)) deallocate(OutData%WriteOutputUntforPE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUntforPE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUntforPE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputHdrSep)) deallocate(OutData%WriteOutputHdrSep) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdrSep(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdrSep) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUntSep)) deallocate(OutData%WriteOutputUntSep) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUntSep(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUntSep) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputHdrNodes)) deallocate(OutData%WriteOutputHdrNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdrNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdrNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUntNodes)) deallocate(OutData%WriteOutputUntNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUntNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUntNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%delim) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdrforPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUntforPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdrSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUntSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUntNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -1185,403 +984,123 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInputFile' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT_AA) - call RegPack(Buf, InData%IBLUNT) - call RegPack(Buf, InData%ILAM) - call RegPack(Buf, InData%ITIP) - call RegPack(Buf, InData%ITRIP) - call RegPack(Buf, InData%ITURB) - call RegPack(Buf, InData%IInflow) - call RegPack(Buf, InData%X_BLMethod) - call RegPack(Buf, InData%TICalcMeth) - call RegPack(Buf, InData%NReListBL) - call RegPack(Buf, InData%aweightflag) - call RegPack(Buf, InData%ROUND) - call RegPack(Buf, InData%ALPRAT) - call RegPack(Buf, InData%AA_Bl_Prcntge) - call RegPack(Buf, InData%NrObsLoc) - call RegPack(Buf, allocated(InData%ObsX)) - if (allocated(InData%ObsX)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsX, kind=B8Ki), ubound(InData%ObsX, kind=B8Ki)) - call RegPack(Buf, InData%ObsX) - end if - call RegPack(Buf, allocated(InData%ObsY)) - if (allocated(InData%ObsY)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsY, kind=B8Ki), ubound(InData%ObsY, kind=B8Ki)) - call RegPack(Buf, InData%ObsY) - end if - call RegPack(Buf, allocated(InData%ObsZ)) - if (allocated(InData%ObsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsZ, kind=B8Ki), ubound(InData%ObsZ, kind=B8Ki)) - call RegPack(Buf, InData%ObsZ) - end if - call RegPack(Buf, allocated(InData%BladeProps)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT_AA) + call RegPack(RF, InData%IBLUNT) + call RegPack(RF, InData%ILAM) + call RegPack(RF, InData%ITIP) + call RegPack(RF, InData%ITRIP) + call RegPack(RF, InData%ITURB) + call RegPack(RF, InData%IInflow) + call RegPack(RF, InData%X_BLMethod) + call RegPack(RF, InData%TICalcMeth) + call RegPack(RF, InData%NReListBL) + call RegPack(RF, InData%aweightflag) + call RegPack(RF, InData%ROUND) + call RegPack(RF, InData%ALPRAT) + call RegPack(RF, InData%AA_Bl_Prcntge) + call RegPack(RF, InData%NrObsLoc) + call RegPackAlloc(RF, InData%ObsX) + call RegPackAlloc(RF, InData%ObsY) + call RegPackAlloc(RF, InData%ObsZ) + call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) - call AA_PackBladePropsType(Buf, InData%BladeProps(i1)) + call AA_PackBladePropsType(RF, InData%BladeProps(i1)) end do end if - call RegPack(Buf, InData%NrOutFile) - call RegPack(Buf, allocated(InData%AAoutfile)) - if (allocated(InData%AAoutfile)) then - call RegPackBounds(Buf, 1, lbound(InData%AAoutfile, kind=B8Ki), ubound(InData%AAoutfile, kind=B8Ki)) - call RegPack(Buf, InData%AAoutfile) - end if - call RegPack(Buf, InData%TICalcTabFile) - call RegPack(Buf, InData%FTitle) - call RegPack(Buf, InData%AAStart) - call RegPack(Buf, InData%Lturb) - call RegPack(Buf, InData%AvgV) - call RegPack(Buf, allocated(InData%ReListBL)) - if (allocated(InData%ReListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%ReListBL, kind=B8Ki), ubound(InData%ReListBL, kind=B8Ki)) - call RegPack(Buf, InData%ReListBL) - end if - call RegPack(Buf, allocated(InData%AoAListBL)) - if (allocated(InData%AoAListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%AoAListBL, kind=B8Ki), ubound(InData%AoAListBL, kind=B8Ki)) - call RegPack(Buf, InData%AoAListBL) - end if - call RegPack(Buf, allocated(InData%Pres_DispThick)) - if (allocated(InData%Pres_DispThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick, kind=B8Ki), ubound(InData%Pres_DispThick, kind=B8Ki)) - call RegPack(Buf, InData%Pres_DispThick) - end if - call RegPack(Buf, allocated(InData%Suct_DispThick)) - if (allocated(InData%Suct_DispThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick, kind=B8Ki), ubound(InData%Suct_DispThick, kind=B8Ki)) - call RegPack(Buf, InData%Suct_DispThick) - end if - call RegPack(Buf, allocated(InData%Pres_BLThick)) - if (allocated(InData%Pres_BLThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick, kind=B8Ki), ubound(InData%Pres_BLThick, kind=B8Ki)) - call RegPack(Buf, InData%Pres_BLThick) - end if - call RegPack(Buf, allocated(InData%Suct_BLThick)) - if (allocated(InData%Suct_BLThick)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick, kind=B8Ki), ubound(InData%Suct_BLThick, kind=B8Ki)) - call RegPack(Buf, InData%Suct_BLThick) - end if - call RegPack(Buf, allocated(InData%Pres_Cf)) - if (allocated(InData%Pres_Cf)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf, kind=B8Ki), ubound(InData%Pres_Cf, kind=B8Ki)) - call RegPack(Buf, InData%Pres_Cf) - end if - call RegPack(Buf, allocated(InData%Suct_Cf)) - if (allocated(InData%Suct_Cf)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf, kind=B8Ki), ubound(InData%Suct_Cf, kind=B8Ki)) - call RegPack(Buf, InData%Suct_Cf) - end if - call RegPack(Buf, allocated(InData%Pres_EdgeVelRat)) - if (allocated(InData%Pres_EdgeVelRat)) then - call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat, kind=B8Ki), ubound(InData%Pres_EdgeVelRat, kind=B8Ki)) - call RegPack(Buf, InData%Pres_EdgeVelRat) - end if - call RegPack(Buf, allocated(InData%Suct_EdgeVelRat)) - if (allocated(InData%Suct_EdgeVelRat)) then - call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat, kind=B8Ki), ubound(InData%Suct_EdgeVelRat, kind=B8Ki)) - call RegPack(Buf, InData%Suct_EdgeVelRat) - end if - call RegPack(Buf, allocated(InData%TI_Grid_In)) - if (allocated(InData%TI_Grid_In)) then - call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In, kind=B8Ki), ubound(InData%TI_Grid_In, kind=B8Ki)) - call RegPack(Buf, InData%TI_Grid_In) - end if - call RegPack(Buf, InData%dz_turb_in) - call RegPack(Buf, InData%dy_turb_in) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%NrOutFile) + call RegPackAlloc(RF, InData%AAoutfile) + call RegPack(RF, InData%TICalcTabFile) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%AAStart) + call RegPack(RF, InData%Lturb) + call RegPack(RF, InData%AvgV) + call RegPackAlloc(RF, InData%ReListBL) + call RegPackAlloc(RF, InData%AoAListBL) + call RegPackAlloc(RF, InData%Pres_DispThick) + call RegPackAlloc(RF, InData%Suct_DispThick) + call RegPackAlloc(RF, InData%Pres_BLThick) + call RegPackAlloc(RF, InData%Suct_BLThick) + call RegPackAlloc(RF, InData%Pres_Cf) + call RegPackAlloc(RF, InData%Suct_Cf) + call RegPackAlloc(RF, InData%Pres_EdgeVelRat) + call RegPackAlloc(RF, InData%Suct_EdgeVelRat) + call RegPackAlloc(RF, InData%TI_Grid_In) + call RegPack(RF, InData%dz_turb_in) + call RegPack(RF, InData%dy_turb_in) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInputFile' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT_AA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IBLUNT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ILAM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ITIP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ITRIP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ITURB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IInflow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X_BLMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TICalcMeth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NReListBL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%aweightflag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ROUND) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ALPRAT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AA_Bl_Prcntge) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NrObsLoc) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ObsX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ObsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ObsY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ObsY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ObsZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ObsZ) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT_AA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IBLUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ILAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITRIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITURB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_BLMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TICalcMeth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NReListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aweightflag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ROUND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ALPRAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsZ); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AA_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + call AA_UnpackBladePropsType(RF, OutData%BladeProps(i1)) ! BladeProps end do end if - call RegUnpack(Buf, OutData%NrOutFile) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AAoutfile)) deallocate(OutData%AAoutfile) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AAoutfile(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AAoutfile) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TICalcTabFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AAStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Lturb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgV) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ReListBL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ReListBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AoAListBL)) deallocate(OutData%AoAListBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AoAListBL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AoAListBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pres_DispThick)) deallocate(OutData%Pres_DispThick) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_DispThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pres_DispThick) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Suct_DispThick)) deallocate(OutData%Suct_DispThick) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_DispThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Suct_DispThick) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pres_BLThick)) deallocate(OutData%Pres_BLThick) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_BLThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pres_BLThick) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Suct_BLThick)) deallocate(OutData%Suct_BLThick) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_BLThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Suct_BLThick) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pres_Cf)) deallocate(OutData%Pres_Cf) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_Cf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pres_Cf) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Suct_Cf)) deallocate(OutData%Suct_Cf) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_Cf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Suct_Cf) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pres_EdgeVelRat)) deallocate(OutData%Pres_EdgeVelRat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_EdgeVelRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pres_EdgeVelRat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Suct_EdgeVelRat)) deallocate(OutData%Suct_EdgeVelRat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_EdgeVelRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Suct_EdgeVelRat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI_Grid_In) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%dz_turb_in) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dy_turb_in) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AAoutfile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TICalcTabFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AoAListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_DispThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_DispThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_BLThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_BLThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_Cf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_Cf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pres_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Suct_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_Grid_In); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dz_turb_in); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dy_turb_in); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1605,22 +1124,21 @@ subroutine AA_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AA_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -1810,231 +1328,44 @@ subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%MeanVrel)) - if (allocated(InData%MeanVrel)) then - call RegPackBounds(Buf, 2, lbound(InData%MeanVrel, kind=B8Ki), ubound(InData%MeanVrel, kind=B8Ki)) - call RegPack(Buf, InData%MeanVrel) - end if - call RegPack(Buf, allocated(InData%VrelSq)) - if (allocated(InData%VrelSq)) then - call RegPackBounds(Buf, 2, lbound(InData%VrelSq, kind=B8Ki), ubound(InData%VrelSq, kind=B8Ki)) - call RegPack(Buf, InData%VrelSq) - end if - call RegPack(Buf, allocated(InData%TIVrel)) - if (allocated(InData%TIVrel)) then - call RegPackBounds(Buf, 2, lbound(InData%TIVrel, kind=B8Ki), ubound(InData%TIVrel, kind=B8Ki)) - call RegPack(Buf, InData%TIVrel) - end if - call RegPack(Buf, allocated(InData%VrelStore)) - if (allocated(InData%VrelStore)) then - call RegPackBounds(Buf, 3, lbound(InData%VrelStore, kind=B8Ki), ubound(InData%VrelStore, kind=B8Ki)) - call RegPack(Buf, InData%VrelStore) - end if - call RegPack(Buf, allocated(InData%TIVx)) - if (allocated(InData%TIVx)) then - call RegPackBounds(Buf, 2, lbound(InData%TIVx, kind=B8Ki), ubound(InData%TIVx, kind=B8Ki)) - call RegPack(Buf, InData%TIVx) - end if - call RegPack(Buf, allocated(InData%MeanVxVyVz)) - if (allocated(InData%MeanVxVyVz)) then - call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz, kind=B8Ki), ubound(InData%MeanVxVyVz, kind=B8Ki)) - call RegPack(Buf, InData%MeanVxVyVz) - end if - call RegPack(Buf, allocated(InData%VxSq)) - if (allocated(InData%VxSq)) then - call RegPackBounds(Buf, 2, lbound(InData%VxSq, kind=B8Ki), ubound(InData%VxSq, kind=B8Ki)) - call RegPack(Buf, InData%VxSq) - end if - call RegPack(Buf, allocated(InData%allregcounter)) - if (allocated(InData%allregcounter)) then - call RegPackBounds(Buf, 2, lbound(InData%allregcounter, kind=B8Ki), ubound(InData%allregcounter, kind=B8Ki)) - call RegPack(Buf, InData%allregcounter) - end if - call RegPack(Buf, allocated(InData%VxSqRegion)) - if (allocated(InData%VxSqRegion)) then - call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion, kind=B8Ki), ubound(InData%VxSqRegion, kind=B8Ki)) - call RegPack(Buf, InData%VxSqRegion) - end if - call RegPack(Buf, allocated(InData%RegVxStor)) - if (allocated(InData%RegVxStor)) then - call RegPackBounds(Buf, 3, lbound(InData%RegVxStor, kind=B8Ki), ubound(InData%RegVxStor, kind=B8Ki)) - call RegPack(Buf, InData%RegVxStor) - end if - call RegPack(Buf, allocated(InData%RegionTIDelete)) - if (allocated(InData%RegionTIDelete)) then - call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete, kind=B8Ki), ubound(InData%RegionTIDelete, kind=B8Ki)) - call RegPack(Buf, InData%RegionTIDelete) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%MeanVrel) + call RegPackAlloc(RF, InData%VrelSq) + call RegPackAlloc(RF, InData%TIVrel) + call RegPackAlloc(RF, InData%VrelStore) + call RegPackAlloc(RF, InData%TIVx) + call RegPackAlloc(RF, InData%MeanVxVyVz) + call RegPackAlloc(RF, InData%VxSq) + call RegPackAlloc(RF, InData%allregcounter) + call RegPackAlloc(RF, InData%VxSqRegion) + call RegPackAlloc(RF, InData%RegVxStor) + call RegPackAlloc(RF, InData%RegionTIDelete) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackDiscState' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%MeanVrel)) deallocate(OutData%MeanVrel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MeanVrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MeanVrel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VrelSq)) deallocate(OutData%VrelSq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VrelSq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VrelSq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TIVrel)) deallocate(OutData%TIVrel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TIVrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TIVrel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VrelStore)) deallocate(OutData%VrelStore) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelStore.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VrelStore) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TIVx)) deallocate(OutData%TIVx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TIVx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TIVx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MeanVxVyVz)) deallocate(OutData%MeanVxVyVz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MeanVxVyVz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VxSq)) deallocate(OutData%VxSq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VxSq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VxSq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%allregcounter)) deallocate(OutData%allregcounter) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%allregcounter(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%allregcounter) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VxSqRegion)) deallocate(OutData%VxSqRegion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VxSqRegion) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RegVxStor)) deallocate(OutData%RegVxStor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegVxStor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RegVxStor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RegionTIDelete)) deallocate(OutData%RegionTIDelete) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RegionTIDelete) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%MeanVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VrelSq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TIVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VrelStore); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TIVx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeanVxVyVz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VxSq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%allregcounter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VxSqRegion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RegVxStor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RegionTIDelete); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -2058,22 +1389,21 @@ subroutine AA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AA_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -2097,22 +1427,21 @@ subroutine AA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AA_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -2455,499 +1784,139 @@ subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - call RegPack(Buf, allocated(InData%ChordAngleTE)) - if (allocated(InData%ChordAngleTE)) then - call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE, kind=B8Ki), ubound(InData%ChordAngleTE, kind=B8Ki)) - call RegPack(Buf, InData%ChordAngleTE) - end if - call RegPack(Buf, allocated(InData%SpanAngleTE)) - if (allocated(InData%SpanAngleTE)) then - call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE, kind=B8Ki), ubound(InData%SpanAngleTE, kind=B8Ki)) - call RegPack(Buf, InData%SpanAngleTE) - end if - call RegPack(Buf, allocated(InData%ChordAngleLE)) - if (allocated(InData%ChordAngleLE)) then - call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE, kind=B8Ki), ubound(InData%ChordAngleLE, kind=B8Ki)) - call RegPack(Buf, InData%ChordAngleLE) - end if - call RegPack(Buf, allocated(InData%SpanAngleLE)) - if (allocated(InData%SpanAngleLE)) then - call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE, kind=B8Ki), ubound(InData%SpanAngleLE, kind=B8Ki)) - call RegPack(Buf, InData%SpanAngleLE) - end if - call RegPack(Buf, allocated(InData%rTEtoObserve)) - if (allocated(InData%rTEtoObserve)) then - call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve, kind=B8Ki), ubound(InData%rTEtoObserve, kind=B8Ki)) - call RegPack(Buf, InData%rTEtoObserve) - end if - call RegPack(Buf, allocated(InData%rLEtoObserve)) - if (allocated(InData%rLEtoObserve)) then - call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve, kind=B8Ki), ubound(InData%rLEtoObserve, kind=B8Ki)) - call RegPack(Buf, InData%rLEtoObserve) - end if - call RegPack(Buf, allocated(InData%LE_Location)) - if (allocated(InData%LE_Location)) then - call RegPackBounds(Buf, 3, lbound(InData%LE_Location, kind=B8Ki), ubound(InData%LE_Location, kind=B8Ki)) - call RegPack(Buf, InData%LE_Location) - end if - call RegPack(Buf, InData%RotSpeedAoA) - call RegPack(Buf, allocated(InData%SPLLBL)) - if (allocated(InData%SPLLBL)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLLBL, kind=B8Ki), ubound(InData%SPLLBL, kind=B8Ki)) - call RegPack(Buf, InData%SPLLBL) - end if - call RegPack(Buf, allocated(InData%SPLP)) - if (allocated(InData%SPLP)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLP, kind=B8Ki), ubound(InData%SPLP, kind=B8Ki)) - call RegPack(Buf, InData%SPLP) - end if - call RegPack(Buf, allocated(InData%SPLS)) - if (allocated(InData%SPLS)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLS, kind=B8Ki), ubound(InData%SPLS, kind=B8Ki)) - call RegPack(Buf, InData%SPLS) - end if - call RegPack(Buf, allocated(InData%SPLALPH)) - if (allocated(InData%SPLALPH)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLALPH, kind=B8Ki), ubound(InData%SPLALPH, kind=B8Ki)) - call RegPack(Buf, InData%SPLALPH) - end if - call RegPack(Buf, allocated(InData%SPLTBL)) - if (allocated(InData%SPLTBL)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTBL, kind=B8Ki), ubound(InData%SPLTBL, kind=B8Ki)) - call RegPack(Buf, InData%SPLTBL) - end if - call RegPack(Buf, allocated(InData%SPLTIP)) - if (allocated(InData%SPLTIP)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTIP, kind=B8Ki), ubound(InData%SPLTIP, kind=B8Ki)) - call RegPack(Buf, InData%SPLTIP) - end if - call RegPack(Buf, allocated(InData%SPLTI)) - if (allocated(InData%SPLTI)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTI, kind=B8Ki), ubound(InData%SPLTI, kind=B8Ki)) - call RegPack(Buf, InData%SPLTI) - end if - call RegPack(Buf, allocated(InData%SPLTIGui)) - if (allocated(InData%SPLTIGui)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui, kind=B8Ki), ubound(InData%SPLTIGui, kind=B8Ki)) - call RegPack(Buf, InData%SPLTIGui) - end if - call RegPack(Buf, allocated(InData%SPLBLUNT)) - if (allocated(InData%SPLBLUNT)) then - call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT, kind=B8Ki), ubound(InData%SPLBLUNT, kind=B8Ki)) - call RegPack(Buf, InData%SPLBLUNT) - end if - call RegPack(Buf, allocated(InData%CfVar)) - if (allocated(InData%CfVar)) then - call RegPackBounds(Buf, 1, lbound(InData%CfVar, kind=B8Ki), ubound(InData%CfVar, kind=B8Ki)) - call RegPack(Buf, InData%CfVar) - end if - call RegPack(Buf, allocated(InData%d99Var)) - if (allocated(InData%d99Var)) then - call RegPackBounds(Buf, 1, lbound(InData%d99Var, kind=B8Ki), ubound(InData%d99Var, kind=B8Ki)) - call RegPack(Buf, InData%d99Var) - end if - call RegPack(Buf, allocated(InData%dStarVar)) - if (allocated(InData%dStarVar)) then - call RegPackBounds(Buf, 1, lbound(InData%dStarVar, kind=B8Ki), ubound(InData%dStarVar, kind=B8Ki)) - call RegPack(Buf, InData%dStarVar) - end if - call RegPack(Buf, allocated(InData%EdgeVelVar)) - if (allocated(InData%EdgeVelVar)) then - call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar, kind=B8Ki), ubound(InData%EdgeVelVar, kind=B8Ki)) - call RegPack(Buf, InData%EdgeVelVar) - end if - call RegPack(Buf, InData%speccou) - call RegPack(Buf, InData%filesopen) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%ChordAngleTE) + call RegPackAlloc(RF, InData%SpanAngleTE) + call RegPackAlloc(RF, InData%ChordAngleLE) + call RegPackAlloc(RF, InData%SpanAngleLE) + call RegPackAlloc(RF, InData%rTEtoObserve) + call RegPackAlloc(RF, InData%rLEtoObserve) + call RegPackAlloc(RF, InData%LE_Location) + call RegPack(RF, InData%RotSpeedAoA) + call RegPackAlloc(RF, InData%SPLLBL) + call RegPackAlloc(RF, InData%SPLP) + call RegPackAlloc(RF, InData%SPLS) + call RegPackAlloc(RF, InData%SPLALPH) + call RegPackAlloc(RF, InData%SPLTBL) + call RegPackAlloc(RF, InData%SPLTIP) + call RegPackAlloc(RF, InData%SPLTI) + call RegPackAlloc(RF, InData%SPLTIGui) + call RegPackAlloc(RF, InData%SPLBLUNT) + call RegPackAlloc(RF, InData%CfVar) + call RegPackAlloc(RF, InData%d99Var) + call RegPackAlloc(RF, InData%dStarVar) + call RegPackAlloc(RF, InData%EdgeVelVar) + call RegPack(RF, InData%speccou) + call RegPack(RF, InData%filesopen) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackMisc' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChordAngleTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SpanAngleTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChordAngleLE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SpanAngleLE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rTEtoObserve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLEtoObserve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LE_Location); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedAoA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLLBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLALPH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLTIGui); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SPLBLUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CfVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d99Var); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dStarVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgeVelVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%speccou); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filesopen); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AA_ParameterType), intent(in) :: SrcParamData + type(AA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%IBLUNT = SrcParamData%IBLUNT + DstParamData%ILAM = SrcParamData%ILAM + DstParamData%ITIP = SrcParamData%ITIP + DstParamData%ITRIP = SrcParamData%ITRIP + DstParamData%ITURB = SrcParamData%ITURB + DstParamData%IInflow = SrcParamData%IInflow + DstParamData%X_BLMethod = SrcParamData%X_BLMethod + DstParamData%TICalcMeth = SrcParamData%TICalcMeth + DstParamData%ROUND = SrcParamData%ROUND + DstParamData%ALPRAT = SrcParamData%ALPRAT + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumBlNds = SrcParamData%NumBlNds + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%HubHeight = SrcParamData%HubHeight + DstParamData%toptip = SrcParamData%toptip + DstParamData%bottip = SrcParamData%bottip + if (allocated(SrcParamData%rotorregionlimitsVert)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) + if (.not. allocated(DstParamData%rotorregionlimitsVert)) then + allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return + DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert end if - if (allocated(OutData%ChordAngleTE)) deallocate(OutData%ChordAngleTE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcParamData%rotorregionlimitsHorz)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) + if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then + allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%ChordAngleTE) - if (RegCheckErr(Buf, RoutineName)) return + DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz end if - if (allocated(OutData%SpanAngleTE)) deallocate(OutData%SpanAngleTE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcParamData%rotorregionlimitsalph)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) + if (.not. allocated(DstParamData%rotorregionlimitsalph)) then + allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%SpanAngleTE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ChordAngleLE)) deallocate(OutData%ChordAngleLE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleLE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ChordAngleLE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SpanAngleLE)) deallocate(OutData%SpanAngleLE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleLE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SpanAngleLE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rTEtoObserve)) deallocate(OutData%rTEtoObserve) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTEtoObserve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rTEtoObserve) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rLEtoObserve)) deallocate(OutData%rLEtoObserve) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLEtoObserve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rLEtoObserve) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LE_Location)) deallocate(OutData%LE_Location) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE_Location.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LE_Location) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RotSpeedAoA) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%SPLLBL)) deallocate(OutData%SPLLBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLLBL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLLBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLP)) deallocate(OutData%SPLP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLS)) deallocate(OutData%SPLS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLALPH)) deallocate(OutData%SPLALPH) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLALPH(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLALPH) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLTBL)) deallocate(OutData%SPLTBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLTBL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLTBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLTIP)) deallocate(OutData%SPLTIP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLTIP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLTIP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLTI)) deallocate(OutData%SPLTI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLTI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLTI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLTIGui)) deallocate(OutData%SPLTIGui) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLTIGui(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLTIGui) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SPLBLUNT)) deallocate(OutData%SPLBLUNT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SPLBLUNT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SPLBLUNT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CfVar)) deallocate(OutData%CfVar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CfVar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CfVar) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%d99Var)) deallocate(OutData%d99Var) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%d99Var(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%d99Var) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dStarVar)) deallocate(OutData%dStarVar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dStarVar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dStarVar) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%EdgeVelVar)) deallocate(OutData%EdgeVelVar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%EdgeVelVar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%EdgeVelVar) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%speccou) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%filesopen) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(AA_ParameterType), intent(in) :: SrcParamData - type(AA_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AA_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%DT = SrcParamData%DT - DstParamData%IBLUNT = SrcParamData%IBLUNT - DstParamData%ILAM = SrcParamData%ILAM - DstParamData%ITIP = SrcParamData%ITIP - DstParamData%ITRIP = SrcParamData%ITRIP - DstParamData%ITURB = SrcParamData%ITURB - DstParamData%IInflow = SrcParamData%IInflow - DstParamData%X_BLMethod = SrcParamData%X_BLMethod - DstParamData%TICalcMeth = SrcParamData%TICalcMeth - DstParamData%ROUND = SrcParamData%ROUND - DstParamData%ALPRAT = SrcParamData%ALPRAT - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumBlNds = SrcParamData%NumBlNds - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip - if (allocated(SrcParamData%rotorregionlimitsVert)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) - if (.not. allocated(DstParamData%rotorregionlimitsVert)) then - allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert - end if - if (allocated(SrcParamData%rotorregionlimitsHorz)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) - if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then - allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz - end if - if (allocated(SrcParamData%rotorregionlimitsalph)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) - if (.not. allocated(DstParamData%rotorregionlimitsalph)) then - allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph + DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph end if if (allocated(SrcParamData%rotorregionlimitsrad)) then LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) @@ -3454,778 +2423,219 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%IBLUNT) - call RegPack(Buf, InData%ILAM) - call RegPack(Buf, InData%ITIP) - call RegPack(Buf, InData%ITRIP) - call RegPack(Buf, InData%ITURB) - call RegPack(Buf, InData%IInflow) - call RegPack(Buf, InData%X_BLMethod) - call RegPack(Buf, InData%TICalcMeth) - call RegPack(Buf, InData%ROUND) - call RegPack(Buf, InData%ALPRAT) - call RegPack(Buf, InData%NumBlades) - call RegPack(Buf, InData%NumBlNds) - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%HubHeight) - call RegPack(Buf, InData%toptip) - call RegPack(Buf, InData%bottip) - call RegPack(Buf, allocated(InData%rotorregionlimitsVert)) - if (allocated(InData%rotorregionlimitsVert)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert, kind=B8Ki), ubound(InData%rotorregionlimitsVert, kind=B8Ki)) - call RegPack(Buf, InData%rotorregionlimitsVert) - end if - call RegPack(Buf, allocated(InData%rotorregionlimitsHorz)) - if (allocated(InData%rotorregionlimitsHorz)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz, kind=B8Ki), ubound(InData%rotorregionlimitsHorz, kind=B8Ki)) - call RegPack(Buf, InData%rotorregionlimitsHorz) - end if - call RegPack(Buf, allocated(InData%rotorregionlimitsalph)) - if (allocated(InData%rotorregionlimitsalph)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph, kind=B8Ki), ubound(InData%rotorregionlimitsalph, kind=B8Ki)) - call RegPack(Buf, InData%rotorregionlimitsalph) - end if - call RegPack(Buf, allocated(InData%rotorregionlimitsrad)) - if (allocated(InData%rotorregionlimitsrad)) then - call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad, kind=B8Ki), ubound(InData%rotorregionlimitsrad, kind=B8Ki)) - call RegPack(Buf, InData%rotorregionlimitsrad) - end if - call RegPack(Buf, InData%NrObsLoc) - call RegPack(Buf, InData%aweightflag) - call RegPack(Buf, InData%TxtFileOutput) - call RegPack(Buf, InData%AAStart) - call RegPack(Buf, allocated(InData%ObsX)) - if (allocated(InData%ObsX)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsX, kind=B8Ki), ubound(InData%ObsX, kind=B8Ki)) - call RegPack(Buf, InData%ObsX) - end if - call RegPack(Buf, allocated(InData%ObsY)) - if (allocated(InData%ObsY)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsY, kind=B8Ki), ubound(InData%ObsY, kind=B8Ki)) - call RegPack(Buf, InData%ObsY) - end if - call RegPack(Buf, allocated(InData%ObsZ)) - if (allocated(InData%ObsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%ObsZ, kind=B8Ki), ubound(InData%ObsZ, kind=B8Ki)) - call RegPack(Buf, InData%ObsZ) - end if - call RegPack(Buf, allocated(InData%FreqList)) - if (allocated(InData%FreqList)) then - call RegPackBounds(Buf, 1, lbound(InData%FreqList, kind=B8Ki), ubound(InData%FreqList, kind=B8Ki)) - call RegPack(Buf, InData%FreqList) - end if - call RegPack(Buf, allocated(InData%Aweight)) - if (allocated(InData%Aweight)) then - call RegPackBounds(Buf, 1, lbound(InData%Aweight, kind=B8Ki), ubound(InData%Aweight, kind=B8Ki)) - call RegPack(Buf, InData%Aweight) - end if - call RegPack(Buf, InData%Fsample) - call RegPack(Buf, InData%total_sample) - call RegPack(Buf, InData%total_sampleTI) - call RegPack(Buf, InData%AA_Bl_Prcntge) - call RegPack(Buf, InData%startnode) - call RegPack(Buf, InData%Lturb) - call RegPack(Buf, InData%AvgV) - call RegPack(Buf, InData%dz_turb_in) - call RegPack(Buf, InData%dy_turb_in) - call RegPack(Buf, allocated(InData%TI_Grid_In)) - if (allocated(InData%TI_Grid_In)) then - call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In, kind=B8Ki), ubound(InData%TI_Grid_In, kind=B8Ki)) - call RegPack(Buf, InData%TI_Grid_In) - end if - call RegPack(Buf, InData%FTitle) - call RegPack(Buf, InData%outFmt) - call RegPack(Buf, InData%NrOutFile) - call RegPack(Buf, InData%delim) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%NumOutsForPE) - call RegPack(Buf, InData%NumOutsForSep) - call RegPack(Buf, InData%NumOutsForNodes) - call RegPack(Buf, InData%unOutFile) - call RegPack(Buf, InData%unOutFile2) - call RegPack(Buf, InData%unOutFile3) - call RegPack(Buf, InData%unOutFile4) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%IBLUNT) + call RegPack(RF, InData%ILAM) + call RegPack(RF, InData%ITIP) + call RegPack(RF, InData%ITRIP) + call RegPack(RF, InData%ITURB) + call RegPack(RF, InData%IInflow) + call RegPack(RF, InData%X_BLMethod) + call RegPack(RF, InData%TICalcMeth) + call RegPack(RF, InData%ROUND) + call RegPack(RF, InData%ALPRAT) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%HubHeight) + call RegPack(RF, InData%toptip) + call RegPack(RF, InData%bottip) + call RegPackAlloc(RF, InData%rotorregionlimitsVert) + call RegPackAlloc(RF, InData%rotorregionlimitsHorz) + call RegPackAlloc(RF, InData%rotorregionlimitsalph) + call RegPackAlloc(RF, InData%rotorregionlimitsrad) + call RegPack(RF, InData%NrObsLoc) + call RegPack(RF, InData%aweightflag) + call RegPack(RF, InData%TxtFileOutput) + call RegPack(RF, InData%AAStart) + call RegPackAlloc(RF, InData%ObsX) + call RegPackAlloc(RF, InData%ObsY) + call RegPackAlloc(RF, InData%ObsZ) + call RegPackAlloc(RF, InData%FreqList) + call RegPackAlloc(RF, InData%Aweight) + call RegPack(RF, InData%Fsample) + call RegPack(RF, InData%total_sample) + call RegPack(RF, InData%total_sampleTI) + call RegPack(RF, InData%AA_Bl_Prcntge) + call RegPack(RF, InData%startnode) + call RegPack(RF, InData%Lturb) + call RegPack(RF, InData%AvgV) + call RegPack(RF, InData%dz_turb_in) + call RegPack(RF, InData%dy_turb_in) + call RegPackAlloc(RF, InData%TI_Grid_In) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%outFmt) + call RegPack(RF, InData%NrOutFile) + call RegPack(RF, InData%delim) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumOutsForPE) + call RegPack(RF, InData%NumOutsForSep) + call RegPack(RF, InData%NumOutsForNodes) + call RegPack(RF, InData%unOutFile) + call RegPack(RF, InData%unOutFile2) + call RegPack(RF, InData%unOutFile3) + call RegPack(RF, InData%unOutFile4) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, allocated(InData%StallStart)) - if (allocated(InData%StallStart)) then - call RegPackBounds(Buf, 2, lbound(InData%StallStart, kind=B8Ki), ubound(InData%StallStart, kind=B8Ki)) - call RegPack(Buf, InData%StallStart) - end if - call RegPack(Buf, allocated(InData%TEThick)) - if (allocated(InData%TEThick)) then - call RegPackBounds(Buf, 2, lbound(InData%TEThick, kind=B8Ki), ubound(InData%TEThick, kind=B8Ki)) - call RegPack(Buf, InData%TEThick) - end if - call RegPack(Buf, allocated(InData%TEAngle)) - if (allocated(InData%TEAngle)) then - call RegPackBounds(Buf, 2, lbound(InData%TEAngle, kind=B8Ki), ubound(InData%TEAngle, kind=B8Ki)) - call RegPack(Buf, InData%TEAngle) - end if - call RegPack(Buf, allocated(InData%AerCent)) - if (allocated(InData%AerCent)) then - call RegPackBounds(Buf, 3, lbound(InData%AerCent, kind=B8Ki), ubound(InData%AerCent, kind=B8Ki)) - call RegPack(Buf, InData%AerCent) - end if - call RegPack(Buf, allocated(InData%BlAFID)) - if (allocated(InData%BlAFID)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAFID, kind=B8Ki), ubound(InData%BlAFID, kind=B8Ki)) - call RegPack(Buf, InData%BlAFID) - end if - call RegPack(Buf, allocated(InData%AFInfo)) + call RegPackAlloc(RF, InData%StallStart) + call RegPackAlloc(RF, InData%TEThick) + call RegPackAlloc(RF, InData%TEAngle) + call RegPackAlloc(RF, InData%AerCent) + call RegPackAlloc(RF, InData%BlAFID) + call RegPack(RF, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(Buf, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) do i1 = LB(1), UB(1) - call AFI_PackParam(Buf, InData%AFInfo(i1)) + call AFI_PackParam(RF, InData%AFInfo(i1)) end do end if - call RegPack(Buf, allocated(InData%AFLECo)) - if (allocated(InData%AFLECo)) then - call RegPackBounds(Buf, 3, lbound(InData%AFLECo, kind=B8Ki), ubound(InData%AFLECo, kind=B8Ki)) - call RegPack(Buf, InData%AFLECo) - end if - call RegPack(Buf, allocated(InData%AFTECo)) - if (allocated(InData%AFTECo)) then - call RegPackBounds(Buf, 3, lbound(InData%AFTECo, kind=B8Ki), ubound(InData%AFTECo, kind=B8Ki)) - call RegPack(Buf, InData%AFTECo) - end if - call RegPack(Buf, allocated(InData%BlSpn)) - if (allocated(InData%BlSpn)) then - call RegPackBounds(Buf, 2, lbound(InData%BlSpn, kind=B8Ki), ubound(InData%BlSpn, kind=B8Ki)) - call RegPack(Buf, InData%BlSpn) - end if - call RegPack(Buf, allocated(InData%BlChord)) - if (allocated(InData%BlChord)) then - call RegPackBounds(Buf, 2, lbound(InData%BlChord, kind=B8Ki), ubound(InData%BlChord, kind=B8Ki)) - call RegPack(Buf, InData%BlChord) - end if - call RegPack(Buf, allocated(InData%ReListBL)) - if (allocated(InData%ReListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%ReListBL, kind=B8Ki), ubound(InData%ReListBL, kind=B8Ki)) - call RegPack(Buf, InData%ReListBL) - end if - call RegPack(Buf, allocated(InData%AOAListBL)) - if (allocated(InData%AOAListBL)) then - call RegPackBounds(Buf, 1, lbound(InData%AOAListBL, kind=B8Ki), ubound(InData%AOAListBL, kind=B8Ki)) - call RegPack(Buf, InData%AOAListBL) - end if - call RegPack(Buf, allocated(InData%dStarAll1)) - if (allocated(InData%dStarAll1)) then - call RegPackBounds(Buf, 3, lbound(InData%dStarAll1, kind=B8Ki), ubound(InData%dStarAll1, kind=B8Ki)) - call RegPack(Buf, InData%dStarAll1) - end if - call RegPack(Buf, allocated(InData%dStarAll2)) - if (allocated(InData%dStarAll2)) then - call RegPackBounds(Buf, 3, lbound(InData%dStarAll2, kind=B8Ki), ubound(InData%dStarAll2, kind=B8Ki)) - call RegPack(Buf, InData%dStarAll2) - end if - call RegPack(Buf, allocated(InData%d99All1)) - if (allocated(InData%d99All1)) then - call RegPackBounds(Buf, 3, lbound(InData%d99All1, kind=B8Ki), ubound(InData%d99All1, kind=B8Ki)) - call RegPack(Buf, InData%d99All1) - end if - call RegPack(Buf, allocated(InData%d99All2)) - if (allocated(InData%d99All2)) then - call RegPackBounds(Buf, 3, lbound(InData%d99All2, kind=B8Ki), ubound(InData%d99All2, kind=B8Ki)) - call RegPack(Buf, InData%d99All2) - end if - call RegPack(Buf, allocated(InData%CfAll1)) - if (allocated(InData%CfAll1)) then - call RegPackBounds(Buf, 3, lbound(InData%CfAll1, kind=B8Ki), ubound(InData%CfAll1, kind=B8Ki)) - call RegPack(Buf, InData%CfAll1) - end if - call RegPack(Buf, allocated(InData%CfAll2)) - if (allocated(InData%CfAll2)) then - call RegPackBounds(Buf, 3, lbound(InData%CfAll2, kind=B8Ki), ubound(InData%CfAll2, kind=B8Ki)) - call RegPack(Buf, InData%CfAll2) - end if - call RegPack(Buf, allocated(InData%EdgeVelRat1)) - if (allocated(InData%EdgeVelRat1)) then - call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1, kind=B8Ki), ubound(InData%EdgeVelRat1, kind=B8Ki)) - call RegPack(Buf, InData%EdgeVelRat1) - end if - call RegPack(Buf, allocated(InData%EdgeVelRat2)) - if (allocated(InData%EdgeVelRat2)) then - call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2, kind=B8Ki), ubound(InData%EdgeVelRat2, kind=B8Ki)) - call RegPack(Buf, InData%EdgeVelRat2) - end if - call RegPack(Buf, allocated(InData%AFThickGuida)) - if (allocated(InData%AFThickGuida)) then - call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida, kind=B8Ki), ubound(InData%AFThickGuida, kind=B8Ki)) - call RegPack(Buf, InData%AFThickGuida) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%AFLECo) + call RegPackAlloc(RF, InData%AFTECo) + call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlChord) + call RegPackAlloc(RF, InData%ReListBL) + call RegPackAlloc(RF, InData%AOAListBL) + call RegPackAlloc(RF, InData%dStarAll1) + call RegPackAlloc(RF, InData%dStarAll2) + call RegPackAlloc(RF, InData%d99All1) + call RegPackAlloc(RF, InData%d99All2) + call RegPackAlloc(RF, InData%CfAll1) + call RegPackAlloc(RF, InData%CfAll2) + call RegPackAlloc(RF, InData%EdgeVelRat1) + call RegPackAlloc(RF, InData%EdgeVelRat2) + call RegPackAlloc(RF, InData%AFThickGuida) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IBLUNT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ILAM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ITIP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ITRIP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ITURB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IInflow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X_BLMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TICalcMeth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ROUND) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ALPRAT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubHeight) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%toptip) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bottip) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rotorregionlimitsVert)) deallocate(OutData%rotorregionlimitsVert) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rotorregionlimitsVert(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rotorregionlimitsVert) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rotorregionlimitsHorz)) deallocate(OutData%rotorregionlimitsHorz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rotorregionlimitsHorz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rotorregionlimitsHorz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rotorregionlimitsalph)) deallocate(OutData%rotorregionlimitsalph) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rotorregionlimitsalph(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rotorregionlimitsalph) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rotorregionlimitsrad)) deallocate(OutData%rotorregionlimitsrad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rotorregionlimitsrad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rotorregionlimitsrad) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NrObsLoc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%aweightflag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TxtFileOutput) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AAStart) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ObsX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ObsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ObsY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ObsY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ObsZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ObsZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FreqList)) deallocate(OutData%FreqList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FreqList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FreqList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Aweight)) deallocate(OutData%Aweight) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Aweight(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Aweight) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Fsample) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%total_sample) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%total_sampleTI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AA_Bl_Prcntge) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%startnode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Lturb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dz_turb_in) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dy_turb_in) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI_Grid_In) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%outFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NrOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOutsForPE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOutsForSep) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOutsForNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%unOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%unOutFile2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%unOutFile3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%unOutFile4) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IBLUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ILAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITRIP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ITURB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_BLMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TICalcMeth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ROUND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ALPRAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%toptip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bottip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsVert); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsHorz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsalph); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rotorregionlimitsrad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aweightflag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TxtFileOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ObsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreqList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Aweight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fsample); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%total_sample); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%total_sampleTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%startnode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dz_turb_in); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dy_turb_in); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_Grid_In); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsForPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsForSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutsForNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unOutFile4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - if (allocated(OutData%StallStart)) deallocate(OutData%StallStart) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StallStart(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StallStart) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TEThick)) deallocate(OutData%TEThick) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TEThick(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TEThick) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TEAngle)) deallocate(OutData%TEAngle) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TEAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TEAngle) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AerCent)) deallocate(OutData%AerCent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AerCent) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlAFID(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlAFID) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%StallStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TEThick); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TEAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AerCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo + call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo end do end if - if (allocated(OutData%AFLECo)) deallocate(OutData%AFLECo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFLECo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFLECo) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AFTECo)) deallocate(OutData%AFTECo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFTECo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFTECo) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlSpn(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlSpn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlChord(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlChord) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ReListBL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ReListBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AOAListBL)) deallocate(OutData%AOAListBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AOAListBL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AOAListBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dStarAll1)) deallocate(OutData%dStarAll1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dStarAll1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dStarAll2)) deallocate(OutData%dStarAll2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dStarAll2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%d99All1)) deallocate(OutData%d99All1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%d99All1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%d99All2)) deallocate(OutData%d99All2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%d99All2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CfAll1)) deallocate(OutData%CfAll1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CfAll1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CfAll2)) deallocate(OutData%CfAll2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CfAll2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%EdgeVelRat1)) deallocate(OutData%EdgeVelRat1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%EdgeVelRat1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%EdgeVelRat2)) deallocate(OutData%EdgeVelRat2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%EdgeVelRat2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AFThickGuida)) deallocate(OutData%AFThickGuida) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFThickGuida) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%AFLECo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFTECo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AOAListBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dStarAll1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dStarAll2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d99All1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d99All2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CfAll1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CfAll2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgeVelRat1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgeVelRat2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFThickGuida); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -4325,117 +2735,32 @@ subroutine AA_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%RotGtoL)) - if (allocated(InData%RotGtoL)) then - call RegPackBounds(Buf, 4, lbound(InData%RotGtoL, kind=B8Ki), ubound(InData%RotGtoL, kind=B8Ki)) - call RegPack(Buf, InData%RotGtoL) - end if - call RegPack(Buf, allocated(InData%AeroCent_G)) - if (allocated(InData%AeroCent_G)) then - call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G, kind=B8Ki), ubound(InData%AeroCent_G, kind=B8Ki)) - call RegPack(Buf, InData%AeroCent_G) - end if - call RegPack(Buf, allocated(InData%Vrel)) - if (allocated(InData%Vrel)) then - call RegPackBounds(Buf, 2, lbound(InData%Vrel, kind=B8Ki), ubound(InData%Vrel, kind=B8Ki)) - call RegPack(Buf, InData%Vrel) - end if - call RegPack(Buf, allocated(InData%AoANoise)) - if (allocated(InData%AoANoise)) then - call RegPackBounds(Buf, 2, lbound(InData%AoANoise, kind=B8Ki), ubound(InData%AoANoise, kind=B8Ki)) - call RegPack(Buf, InData%AoANoise) - end if - call RegPack(Buf, allocated(InData%Inflow)) - if (allocated(InData%Inflow)) then - call RegPackBounds(Buf, 3, lbound(InData%Inflow, kind=B8Ki), ubound(InData%Inflow, kind=B8Ki)) - call RegPack(Buf, InData%Inflow) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%RotGtoL) + call RegPackAlloc(RF, InData%AeroCent_G) + call RegPackAlloc(RF, InData%Vrel) + call RegPackAlloc(RF, InData%AoANoise) + call RegPackAlloc(RF, InData%Inflow) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInput' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%RotGtoL)) deallocate(OutData%RotGtoL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotGtoL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotGtoL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AeroCent_G)) deallocate(OutData%AeroCent_G) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroCent_G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AeroCent_G) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vrel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AoANoise)) deallocate(OutData%AoANoise) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AoANoise(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AoANoise) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Inflow) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%RotGtoL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AeroCent_G); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AoANoise); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Inflow); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -4625,231 +2950,44 @@ subroutine AA_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine AA_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AA_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%SumSpecNoise)) - if (allocated(InData%SumSpecNoise)) then - call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise, kind=B8Ki), ubound(InData%SumSpecNoise, kind=B8Ki)) - call RegPack(Buf, InData%SumSpecNoise) - end if - call RegPack(Buf, allocated(InData%SumSpecNoiseSep)) - if (allocated(InData%SumSpecNoiseSep)) then - call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep, kind=B8Ki), ubound(InData%SumSpecNoiseSep, kind=B8Ki)) - call RegPack(Buf, InData%SumSpecNoiseSep) - end if - call RegPack(Buf, allocated(InData%OASPL)) - if (allocated(InData%OASPL)) then - call RegPackBounds(Buf, 3, lbound(InData%OASPL, kind=B8Ki), ubound(InData%OASPL, kind=B8Ki)) - call RegPack(Buf, InData%OASPL) - end if - call RegPack(Buf, allocated(InData%OASPL_Mech)) - if (allocated(InData%OASPL_Mech)) then - call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech, kind=B8Ki), ubound(InData%OASPL_Mech, kind=B8Ki)) - call RegPack(Buf, InData%OASPL_Mech) - end if - call RegPack(Buf, allocated(InData%DirectiviOutput)) - if (allocated(InData%DirectiviOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput, kind=B8Ki), ubound(InData%DirectiviOutput, kind=B8Ki)) - call RegPack(Buf, InData%DirectiviOutput) - end if - call RegPack(Buf, allocated(InData%OutLECoords)) - if (allocated(InData%OutLECoords)) then - call RegPackBounds(Buf, 4, lbound(InData%OutLECoords, kind=B8Ki), ubound(InData%OutLECoords, kind=B8Ki)) - call RegPack(Buf, InData%OutLECoords) - end if - call RegPack(Buf, allocated(InData%PtotalFreq)) - if (allocated(InData%PtotalFreq)) then - call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq, kind=B8Ki), ubound(InData%PtotalFreq, kind=B8Ki)) - call RegPack(Buf, InData%PtotalFreq) - end if - call RegPack(Buf, allocated(InData%WriteOutputForPE)) - if (allocated(InData%WriteOutputForPE)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE, kind=B8Ki), ubound(InData%WriteOutputForPE, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputForPE) - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, allocated(InData%WriteOutputSep)) - if (allocated(InData%WriteOutputSep)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep, kind=B8Ki), ubound(InData%WriteOutputSep, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputSep) - end if - call RegPack(Buf, allocated(InData%WriteOutputNode)) - if (allocated(InData%WriteOutputNode)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode, kind=B8Ki), ubound(InData%WriteOutputNode, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputNode) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%SumSpecNoise) + call RegPackAlloc(RF, InData%SumSpecNoiseSep) + call RegPackAlloc(RF, InData%OASPL) + call RegPackAlloc(RF, InData%OASPL_Mech) + call RegPackAlloc(RF, InData%DirectiviOutput) + call RegPackAlloc(RF, InData%OutLECoords) + call RegPackAlloc(RF, InData%PtotalFreq) + call RegPackAlloc(RF, InData%WriteOutputForPE) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%WriteOutputSep) + call RegPackAlloc(RF, InData%WriteOutputNode) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AA_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOutput' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%SumSpecNoise)) deallocate(OutData%SumSpecNoise) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoise.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SumSpecNoise) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SumSpecNoiseSep)) deallocate(OutData%SumSpecNoiseSep) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoiseSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SumSpecNoiseSep) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OASPL)) deallocate(OutData%OASPL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OASPL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OASPL_Mech)) deallocate(OutData%OASPL_Mech) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL_Mech.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OASPL_Mech) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DirectiviOutput)) deallocate(OutData%DirectiviOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DirectiviOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DirectiviOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OutLECoords)) deallocate(OutData%OutLECoords) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutLECoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutLECoords) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtotalFreq)) deallocate(OutData%PtotalFreq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtotalFreq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputForPE)) deallocate(OutData%WriteOutputForPE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputForPE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputForPE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputSep)) deallocate(OutData%WriteOutputSep) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputSep(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputSep) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputNode)) deallocate(OutData%WriteOutputNode) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputNode(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputNode) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%SumSpecNoise); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SumSpecNoiseSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OASPL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OASPL_Mech); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DirectiviOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutLECoords); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtotalFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputForPE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputSep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputNode); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 4a9345bb6c..7d2b77655f 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -230,52 +230,41 @@ subroutine AD_Dvr_DestroyDvr_Case(Dvr_CaseData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD_Dvr_PackDvr_Case(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackDvr_Case(RF, Indata) + type(RegFile), intent(inout) :: RF type(Dvr_Case), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Case' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%HWindSpeed) - call RegPack(Buf, InData%PLExp) - call RegPack(Buf, InData%rotSpeed) - call RegPack(Buf, InData%bldPitch) - call RegPack(Buf, InData%nacYaw) - call RegPack(Buf, InData%tMax) - call RegPack(Buf, InData%dT) - call RegPack(Buf, InData%numSteps) - call RegPack(Buf, InData%DOF) - call RegPack(Buf, InData%amplitude) - call RegPack(Buf, InData%frequency) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%rotSpeed) + call RegPack(RF, InData%bldPitch) + call RegPack(RF, InData%nacYaw) + call RegPack(RF, InData%tMax) + call RegPack(RF, InData%dT) + call RegPack(RF, InData%numSteps) + call RegPack(RF, InData%DOF) + call RegPack(RF, InData%amplitude) + call RegPack(RF, InData%frequency) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackDvr_Case(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackDvr_Case(RF, OutData) + type(RegFile), intent(inout) :: RF type(Dvr_Case), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Case' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bldPitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nacYaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numSteps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%amplitude) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%frequency) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bldPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%amplitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%frequency); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) @@ -301,28 +290,25 @@ subroutine AD_Dvr_DestroyDvrVTK_SurfaceType(DvrVTK_SurfaceTypeData, ErrStat, Err ErrMsg = '' end subroutine -subroutine AD_Dvr_PackDvrVTK_SurfaceType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackDvrVTK_SurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF type(DvrVTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumSectors) - call RegPack(Buf, InData%NacelleBox) - call RegPack(Buf, InData%BaseBox) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumSectors) + call RegPack(RF, InData%NacelleBox) + call RegPack(RF, InData%BaseBox) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackDvrVTK_SurfaceType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackDvrVTK_SurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF type(DvrVTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumSectors) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacelleBox) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BaseBox) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumSectors); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleBox); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BaseBox); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg) @@ -476,200 +462,95 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackDvr_Outputs(RF, Indata) + type(RegFile), intent(inout) :: RF type(Dvr_Outputs), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%AD_ver) - call RegPack(Buf, allocated(InData%unOutFile)) - if (allocated(InData%unOutFile)) then - call RegPackBounds(Buf, 1, lbound(InData%unOutFile, kind=B8Ki), ubound(InData%unOutFile, kind=B8Ki)) - call RegPack(Buf, InData%unOutFile) - end if - call RegPack(Buf, InData%ActualChanLen) - call RegPack(Buf, InData%nDvrOutputs) - call RegPack(Buf, InData%Fmt_t) - call RegPack(Buf, InData%Fmt_a) - call RegPack(Buf, InData%delim) - call RegPack(Buf, InData%outFmt) - call RegPack(Buf, InData%fileFmt) - call RegPack(Buf, InData%wrVTK) - call RegPack(Buf, InData%WrVTK_Type) - call RegPack(Buf, InData%Root) - call RegPack(Buf, InData%VTK_OutFileRoot) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call RegPack(Buf, allocated(InData%storage)) - if (allocated(InData%storage)) then - call RegPackBounds(Buf, 3, lbound(InData%storage, kind=B8Ki), ubound(InData%storage, kind=B8Ki)) - call RegPack(Buf, InData%storage) - end if - call RegPack(Buf, allocated(InData%outLine)) - if (allocated(InData%outLine)) then - call RegPackBounds(Buf, 1, lbound(InData%outLine, kind=B8Ki), ubound(InData%outLine, kind=B8Ki)) - call RegPack(Buf, InData%outLine) - end if - call RegPack(Buf, allocated(InData%VTK_surface)) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%AD_ver) + call RegPackAlloc(RF, InData%unOutFile) + call RegPack(RF, InData%ActualChanLen) + call RegPack(RF, InData%nDvrOutputs) + call RegPack(RF, InData%Fmt_t) + call RegPack(RF, InData%Fmt_a) + call RegPack(RF, InData%delim) + call RegPack(RF, InData%outFmt) + call RegPack(RF, InData%fileFmt) + call RegPack(RF, InData%wrVTK) + call RegPack(RF, InData%WrVTK_Type) + call RegPack(RF, InData%Root) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%storage) + call RegPackAlloc(RF, InData%outLine) + call RegPack(RF, allocated(InData%VTK_surface)) if (allocated(InData%VTK_surface)) then - call RegPackBounds(Buf, 1, lbound(InData%VTK_surface, kind=B8Ki), ubound(InData%VTK_surface, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VTK_surface, kind=B8Ki), ubound(InData%VTK_surface, kind=B8Ki)) LB(1:1) = lbound(InData%VTK_surface, kind=B8Ki) UB(1:1) = ubound(InData%VTK_surface, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_Dvr_PackDvrVTK_SurfaceType(Buf, InData%VTK_surface(i1)) + call AD_Dvr_PackDvrVTK_SurfaceType(RF, InData%VTK_surface(i1)) end do end if - call RegPack(Buf, InData%VTK_tWidth) - call RegPack(Buf, InData%n_VTKTime) - call RegPack(Buf, InData%VTKHubRad) - call RegPack(Buf, InData%VTKNacDim) - call RegPack(Buf, InData%VTKRefPoint) - call RegPack(Buf, InData%DT_Outs) - call RegPack(Buf, InData%n_DT_Out) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%VTK_tWidth) + call RegPack(RF, InData%n_VTKTime) + call RegPack(RF, InData%VTKHubRad) + call RegPack(RF, InData%VTKNacDim) + call RegPack(RF, InData%VTKRefPoint) + call RegPack(RF, InData%DT_Outs) + call RegPack(RF, InData%n_DT_Out) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackDvr_Outputs(RF, OutData) + type(RegFile), intent(inout) :: RF type(Dvr_Outputs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%AD_ver) ! AD_ver - if (allocated(OutData%unOutFile)) deallocate(OutData%unOutFile) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%unOutFile(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%unOutFile) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%ActualChanLen) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDvrOutputs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fmt_t) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fmt_a) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%outFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fileFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%wrVTK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK_Type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Root) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%storage)) deallocate(OutData%storage) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%storage.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%storage) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%outLine)) deallocate(OutData%outLine) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%outLine(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%outLine) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%AD_ver) ! AD_ver + call RegUnpackAlloc(RF, OutData%unOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDvrOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmt_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmt_a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fileFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%wrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Root); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%storage); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outLine); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%VTK_surface)) deallocate(OutData%VTK_surface) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VTK_surface(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_Dvr_UnpackDvrVTK_SurfaceType(Buf, OutData%VTK_surface(i1)) ! VTK_surface + call AD_Dvr_UnpackDvrVTK_SurfaceType(RF, OutData%VTK_surface(i1)) ! VTK_surface end do end if - call RegUnpack(Buf, OutData%VTK_tWidth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_VTKTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKHubRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKNacDim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKRefPoint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT_Outs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_DT_Out) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_VTKTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKHubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNacDim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKRefPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Outs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_DT_Out); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg) @@ -719,71 +600,44 @@ subroutine AD_Dvr_DestroyBladeData(BladeDataData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_Dvr_PackBladeData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackBladeData(RF, Indata) + type(RegFile), intent(inout) :: RF type(BladeData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackBladeData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%pitch) - call RegPack(Buf, InData%pitchSpeed) - call RegPack(Buf, InData%pitchAcc) - call RegPack(Buf, InData%origin_h) - call RegPack(Buf, InData%orientation_h) - call RegPack(Buf, InData%hubRad_bl) - call RegPack(Buf, InData%Rh2bl0) - call RegPack(Buf, InData%motionType) - call RegPack(Buf, InData%iMotion) - call RegPack(Buf, allocated(InData%motion)) - if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) - call RegPack(Buf, InData%motion) - end if - call RegPack(Buf, InData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%pitch) + call RegPack(RF, InData%pitchSpeed) + call RegPack(RF, InData%pitchAcc) + call RegPack(RF, InData%origin_h) + call RegPack(RF, InData%orientation_h) + call RegPack(RF, InData%hubRad_bl) + call RegPack(RF, InData%Rh2bl0) + call RegPack(RF, InData%motionType) + call RegPack(RF, InData%iMotion) + call RegPackAlloc(RF, InData%motion) + call RegPack(RF, InData%motionFileName) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackBladeData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackBladeData(RF, OutData) + type(RegFile), intent(inout) :: RF type(BladeData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%pitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchAcc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%origin_h) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%orientation_h) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%hubRad_bl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Rh2bl0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%motion)) deallocate(OutData%motion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%motion) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%origin_h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%orientation_h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hubRad_bl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rh2bl0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg) @@ -831,65 +685,40 @@ subroutine AD_Dvr_DestroyHubData(HubDataData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_Dvr_PackHubData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackHubData(RF, Indata) + type(RegFile), intent(inout) :: RF type(HubData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackHubData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%origin_n) - call RegPack(Buf, InData%orientation_n) - call RegPack(Buf, InData%motionType) - call RegPack(Buf, InData%iMotion) - call RegPack(Buf, InData%azimuth) - call RegPack(Buf, InData%rotSpeed) - call RegPack(Buf, InData%rotAcc) - call RegPack(Buf, InData%motionFileName) - call RegPack(Buf, allocated(InData%motion)) - if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) - call RegPack(Buf, InData%motion) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%origin_n) + call RegPack(RF, InData%orientation_n) + call RegPack(RF, InData%motionType) + call RegPack(RF, InData%iMotion) + call RegPack(RF, InData%azimuth) + call RegPack(RF, InData%rotSpeed) + call RegPack(RF, InData%rotAcc) + call RegPack(RF, InData%motionFileName) + call RegPackAlloc(RF, InData%motion) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackHubData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackHubData(RF, OutData) + type(RegFile), intent(inout) :: RF type(HubData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%origin_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%orientation_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%azimuth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rotAcc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%motion)) deallocate(OutData%motion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%motion) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%origin_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%orientation_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rotAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg) @@ -936,62 +765,38 @@ subroutine AD_Dvr_DestroyNacData(NacDataData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_Dvr_PackNacData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackNacData(RF, Indata) + type(RegFile), intent(inout) :: RF type(NacData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackNacData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%origin_t) - call RegPack(Buf, InData%motionType) - call RegPack(Buf, InData%iMotion) - call RegPack(Buf, InData%yaw) - call RegPack(Buf, InData%yawSpeed) - call RegPack(Buf, InData%yawAcc) - call RegPack(Buf, InData%motionFileName) - call RegPack(Buf, allocated(InData%motion)) - if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) - call RegPack(Buf, InData%motion) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%origin_t) + call RegPack(RF, InData%motionType) + call RegPack(RF, InData%iMotion) + call RegPack(RF, InData%yaw) + call RegPack(RF, InData%yawSpeed) + call RegPack(RF, InData%yawAcc) + call RegPack(RF, InData%motionFileName) + call RegPackAlloc(RF, InData%motion) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackNacData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackNacData(RF, OutData) + type(RegFile), intent(inout) :: RF type(NacData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%origin_t) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yawSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yawAcc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%motion)) deallocate(OutData%motion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%motion) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%origin_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyTwrData(SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg) @@ -1015,22 +820,21 @@ subroutine AD_Dvr_DestroyTwrData(TwrDataData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD_Dvr_PackTwrData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackTwrData(RF, Indata) + type(RegFile), intent(inout) :: RF type(TwrData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackTwrData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%origin_t) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%origin_t) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackTwrData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackTwrData(RF, OutData) + type(RegFile), intent(inout) :: RF type(TwrData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackTwrData' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%origin_t) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%origin_t); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg) @@ -1200,184 +1004,115 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_Dvr_PackWTData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackWTData(RF, Indata) + type(RegFile), intent(inout) :: RF type(WTData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%originInit) - call RegPack(Buf, InData%orientationInit) - call NWTC_Library_PackMeshMapType(Buf, InData%map2twrPt) - call NWTC_Library_PackMeshMapType(Buf, InData%map2nacPt) - call NWTC_Library_PackMeshMapType(Buf, InData%map2hubPt) - call RegPack(Buf, allocated(InData%map2BldPt)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%originInit) + call RegPack(RF, InData%orientationInit) + call NWTC_Library_PackMeshMapType(RF, InData%map2twrPt) + call NWTC_Library_PackMeshMapType(RF, InData%map2nacPt) + call NWTC_Library_PackMeshMapType(RF, InData%map2hubPt) + call RegPack(RF, allocated(InData%map2BldPt)) if (allocated(InData%map2BldPt)) then - call RegPackBounds(Buf, 1, lbound(InData%map2BldPt, kind=B8Ki), ubound(InData%map2BldPt, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%map2BldPt, kind=B8Ki), ubound(InData%map2BldPt, kind=B8Ki)) LB(1:1) = lbound(InData%map2BldPt, kind=B8Ki) UB(1:1) = ubound(InData%map2BldPt, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%map2BldPt(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%map2BldPt(i1)) end do end if - call RegPack(Buf, allocated(InData%bld)) + call RegPack(RF, allocated(InData%bld)) if (allocated(InData%bld)) then - call RegPackBounds(Buf, 1, lbound(InData%bld, kind=B8Ki), ubound(InData%bld, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%bld, kind=B8Ki), ubound(InData%bld, kind=B8Ki)) LB(1:1) = lbound(InData%bld, kind=B8Ki) UB(1:1) = ubound(InData%bld, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_Dvr_PackBladeData(Buf, InData%bld(i1)) + call AD_Dvr_PackBladeData(RF, InData%bld(i1)) end do end if - call AD_Dvr_PackHubData(Buf, InData%hub) - call AD_Dvr_PackNacData(Buf, InData%nac) - call AD_Dvr_PackTwrData(Buf, InData%twr) - call RegPack(Buf, InData%numBlades) - call RegPack(Buf, InData%basicHAWTFormat) - call RegPack(Buf, InData%hasTower) - call RegPack(Buf, InData%projMod) - call RegPack(Buf, InData%BEM_Mod) - call RegPack(Buf, InData%HAWTprojection) - call RegPack(Buf, InData%motionType) - call RegPack(Buf, allocated(InData%motion)) - if (allocated(InData%motion)) then - call RegPackBounds(Buf, 2, lbound(InData%motion, kind=B8Ki), ubound(InData%motion, kind=B8Ki)) - call RegPack(Buf, InData%motion) - end if - call RegPack(Buf, InData%iMotion) - call RegPack(Buf, InData%degreeOfFreedom) - call RegPack(Buf, InData%amplitude) - call RegPack(Buf, InData%frequency) - call RegPack(Buf, InData%motionFileName) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, allocated(InData%userSwapArray)) - if (allocated(InData%userSwapArray)) then - call RegPackBounds(Buf, 1, lbound(InData%userSwapArray, kind=B8Ki), ubound(InData%userSwapArray, kind=B8Ki)) - call RegPack(Buf, InData%userSwapArray) - end if - if (RegCheckErr(Buf, RoutineName)) return + call AD_Dvr_PackHubData(RF, InData%hub) + call AD_Dvr_PackNacData(RF, InData%nac) + call AD_Dvr_PackTwrData(RF, InData%twr) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%basicHAWTFormat) + call RegPack(RF, InData%hasTower) + call RegPack(RF, InData%projMod) + call RegPack(RF, InData%BEM_Mod) + call RegPack(RF, InData%HAWTprojection) + call RegPack(RF, InData%motionType) + call RegPackAlloc(RF, InData%motion) + call RegPack(RF, InData%iMotion) + call RegPack(RF, InData%degreeOfFreedom) + call RegPack(RF, InData%amplitude) + call RegPack(RF, InData%frequency) + call RegPack(RF, InData%motionFileName) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%userSwapArray) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackWTData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackWTData(RF, OutData) + type(RegFile), intent(inout) :: RF type(WTData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%originInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%orientationInit) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2twrPt) ! map2twrPt - call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2nacPt) ! map2nacPt - call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2hubPt) ! map2hubPt + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%originInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%orientationInit); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2twrPt) ! map2twrPt + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2nacPt) ! map2nacPt + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2hubPt) ! map2hubPt if (allocated(OutData%map2BldPt)) deallocate(OutData%map2BldPt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%map2BldPt(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2BldPt(i1)) ! map2BldPt + call NWTC_Library_UnpackMeshMapType(RF, OutData%map2BldPt(i1)) ! map2BldPt end do end if if (allocated(OutData%bld)) deallocate(OutData%bld) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%bld(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_Dvr_UnpackBladeData(Buf, OutData%bld(i1)) ! bld + call AD_Dvr_UnpackBladeData(RF, OutData%bld(i1)) ! bld end do end if - call AD_Dvr_UnpackHubData(Buf, OutData%hub) ! hub - call AD_Dvr_UnpackNacData(Buf, OutData%nac) ! nac - call AD_Dvr_UnpackTwrData(Buf, OutData%twr) ! twr - call RegUnpack(Buf, OutData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%basicHAWTFormat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%hasTower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%projMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWTprojection) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionType) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%motion)) deallocate(OutData%motion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%motion) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%degreeOfFreedom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%amplitude) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%frequency) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%userSwapArray)) deallocate(OutData%userSwapArray) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%userSwapArray(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%userSwapArray) - if (RegCheckErr(Buf, RoutineName)) return - end if + call AD_Dvr_UnpackHubData(RF, OutData%hub) ! hub + call AD_Dvr_UnpackNacData(RF, OutData%nac) ! nac + call AD_Dvr_UnpackTwrData(RF, OutData%twr) ! twr + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%basicHAWTFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hasTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%projMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWTprojection); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%motion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%degreeOfFreedom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%amplitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%frequency); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%motionFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%userSwapArray); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg) @@ -1501,150 +1236,111 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackDvr_SimData(RF, Indata) + type(RegFile), intent(inout) :: RF type(Dvr_SimData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AD_InputFile) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%AnalysisType) - call RegPack(Buf, InData%FldDens) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%Patm) - call RegPack(Buf, InData%Pvap) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%numTurbines) - call RegPack(Buf, allocated(InData%WT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AD_InputFile) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%AnalysisType) + call RegPack(RF, InData%FldDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%numTurbines) + call RegPack(RF, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(Buf, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) LB(1:1) = lbound(InData%WT, kind=B8Ki) UB(1:1) = ubound(InData%WT, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_Dvr_PackWTData(Buf, InData%WT(i1)) + call AD_Dvr_PackWTData(RF, InData%WT(i1)) end do end if - call RegPack(Buf, InData%dT) - call RegPack(Buf, InData%tMax) - call RegPack(Buf, InData%numSteps) - call RegPack(Buf, InData%numCases) - call RegPack(Buf, allocated(InData%Cases)) + call RegPack(RF, InData%dT) + call RegPack(RF, InData%tMax) + call RegPack(RF, InData%numSteps) + call RegPack(RF, InData%numCases) + call RegPack(RF, allocated(InData%Cases)) if (allocated(InData%Cases)) then - call RegPackBounds(Buf, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) LB(1:1) = lbound(InData%Cases, kind=B8Ki) UB(1:1) = ubound(InData%Cases, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_Dvr_PackDvr_Case(Buf, InData%Cases(i1)) + call AD_Dvr_PackDvr_Case(RF, InData%Cases(i1)) end do end if - call RegPack(Buf, InData%iCase) - call RegPack(Buf, allocated(InData%timeSeries)) - if (allocated(InData%timeSeries)) then - call RegPackBounds(Buf, 2, lbound(InData%timeSeries, kind=B8Ki), ubound(InData%timeSeries, kind=B8Ki)) - call RegPack(Buf, InData%timeSeries) - end if - call RegPack(Buf, InData%iTimeSeries) - call RegPack(Buf, InData%root) - call AD_Dvr_PackDvr_Outputs(Buf, InData%out) - call ADI_PackIW_InputData(Buf, InData%IW_InitInp) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%iCase) + call RegPackAlloc(RF, InData%timeSeries) + call RegPack(RF, InData%iTimeSeries) + call RegPack(RF, InData%root) + call AD_Dvr_PackDvr_Outputs(RF, InData%out) + call ADI_PackIW_InputData(RF, InData%IW_InitInp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackDvr_SimData(RF, OutData) + type(RegFile), intent(inout) :: RF type(Dvr_SimData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AD_InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AnalysisType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FldDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Patm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numTurbines) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AD_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AnalysisType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FldDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numTurbines); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WT)) deallocate(OutData%WT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_Dvr_UnpackWTData(Buf, OutData%WT(i1)) ! WT + call AD_Dvr_UnpackWTData(RF, OutData%WT(i1)) ! WT end do end if - call RegUnpack(Buf, OutData%dT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numSteps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numCases) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%dT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numCases); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%Cases)) deallocate(OutData%Cases) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Cases(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_Dvr_UnpackDvr_Case(Buf, OutData%Cases(i1)) ! Cases + call AD_Dvr_UnpackDvr_Case(RF, OutData%Cases(i1)) ! Cases end do end if - call RegUnpack(Buf, OutData%iCase) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%timeSeries)) deallocate(OutData%timeSeries) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%timeSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%timeSeries) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iTimeSeries) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%root) - if (RegCheckErr(Buf, RoutineName)) return - call AD_Dvr_UnpackDvr_Outputs(Buf, OutData%out) ! out - call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp + call RegUnpack(RF, OutData%iCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%timeSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iTimeSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%root); if (RegCheckErr(RF, RoutineName)) return + call AD_Dvr_UnpackDvr_Outputs(RF, OutData%out) ! out + call ADI_UnpackIW_InputData(RF, OutData%IW_InitInp) ! IW_InitInp end subroutine subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) @@ -1689,34 +1385,31 @@ subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_Dvr_PackAllData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_PackAllData(RF, Indata) + type(RegFile), intent(inout) :: RF type(AllData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackAllData' - if (Buf%ErrStat >= AbortErrLev) return - call AD_Dvr_PackDvr_SimData(Buf, InData%dvr) - call ADI_PackData(Buf, InData%ADI) - call ADI_PackFED_Data(Buf, InData%FED) - call RegPack(Buf, InData%errStat) - call RegPack(Buf, InData%errMsg) - call RegPack(Buf, InData%initialized) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_Dvr_PackDvr_SimData(RF, InData%dvr) + call ADI_PackData(RF, InData%ADI) + call ADI_PackFED_Data(RF, InData%FED) + call RegPack(RF, InData%errStat) + call RegPack(RF, InData%errMsg) + call RegPack(RF, InData%initialized) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_Dvr_UnPackAllData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_Dvr_UnPackAllData(RF, OutData) + type(RegFile), intent(inout) :: RF type(AllData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackAllData' - if (Buf%ErrStat /= ErrID_None) return - call AD_Dvr_UnpackDvr_SimData(Buf, OutData%dvr) ! dvr - call ADI_UnpackData(Buf, OutData%ADI) ! ADI - call ADI_UnpackFED_Data(Buf, OutData%FED) ! FED - call RegUnpack(Buf, OutData%errStat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%errMsg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%initialized) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call AD_Dvr_UnpackDvr_SimData(RF, OutData%dvr) ! dvr + call ADI_UnpackData(RF, OutData%ADI) ! ADI + call ADI_UnpackFED_Data(RF, OutData%FED) ! FED + call RegUnpack(RF, OutData%errStat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%errMsg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE AeroDyn_Driver_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index c243d8f180..8d6ef20206 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -244,47 +244,43 @@ subroutine ADI_DestroyInflowWindData(InflowWindDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackInflowWindData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackInflowWindData(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_InflowWindData), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInflowWindData' - if (Buf%ErrStat >= AbortErrLev) return - call InflowWind_PackContState(Buf, InData%x) - call InflowWind_PackDiscState(Buf, InData%xd) - call InflowWind_PackConstrState(Buf, InData%z) - call InflowWind_PackOtherState(Buf, InData%OtherSt) - call InflowWind_PackParam(Buf, InData%p) - call InflowWind_PackMisc(Buf, InData%m) - call InflowWind_PackInput(Buf, InData%u) - call InflowWind_PackOutput(Buf, InData%y) - call RegPack(Buf, InData%CompInflow) - call RegPack(Buf, InData%HWindSpeed) - call RegPack(Buf, InData%RefHt) - call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call InflowWind_PackContState(RF, InData%x) + call InflowWind_PackDiscState(RF, InData%xd) + call InflowWind_PackConstrState(RF, InData%z) + call InflowWind_PackOtherState(RF, InData%OtherSt) + call InflowWind_PackParam(RF, InData%p) + call InflowWind_PackMisc(RF, InData%m) + call InflowWind_PackInput(RF, InData%u) + call InflowWind_PackOutput(RF, InData%y) + call RegPack(RF, InData%CompInflow) + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%PLExp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackInflowWindData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackInflowWindData(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_InflowWindData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInflowWindData' - if (Buf%ErrStat /= ErrID_None) return - call InflowWind_UnpackContState(Buf, OutData%x) ! x - call InflowWind_UnpackDiscState(Buf, OutData%xd) ! xd - call InflowWind_UnpackConstrState(Buf, OutData%z) ! z - call InflowWind_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - call InflowWind_UnpackParam(Buf, OutData%p) ! p - call InflowWind_UnpackMisc(Buf, OutData%m) ! m - call InflowWind_UnpackInput(Buf, OutData%u) ! u - call InflowWind_UnpackOutput(Buf, OutData%y) ! y - call RegUnpack(Buf, OutData%CompInflow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call InflowWind_UnpackContState(RF, OutData%x) ! x + call InflowWind_UnpackDiscState(RF, OutData%xd) ! xd + call InflowWind_UnpackConstrState(RF, OutData%z) ! z + call InflowWind_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call InflowWind_UnpackParam(RF, OutData%p) ! p + call InflowWind_UnpackMisc(RF, OutData%m) ! m + call InflowWind_UnpackInput(RF, OutData%u) ! u + call InflowWind_UnpackOutput(RF, OutData%y) ! y + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg) @@ -324,45 +320,37 @@ subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackIW_InputData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackIW_InputData(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_IW_InputData), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackIW_InputData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%CompInflow) - call RegPack(Buf, InData%HWindSpeed) - call RegPack(Buf, InData%RefHt) - call RegPack(Buf, InData%PLExp) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%CompInflow) + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, InData%Linearize) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackIW_InputData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackIW_InputData(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_IW_InputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackIW_InputData' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompInflow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -404,38 +392,33 @@ subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackInitInput(Buf, InData%AD) - call ADI_PackIW_InputData(Buf, InData%IW_InitInp) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%storeHHVel) - call RegPack(Buf, InData%WrVTK) - call RegPack(Buf, InData%WrVTK_Type) - call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackInitInput(RF, InData%AD) + call ADI_PackIW_InputData(RF, InData%IW_InitInp) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%storeHHVel) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%WrVTK_Type) + call RegPack(RF, InData%WtrDpth) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackInitInput(Buf, OutData%AD) ! AD - call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%storeHHVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK_Type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackInitInput(RF, OutData%AD) ! AD + call ADI_UnpackIW_InputData(RF, OutData%IW_InitInp) ! IW_InitInp + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%storeHHVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -498,62 +481,28 @@ subroutine ADI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ADI_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -585,21 +534,21 @@ subroutine ADI_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackContState(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackContState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackContState(Buf, OutData%AD) ! AD + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackContState(RF, OutData%AD) ! AD end subroutine subroutine ADI_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -631,21 +580,21 @@ subroutine ADI_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackDiscState(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackDiscState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackDiscState(Buf, OutData%AD) ! AD + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackDiscState(RF, OutData%AD) ! AD end subroutine subroutine ADI_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -677,21 +626,21 @@ subroutine ADI_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackConstrState(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackConstrState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackConstrState(Buf, OutData%AD) ! AD + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackConstrState(RF, OutData%AD) ! AD end subroutine subroutine ADI_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -723,21 +672,21 @@ subroutine ADI_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackOtherState(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackOtherState(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackOtherState(Buf, OutData%AD) ! AD + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackOtherState(RF, OutData%AD) ! AD end subroutine subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -803,51 +752,49 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine ADI_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackMisc(Buf, InData%AD) - call ADI_PackInflowWindData(Buf, InData%IW) - call RegPack(Buf, allocated(InData%VTK_surfaces)) + if (RF%ErrStat >= AbortErrLev) return + call AD_PackMisc(RF, InData%AD) + call ADI_PackInflowWindData(RF, InData%IW) + call RegPack(RF, allocated(InData%VTK_surfaces)) if (allocated(InData%VTK_surfaces)) then - call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces, kind=B8Ki), ubound(InData%VTK_surfaces, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VTK_surfaces, kind=B8Ki), ubound(InData%VTK_surfaces, kind=B8Ki)) LB(1:1) = lbound(InData%VTK_surfaces, kind=B8Ki) UB(1:1) = ubound(InData%VTK_surfaces, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackVTK_RotSurfaceType(Buf, InData%VTK_surfaces(i1)) + call AD_PackVTK_RotSurfaceType(RF, InData%VTK_surfaces(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackMisc(Buf, OutData%AD) ! AD - call ADI_UnpackInflowWindData(Buf, OutData%IW) ! IW + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackMisc(RF, OutData%AD) ! AD + call ADI_UnpackInflowWindData(RF, OutData%IW) ! IW if (allocated(OutData%VTK_surfaces)) deallocate(OutData%VTK_surfaces) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VTK_surfaces(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackVTK_RotSurfaceType(Buf, OutData%VTK_surfaces(i1)) ! VTK_surfaces + call AD_UnpackVTK_RotSurfaceType(RF, OutData%VTK_surfaces(i1)) ! VTK_surfaces end do end if end subroutine @@ -888,42 +835,35 @@ subroutine ADI_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackParam(Buf, InData%AD) - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%storeHHVel) - call RegPack(Buf, InData%wrVTK) - call RegPack(Buf, InData%WrVTK_Type) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackParam(RF, InData%AD) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%storeHHVel) + call RegPack(RF, InData%wrVTK) + call RegPack(RF, InData%WrVTK_Type) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackParam' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackParam(Buf, OutData%AD) ! AD - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%storeHHVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%wrVTK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK_Type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackParam(RF, OutData%AD) ! AD + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%storeHHVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%wrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -955,21 +895,21 @@ subroutine ADI_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackInput(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackInput(RF, InData%AD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackInput(Buf, OutData%AD) ! AD + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackInput(RF, OutData%AD) ! AD end subroutine subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1048,84 +988,32 @@ subroutine ADI_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ADI_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call AD_PackOutput(Buf, InData%AD) - call RegPack(Buf, allocated(InData%HHVel)) - if (allocated(InData%HHVel)) then - call RegPackBounds(Buf, 2, lbound(InData%HHVel, kind=B8Ki), ubound(InData%HHVel, kind=B8Ki)) - call RegPack(Buf, InData%HHVel) - end if - call RegPack(Buf, InData%PLExp) - call RegPack(Buf, allocated(InData%IW_WriteOutput)) - if (allocated(InData%IW_WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput, kind=B8Ki), ubound(InData%IW_WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%IW_WriteOutput) - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AD_PackOutput(RF, InData%AD) + call RegPackAlloc(RF, InData%HHVel) + call RegPack(RF, InData%PLExp) + call RegPackAlloc(RF, InData%IW_WriteOutput) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackOutput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call AD_UnpackOutput(Buf, OutData%AD) ! AD - if (allocated(OutData%HHVel)) deallocate(OutData%HHVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HHVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HHVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HHVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%IW_WriteOutput)) deallocate(OutData%IW_WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IW_WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IW_WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IW_WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call AD_UnpackOutput(RF, OutData%AD) ! AD + call RegUnpackAlloc(RF, OutData%HHVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IW_WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) @@ -1311,170 +1199,143 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) end if end subroutine -subroutine ADI_PackData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackData(RF, Indata) + type(RegFile), intent(inout) :: RF type(ADI_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackData' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%x)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call ADI_PackContState(Buf, InData%x(i1)) + call ADI_PackContState(RF, InData%x(i1)) end do end if - call RegPack(Buf, allocated(InData%xd)) + call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(Buf, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call ADI_PackDiscState(Buf, InData%xd(i1)) + call ADI_PackDiscState(RF, InData%xd(i1)) end do end if - call RegPack(Buf, allocated(InData%z)) + call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call ADI_PackConstrState(Buf, InData%z(i1)) + call ADI_PackConstrState(RF, InData%z(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherState)) + call RegPack(RF, allocated(InData%OtherState)) if (allocated(InData%OtherState)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherState, kind=B8Ki), ubound(InData%OtherState, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherState, kind=B8Ki), ubound(InData%OtherState, kind=B8Ki)) LB(1:1) = lbound(InData%OtherState, kind=B8Ki) UB(1:1) = ubound(InData%OtherState, kind=B8Ki) do i1 = LB(1), UB(1) - call ADI_PackOtherState(Buf, InData%OtherState(i1)) + call ADI_PackOtherState(RF, InData%OtherState(i1)) end do end if - call ADI_PackParam(Buf, InData%p) - call ADI_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%u)) + call ADI_PackParam(RF, InData%p) + call ADI_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) LB(1:1) = lbound(InData%u, kind=B8Ki) UB(1:1) = ubound(InData%u, kind=B8Ki) do i1 = LB(1), UB(1) - call ADI_PackInput(Buf, InData%u(i1)) + call ADI_PackInput(RF, InData%u(i1)) end do end if - call ADI_PackOutput(Buf, InData%y) - call RegPack(Buf, allocated(InData%inputTimes)) - if (allocated(InData%inputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%inputTimes, kind=B8Ki), ubound(InData%inputTimes, kind=B8Ki)) - call RegPack(Buf, InData%inputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call ADI_PackOutput(RF, InData%y) + call RegPackAlloc(RF, InData%inputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackData(RF, OutData) + type(RegFile), intent(inout) :: RF type(ADI_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackData' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADI_UnpackContState(Buf, OutData%x(i1)) ! x + call ADI_UnpackContState(RF, OutData%x(i1)) ! x end do end if if (allocated(OutData%xd)) deallocate(OutData%xd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADI_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call ADI_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do end if if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADI_UnpackConstrState(Buf, OutData%z(i1)) ! z + call ADI_UnpackConstrState(RF, OutData%z(i1)) ! z end do end if if (allocated(OutData%OtherState)) deallocate(OutData%OtherState) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherState(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADI_UnpackOtherState(Buf, OutData%OtherState(i1)) ! OtherState + call ADI_UnpackOtherState(RF, OutData%OtherState(i1)) ! OtherState end do end if - call ADI_UnpackParam(Buf, OutData%p) ! p - call ADI_UnpackMisc(Buf, OutData%m) ! m + call ADI_UnpackParam(RF, OutData%p) ! p + call ADI_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADI_UnpackInput(Buf, OutData%u(i1)) ! u + call ADI_UnpackInput(RF, OutData%u(i1)) ! u end do end if - call ADI_UnpackOutput(Buf, OutData%y) ! y - if (allocated(OutData%inputTimes)) deallocate(OutData%inputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%inputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%inputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%inputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call ADI_UnpackOutput(RF, OutData%y) ! y + call RegUnpackAlloc(RF, OutData%inputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg) @@ -1658,150 +1519,139 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ADI_PackRotFED(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackRotFED(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotFED), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackRotFED' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PlatformPtMesh) - call MeshPack(Buf, InData%TwrPtMesh) - call MeshPack(Buf, InData%TwrPtMeshAD) - call MeshPack(Buf, InData%NacelleMotion) - call MeshPack(Buf, InData%HubPtMotion) - call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TwrPtMesh) + call MeshPack(RF, InData%TwrPtMeshAD) + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%HubPtMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeRootMotion(i1)) + call MeshPack(RF, InData%BladeRootMotion(i1)) end do end if - call RegPack(Buf, allocated(InData%BladeLn2Mesh)) + call RegPack(RF, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeLn2Mesh(i1)) + call MeshPack(RF, InData%BladeLn2Mesh(i1)) end do end if - call RegPack(Buf, InData%hasTower) - call RegPack(Buf, InData%rigidBlades) - call RegPack(Buf, InData%numBlades) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_T) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_T) - call RegPack(Buf, allocated(InData%AD_P_2_AD_L_B)) + call RegPack(RF, InData%hasTower) + call RegPack(RF, InData%rigidBlades) + call RegPack(RF, InData%numBlades) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_T) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_T) + call RegPack(RF, allocated(InData%AD_P_2_AD_L_B)) if (allocated(InData%AD_P_2_AD_L_B)) then - call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B, kind=B8Ki), ubound(InData%AD_P_2_AD_L_B, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%AD_P_2_AD_L_B, kind=B8Ki), ubound(InData%AD_P_2_AD_L_B, kind=B8Ki)) LB(1:1) = lbound(InData%AD_P_2_AD_L_B, kind=B8Ki) UB(1:1) = ubound(InData%AD_P_2_AD_L_B, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_B(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_B(i1)) end do end if - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) - call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_TF) + call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) end do end if - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) - if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_N) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackRotFED(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackRotFED(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotFED), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh - call MeshUnpack(Buf, OutData%TwrPtMesh) ! TwrPtMesh - call MeshUnpack(Buf, OutData%TwrPtMeshAD) ! TwrPtMeshAD - call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion - call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TwrPtMesh) ! TwrPtMesh + call MeshUnpack(RF, OutData%TwrPtMeshAD) ! TwrPtMeshAD + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + call MeshUnpack(RF, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh end do end if - call RegUnpack(Buf, OutData%hasTower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rigidBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_T) ! ED_P_2_AD_P_T - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_T) ! AD_P_2_AD_L_T + call RegUnpack(RF, OutData%hasTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rigidBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_T) ! ED_P_2_AD_P_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_AD_L_T) ! AD_P_2_AD_L_T if (allocated(OutData%AD_P_2_AD_L_B)) deallocate(OutData%AD_P_2_AD_L_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%AD_P_2_AD_L_B(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_B(i1)) ! AD_P_2_AD_L_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_AD_L_B(i1)) ! AD_P_2_AD_L_B end do end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R end do end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N end subroutine subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg) @@ -1857,47 +1707,45 @@ subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine ADI_PackFED_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_PackFED_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(FED_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackFED_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(Buf, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) LB(1:1) = lbound(InData%WT, kind=B8Ki) UB(1:1) = ubound(InData%WT, kind=B8Ki) do i1 = LB(1), UB(1) - call ADI_PackRotFED(Buf, InData%WT(i1)) + call ADI_PackRotFED(RF, InData%WT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ADI_UnPackFED_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ADI_UnPackFED_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(FED_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%WT)) deallocate(OutData%WT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ADI_UnpackRotFED(Buf, OutData%WT(i1)) ! WT + call ADI_UnpackRotFED(RF, OutData%WT(i1)) ! WT end do end if end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 09b91be6f3..fa691fffed 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -524,34 +524,29 @@ subroutine AD_DestroyTFinParameterType(TFinParameterTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD_PackTFinParameterType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackTFinParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF type(TFinParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackTFinParameterType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%TFinMod) - call RegPack(Buf, InData%TFinChord) - call RegPack(Buf, InData%TFinArea) - call RegPack(Buf, InData%TFinIndMod) - call RegPack(Buf, InData%TFinAFID) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TFinMod) + call RegPack(RF, InData%TFinChord) + call RegPack(RF, InData%TFinArea) + call RegPack(RF, InData%TFinIndMod) + call RegPack(RF, InData%TFinAFID) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackTFinParameterType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackTFinParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF type(TFinParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackTFinParameterType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%TFinMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinChord) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinArea) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinIndMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinAFID) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TFinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinIndMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAFID); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyTFinInputFileType(SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg) @@ -581,40 +576,33 @@ subroutine AD_DestroyTFinInputFileType(TFinInputFileTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD_PackTFinInputFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackTFinInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF type(TFinInputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackTFinInputFileType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%TFinMod) - call RegPack(Buf, InData%TFinChord) - call RegPack(Buf, InData%TFinArea) - call RegPack(Buf, InData%TFinRefP_n) - call RegPack(Buf, InData%TFinAngles) - call RegPack(Buf, InData%TFinIndMod) - call RegPack(Buf, InData%TFinAFID) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TFinMod) + call RegPack(RF, InData%TFinChord) + call RegPack(RF, InData%TFinArea) + call RegPack(RF, InData%TFinRefP_n) + call RegPack(RF, InData%TFinAngles) + call RegPack(RF, InData%TFinIndMod) + call RegPack(RF, InData%TFinAFID) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackTFinInputFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackTFinInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF type(TFinInputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackTFinInputFileType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%TFinMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinChord) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinArea) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinRefP_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinAngles) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinIndMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinAFID) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TFinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRefP_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAngles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinIndMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAFID); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) @@ -654,41 +642,24 @@ subroutine AD_DestroyVTK_BLSurfaceType(VTK_BLSurfaceTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackVTK_BLSurfaceType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackVTK_BLSurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_VTK_BLSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackVTK_BLSurfaceType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AirfoilCoords)) - if (allocated(InData%AirfoilCoords)) then - call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords, kind=B8Ki), ubound(InData%AirfoilCoords, kind=B8Ki)) - call RegPack(Buf, InData%AirfoilCoords) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AirfoilCoords) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackVTK_BLSurfaceType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackVTK_BLSurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AirfoilCoords) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AirfoilCoords); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) @@ -759,68 +730,49 @@ subroutine AD_DestroyVTK_RotSurfaceType(VTK_RotSurfaceTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackVTK_RotSurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_VTK_RotSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%BladeShape)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) + call AD_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) end do end if - call RegPack(Buf, allocated(InData%TowerRad)) - if (allocated(InData%TowerRad)) then - call RegPackBounds(Buf, 1, lbound(InData%TowerRad, kind=B8Ki), ubound(InData%TowerRad, kind=B8Ki)) - call RegPack(Buf, InData%TowerRad) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%TowerRad) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackVTK_RotSurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_VTK_RotSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape + call AD_UnpackVTK_BLSurfaceType(RF, OutData%BladeShape(i1)) ! BladeShape end do end if - if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TowerRad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TowerRad) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%TowerRad); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -884,87 +836,44 @@ subroutine AD_DestroyRotInitInputType(RotInitInputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackRotInitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotInitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotInitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumBlades) - call RegPack(Buf, InData%originInit) - call RegPack(Buf, InData%HubPosition) - call RegPack(Buf, InData%HubOrientation) - call RegPack(Buf, allocated(InData%BladeRootPosition)) - if (allocated(InData%BladeRootPosition)) then - call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition, kind=B8Ki), ubound(InData%BladeRootPosition, kind=B8Ki)) - call RegPack(Buf, InData%BladeRootPosition) - end if - call RegPack(Buf, allocated(InData%BladeRootOrientation)) - if (allocated(InData%BladeRootOrientation)) then - call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation, kind=B8Ki), ubound(InData%BladeRootOrientation, kind=B8Ki)) - call RegPack(Buf, InData%BladeRootOrientation) - end if - call RegPack(Buf, InData%NacellePosition) - call RegPack(Buf, InData%NacelleOrientation) - call RegPack(Buf, InData%AeroProjMod) - call RegPack(Buf, InData%AeroBEM_Mod) - call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%originInit) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%HubOrientation) + call RegPackAlloc(RF, InData%BladeRootPosition) + call RegPackAlloc(RF, InData%BladeRootOrientation) + call RegPack(RF, InData%NacellePosition) + call RegPack(RF, InData%NacelleOrientation) + call RegPack(RF, InData%AeroProjMod) + call RegPack(RF, InData%AeroBEM_Mod) + call RegPack(RF, InData%RotSpeed) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotInitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotInitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotInitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%originInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubOrientation) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BladeRootPosition)) deallocate(OutData%BladeRootPosition) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BladeRootPosition) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BladeRootOrientation)) deallocate(OutData%BladeRootOrientation) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BladeRootOrientation) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NacellePosition) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacelleOrientation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AeroProjMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AeroBEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%originInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacellePosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroBEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -1039,93 +948,77 @@ subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotInitInputType(Buf, InData%rotors(i1)) + call AD_PackRotInitInputType(RF, InData%rotors(i1)) end do end if - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%UsePrimaryInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%CompAeroMaps) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%defFldDens) - call RegPack(Buf, InData%defKinVisc) - call RegPack(Buf, InData%defSpdSound) - call RegPack(Buf, InData%defPatm) - call RegPack(Buf, InData%defPvap) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%UsePrimaryInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%defFldDens) + call RegPack(RF, InData%defKinVisc) + call RegPack(RF, InData%defSpdSound) + call RegPack(RF, InData%defPatm) + call RegPack(RF, InData%defPvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInitInputType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotInitInputType(RF, OutData%rotors(i1)) ! rotors end do end if - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UsePrimaryInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defFldDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defKinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defSpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defPatm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defPvap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePrimaryInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defFldDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defKinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defSpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defPatm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defPvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1301,215 +1194,44 @@ subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackBladePropsType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackBladePropsType(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_BladePropsType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackBladePropsType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumBlNds) - call RegPack(Buf, allocated(InData%BlSpn)) - if (allocated(InData%BlSpn)) then - call RegPackBounds(Buf, 1, lbound(InData%BlSpn, kind=B8Ki), ubound(InData%BlSpn, kind=B8Ki)) - call RegPack(Buf, InData%BlSpn) - end if - call RegPack(Buf, allocated(InData%BlCrvAC)) - if (allocated(InData%BlCrvAC)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC, kind=B8Ki), ubound(InData%BlCrvAC, kind=B8Ki)) - call RegPack(Buf, InData%BlCrvAC) - end if - call RegPack(Buf, allocated(InData%BlSwpAC)) - if (allocated(InData%BlSwpAC)) then - call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC, kind=B8Ki), ubound(InData%BlSwpAC, kind=B8Ki)) - call RegPack(Buf, InData%BlSwpAC) - end if - call RegPack(Buf, allocated(InData%BlCrvAng)) - if (allocated(InData%BlCrvAng)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng, kind=B8Ki), ubound(InData%BlCrvAng, kind=B8Ki)) - call RegPack(Buf, InData%BlCrvAng) - end if - call RegPack(Buf, allocated(InData%BlTwist)) - if (allocated(InData%BlTwist)) then - call RegPackBounds(Buf, 1, lbound(InData%BlTwist, kind=B8Ki), ubound(InData%BlTwist, kind=B8Ki)) - call RegPack(Buf, InData%BlTwist) - end if - call RegPack(Buf, allocated(InData%BlChord)) - if (allocated(InData%BlChord)) then - call RegPackBounds(Buf, 1, lbound(InData%BlChord, kind=B8Ki), ubound(InData%BlChord, kind=B8Ki)) - call RegPack(Buf, InData%BlChord) - end if - call RegPack(Buf, allocated(InData%BlAFID)) - if (allocated(InData%BlAFID)) then - call RegPackBounds(Buf, 1, lbound(InData%BlAFID, kind=B8Ki), ubound(InData%BlAFID, kind=B8Ki)) - call RegPack(Buf, InData%BlAFID) - end if - call RegPack(Buf, allocated(InData%BlCb)) - if (allocated(InData%BlCb)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCb, kind=B8Ki), ubound(InData%BlCb, kind=B8Ki)) - call RegPack(Buf, InData%BlCb) - end if - call RegPack(Buf, allocated(InData%BlCenBn)) - if (allocated(InData%BlCenBn)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCenBn, kind=B8Ki), ubound(InData%BlCenBn, kind=B8Ki)) - call RegPack(Buf, InData%BlCenBn) - end if - call RegPack(Buf, allocated(InData%BlCenBt)) - if (allocated(InData%BlCenBt)) then - call RegPackBounds(Buf, 1, lbound(InData%BlCenBt, kind=B8Ki), ubound(InData%BlCenBt, kind=B8Ki)) - call RegPack(Buf, InData%BlCenBt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlNds) + call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlCrvAC) + call RegPackAlloc(RF, InData%BlSwpAC) + call RegPackAlloc(RF, InData%BlCrvAng) + call RegPackAlloc(RF, InData%BlTwist) + call RegPackAlloc(RF, InData%BlChord) + call RegPackAlloc(RF, InData%BlAFID) + call RegPackAlloc(RF, InData%BlCb) + call RegPackAlloc(RF, InData%BlCenBn) + call RegPackAlloc(RF, InData%BlCenBt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackBladePropsType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackBladePropsType(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_BladePropsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlSpn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlSpn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCrvAC)) deallocate(OutData%BlCrvAC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCrvAC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCrvAC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlSwpAC)) deallocate(OutData%BlSwpAC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlSwpAC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlSwpAC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCrvAng)) deallocate(OutData%BlCrvAng) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCrvAng(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCrvAng) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlTwist(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlTwist) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlChord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlChord) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlAFID(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlAFID) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCb)) deallocate(OutData%BlCb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCenBn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCenBn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCenBt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCenBt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCrvAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlSwpAC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCrvAng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg) @@ -1549,41 +1271,24 @@ subroutine AD_DestroyBladeShape(BladeShapeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackBladeShape(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackBladeShape(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_BladeShape), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackBladeShape' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AirfoilCoords)) - if (allocated(InData%AirfoilCoords)) then - call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords, kind=B8Ki), ubound(InData%AirfoilCoords, kind=B8Ki)) - call RegPack(Buf, InData%AirfoilCoords) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AirfoilCoords) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackBladeShape(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackBladeShape(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_BladeShape), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AirfoilCoords) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AirfoilCoords); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1845,304 +1550,95 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackRotInitOutputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotInitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotInitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call RegPack(Buf, allocated(InData%BladeShape)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AirDens) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackBladeShape(Buf, InData%BladeShape(i1)) + call AD_PackBladeShape(RF, InData%BladeShape(i1)) end do end if - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%BladeProps)) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) + call AD_PackBladePropsType(RF, InData%BladeProps(i1)) end do end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - call RegPack(Buf, allocated(InData%TwrElev)) - if (allocated(InData%TwrElev)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrElev, kind=B8Ki), ubound(InData%TwrElev, kind=B8Ki)) - call RegPack(Buf, InData%TwrElev) - end if - call RegPack(Buf, allocated(InData%TwrDiam)) - if (allocated(InData%TwrDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDiam, kind=B8Ki), ubound(InData%TwrDiam, kind=B8Ki)) - call RegPack(Buf, InData%TwrDiam) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%TwrElev) + call RegPackAlloc(RF, InData%TwrDiam) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotInitOutputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotInitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotInitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackBladeShape(Buf, OutData%BladeShape(i1)) ! BladeShape + call AD_UnpackBladeShape(RF, OutData%BladeShape(i1)) ! BladeShape end do end if - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + call AD_UnpackBladePropsType(RF, OutData%BladeProps(i1)) ! BladeProps end do end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrElev(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrElev) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrDiam) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2203,51 +1699,49 @@ subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotInitOutputType(Buf, InData%rotors(i1)) + call AD_PackRotInitOutputType(RF, InData%rotors(i1)) end do end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInitOutputType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotInitOutputType(RF, OutData%rotors(i1)) ! rotors end do end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -2390,167 +1884,73 @@ subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotInputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputFile' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%BladeProps)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) + call AD_PackBladePropsType(RF, InData%BladeProps(i1)) end do end if - call RegPack(Buf, InData%NumTwrNds) - call RegPack(Buf, allocated(InData%TwrElev)) - if (allocated(InData%TwrElev)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrElev, kind=B8Ki), ubound(InData%TwrElev, kind=B8Ki)) - call RegPack(Buf, InData%TwrElev) - end if - call RegPack(Buf, allocated(InData%TwrDiam)) - if (allocated(InData%TwrDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDiam, kind=B8Ki), ubound(InData%TwrDiam, kind=B8Ki)) - call RegPack(Buf, InData%TwrDiam) - end if - call RegPack(Buf, allocated(InData%TwrCd)) - if (allocated(InData%TwrCd)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCd, kind=B8Ki), ubound(InData%TwrCd, kind=B8Ki)) - call RegPack(Buf, InData%TwrCd) - end if - call RegPack(Buf, allocated(InData%TwrTI)) - if (allocated(InData%TwrTI)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrTI, kind=B8Ki), ubound(InData%TwrTI, kind=B8Ki)) - call RegPack(Buf, InData%TwrTI) - end if - call RegPack(Buf, allocated(InData%TwrCb)) - if (allocated(InData%TwrCb)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCb, kind=B8Ki), ubound(InData%TwrCb, kind=B8Ki)) - call RegPack(Buf, InData%TwrCb) - end if - call RegPack(Buf, InData%VolHub) - call RegPack(Buf, InData%HubCenBx) - call RegPack(Buf, InData%VolNac) - call RegPack(Buf, InData%NacCenB) - call RegPack(Buf, InData%TFinAero) - call RegPack(Buf, InData%TFinFile) - call AD_PackTFinInputFileType(Buf, InData%TFin) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%NumTwrNds) + call RegPackAlloc(RF, InData%TwrElev) + call RegPackAlloc(RF, InData%TwrDiam) + call RegPackAlloc(RF, InData%TwrCd) + call RegPackAlloc(RF, InData%TwrTI) + call RegPackAlloc(RF, InData%TwrCb) + call RegPack(RF, InData%VolHub) + call RegPack(RF, InData%HubCenBx) + call RegPack(RF, InData%VolNac) + call RegPack(RF, InData%NacCenB) + call RegPack(RF, InData%TFinAero) + call RegPack(RF, InData%TFinFile) + call AD_PackTFinInputFileType(RF, InData%TFin) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotInputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + call AD_UnpackBladePropsType(RF, OutData%BladeProps(i1)) ! BladeProps end do end if - call RegUnpack(Buf, OutData%NumTwrNds) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrElev(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrElev) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrDiam) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrCd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrCd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrTI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrTI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrCb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrCb) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%VolHub) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubCenBx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VolNac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCenB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinFile) - if (RegCheckErr(Buf, RoutineName)) return - call AD_UnpackTFinInputFileType(Buf, OutData%TFin) ! TFin + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinFile); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackTFinInputFileType(RF, OutData%TFin) ! TFin end subroutine subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -2716,273 +2116,153 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInputFile' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%DTAero) - call RegPack(Buf, InData%WakeMod) - call RegPack(Buf, InData%AFAeroMod) - call RegPack(Buf, InData%TwrPotent) - call RegPack(Buf, InData%TwrShadow) - call RegPack(Buf, InData%TwrAero) - call RegPack(Buf, InData%FrozenWake) - call RegPack(Buf, InData%CavitCheck) - call RegPack(Buf, InData%Buoyancy) - call RegPack(Buf, InData%CompAA) - call RegPack(Buf, InData%AA_InputFile) - call RegPack(Buf, allocated(InData%ADBlFile)) - if (allocated(InData%ADBlFile)) then - call RegPackBounds(Buf, 1, lbound(InData%ADBlFile, kind=B8Ki), ubound(InData%ADBlFile, kind=B8Ki)) - call RegPack(Buf, InData%ADBlFile) - end if - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%Patm) - call RegPack(Buf, InData%Pvap) - call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%SkewMod) - call RegPack(Buf, InData%SkewModFactor) - call RegPack(Buf, InData%TipLoss) - call RegPack(Buf, InData%HubLoss) - call RegPack(Buf, InData%TanInd) - call RegPack(Buf, InData%AIDrag) - call RegPack(Buf, InData%TIDrag) - call RegPack(Buf, InData%IndToler) - call RegPack(Buf, InData%MaxIter) - call RegPack(Buf, InData%UAMod) - call RegPack(Buf, InData%FLookup) - call RegPack(Buf, InData%InCol_Alfa) - call RegPack(Buf, InData%InCol_Cl) - call RegPack(Buf, InData%InCol_Cd) - call RegPack(Buf, InData%InCol_Cm) - call RegPack(Buf, InData%InCol_Cpmin) - call RegPack(Buf, InData%AFTabMod) - call RegPack(Buf, InData%NumAFfiles) - call RegPack(Buf, InData%FVWFileName) - call RegPack(Buf, allocated(InData%AFNames)) - if (allocated(InData%AFNames)) then - call RegPackBounds(Buf, 1, lbound(InData%AFNames, kind=B8Ki), ubound(InData%AFNames, kind=B8Ki)) - call RegPack(Buf, InData%AFNames) - end if - call RegPack(Buf, InData%UseBlCm) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%NBlOuts) - call RegPack(Buf, InData%BlOutNd) - call RegPack(Buf, InData%NTwOuts) - call RegPack(Buf, InData%TwOutNd) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%tau1_const) - call RegPack(Buf, InData%DBEMT_Mod) - call RegPack(Buf, InData%BldNd_NumOuts) - call RegPack(Buf, allocated(InData%BldNd_OutList)) - if (allocated(InData%BldNd_OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList, kind=B8Ki), ubound(InData%BldNd_OutList, kind=B8Ki)) - call RegPack(Buf, InData%BldNd_OutList) - end if - call RegPack(Buf, InData%BldNd_BlOutNd_Str) - call RegPack(Buf, InData%BldNd_BladesOut) - call RegPack(Buf, InData%UAStartRad) - call RegPack(Buf, InData%UAEndRad) - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%DTAero) + call RegPack(RF, InData%WakeMod) + call RegPack(RF, InData%AFAeroMod) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%FrozenWake) + call RegPack(RF, InData%CavitCheck) + call RegPack(RF, InData%Buoyancy) + call RegPack(RF, InData%CompAA) + call RegPack(RF, InData%AA_InputFile) + call RegPackAlloc(RF, InData%ADBlFile) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%SkewMod) + call RegPack(RF, InData%SkewModFactor) + call RegPack(RF, InData%TipLoss) + call RegPack(RF, InData%HubLoss) + call RegPack(RF, InData%TanInd) + call RegPack(RF, InData%AIDrag) + call RegPack(RF, InData%TIDrag) + call RegPack(RF, InData%IndToler) + call RegPack(RF, InData%MaxIter) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%FLookup) + call RegPack(RF, InData%InCol_Alfa) + call RegPack(RF, InData%InCol_Cl) + call RegPack(RF, InData%InCol_Cd) + call RegPack(RF, InData%InCol_Cm) + call RegPack(RF, InData%InCol_Cpmin) + call RegPack(RF, InData%AFTabMod) + call RegPack(RF, InData%NumAFfiles) + call RegPack(RF, InData%FVWFileName) + call RegPackAlloc(RF, InData%AFNames) + call RegPack(RF, InData%UseBlCm) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NBlOuts) + call RegPack(RF, InData%BlOutNd) + call RegPack(RF, InData%NTwOuts) + call RegPack(RF, InData%TwOutNd) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%tau1_const) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPackAlloc(RF, InData%BldNd_OutList) + call RegPack(RF, InData%BldNd_BlOutNd_Str) + call RegPack(RF, InData%BldNd_BladesOut) + call RegPack(RF, InData%UAStartRad) + call RegPack(RF, InData%UAEndRad) + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotInputFile(Buf, InData%rotors(i1)) + call AD_PackRotInputFile(RF, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInputFile' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AFAeroMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrPotent) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrShadow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrozenWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CavitCheck) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Buoyancy) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AA_InputFile) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ADBlFile)) deallocate(OutData%ADBlFile) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ADBlFile(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADBlFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ADBlFile) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Patm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SkewMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SkewModFactor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TipLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TanInd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AIDrag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TIDrag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IndToler) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MaxIter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FLookup) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Alfa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cpmin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AFTabMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumAFfiles) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FVWFileName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AFNames)) deallocate(OutData%AFNames) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFNames(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFNames) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UseBlCm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBlOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTwOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwOutNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldNd_OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAStartRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAEndRad) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFAeroMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrozenWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AA_InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ADBlFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SkewMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SkewModFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IndToler); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FLookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Alfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFTabMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumAFfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FVWFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseBlCm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BlOutNd_Str); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAStartRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAEndRad); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInputFile(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotInputFile(RF, OutData%rotors(i1)) ! rotors end do end if end subroutine @@ -3021,23 +2301,23 @@ subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotContinuousStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' - if (Buf%ErrStat >= AbortErrLev) return - call BEMT_PackContState(Buf, InData%BEMT) - call AA_PackContState(Buf, InData%AA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackContState(RF, InData%BEMT) + call AA_PackContState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotContinuousStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' - if (Buf%ErrStat /= ErrID_None) return - call BEMT_UnpackContState(Buf, OutData%BEMT) ! BEMT - call AA_UnpackContState(Buf, OutData%AA) ! AA + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackContState(RF, OutData%BEMT) ! BEMT + call AA_UnpackContState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -3098,51 +2378,49 @@ subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotContinuousStateType(Buf, InData%rotors(i1)) + call AD_PackRotContinuousStateType(RF, InData%rotors(i1)) end do end if - call FVW_PackContState(Buf, InData%FVW) - if (RegCheckErr(Buf, RoutineName)) return + call FVW_PackContState(RF, InData%FVW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotContinuousStateType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotContinuousStateType(RF, OutData%rotors(i1)) ! rotors end do end if - call FVW_UnpackContState(Buf, OutData%FVW) ! FVW + call FVW_UnpackContState(RF, OutData%FVW) ! FVW end subroutine subroutine AD_CopyRotDiscreteStateType(SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3179,23 +2457,23 @@ subroutine AD_DestroyRotDiscreteStateType(RotDiscreteStateTypeData, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotDiscreteStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotDiscreteStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotDiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotDiscreteStateType' - if (Buf%ErrStat >= AbortErrLev) return - call BEMT_PackDiscState(Buf, InData%BEMT) - call AA_PackDiscState(Buf, InData%AA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackDiscState(RF, InData%BEMT) + call AA_PackDiscState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotDiscreteStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotDiscreteStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotDiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotDiscreteStateType' - if (Buf%ErrStat /= ErrID_None) return - call BEMT_UnpackDiscState(Buf, OutData%BEMT) ! BEMT - call AA_UnpackDiscState(Buf, OutData%AA) ! AA + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackDiscState(RF, OutData%BEMT) ! BEMT + call AA_UnpackDiscState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -3256,51 +2534,49 @@ subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotDiscreteStateType(Buf, InData%rotors(i1)) + call AD_PackRotDiscreteStateType(RF, InData%rotors(i1)) end do end if - call FVW_PackDiscState(Buf, InData%FVW) - if (RegCheckErr(Buf, RoutineName)) return + call FVW_PackDiscState(RF, InData%FVW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotDiscreteStateType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotDiscreteStateType(RF, OutData%rotors(i1)) ! rotors end do end if - call FVW_UnpackDiscState(Buf, OutData%FVW) ! FVW + call FVW_UnpackDiscState(RF, OutData%FVW) ! FVW end subroutine subroutine AD_CopyRotConstraintStateType(SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3337,23 +2613,23 @@ subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotConstraintStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotConstraintStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' - if (Buf%ErrStat >= AbortErrLev) return - call BEMT_PackConstrState(Buf, InData%BEMT) - call AA_PackConstrState(Buf, InData%AA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackConstrState(RF, InData%BEMT) + call AA_PackConstrState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotConstraintStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotConstraintStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' - if (Buf%ErrStat /= ErrID_None) return - call BEMT_UnpackConstrState(Buf, OutData%BEMT) ! BEMT - call AA_UnpackConstrState(Buf, OutData%AA) ! AA + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackConstrState(RF, OutData%BEMT) ! BEMT + call AA_UnpackConstrState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -3414,51 +2690,49 @@ subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotConstraintStateType(Buf, InData%rotors(i1)) + call AD_PackRotConstraintStateType(RF, InData%rotors(i1)) end do end if - call FVW_PackConstrState(Buf, InData%FVW) - if (RegCheckErr(Buf, RoutineName)) return + call FVW_PackConstrState(RF, InData%FVW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotConstraintStateType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotConstraintStateType(RF, OutData%rotors(i1)) ! rotors end do end if - call FVW_UnpackConstrState(Buf, OutData%FVW) ! FVW + call FVW_UnpackConstrState(RF, OutData%FVW) ! FVW end subroutine subroutine AD_CopyRotOtherStateType(SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3495,23 +2769,23 @@ subroutine AD_DestroyRotOtherStateType(RotOtherStateTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotOtherStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotOtherStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotOtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotOtherStateType' - if (Buf%ErrStat >= AbortErrLev) return - call BEMT_PackOtherState(Buf, InData%BEMT) - call AA_PackOtherState(Buf, InData%AA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackOtherState(RF, InData%BEMT) + call AA_PackOtherState(RF, InData%AA) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotOtherStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotOtherStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotOtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotOtherStateType' - if (Buf%ErrStat /= ErrID_None) return - call BEMT_UnpackOtherState(Buf, OutData%BEMT) ! BEMT - call AA_UnpackOtherState(Buf, OutData%AA) ! AA + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackOtherState(RF, OutData%BEMT) ! BEMT + call AA_UnpackOtherState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -3587,70 +2861,51 @@ subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotOtherStateType(Buf, InData%rotors(i1)) + call AD_PackRotOtherStateType(RF, InData%rotors(i1)) end do end if - call FVW_PackOtherState(Buf, InData%FVW) - call RegPack(Buf, allocated(InData%WakeLocationPoints)) - if (allocated(InData%WakeLocationPoints)) then - call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints, kind=B8Ki), ubound(InData%WakeLocationPoints, kind=B8Ki)) - call RegPack(Buf, InData%WakeLocationPoints) - end if - if (RegCheckErr(Buf, RoutineName)) return + call FVW_PackOtherState(RF, InData%FVW) + call RegPackAlloc(RF, InData%WakeLocationPoints) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotOtherStateType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotOtherStateType(RF, OutData%rotors(i1)) ! rotors end do end if - call FVW_UnpackOtherState(Buf, OutData%FVW) ! FVW - if (allocated(OutData%WakeLocationPoints)) deallocate(OutData%WakeLocationPoints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WakeLocationPoints) - if (RegCheckErr(Buf, RoutineName)) return - end if + call FVW_UnpackOtherState(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WakeLocationPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) @@ -4310,758 +3565,271 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotMiscVarType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotMiscVarType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotMiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) - if (Buf%ErrStat >= AbortErrLev) return - call BEMT_PackMisc(Buf, InData%BEMT) - call BEMT_PackOutput(Buf, InData%BEMT_y) + if (RF%ErrStat >= AbortErrLev) return + call BEMT_PackMisc(RF, InData%BEMT) + call BEMT_PackOutput(RF, InData%BEMT_y) LB(1:1) = lbound(InData%BEMT_u, kind=B8Ki) UB(1:1) = ubound(InData%BEMT_u, kind=B8Ki) do i1 = LB(1), UB(1) - call BEMT_PackInput(Buf, InData%BEMT_u(i1)) + call BEMT_PackInput(RF, InData%BEMT_u(i1)) end do - call AA_PackMisc(Buf, InData%AA) - call AA_PackOutput(Buf, InData%AA_y) - call AA_PackInput(Buf, InData%AA_u) - call RegPack(Buf, allocated(InData%DisturbedInflow)) - if (allocated(InData%DisturbedInflow)) then - call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow, kind=B8Ki), ubound(InData%DisturbedInflow, kind=B8Ki)) - call RegPack(Buf, InData%DisturbedInflow) - end if - call RegPack(Buf, allocated(InData%orientationAnnulus)) - if (allocated(InData%orientationAnnulus)) then - call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus, kind=B8Ki), ubound(InData%orientationAnnulus, kind=B8Ki)) - call RegPack(Buf, InData%orientationAnnulus) - end if - call RegPack(Buf, allocated(InData%R_li)) - if (allocated(InData%R_li)) then - call RegPackBounds(Buf, 4, lbound(InData%R_li, kind=B8Ki), ubound(InData%R_li, kind=B8Ki)) - call RegPack(Buf, InData%R_li) - end if - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - call RegPack(Buf, allocated(InData%W_Twr)) - if (allocated(InData%W_Twr)) then - call RegPackBounds(Buf, 1, lbound(InData%W_Twr, kind=B8Ki), ubound(InData%W_Twr, kind=B8Ki)) - call RegPack(Buf, InData%W_Twr) - end if - call RegPack(Buf, allocated(InData%X_Twr)) - if (allocated(InData%X_Twr)) then - call RegPackBounds(Buf, 1, lbound(InData%X_Twr, kind=B8Ki), ubound(InData%X_Twr, kind=B8Ki)) - call RegPack(Buf, InData%X_Twr) - end if - call RegPack(Buf, allocated(InData%Y_Twr)) - if (allocated(InData%Y_Twr)) then - call RegPackBounds(Buf, 1, lbound(InData%Y_Twr, kind=B8Ki), ubound(InData%Y_Twr, kind=B8Ki)) - call RegPack(Buf, InData%Y_Twr) - end if - call RegPack(Buf, allocated(InData%Curve)) - if (allocated(InData%Curve)) then - call RegPackBounds(Buf, 2, lbound(InData%Curve, kind=B8Ki), ubound(InData%Curve, kind=B8Ki)) - call RegPack(Buf, InData%Curve) - end if - call RegPack(Buf, allocated(InData%TwrClrnc)) - if (allocated(InData%TwrClrnc)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc, kind=B8Ki), ubound(InData%TwrClrnc, kind=B8Ki)) - call RegPack(Buf, InData%TwrClrnc) - end if - call RegPack(Buf, allocated(InData%X)) - if (allocated(InData%X)) then - call RegPackBounds(Buf, 2, lbound(InData%X, kind=B8Ki), ubound(InData%X, kind=B8Ki)) - call RegPack(Buf, InData%X) - end if - call RegPack(Buf, allocated(InData%Y)) - if (allocated(InData%Y)) then - call RegPackBounds(Buf, 2, lbound(InData%Y, kind=B8Ki), ubound(InData%Y, kind=B8Ki)) - call RegPack(Buf, InData%Y) - end if - call RegPack(Buf, allocated(InData%Z)) - if (allocated(InData%Z)) then - call RegPackBounds(Buf, 2, lbound(InData%Z, kind=B8Ki), ubound(InData%Z, kind=B8Ki)) - call RegPack(Buf, InData%Z) - end if - call RegPack(Buf, allocated(InData%M)) - if (allocated(InData%M)) then - call RegPackBounds(Buf, 2, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) - call RegPack(Buf, InData%M) - end if - call RegPack(Buf, allocated(InData%Mx)) - if (allocated(InData%Mx)) then - call RegPackBounds(Buf, 2, lbound(InData%Mx, kind=B8Ki), ubound(InData%Mx, kind=B8Ki)) - call RegPack(Buf, InData%Mx) - end if - call RegPack(Buf, allocated(InData%My)) - if (allocated(InData%My)) then - call RegPackBounds(Buf, 2, lbound(InData%My, kind=B8Ki), ubound(InData%My, kind=B8Ki)) - call RegPack(Buf, InData%My) - end if - call RegPack(Buf, allocated(InData%Mz)) - if (allocated(InData%Mz)) then - call RegPackBounds(Buf, 2, lbound(InData%Mz, kind=B8Ki), ubound(InData%Mz, kind=B8Ki)) - call RegPack(Buf, InData%Mz) - end if - call RegPack(Buf, allocated(InData%Vind_i)) - if (allocated(InData%Vind_i)) then - call RegPackBounds(Buf, 3, lbound(InData%Vind_i, kind=B8Ki), ubound(InData%Vind_i, kind=B8Ki)) - call RegPack(Buf, InData%Vind_i) - end if - call RegPack(Buf, InData%V_DiskAvg) - call RegPack(Buf, InData%yaw) - call RegPack(Buf, InData%tilt) - call RegPack(Buf, allocated(InData%hub_theta_x_root)) - if (allocated(InData%hub_theta_x_root)) then - call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root, kind=B8Ki), ubound(InData%hub_theta_x_root, kind=B8Ki)) - call RegPack(Buf, InData%hub_theta_x_root) - end if - call RegPack(Buf, InData%V_dot_x) - call MeshPack(Buf, InData%HubLoad) - call RegPack(Buf, allocated(InData%B_L_2_H_P)) + call AA_PackMisc(RF, InData%AA) + call AA_PackOutput(RF, InData%AA_y) + call AA_PackInput(RF, InData%AA_u) + call RegPackAlloc(RF, InData%DisturbedInflow) + call RegPackAlloc(RF, InData%orientationAnnulus) + call RegPackAlloc(RF, InData%R_li) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%W_Twr) + call RegPackAlloc(RF, InData%X_Twr) + call RegPackAlloc(RF, InData%Y_Twr) + call RegPackAlloc(RF, InData%Curve) + call RegPackAlloc(RF, InData%TwrClrnc) + call RegPackAlloc(RF, InData%X) + call RegPackAlloc(RF, InData%Y) + call RegPackAlloc(RF, InData%Z) + call RegPackAlloc(RF, InData%M) + call RegPackAlloc(RF, InData%Mx) + call RegPackAlloc(RF, InData%My) + call RegPackAlloc(RF, InData%Mz) + call RegPackAlloc(RF, InData%Vind_i) + call RegPack(RF, InData%V_DiskAvg) + call RegPack(RF, InData%yaw) + call RegPack(RF, InData%tilt) + call RegPackAlloc(RF, InData%hub_theta_x_root) + call RegPack(RF, InData%V_dot_x) + call MeshPack(RF, InData%HubLoad) + call RegPack(RF, allocated(InData%B_L_2_H_P)) if (allocated(InData%B_L_2_H_P)) then - call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%B_L_2_H_P, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) LB(1:1) = lbound(InData%B_L_2_H_P, kind=B8Ki) UB(1:1) = ubound(InData%B_L_2_H_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_H_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) end do end if - call RegPack(Buf, allocated(InData%SigmaCavitCrit)) - if (allocated(InData%SigmaCavitCrit)) then - call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit, kind=B8Ki), ubound(InData%SigmaCavitCrit, kind=B8Ki)) - call RegPack(Buf, InData%SigmaCavitCrit) - end if - call RegPack(Buf, allocated(InData%SigmaCavit)) - if (allocated(InData%SigmaCavit)) then - call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit, kind=B8Ki), ubound(InData%SigmaCavit, kind=B8Ki)) - call RegPack(Buf, InData%SigmaCavit) - end if - call RegPack(Buf, allocated(InData%CavitWarnSet)) - if (allocated(InData%CavitWarnSet)) then - call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet, kind=B8Ki), ubound(InData%CavitWarnSet, kind=B8Ki)) - call RegPack(Buf, InData%CavitWarnSet) - end if - call RegPack(Buf, allocated(InData%TwrFB)) - if (allocated(InData%TwrFB)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrFB, kind=B8Ki), ubound(InData%TwrFB, kind=B8Ki)) - call RegPack(Buf, InData%TwrFB) - end if - call RegPack(Buf, allocated(InData%TwrMB)) - if (allocated(InData%TwrMB)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrMB, kind=B8Ki), ubound(InData%TwrMB, kind=B8Ki)) - call RegPack(Buf, InData%TwrMB) - end if - call RegPack(Buf, allocated(InData%HubFB)) - if (allocated(InData%HubFB)) then - call RegPackBounds(Buf, 1, lbound(InData%HubFB, kind=B8Ki), ubound(InData%HubFB, kind=B8Ki)) - call RegPack(Buf, InData%HubFB) - end if - call RegPack(Buf, allocated(InData%HubMB)) - if (allocated(InData%HubMB)) then - call RegPackBounds(Buf, 1, lbound(InData%HubMB, kind=B8Ki), ubound(InData%HubMB, kind=B8Ki)) - call RegPack(Buf, InData%HubMB) - end if - call RegPack(Buf, allocated(InData%NacFB)) - if (allocated(InData%NacFB)) then - call RegPackBounds(Buf, 1, lbound(InData%NacFB, kind=B8Ki), ubound(InData%NacFB, kind=B8Ki)) - call RegPack(Buf, InData%NacFB) - end if - call RegPack(Buf, allocated(InData%NacMB)) - if (allocated(InData%NacMB)) then - call RegPackBounds(Buf, 1, lbound(InData%NacMB, kind=B8Ki), ubound(InData%NacMB, kind=B8Ki)) - call RegPack(Buf, InData%NacMB) - end if - call RegPack(Buf, allocated(InData%BladeRootLoad)) + call RegPackAlloc(RF, InData%SigmaCavitCrit) + call RegPackAlloc(RF, InData%SigmaCavit) + call RegPackAlloc(RF, InData%CavitWarnSet) + call RegPackAlloc(RF, InData%TwrFB) + call RegPackAlloc(RF, InData%TwrMB) + call RegPackAlloc(RF, InData%HubFB) + call RegPackAlloc(RF, InData%HubMB) + call RegPackAlloc(RF, InData%NacFB) + call RegPackAlloc(RF, InData%NacMB) + call RegPack(RF, allocated(InData%BladeRootLoad)) if (allocated(InData%BladeRootLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeRootLoad, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) LB(1:1) = lbound(InData%BladeRootLoad, kind=B8Ki) UB(1:1) = ubound(InData%BladeRootLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeRootLoad(i1)) + call MeshPack(RF, InData%BladeRootLoad(i1)) end do end if - call RegPack(Buf, allocated(InData%B_L_2_R_P)) + call RegPack(RF, allocated(InData%B_L_2_R_P)) if (allocated(InData%B_L_2_R_P)) then - call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%B_L_2_R_P, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) LB(1:1) = lbound(InData%B_L_2_R_P, kind=B8Ki) UB(1:1) = ubound(InData%B_L_2_R_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_R_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) end do end if - call RegPack(Buf, allocated(InData%BladeBuoyLoadPoint)) + call RegPack(RF, allocated(InData%BladeBuoyLoadPoint)) if (allocated(InData%BladeBuoyLoadPoint)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoadPoint, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) LB(1:1) = lbound(InData%BladeBuoyLoadPoint, kind=B8Ki) UB(1:1) = ubound(InData%BladeBuoyLoadPoint, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeBuoyLoadPoint(i1)) + call MeshPack(RF, InData%BladeBuoyLoadPoint(i1)) end do end if - call RegPack(Buf, allocated(InData%BladeBuoyLoad)) + call RegPack(RF, allocated(InData%BladeBuoyLoad)) if (allocated(InData%BladeBuoyLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeBuoyLoad, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) LB(1:1) = lbound(InData%BladeBuoyLoad, kind=B8Ki) UB(1:1) = ubound(InData%BladeBuoyLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeBuoyLoad(i1)) + call MeshPack(RF, InData%BladeBuoyLoad(i1)) end do end if - call RegPack(Buf, allocated(InData%B_P_2_B_L)) + call RegPack(RF, allocated(InData%B_P_2_B_L)) if (allocated(InData%B_P_2_B_L)) then - call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%B_P_2_B_L, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) LB(1:1) = lbound(InData%B_P_2_B_L, kind=B8Ki) UB(1:1) = ubound(InData%B_P_2_B_L, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%B_P_2_B_L(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%B_P_2_B_L(i1)) end do end if - call MeshPack(Buf, InData%TwrBuoyLoadPoint) - call MeshPack(Buf, InData%TwrBuoyLoad) - call NWTC_Library_PackMeshMapType(Buf, InData%T_P_2_T_L) - call RegPack(Buf, InData%FirstWarn_TowerStrike) - call RegPack(Buf, InData%AvgDiskVel) - call RegPack(Buf, InData%AvgDiskVelDist) - call RegPack(Buf, InData%TFinAlpha) - call RegPack(Buf, InData%TFinRe) - call RegPack(Buf, InData%TFinVrel) - call RegPack(Buf, InData%TFinVund_i) - call RegPack(Buf, InData%TFinVind_i) - call RegPack(Buf, InData%TFinVrel_i) - call RegPack(Buf, InData%TFinSTV_i) - call RegPack(Buf, InData%TFinF_i) - call RegPack(Buf, InData%TFinM_i) - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%TwrBuoyLoadPoint) + call MeshPack(RF, InData%TwrBuoyLoad) + call NWTC_Library_PackMeshMapType(RF, InData%T_P_2_T_L) + call RegPack(RF, InData%FirstWarn_TowerStrike) + call RegPack(RF, InData%AvgDiskVel) + call RegPack(RF, InData%AvgDiskVelDist) + call RegPack(RF, InData%TFinAlpha) + call RegPack(RF, InData%TFinRe) + call RegPack(RF, InData%TFinVrel) + call RegPack(RF, InData%TFinVund_i) + call RegPack(RF, InData%TFinVind_i) + call RegPack(RF, InData%TFinVrel_i) + call RegPack(RF, InData%TFinSTV_i) + call RegPack(RF, InData%TFinF_i) + call RegPack(RF, InData%TFinM_i) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotMiscVarType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotMiscVarType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotMiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call BEMT_UnpackMisc(Buf, OutData%BEMT) ! BEMT - call BEMT_UnpackOutput(Buf, OutData%BEMT_y) ! BEMT_y + if (RF%ErrStat /= ErrID_None) return + call BEMT_UnpackMisc(RF, OutData%BEMT) ! BEMT + call BEMT_UnpackOutput(RF, OutData%BEMT_y) ! BEMT_y LB(1:1) = lbound(OutData%BEMT_u, kind=B8Ki) UB(1:1) = ubound(OutData%BEMT_u, kind=B8Ki) do i1 = LB(1), UB(1) - call BEMT_UnpackInput(Buf, OutData%BEMT_u(i1)) ! BEMT_u + call BEMT_UnpackInput(RF, OutData%BEMT_u(i1)) ! BEMT_u end do - call AA_UnpackMisc(Buf, OutData%AA) ! AA - call AA_UnpackOutput(Buf, OutData%AA_y) ! AA_y - call AA_UnpackInput(Buf, OutData%AA_u) ! AA_u - if (allocated(OutData%DisturbedInflow)) deallocate(OutData%DisturbedInflow) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DisturbedInflow) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%orientationAnnulus)) deallocate(OutData%orientationAnnulus) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%orientationAnnulus.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%orientationAnnulus) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%R_li)) deallocate(OutData%R_li) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%R_li(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%R_li.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%R_li) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%W_Twr)) deallocate(OutData%W_Twr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%W_Twr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%W_Twr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%X_Twr)) deallocate(OutData%X_Twr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X_Twr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X_Twr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y_Twr)) deallocate(OutData%Y_Twr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y_Twr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y_Twr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Curve)) deallocate(OutData%Curve) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Curve(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Curve) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrClrnc)) deallocate(OutData%TwrClrnc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrClrnc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%X)) deallocate(OutData%X) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y)) deallocate(OutData%Y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Z)) deallocate(OutData%Z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Z(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Z) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M)) deallocate(OutData%M) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Mx)) deallocate(OutData%Mx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%My)) deallocate(OutData%My) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%My(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%My) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Mz)) deallocate(OutData%Mz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vind_i)) deallocate(OutData%Vind_i) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vind_i(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_i.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vind_i) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%V_DiskAvg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tilt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%hub_theta_x_root)) deallocate(OutData%hub_theta_x_root) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%hub_theta_x_root(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%hub_theta_x_root.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%hub_theta_x_root) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%V_dot_x) - if (RegCheckErr(Buf, RoutineName)) return - call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad + call AA_UnpackMisc(RF, OutData%AA) ! AA + call AA_UnpackOutput(RF, OutData%AA_y) ! AA_y + call AA_UnpackInput(RF, OutData%AA_u) ! AA_u + call RegUnpackAlloc(RF, OutData%DisturbedInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%orientationAnnulus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%R_li); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_Twr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Curve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrClrnc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%My); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_DiskAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%hub_theta_x_root); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_dot_x); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P end do end if - if (allocated(OutData%SigmaCavitCrit)) deallocate(OutData%SigmaCavitCrit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SigmaCavitCrit) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SigmaCavit)) deallocate(OutData%SigmaCavit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SigmaCavit) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CavitWarnSet)) deallocate(OutData%CavitWarnSet) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CavitWarnSet) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrFB)) deallocate(OutData%TwrFB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrFB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrFB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrMB)) deallocate(OutData%TwrMB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrMB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrMB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HubFB)) deallocate(OutData%HubFB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HubFB(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HubFB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HubMB)) deallocate(OutData%HubMB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HubMB(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HubMB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NacFB)) deallocate(OutData%NacFB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NacFB(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NacFB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NacMB)) deallocate(OutData%NacMB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NacMB(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NacMB) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%SigmaCavitCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SigmaCavit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CavitWarnSet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HubMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacFB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NacMB); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeRootLoad(i1)) ! BladeRootLoad + call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad end do end if if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P end do end if if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint + call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint end do end if if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad + call MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad end do end if if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L end do end if - call MeshUnpack(Buf, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint - call MeshUnpack(Buf, OutData%TwrBuoyLoad) ! TwrBuoyLoad - call NWTC_Library_UnpackMeshMapType(Buf, OutData%T_P_2_T_L) ! T_P_2_T_L - call RegUnpack(Buf, OutData%FirstWarn_TowerStrike) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgDiskVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgDiskVelDist) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinAlpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinRe) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinVrel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinVund_i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinVind_i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinVrel_i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinSTV_i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinF_i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinM_i) - if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(RF, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + call MeshUnpack(RF, OutData%TwrBuoyLoad) ! TwrBuoyLoad + call NWTC_Library_UnpackMeshMapType(RF, OutData%T_P_2_T_L) ! T_P_2_T_L + call RegUnpack(RF, OutData%FirstWarn_TowerStrike); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVelDist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVund_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVind_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinVrel_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinSTV_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinF_i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinM_i); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -5197,134 +3965,79 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotMiscVarType(Buf, InData%rotors(i1)) + call AD_PackRotMiscVarType(RF, InData%rotors(i1)) end do end if - call RegPack(Buf, allocated(InData%FVW_u)) + call RegPack(RF, allocated(InData%FVW_u)) if (allocated(InData%FVW_u)) then - call RegPackBounds(Buf, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%FVW_u, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackInput(Buf, InData%FVW_u(i1)) + call FVW_PackInput(RF, InData%FVW_u(i1)) end do end if - call FVW_PackOutput(Buf, InData%FVW_y) - call FVW_PackMisc(Buf, InData%FVW) - call RegPack(Buf, allocated(InData%WindPos)) - if (allocated(InData%WindPos)) then - call RegPackBounds(Buf, 2, lbound(InData%WindPos, kind=B8Ki), ubound(InData%WindPos, kind=B8Ki)) - call RegPack(Buf, InData%WindPos) - end if - call RegPack(Buf, allocated(InData%WindVel)) - if (allocated(InData%WindVel)) then - call RegPackBounds(Buf, 2, lbound(InData%WindVel, kind=B8Ki), ubound(InData%WindVel, kind=B8Ki)) - call RegPack(Buf, InData%WindVel) - end if - call RegPack(Buf, allocated(InData%WindAcc)) - if (allocated(InData%WindAcc)) then - call RegPackBounds(Buf, 2, lbound(InData%WindAcc, kind=B8Ki), ubound(InData%WindAcc, kind=B8Ki)) - call RegPack(Buf, InData%WindAcc) - end if - if (RegCheckErr(Buf, RoutineName)) return + call FVW_PackOutput(RF, InData%FVW_y) + call FVW_PackMisc(RF, InData%FVW) + call RegPackAlloc(RF, InData%WindPos) + call RegPackAlloc(RF, InData%WindVel) + call RegPackAlloc(RF, InData%WindAcc) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotMiscVarType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors end do end if if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackInput(Buf, OutData%FVW_u(i1)) ! FVW_u + call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u end do end if - call FVW_UnpackOutput(Buf, OutData%FVW_y) ! FVW_y - call FVW_UnpackMisc(Buf, OutData%FVW) ! FVW - if (allocated(OutData%WindPos)) deallocate(OutData%WindPos) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindPos) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindVel)) deallocate(OutData%WindVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindAcc)) deallocate(OutData%WindAcc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindAcc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindAcc) - if (RegCheckErr(Buf, RoutineName)) return - end if + call FVW_UnpackOutput(RF, OutData%FVW_y) ! FVW_y + call FVW_UnpackMisc(RF, OutData%FVW) ! FVW + call RegUnpackAlloc(RF, OutData%WindPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAcc); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -5744,557 +4457,191 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotParameterType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotParameterType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumBlades) - call RegPack(Buf, InData%NumBlNds) - call RegPack(Buf, InData%NumTwrNds) - call RegPack(Buf, allocated(InData%TwrDiam)) - if (allocated(InData%TwrDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDiam, kind=B8Ki), ubound(InData%TwrDiam, kind=B8Ki)) - call RegPack(Buf, InData%TwrDiam) - end if - call RegPack(Buf, allocated(InData%TwrCd)) - if (allocated(InData%TwrCd)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCd, kind=B8Ki), ubound(InData%TwrCd, kind=B8Ki)) - call RegPack(Buf, InData%TwrCd) - end if - call RegPack(Buf, allocated(InData%TwrTI)) - if (allocated(InData%TwrTI)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrTI, kind=B8Ki), ubound(InData%TwrTI, kind=B8Ki)) - call RegPack(Buf, InData%TwrTI) - end if - call RegPack(Buf, allocated(InData%BlTwist)) - if (allocated(InData%BlTwist)) then - call RegPackBounds(Buf, 2, lbound(InData%BlTwist, kind=B8Ki), ubound(InData%BlTwist, kind=B8Ki)) - call RegPack(Buf, InData%BlTwist) - end if - call RegPack(Buf, allocated(InData%TwrCb)) - if (allocated(InData%TwrCb)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrCb, kind=B8Ki), ubound(InData%TwrCb, kind=B8Ki)) - call RegPack(Buf, InData%TwrCb) - end if - call RegPack(Buf, allocated(InData%BlCenBn)) - if (allocated(InData%BlCenBn)) then - call RegPackBounds(Buf, 2, lbound(InData%BlCenBn, kind=B8Ki), ubound(InData%BlCenBn, kind=B8Ki)) - call RegPack(Buf, InData%BlCenBn) - end if - call RegPack(Buf, allocated(InData%BlCenBt)) - if (allocated(InData%BlCenBt)) then - call RegPackBounds(Buf, 2, lbound(InData%BlCenBt, kind=B8Ki), ubound(InData%BlCenBt, kind=B8Ki)) - call RegPack(Buf, InData%BlCenBt) - end if - call RegPack(Buf, InData%VolHub) - call RegPack(Buf, InData%HubCenBx) - call RegPack(Buf, InData%VolNac) - call RegPack(Buf, InData%NacCenB) - call RegPack(Buf, InData%VolBl) - call RegPack(Buf, InData%VolTwr) - call RegPack(Buf, allocated(InData%BlRad)) - if (allocated(InData%BlRad)) then - call RegPackBounds(Buf, 2, lbound(InData%BlRad, kind=B8Ki), ubound(InData%BlRad, kind=B8Ki)) - call RegPack(Buf, InData%BlRad) - end if - call RegPack(Buf, allocated(InData%BlDL)) - if (allocated(InData%BlDL)) then - call RegPackBounds(Buf, 2, lbound(InData%BlDL, kind=B8Ki), ubound(InData%BlDL, kind=B8Ki)) - call RegPack(Buf, InData%BlDL) - end if - call RegPack(Buf, allocated(InData%BlTaper)) - if (allocated(InData%BlTaper)) then - call RegPackBounds(Buf, 2, lbound(InData%BlTaper, kind=B8Ki), ubound(InData%BlTaper, kind=B8Ki)) - call RegPack(Buf, InData%BlTaper) - end if - call RegPack(Buf, allocated(InData%BlAxCent)) - if (allocated(InData%BlAxCent)) then - call RegPackBounds(Buf, 2, lbound(InData%BlAxCent, kind=B8Ki), ubound(InData%BlAxCent, kind=B8Ki)) - call RegPack(Buf, InData%BlAxCent) - end if - call RegPack(Buf, allocated(InData%TwrRad)) - if (allocated(InData%TwrRad)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrRad, kind=B8Ki), ubound(InData%TwrRad, kind=B8Ki)) - call RegPack(Buf, InData%TwrRad) - end if - call RegPack(Buf, allocated(InData%TwrDL)) - if (allocated(InData%TwrDL)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrDL, kind=B8Ki), ubound(InData%TwrDL, kind=B8Ki)) - call RegPack(Buf, InData%TwrDL) - end if - call RegPack(Buf, allocated(InData%TwrTaper)) - if (allocated(InData%TwrTaper)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrTaper, kind=B8Ki), ubound(InData%TwrTaper, kind=B8Ki)) - call RegPack(Buf, InData%TwrTaper) - end if - call RegPack(Buf, allocated(InData%TwrAxCent)) - if (allocated(InData%TwrAxCent)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent, kind=B8Ki), ubound(InData%TwrAxCent, kind=B8Ki)) - call RegPack(Buf, InData%TwrAxCent) - end if - call BEMT_PackParam(Buf, InData%BEMT) - call AA_PackParam(Buf, InData%AA) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, allocated(InData%dx)) - if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) - call RegPack(Buf, InData%dx) - end if - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%NumBl_Lin) - call RegPack(Buf, InData%TwrPotent) - call RegPack(Buf, InData%TwrShadow) - call RegPack(Buf, InData%TwrAero) - call RegPack(Buf, InData%FrozenWake) - call RegPack(Buf, InData%CavitCheck) - call RegPack(Buf, InData%Buoyancy) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%CompAA) - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%Patm) - call RegPack(Buf, InData%Pvap) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%AeroProjMod) - call RegPack(Buf, InData%AeroBEM_Mod) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumBlNds) + call RegPack(RF, InData%NumTwrNds) + call RegPackAlloc(RF, InData%TwrDiam) + call RegPackAlloc(RF, InData%TwrCd) + call RegPackAlloc(RF, InData%TwrTI) + call RegPackAlloc(RF, InData%BlTwist) + call RegPackAlloc(RF, InData%TwrCb) + call RegPackAlloc(RF, InData%BlCenBn) + call RegPackAlloc(RF, InData%BlCenBt) + call RegPack(RF, InData%VolHub) + call RegPack(RF, InData%HubCenBx) + call RegPack(RF, InData%VolNac) + call RegPack(RF, InData%NacCenB) + call RegPack(RF, InData%VolBl) + call RegPack(RF, InData%VolTwr) + call RegPackAlloc(RF, InData%BlRad) + call RegPackAlloc(RF, InData%BlDL) + call RegPackAlloc(RF, InData%BlTaper) + call RegPackAlloc(RF, InData%BlAxCent) + call RegPackAlloc(RF, InData%TwrRad) + call RegPackAlloc(RF, InData%TwrDL) + call RegPackAlloc(RF, InData%TwrTaper) + call RegPackAlloc(RF, InData%TwrAxCent) + call BEMT_PackParam(RF, InData%BEMT) + call AA_PackParam(RF, InData%AA) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%TwrAero) + call RegPack(RF, InData%FrozenWake) + call RegPack(RF, InData%CavitCheck) + call RegPack(RF, InData%Buoyancy) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%CompAA) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%AeroProjMod) + call RegPack(RF, InData%AeroBEM_Mod) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%NBlOuts) - call RegPack(Buf, InData%BlOutNd) - call RegPack(Buf, InData%NTwOuts) - call RegPack(Buf, InData%TwOutNd) - call RegPack(Buf, InData%BldNd_NumOuts) - call RegPack(Buf, InData%BldNd_TotNumOuts) - call RegPack(Buf, allocated(InData%BldNd_OutParam)) + call RegPack(RF, InData%NBlOuts) + call RegPack(RF, InData%BlOutNd) + call RegPack(RF, InData%NTwOuts) + call RegPack(RF, InData%TwOutNd) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do end if - call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) - if (allocated(InData%BldNd_BlOutNd)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd, kind=B8Ki), ubound(InData%BldNd_BlOutNd, kind=B8Ki)) - call RegPack(Buf, InData%BldNd_BlOutNd) - end if - call RegPack(Buf, InData%BldNd_BladesOut) - call RegPack(Buf, InData%TFinAero) - call AD_PackTFinParameterType(Buf, InData%TFin) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPack(RF, InData%BldNd_BladesOut) + call RegPack(RF, InData%TFinAero) + call AD_PackTFinParameterType(RF, InData%TFin) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotParameterType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTwrNds) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrDiam) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrCd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrCd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrTI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrTI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlTwist(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlTwist) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrCb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrCb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCenBn(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCenBn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlCenBt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlCenBt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%VolHub) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubCenBx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VolNac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCenB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VolBl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VolTwr) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlRad)) deallocate(OutData%BlRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlRad(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlRad) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlDL)) deallocate(OutData%BlDL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlDL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlDL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlDL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlTaper)) deallocate(OutData%BlTaper) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlTaper(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTaper.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlTaper) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlAxCent)) deallocate(OutData%BlAxCent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlAxCent(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAxCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlAxCent) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrRad)) deallocate(OutData%TwrRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrRad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrRad) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrDL)) deallocate(OutData%TwrDL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrDL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrDL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrTaper)) deallocate(OutData%TwrTaper) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrTaper(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTaper.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrTaper) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrAxCent)) deallocate(OutData%TwrAxCent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrAxCent(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAxCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrAxCent) - if (RegCheckErr(Buf, RoutineName)) return - end if - call BEMT_UnpackParam(Buf, OutData%BEMT) ! BEMT - call AA_UnpackParam(Buf, OutData%AA) ! AA - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl_Lin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrPotent) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrShadow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrozenWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CavitCheck) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Buoyancy) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Patm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AeroProjMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AeroBEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlCenBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCenBx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolNac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCenB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VolTwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAxCent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrDL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrTaper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrAxCent); if (RegCheckErr(RF, RoutineName)) return + call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT + call AA_UnpackParam(RF, OutData%AA) ! AA + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrozenWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CavitCheck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Buoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroProjMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroBEM_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%NBlOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTwOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwOutNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_TotNumOuts) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NBlOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldNd_BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinAero) - if (RegCheckErr(Buf, RoutineName)) return - call AD_UnpackTFinParameterType(Buf, OutData%TFin) ! TFin + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinAero); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackTFinParameterType(RF, OutData%TFin) ! TFin end subroutine subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -6388,51 +4735,51 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%FlowField) end subroutine -subroutine AD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotParameterType(Buf, InData%rotors(i1)) + call AD_PackRotParameterType(RF, InData%rotors(i1)) end do end if - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%AFI)) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%AFI)) if (allocated(InData%AFI)) then - call RegPackBounds(Buf, 1, lbound(InData%AFI, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%AFI, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) LB(1:1) = lbound(InData%AFI, kind=B8Ki) UB(1:1) = ubound(InData%AFI, kind=B8Ki) do i1 = LB(1), UB(1) - call AFI_PackParam(Buf, InData%AFI(i1)) + call AFI_PackParam(RF, InData%AFI(i1)) end do end if - call RegPack(Buf, InData%SkewMod) - call RegPack(Buf, InData%WakeMod) - call FVW_PackParam(Buf, InData%FVW) - call RegPack(Buf, InData%CompAeroMaps) - call RegPack(Buf, InData%UA_Flag) - call RegPack(Buf, associated(InData%FlowField)) + call RegPack(RF, InData%SkewMod) + call RegPack(RF, InData%WakeMod) + call FVW_PackParam(RF, InData%FVW) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, associated(InData%FlowField)) if (associated(InData%FlowField)) then - call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackParam' integer(B8Ki) :: i1 @@ -6441,66 +4788,54 @@ subroutine AD_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotParameterType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors end do end if - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%AFI)) deallocate(OutData%AFI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%AFI(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AFI_UnpackParam(Buf, OutData%AFI(i1)) ! AFI + call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI end do end if - call RegUnpack(Buf, OutData%SkewMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeMod) - if (RegCheckErr(Buf, RoutineName)) return - call FVW_UnpackParam(Buf, OutData%FVW) ! FVW - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%SkewMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeMod); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackParam(RF, OutData%FVW) ! FVW + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%FlowField) else allocate(OutData%FlowField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if else OutData%FlowField => null() @@ -6559,60 +4894,26 @@ subroutine AD_DestroyBldInputType(BldInputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackBldInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackBldInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(BldInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackBldInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%InflowOnBlade)) - if (allocated(InData%InflowOnBlade)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowOnBlade, kind=B8Ki), ubound(InData%InflowOnBlade, kind=B8Ki)) - call RegPack(Buf, InData%InflowOnBlade) - end if - call RegPack(Buf, allocated(InData%AccelOnBlade)) - if (allocated(InData%AccelOnBlade)) then - call RegPackBounds(Buf, 2, lbound(InData%AccelOnBlade, kind=B8Ki), ubound(InData%AccelOnBlade, kind=B8Ki)) - call RegPack(Buf, InData%AccelOnBlade) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%InflowOnBlade) + call RegPackAlloc(RF, InData%AccelOnBlade) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackBldInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackBldInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(BldInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBldInputType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%InflowOnBlade)) deallocate(OutData%InflowOnBlade) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InflowOnBlade) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AccelOnBlade)) deallocate(OutData%AccelOnBlade) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AccelOnBlade(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelOnBlade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AccelOnBlade) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%InflowOnBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelOnBlade); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -6787,174 +5088,113 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackRotInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%NacelleMotion) - call MeshPack(Buf, InData%TowerMotion) - call MeshPack(Buf, InData%HubMotion) - call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TowerMotion) + call MeshPack(RF, InData%HubMotion) + call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeRootMotion(i1)) + call MeshPack(RF, InData%BladeRootMotion(i1)) end do end if - call RegPack(Buf, allocated(InData%BladeMotion)) + call RegPack(RF, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeMotion(i1)) + call MeshPack(RF, InData%BladeMotion(i1)) end do end if - call MeshPack(Buf, InData%TFinMotion) - call RegPack(Buf, allocated(InData%Bld)) + call MeshPack(RF, InData%TFinMotion) + call RegPack(RF, allocated(InData%Bld)) if (allocated(InData%Bld)) then - call RegPackBounds(Buf, 1, lbound(InData%Bld, kind=B8Ki), ubound(InData%Bld, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Bld, kind=B8Ki), ubound(InData%Bld, kind=B8Ki)) LB(1:1) = lbound(InData%Bld, kind=B8Ki) UB(1:1) = ubound(InData%Bld, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackBldInputType(Buf, InData%Bld(i1)) + call AD_PackBldInputType(RF, InData%Bld(i1)) end do end if - call RegPack(Buf, allocated(InData%InflowOnTower)) - if (allocated(InData%InflowOnTower)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower, kind=B8Ki), ubound(InData%InflowOnTower, kind=B8Ki)) - call RegPack(Buf, InData%InflowOnTower) - end if - call RegPack(Buf, allocated(InData%AccelOnTower)) - if (allocated(InData%AccelOnTower)) then - call RegPackBounds(Buf, 2, lbound(InData%AccelOnTower, kind=B8Ki), ubound(InData%AccelOnTower, kind=B8Ki)) - call RegPack(Buf, InData%AccelOnTower) - end if - call RegPack(Buf, InData%InflowOnHub) - call RegPack(Buf, InData%InflowOnNacelle) - call RegPack(Buf, InData%InflowOnTailFin) - call RegPack(Buf, InData%AvgDiskVel) - call RegPack(Buf, allocated(InData%UserProp)) - if (allocated(InData%UserProp)) then - call RegPackBounds(Buf, 2, lbound(InData%UserProp, kind=B8Ki), ubound(InData%UserProp, kind=B8Ki)) - call RegPack(Buf, InData%UserProp) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InflowOnTower) + call RegPackAlloc(RF, InData%AccelOnTower) + call RegPack(RF, InData%InflowOnHub) + call RegPack(RF, InData%InflowOnNacelle) + call RegPack(RF, InData%InflowOnTailFin) + call RegPack(RF, InData%AvgDiskVel) + call RegPackAlloc(RF, InData%UserProp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion - call MeshUnpack(Buf, OutData%TowerMotion) ! TowerMotion - call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TowerMotion) ! TowerMotion + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeMotion(i1)) ! BladeMotion + call MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion end do end if - call MeshUnpack(Buf, OutData%TFinMotion) ! TFinMotion + call MeshUnpack(RF, OutData%TFinMotion) ! TFinMotion if (allocated(OutData%Bld)) deallocate(OutData%Bld) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Bld(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackBldInputType(Buf, OutData%Bld(i1)) ! Bld + call AD_UnpackBldInputType(RF, OutData%Bld(i1)) ! Bld end do end if - if (allocated(OutData%InflowOnTower)) deallocate(OutData%InflowOnTower) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InflowOnTower) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AccelOnTower)) deallocate(OutData%AccelOnTower) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AccelOnTower(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelOnTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AccelOnTower) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%InflowOnHub) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InflowOnNacelle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InflowOnTailFin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgDiskVel) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UserProp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InflowOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelOnTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnNacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowOnTailFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgDiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -7025,68 +5265,49 @@ subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotInputType(Buf, InData%rotors(i1)) + call AD_PackRotInputType(RF, InData%rotors(i1)) end do end if - call RegPack(Buf, allocated(InData%InflowWakeVel)) - if (allocated(InData%InflowWakeVel)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel, kind=B8Ki), ubound(InData%InflowWakeVel, kind=B8Ki)) - call RegPack(Buf, InData%InflowWakeVel) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InflowWakeVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotInputType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors end do end if - if (allocated(OutData%InflowWakeVel)) deallocate(OutData%InflowWakeVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InflowWakeVel) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -7177,76 +5398,57 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackRotOutputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackRotOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotOutputType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%NacelleLoad) - call MeshPack(Buf, InData%HubLoad) - call MeshPack(Buf, InData%TowerLoad) - call RegPack(Buf, allocated(InData%BladeLoad)) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%NacelleLoad) + call MeshPack(RF, InData%HubLoad) + call MeshPack(RF, InData%TowerLoad) + call RegPack(RF, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeLoad(i1)) + call MeshPack(RF, InData%BladeLoad(i1)) end do end if - call MeshPack(Buf, InData%TFinLoad) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%TFinLoad) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackRotOutputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackRotOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%NacelleLoad) ! NacelleLoad - call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad - call MeshUnpack(Buf, OutData%TowerLoad) ! TowerLoad + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%NacelleLoad) ! NacelleLoad + call MeshUnpack(RF, OutData%HubLoad) ! HubLoad + call MeshUnpack(RF, OutData%TowerLoad) ! TowerLoad if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeLoad(i1)) ! BladeLoad + call MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad end do end if - call MeshUnpack(Buf, OutData%TFinLoad) ! TFinLoad - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + call MeshUnpack(RF, OutData%TFinLoad) ! TFinLoad + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -7302,47 +5504,45 @@ subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine AD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackRotOutputType(Buf, InData%rotors(i1)) + call AD_PackRotOutputType(RF, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotOutputType(Buf, OutData%rotors(i1)) ! rotors + call AD_UnpackRotOutputType(RF, OutData%rotors(i1)) ! rotors end do end if end subroutine diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 48668f43af..83b789170b 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -267,160 +267,113 @@ subroutine AFI_DestroyUA_BL_Type(UA_BL_TypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AFI_PackUA_BL_Type(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackUA_BL_Type(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_UA_BL_Type), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Type' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%alpha0) - call RegPack(Buf, InData%alpha1) - call RegPack(Buf, InData%alpha2) - call RegPack(Buf, InData%eta_e) - call RegPack(Buf, InData%C_nalpha) - call RegPack(Buf, InData%C_lalpha) - call RegPack(Buf, InData%T_f0) - call RegPack(Buf, InData%T_V0) - call RegPack(Buf, InData%T_p) - call RegPack(Buf, InData%T_VL) - call RegPack(Buf, InData%b1) - call RegPack(Buf, InData%b2) - call RegPack(Buf, InData%b5) - call RegPack(Buf, InData%A1) - call RegPack(Buf, InData%A2) - call RegPack(Buf, InData%A5) - call RegPack(Buf, InData%S1) - call RegPack(Buf, InData%S2) - call RegPack(Buf, InData%S3) - call RegPack(Buf, InData%S4) - call RegPack(Buf, InData%Cn1) - call RegPack(Buf, InData%Cn2) - call RegPack(Buf, InData%St_sh) - call RegPack(Buf, InData%Cd0) - call RegPack(Buf, InData%Cm0) - call RegPack(Buf, InData%k0) - call RegPack(Buf, InData%k1) - call RegPack(Buf, InData%k2) - call RegPack(Buf, InData%k3) - call RegPack(Buf, InData%k1_hat) - call RegPack(Buf, InData%x_cp_bar) - call RegPack(Buf, InData%UACutout) - call RegPack(Buf, InData%UACutout_delta) - call RegPack(Buf, InData%UACutout_blend) - call RegPack(Buf, InData%filtCutOff) - call RegPack(Buf, InData%alphaUpper) - call RegPack(Buf, InData%alphaLower) - call RegPack(Buf, InData%c_Rate) - call RegPack(Buf, InData%c_RateUpper) - call RegPack(Buf, InData%c_RateLower) - call RegPack(Buf, InData%c_alphaLower) - call RegPack(Buf, InData%c_alphaUpper) - call RegPack(Buf, InData%alphaUpperWrap) - call RegPack(Buf, InData%alphaLowerWrap) - call RegPack(Buf, InData%c_RateWrap) - call RegPack(Buf, InData%c_alphaLowerWrap) - call RegPack(Buf, InData%c_alphaUpperWrap) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%alpha0) + call RegPack(RF, InData%alpha1) + call RegPack(RF, InData%alpha2) + call RegPack(RF, InData%eta_e) + call RegPack(RF, InData%C_nalpha) + call RegPack(RF, InData%C_lalpha) + call RegPack(RF, InData%T_f0) + call RegPack(RF, InData%T_V0) + call RegPack(RF, InData%T_p) + call RegPack(RF, InData%T_VL) + call RegPack(RF, InData%b1) + call RegPack(RF, InData%b2) + call RegPack(RF, InData%b5) + call RegPack(RF, InData%A1) + call RegPack(RF, InData%A2) + call RegPack(RF, InData%A5) + call RegPack(RF, InData%S1) + call RegPack(RF, InData%S2) + call RegPack(RF, InData%S3) + call RegPack(RF, InData%S4) + call RegPack(RF, InData%Cn1) + call RegPack(RF, InData%Cn2) + call RegPack(RF, InData%St_sh) + call RegPack(RF, InData%Cd0) + call RegPack(RF, InData%Cm0) + call RegPack(RF, InData%k0) + call RegPack(RF, InData%k1) + call RegPack(RF, InData%k2) + call RegPack(RF, InData%k3) + call RegPack(RF, InData%k1_hat) + call RegPack(RF, InData%x_cp_bar) + call RegPack(RF, InData%UACutout) + call RegPack(RF, InData%UACutout_delta) + call RegPack(RF, InData%UACutout_blend) + call RegPack(RF, InData%filtCutOff) + call RegPack(RF, InData%alphaUpper) + call RegPack(RF, InData%alphaLower) + call RegPack(RF, InData%c_Rate) + call RegPack(RF, InData%c_RateUpper) + call RegPack(RF, InData%c_RateLower) + call RegPack(RF, InData%c_alphaLower) + call RegPack(RF, InData%c_alphaUpper) + call RegPack(RF, InData%alphaUpperWrap) + call RegPack(RF, InData%alphaLowerWrap) + call RegPack(RF, InData%c_RateWrap) + call RegPack(RF, InData%c_alphaLowerWrap) + call RegPack(RF, InData%c_alphaUpperWrap) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackUA_BL_Type(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackUA_BL_Type(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_UA_BL_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Type' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%alpha0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%eta_e) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_nalpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_lalpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_f0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_V0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_p) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_VL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b5) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%A1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%A2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%A5) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S4) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%St_sh) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cd0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k1_hat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%x_cp_bar) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UACutout) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UACutout_delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UACutout_blend) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%filtCutOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaUpper) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaLower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_Rate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_RateUpper) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_RateLower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_alphaLower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_alphaUpper) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaUpperWrap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaLowerWrap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_RateWrap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_alphaLowerWrap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c_alphaUpperWrap) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%alpha0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%eta_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_nalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_lalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_f0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_VL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%St_sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_cp_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout_blend); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filtCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaLower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_Rate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_RateUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_RateLower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_alphaLower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_alphaUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaUpperWrap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaLowerWrap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_RateWrap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_alphaLowerWrap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c_alphaUpperWrap); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AFI_CopyUA_BL_Default_Type(SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg) @@ -479,127 +432,91 @@ subroutine AFI_DestroyUA_BL_Default_Type(UA_BL_Default_TypeData, ErrStat, ErrMsg ErrMsg = '' end subroutine -subroutine AFI_PackUA_BL_Default_Type(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackUA_BL_Default_Type(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_UA_BL_Default_Type), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Default_Type' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%alpha0) - call RegPack(Buf, InData%alpha1) - call RegPack(Buf, InData%alpha2) - call RegPack(Buf, InData%eta_e) - call RegPack(Buf, InData%C_nalpha) - call RegPack(Buf, InData%C_lalpha) - call RegPack(Buf, InData%T_f0) - call RegPack(Buf, InData%T_V0) - call RegPack(Buf, InData%T_p) - call RegPack(Buf, InData%T_VL) - call RegPack(Buf, InData%b1) - call RegPack(Buf, InData%b2) - call RegPack(Buf, InData%b5) - call RegPack(Buf, InData%A1) - call RegPack(Buf, InData%A2) - call RegPack(Buf, InData%A5) - call RegPack(Buf, InData%S1) - call RegPack(Buf, InData%S2) - call RegPack(Buf, InData%S3) - call RegPack(Buf, InData%S4) - call RegPack(Buf, InData%Cn1) - call RegPack(Buf, InData%Cn2) - call RegPack(Buf, InData%St_sh) - call RegPack(Buf, InData%Cd0) - call RegPack(Buf, InData%Cm0) - call RegPack(Buf, InData%k0) - call RegPack(Buf, InData%k1) - call RegPack(Buf, InData%k2) - call RegPack(Buf, InData%k3) - call RegPack(Buf, InData%k1_hat) - call RegPack(Buf, InData%x_cp_bar) - call RegPack(Buf, InData%UACutout) - call RegPack(Buf, InData%UACutout_delta) - call RegPack(Buf, InData%filtCutOff) - call RegPack(Buf, InData%alphaUpper) - call RegPack(Buf, InData%alphaLower) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%alpha0) + call RegPack(RF, InData%alpha1) + call RegPack(RF, InData%alpha2) + call RegPack(RF, InData%eta_e) + call RegPack(RF, InData%C_nalpha) + call RegPack(RF, InData%C_lalpha) + call RegPack(RF, InData%T_f0) + call RegPack(RF, InData%T_V0) + call RegPack(RF, InData%T_p) + call RegPack(RF, InData%T_VL) + call RegPack(RF, InData%b1) + call RegPack(RF, InData%b2) + call RegPack(RF, InData%b5) + call RegPack(RF, InData%A1) + call RegPack(RF, InData%A2) + call RegPack(RF, InData%A5) + call RegPack(RF, InData%S1) + call RegPack(RF, InData%S2) + call RegPack(RF, InData%S3) + call RegPack(RF, InData%S4) + call RegPack(RF, InData%Cn1) + call RegPack(RF, InData%Cn2) + call RegPack(RF, InData%St_sh) + call RegPack(RF, InData%Cd0) + call RegPack(RF, InData%Cm0) + call RegPack(RF, InData%k0) + call RegPack(RF, InData%k1) + call RegPack(RF, InData%k2) + call RegPack(RF, InData%k3) + call RegPack(RF, InData%k1_hat) + call RegPack(RF, InData%x_cp_bar) + call RegPack(RF, InData%UACutout) + call RegPack(RF, InData%UACutout_delta) + call RegPack(RF, InData%filtCutOff) + call RegPack(RF, InData%alphaUpper) + call RegPack(RF, InData%alphaLower) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackUA_BL_Default_Type(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackUA_BL_Default_Type(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_UA_BL_Default_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Default_Type' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%alpha0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%eta_e) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_nalpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_lalpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_f0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_V0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_p) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_VL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b5) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%A1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%A2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%A5) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%S4) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%St_sh) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cd0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k1_hat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%x_cp_bar) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UACutout) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UACutout_delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%filtCutOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaUpper) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaLower) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%alpha0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%eta_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_nalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_lalpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_f0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_VL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%A5); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%S4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%St_sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k1_hat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_cp_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UACutout_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filtCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaUpper); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaLower); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg) @@ -682,96 +599,40 @@ subroutine AFI_DestroyTable_Type(Table_TypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AFI_PackTable_Type(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackTable_Type(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_Table_Type), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackTable_Type' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Alpha)) - if (allocated(InData%Alpha)) then - call RegPackBounds(Buf, 1, lbound(InData%Alpha, kind=B8Ki), ubound(InData%Alpha, kind=B8Ki)) - call RegPack(Buf, InData%Alpha) - end if - call RegPack(Buf, allocated(InData%Coefs)) - if (allocated(InData%Coefs)) then - call RegPackBounds(Buf, 2, lbound(InData%Coefs, kind=B8Ki), ubound(InData%Coefs, kind=B8Ki)) - call RegPack(Buf, InData%Coefs) - end if - call RegPack(Buf, allocated(InData%SplineCoefs)) - if (allocated(InData%SplineCoefs)) then - call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs, kind=B8Ki), ubound(InData%SplineCoefs, kind=B8Ki)) - call RegPack(Buf, InData%SplineCoefs) - end if - call RegPack(Buf, InData%UserProp) - call RegPack(Buf, InData%Re) - call RegPack(Buf, InData%NumAlf) - call RegPack(Buf, InData%ConstData) - call RegPack(Buf, InData%InclUAdata) - call AFI_PackUA_BL_Type(Buf, InData%UA_BL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Alpha) + call RegPackAlloc(RF, InData%Coefs) + call RegPackAlloc(RF, InData%SplineCoefs) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%Re) + call RegPack(RF, InData%NumAlf) + call RegPack(RF, InData%ConstData) + call RegPack(RF, InData%InclUAdata) + call AFI_PackUA_BL_Type(RF, InData%UA_BL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackTable_Type(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackTable_Type(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_Table_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Alpha(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Alpha) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Coefs)) deallocate(OutData%Coefs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Coefs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Coefs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SplineCoefs)) deallocate(OutData%SplineCoefs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SplineCoefs) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Re) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumAlf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ConstData) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InclUAdata) - if (RegCheckErr(Buf, RoutineName)) return - call AFI_UnpackUA_BL_Type(Buf, OutData%UA_BL) ! UA_BL + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Coefs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SplineCoefs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumAlf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConstData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InclUAdata); if (RegCheckErr(RF, RoutineName)) return + call AFI_UnpackUA_BL_Type(RF, OutData%UA_BL) ! UA_BL end subroutine subroutine AFI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -802,43 +663,35 @@ subroutine AFI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AFI_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FileName) - call RegPack(Buf, InData%AFTabMod) - call RegPack(Buf, InData%InCol_Alfa) - call RegPack(Buf, InData%InCol_Cl) - call RegPack(Buf, InData%InCol_Cd) - call RegPack(Buf, InData%InCol_Cm) - call RegPack(Buf, InData%InCol_Cpmin) - call RegPack(Buf, InData%UA_f_cn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FileName) + call RegPack(RF, InData%AFTabMod) + call RegPack(RF, InData%InCol_Alfa) + call RegPack(RF, InData%InCol_Cl) + call RegPack(RF, InData%InCol_Cd) + call RegPack(RF, InData%InCol_Cm) + call RegPack(RF, InData%InCol_Cpmin) + call RegPack(RF, InData%UA_f_cn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AFTabMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Alfa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InCol_Cpmin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UA_f_cn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFTabMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Alfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InCol_Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_f_cn); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AFI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -870,21 +723,21 @@ subroutine AFI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AFI_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -998,145 +851,79 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine AFI_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%ColCd) - call RegPack(Buf, InData%ColCl) - call RegPack(Buf, InData%ColCm) - call RegPack(Buf, InData%ColCpmin) - call RegPack(Buf, InData%ColUAf) - call RegPack(Buf, InData%AFTabMod) - call RegPack(Buf, allocated(InData%secondVals)) - if (allocated(InData%secondVals)) then - call RegPackBounds(Buf, 1, lbound(InData%secondVals, kind=B8Ki), ubound(InData%secondVals, kind=B8Ki)) - call RegPack(Buf, InData%secondVals) - end if - call RegPack(Buf, InData%InterpOrd) - call RegPack(Buf, InData%RelThickness) - call RegPack(Buf, InData%NonDimArea) - call RegPack(Buf, InData%NumCoords) - call RegPack(Buf, allocated(InData%X_Coord)) - if (allocated(InData%X_Coord)) then - call RegPackBounds(Buf, 1, lbound(InData%X_Coord, kind=B8Ki), ubound(InData%X_Coord, kind=B8Ki)) - call RegPack(Buf, InData%X_Coord) - end if - call RegPack(Buf, allocated(InData%Y_Coord)) - if (allocated(InData%Y_Coord)) then - call RegPackBounds(Buf, 1, lbound(InData%Y_Coord, kind=B8Ki), ubound(InData%Y_Coord, kind=B8Ki)) - call RegPack(Buf, InData%Y_Coord) - end if - call RegPack(Buf, InData%NumTabs) - call RegPack(Buf, allocated(InData%Table)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ColCd) + call RegPack(RF, InData%ColCl) + call RegPack(RF, InData%ColCm) + call RegPack(RF, InData%ColCpmin) + call RegPack(RF, InData%ColUAf) + call RegPack(RF, InData%AFTabMod) + call RegPackAlloc(RF, InData%secondVals) + call RegPack(RF, InData%InterpOrd) + call RegPack(RF, InData%RelThickness) + call RegPack(RF, InData%NonDimArea) + call RegPack(RF, InData%NumCoords) + call RegPackAlloc(RF, InData%X_Coord) + call RegPackAlloc(RF, InData%Y_Coord) + call RegPack(RF, InData%NumTabs) + call RegPack(RF, allocated(InData%Table)) if (allocated(InData%Table)) then - call RegPackBounds(Buf, 1, lbound(InData%Table, kind=B8Ki), ubound(InData%Table, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Table, kind=B8Ki), ubound(InData%Table, kind=B8Ki)) LB(1:1) = lbound(InData%Table, kind=B8Ki) UB(1:1) = ubound(InData%Table, kind=B8Ki) do i1 = LB(1), UB(1) - call AFI_PackTable_Type(Buf, InData%Table(i1)) + call AFI_PackTable_Type(RF, InData%Table(i1)) end do end if - call RegPack(Buf, InData%BL_file) - call RegPack(Buf, InData%FileName) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%BL_file) + call RegPack(RF, InData%FileName) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%ColCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ColCl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ColCm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ColCpmin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ColUAf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AFTabMod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%secondVals)) deallocate(OutData%secondVals) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%secondVals(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%secondVals) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%InterpOrd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RelThickness) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NonDimArea) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumCoords) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%X_Coord)) deallocate(OutData%X_Coord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X_Coord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X_Coord) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y_Coord)) deallocate(OutData%Y_Coord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y_Coord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y_Coord) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumTabs) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ColCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColCl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColCm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColCpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ColUAf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFTabMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%secondVals); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RelThickness); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NonDimArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCoords); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X_Coord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_Coord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTabs); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%Table)) deallocate(OutData%Table) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Table(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AFI_UnpackTable_Type(Buf, OutData%Table(i1)) ! Table + call AFI_UnpackTable_Type(RF, OutData%Table(i1)) ! Table end do end if - call RegUnpack(Buf, OutData%BL_file) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FileName) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%BL_file); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AFI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1162,28 +949,25 @@ subroutine AFI_DestroyInput(InputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AFI_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AoA) - call RegPack(Buf, InData%UserProp) - call RegPack(Buf, InData%Re) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AoA) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%Re) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AoA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Re) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AoA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AFI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1215,46 +999,37 @@ subroutine AFI_DestroyOutput(OutputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AFI_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AFI_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Cl) - call RegPack(Buf, InData%Cd) - call RegPack(Buf, InData%Cm) - call RegPack(Buf, InData%Cpmin) - call RegPack(Buf, InData%Cd0) - call RegPack(Buf, InData%Cm0) - call RegPack(Buf, InData%f_st) - call RegPack(Buf, InData%FullySeparate) - call RegPack(Buf, InData%FullyAttached) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Cl) + call RegPack(RF, InData%Cd) + call RegPack(RF, InData%Cm) + call RegPack(RF, InData%Cpmin) + call RegPack(RF, InData%Cd0) + call RegPack(RF, InData%Cm0) + call RegPack(RF, InData%f_st) + call RegPack(RF, InData%FullySeparate) + call RegPack(RF, InData%FullyAttached) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AFI_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AFI_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AFI_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Cl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cpmin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cd0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%f_st) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FullySeparate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FullyAttached) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f_st); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullySeparate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullyAttached); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AFI_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index c8acce2fc8..01b8ef02a6 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -411,268 +411,90 @@ subroutine BEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine BEMT_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%chord)) - if (allocated(InData%chord)) then - call RegPackBounds(Buf, 2, lbound(InData%chord, kind=B8Ki), ubound(InData%chord, kind=B8Ki)) - call RegPack(Buf, InData%chord) - end if - call RegPack(Buf, InData%numBlades) - call RegPack(Buf, InData%airDens) - call RegPack(Buf, InData%kinVisc) - call RegPack(Buf, InData%skewWakeMod) - call RegPack(Buf, InData%aTol) - call RegPack(Buf, InData%useTipLoss) - call RegPack(Buf, InData%useHubLoss) - call RegPack(Buf, InData%useInduction) - call RegPack(Buf, InData%useTanInd) - call RegPack(Buf, InData%useAIDrag) - call RegPack(Buf, InData%useTIDrag) - call RegPack(Buf, InData%MomentumCorr) - call RegPack(Buf, InData%numBladeNodes) - call RegPack(Buf, InData%numReIterations) - call RegPack(Buf, InData%maxIndIterations) - call RegPack(Buf, allocated(InData%AFindx)) - if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) - call RegPack(Buf, InData%AFindx) - end if - call RegPack(Buf, allocated(InData%zHub)) - if (allocated(InData%zHub)) then - call RegPackBounds(Buf, 1, lbound(InData%zHub, kind=B8Ki), ubound(InData%zHub, kind=B8Ki)) - call RegPack(Buf, InData%zHub) - end if - call RegPack(Buf, allocated(InData%zLocal)) - if (allocated(InData%zLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%zLocal, kind=B8Ki), ubound(InData%zLocal, kind=B8Ki)) - call RegPack(Buf, InData%zLocal) - end if - call RegPack(Buf, allocated(InData%zTip)) - if (allocated(InData%zTip)) then - call RegPackBounds(Buf, 1, lbound(InData%zTip, kind=B8Ki), ubound(InData%zTip, kind=B8Ki)) - call RegPack(Buf, InData%zTip) - end if - call RegPack(Buf, allocated(InData%rLocal)) - if (allocated(InData%rLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%rLocal, kind=B8Ki), ubound(InData%rLocal, kind=B8Ki)) - call RegPack(Buf, InData%rLocal) - end if - call RegPack(Buf, allocated(InData%rTipFix)) - if (allocated(InData%rTipFix)) then - call RegPackBounds(Buf, 1, lbound(InData%rTipFix, kind=B8Ki), ubound(InData%rTipFix, kind=B8Ki)) - call RegPack(Buf, InData%rTipFix) - end if - call RegPack(Buf, InData%UAMod) - call RegPack(Buf, InData%UA_Flag) - call RegPack(Buf, InData%Flookup) - call RegPack(Buf, InData%a_s) - call RegPack(Buf, InData%DBEMT_Mod) - call RegPack(Buf, InData%tau1_const) - call RegPack(Buf, InData%yawCorrFactor) - call RegPack(Buf, allocated(InData%UAOff_innerNode)) - if (allocated(InData%UAOff_innerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode, kind=B8Ki), ubound(InData%UAOff_innerNode, kind=B8Ki)) - call RegPack(Buf, InData%UAOff_innerNode) - end if - call RegPack(Buf, allocated(InData%UAOff_outerNode)) - if (allocated(InData%UAOff_outerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode, kind=B8Ki), ubound(InData%UAOff_outerNode, kind=B8Ki)) - call RegPack(Buf, InData%UAOff_outerNode) - end if - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%BEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%chord) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%airDens) + call RegPack(RF, InData%kinVisc) + call RegPack(RF, InData%skewWakeMod) + call RegPack(RF, InData%aTol) + call RegPack(RF, InData%useTipLoss) + call RegPack(RF, InData%useHubLoss) + call RegPack(RF, InData%useInduction) + call RegPack(RF, InData%useTanInd) + call RegPack(RF, InData%useAIDrag) + call RegPack(RF, InData%useTIDrag) + call RegPack(RF, InData%MomentumCorr) + call RegPack(RF, InData%numBladeNodes) + call RegPack(RF, InData%numReIterations) + call RegPack(RF, InData%maxIndIterations) + call RegPackAlloc(RF, InData%AFindx) + call RegPackAlloc(RF, InData%zHub) + call RegPackAlloc(RF, InData%zLocal) + call RegPackAlloc(RF, InData%zTip) + call RegPackAlloc(RF, InData%rLocal) + call RegPackAlloc(RF, InData%rTipFix) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, InData%Flookup) + call RegPack(RF, InData%a_s) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%tau1_const) + call RegPack(RF, InData%yawCorrFactor) + call RegPackAlloc(RF, InData%UAOff_innerNode) + call RegPackAlloc(RF, InData%UAOff_outerNode) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%BEM_Mod) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%chord)) deallocate(OutData%chord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chord(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chord) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%airDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%skewWakeMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%aTol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useTipLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useHubLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useInduction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useTanInd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useAIDrag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useTIDrag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MomentumCorr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numBladeNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numReIterations) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%maxIndIterations) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFindx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zHub)) deallocate(OutData%zHub) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zHub(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zHub) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zLocal)) deallocate(OutData%zLocal) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zLocal) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zTip)) deallocate(OutData%zTip) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zTip(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zTip) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rLocal) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rTipFix)) deallocate(OutData%rTipFix) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rTipFix(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTipFix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rTipFix) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a_s) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yawCorrFactor) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UAOff_innerNode(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UAOff_innerNode) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UAOff_outerNode(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UAOff_outerNode) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%airDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%skewWakeMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useHubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useAIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomentumCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBladeNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numReIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%maxIndIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zHub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zLocal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zTip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLocal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rTipFix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawCorrFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UAOff_innerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UAOff_outerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -704,21 +526,21 @@ subroutine BEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine BEMT_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Version) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Version) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Version) ! Version end subroutine subroutine BEMT_CopySkewWake_InputType(SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -744,28 +566,25 @@ subroutine BEMT_DestroySkewWake_InputType(SkewWake_InputTypeData, ErrStat, ErrMs ErrMsg = '' end subroutine -subroutine BEMT_PackSkewWake_InputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackSkewWake_InputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_SkewWake_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackSkewWake_InputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%v_qsw) - call RegPack(Buf, InData%V0) - call RegPack(Buf, InData%R) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%v_qsw) + call RegPack(RF, InData%V0) + call RegPack(RF, InData%R) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackSkewWake_InputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackSkewWake_InputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_SkewWake_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackSkewWake_InputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%v_qsw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%V0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%R) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%v_qsw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -803,26 +622,25 @@ subroutine BEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine BEMT_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call UA_PackContState(Buf, InData%UA) - call DBEMT_PackContState(Buf, InData%DBEMT) - call RegPack(Buf, InData%V_w) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call UA_PackContState(RF, InData%UA) + call DBEMT_PackContState(RF, InData%DBEMT) + call RegPack(RF, InData%V_w) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call UA_UnpackContState(Buf, OutData%UA) ! UA - call DBEMT_UnpackContState(Buf, OutData%DBEMT) ! DBEMT - call RegUnpack(Buf, OutData%V_w) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call UA_UnpackContState(RF, OutData%UA) ! UA + call DBEMT_UnpackContState(RF, OutData%DBEMT) ! DBEMT + call RegUnpack(RF, OutData%V_w); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -854,21 +672,21 @@ subroutine BEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine BEMT_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call UA_PackDiscState(Buf, InData%UA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call UA_PackDiscState(RF, InData%UA) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call UA_UnpackDiscState(Buf, OutData%UA) ! UA + if (RF%ErrStat /= ErrID_None) return + call UA_UnpackDiscState(RF, OutData%UA) ! UA end subroutine subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -908,41 +726,24 @@ subroutine BEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end if end subroutine -subroutine BEMT_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%phi)) - if (allocated(InData%phi)) then - call RegPackBounds(Buf, 2, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) - call RegPack(Buf, InData%phi) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%phi) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%phi)) deallocate(OutData%phi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%phi) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1013,64 +814,45 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end do end subroutine -subroutine BEMT_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call UA_PackOtherState(Buf, InData%UA) - call DBEMT_PackOtherState(Buf, InData%DBEMT) - call RegPack(Buf, allocated(InData%ValidPhi)) - if (allocated(InData%ValidPhi)) then - call RegPackBounds(Buf, 2, lbound(InData%ValidPhi, kind=B8Ki), ubound(InData%ValidPhi, kind=B8Ki)) - call RegPack(Buf, InData%ValidPhi) - end if - call RegPack(Buf, InData%nodesInitialized) + if (RF%ErrStat >= AbortErrLev) return + call UA_PackOtherState(RF, InData%UA) + call DBEMT_PackOtherState(RF, InData%DBEMT) + call RegPackAlloc(RF, InData%ValidPhi) + call RegPack(RF, InData%nodesInitialized) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call BEMT_PackContState(Buf, InData%xdot(i1)) + call BEMT_PackContState(RF, InData%xdot(i1)) end do - call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call UA_UnpackOtherState(Buf, OutData%UA) ! UA - call DBEMT_UnpackOtherState(Buf, OutData%DBEMT) ! DBEMT - if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ValidPhi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ValidPhi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nodesInitialized) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call UA_UnpackOtherState(RF, OutData%UA) ! UA + call DBEMT_UnpackOtherState(RF, OutData%DBEMT) ! DBEMT + call RegUnpackAlloc(RF, OutData%ValidPhi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nodesInitialized); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%xdot, kind=B8Ki) UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call BEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call BEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1300,28 +1082,28 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine BEMT_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackMisc' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FirstWarn_Skew) - call RegPack(Buf, InData%FirstWarn_Phi) - call RegPack(Buf, InData%FirstWarn_BEMoff) - call UA_PackMisc(Buf, InData%UA) - call DBEMT_PackMisc(Buf, InData%DBEMT) - call UA_PackOutput(Buf, InData%y_UA) - call RegPack(Buf, allocated(InData%u_UA)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FirstWarn_Skew) + call RegPack(RF, InData%FirstWarn_Phi) + call RegPack(RF, InData%FirstWarn_BEMoff) + call UA_PackMisc(RF, InData%UA) + call DBEMT_PackMisc(RF, InData%DBEMT) + call UA_PackOutput(RF, InData%y_UA) + call RegPack(RF, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(Buf, 3, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) LB(1:3) = lbound(InData%u_UA, kind=B8Ki) UB(1:3) = ubound(InData%u_UA, kind=B8Ki) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call UA_PackInput(Buf, InData%u_UA(i1,i2,i3)) + call UA_PackInput(RF, InData%u_UA(i1,i2,i3)) end do end do end do @@ -1329,91 +1111,54 @@ subroutine BEMT_PackMisc(Buf, Indata) LB(1:1) = lbound(InData%u_DBEMT, kind=B8Ki) UB(1:1) = ubound(InData%u_DBEMT, kind=B8Ki) do i1 = LB(1), UB(1) - call DBEMT_PackInput(Buf, InData%u_DBEMT(i1)) + call DBEMT_PackInput(RF, InData%u_DBEMT(i1)) end do LB(1:1) = lbound(InData%u_SkewWake, kind=B8Ki) UB(1:1) = ubound(InData%u_SkewWake, kind=B8Ki) do i1 = LB(1), UB(1) - call BEMT_PackSkewWake_InputType(Buf, InData%u_SkewWake(i1)) + call BEMT_PackSkewWake_InputType(RF, InData%u_SkewWake(i1)) end do - call RegPack(Buf, allocated(InData%TnInd_op)) - if (allocated(InData%TnInd_op)) then - call RegPackBounds(Buf, 2, lbound(InData%TnInd_op, kind=B8Ki), ubound(InData%TnInd_op, kind=B8Ki)) - call RegPack(Buf, InData%TnInd_op) - end if - call RegPack(Buf, allocated(InData%AxInd_op)) - if (allocated(InData%AxInd_op)) then - call RegPackBounds(Buf, 2, lbound(InData%AxInd_op, kind=B8Ki), ubound(InData%AxInd_op, kind=B8Ki)) - call RegPack(Buf, InData%AxInd_op) - end if - call RegPack(Buf, allocated(InData%AxInduction)) - if (allocated(InData%AxInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%AxInduction, kind=B8Ki), ubound(InData%AxInduction, kind=B8Ki)) - call RegPack(Buf, InData%AxInduction) - end if - call RegPack(Buf, allocated(InData%TanInduction)) - if (allocated(InData%TanInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%TanInduction, kind=B8Ki), ubound(InData%TanInduction, kind=B8Ki)) - call RegPack(Buf, InData%TanInduction) - end if - call RegPack(Buf, InData%UseFrozenWake) - call RegPack(Buf, allocated(InData%Rtip)) - if (allocated(InData%Rtip)) then - call RegPackBounds(Buf, 1, lbound(InData%Rtip, kind=B8Ki), ubound(InData%Rtip, kind=B8Ki)) - call RegPack(Buf, InData%Rtip) - end if - call RegPack(Buf, allocated(InData%phi)) - if (allocated(InData%phi)) then - call RegPackBounds(Buf, 2, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) - call RegPack(Buf, InData%phi) - end if - call RegPack(Buf, allocated(InData%chi)) - if (allocated(InData%chi)) then - call RegPackBounds(Buf, 2, lbound(InData%chi, kind=B8Ki), ubound(InData%chi, kind=B8Ki)) - call RegPack(Buf, InData%chi) - end if - call RegPack(Buf, allocated(InData%ValidPhi)) - if (allocated(InData%ValidPhi)) then - call RegPackBounds(Buf, 2, lbound(InData%ValidPhi, kind=B8Ki), ubound(InData%ValidPhi, kind=B8Ki)) - call RegPack(Buf, InData%ValidPhi) - end if - call RegPack(Buf, InData%BEM_weight) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%TnInd_op) + call RegPackAlloc(RF, InData%AxInd_op) + call RegPackAlloc(RF, InData%AxInduction) + call RegPackAlloc(RF, InData%TanInduction) + call RegPack(RF, InData%UseFrozenWake) + call RegPackAlloc(RF, InData%Rtip) + call RegPackAlloc(RF, InData%phi) + call RegPackAlloc(RF, InData%chi) + call RegPackAlloc(RF, InData%ValidPhi) + call RegPack(RF, InData%BEM_weight) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FirstWarn_Skew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstWarn_Phi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstWarn_BEMoff) - if (RegCheckErr(Buf, RoutineName)) return - call UA_UnpackMisc(Buf, OutData%UA) ! UA - call DBEMT_UnpackMisc(Buf, OutData%DBEMT) ! DBEMT - call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FirstWarn_Skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_BEMoff); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackMisc(RF, OutData%UA) ! UA + call DBEMT_UnpackMisc(RF, OutData%DBEMT) ! DBEMT + call UA_UnpackOutput(RF, OutData%y_UA) ! y_UA if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 3, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call UA_UnpackInput(Buf, OutData%u_UA(i1,i2,i3)) ! u_UA + call UA_UnpackInput(RF, OutData%u_UA(i1,i2,i3)) ! u_UA end do end do end do @@ -1421,129 +1166,23 @@ subroutine BEMT_UnPackMisc(Buf, OutData) LB(1:1) = lbound(OutData%u_DBEMT, kind=B8Ki) UB(1:1) = ubound(OutData%u_DBEMT, kind=B8Ki) do i1 = LB(1), UB(1) - call DBEMT_UnpackInput(Buf, OutData%u_DBEMT(i1)) ! u_DBEMT + call DBEMT_UnpackInput(RF, OutData%u_DBEMT(i1)) ! u_DBEMT end do LB(1:1) = lbound(OutData%u_SkewWake, kind=B8Ki) UB(1:1) = ubound(OutData%u_SkewWake, kind=B8Ki) do i1 = LB(1), UB(1) - call BEMT_UnpackSkewWake_InputType(Buf, OutData%u_SkewWake(i1)) ! u_SkewWake + call BEMT_UnpackSkewWake_InputType(RF, OutData%u_SkewWake(i1)) ! u_SkewWake end do - if (allocated(OutData%TnInd_op)) deallocate(OutData%TnInd_op) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TnInd_op(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TnInd_op) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AxInd_op)) deallocate(OutData%AxInd_op) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxInd_op(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxInd_op) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AxInduction)) deallocate(OutData%AxInduction) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxInduction) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TanInduction)) deallocate(OutData%TanInduction) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TanInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TanInduction) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UseFrozenWake) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Rtip)) deallocate(OutData%Rtip) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Rtip(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Rtip) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%phi)) deallocate(OutData%phi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%phi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%chi)) deallocate(OutData%chi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ValidPhi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ValidPhi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BEM_weight) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TnInd_op); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxInd_op); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TanInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseFrozenWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Rtip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ValidPhi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_weight); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1708,225 +1347,84 @@ subroutine BEMT_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine BEMT_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, allocated(InData%chord)) - if (allocated(InData%chord)) then - call RegPackBounds(Buf, 2, lbound(InData%chord, kind=B8Ki), ubound(InData%chord, kind=B8Ki)) - call RegPack(Buf, InData%chord) - end if - call RegPack(Buf, InData%numBlades) - call RegPack(Buf, InData%airDens) - call RegPack(Buf, InData%kinVisc) - call RegPack(Buf, InData%skewWakeMod) - call RegPack(Buf, InData%aTol) - call RegPack(Buf, InData%useTipLoss) - call RegPack(Buf, InData%useHubLoss) - call RegPack(Buf, InData%useInduction) - call RegPack(Buf, InData%useTanInd) - call RegPack(Buf, InData%useAIDrag) - call RegPack(Buf, InData%useTIDrag) - call RegPack(Buf, InData%numBladeNodes) - call RegPack(Buf, InData%numReIterations) - call RegPack(Buf, InData%maxIndIterations) - call RegPack(Buf, allocated(InData%AFindx)) - if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) - call RegPack(Buf, InData%AFindx) - end if - call RegPack(Buf, allocated(InData%tipLossConst)) - if (allocated(InData%tipLossConst)) then - call RegPackBounds(Buf, 2, lbound(InData%tipLossConst, kind=B8Ki), ubound(InData%tipLossConst, kind=B8Ki)) - call RegPack(Buf, InData%tipLossConst) - end if - call RegPack(Buf, allocated(InData%hubLossConst)) - if (allocated(InData%hubLossConst)) then - call RegPackBounds(Buf, 2, lbound(InData%hubLossConst, kind=B8Ki), ubound(InData%hubLossConst, kind=B8Ki)) - call RegPack(Buf, InData%hubLossConst) - end if - call RegPack(Buf, allocated(InData%zHub)) - if (allocated(InData%zHub)) then - call RegPackBounds(Buf, 1, lbound(InData%zHub, kind=B8Ki), ubound(InData%zHub, kind=B8Ki)) - call RegPack(Buf, InData%zHub) - end if - call UA_PackParam(Buf, InData%UA) - call DBEMT_PackParam(Buf, InData%DBEMT) - call RegPack(Buf, InData%UA_Flag) - call RegPack(Buf, InData%DBEMT_Mod) - call RegPack(Buf, InData%yawCorrFactor) - call RegPack(Buf, allocated(InData%FixedInductions)) - if (allocated(InData%FixedInductions)) then - call RegPackBounds(Buf, 2, lbound(InData%FixedInductions, kind=B8Ki), ubound(InData%FixedInductions, kind=B8Ki)) - call RegPack(Buf, InData%FixedInductions) - end if - call RegPack(Buf, InData%MomentumCorr) - call RegPack(Buf, InData%rTipFixMax) - call RegPack(Buf, allocated(InData%IntegrateWeight)) - if (allocated(InData%IntegrateWeight)) then - call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight, kind=B8Ki), ubound(InData%IntegrateWeight, kind=B8Ki)) - call RegPack(Buf, InData%IntegrateWeight) - end if - call RegPack(Buf, InData%lin_nx) - call RegPack(Buf, InData%BEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%chord) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%airDens) + call RegPack(RF, InData%kinVisc) + call RegPack(RF, InData%skewWakeMod) + call RegPack(RF, InData%aTol) + call RegPack(RF, InData%useTipLoss) + call RegPack(RF, InData%useHubLoss) + call RegPack(RF, InData%useInduction) + call RegPack(RF, InData%useTanInd) + call RegPack(RF, InData%useAIDrag) + call RegPack(RF, InData%useTIDrag) + call RegPack(RF, InData%numBladeNodes) + call RegPack(RF, InData%numReIterations) + call RegPack(RF, InData%maxIndIterations) + call RegPackAlloc(RF, InData%AFindx) + call RegPackAlloc(RF, InData%tipLossConst) + call RegPackAlloc(RF, InData%hubLossConst) + call RegPackAlloc(RF, InData%zHub) + call UA_PackParam(RF, InData%UA) + call DBEMT_PackParam(RF, InData%DBEMT) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, InData%DBEMT_Mod) + call RegPack(RF, InData%yawCorrFactor) + call RegPackAlloc(RF, InData%FixedInductions) + call RegPack(RF, InData%MomentumCorr) + call RegPack(RF, InData%rTipFixMax) + call RegPackAlloc(RF, InData%IntegrateWeight) + call RegPack(RF, InData%lin_nx) + call RegPack(RF, InData%BEM_Mod) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%chord)) deallocate(OutData%chord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chord(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chord) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%airDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%skewWakeMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%aTol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useTipLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useHubLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useInduction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useTanInd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useAIDrag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%useTIDrag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numBladeNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numReIterations) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%maxIndIterations) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFindx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tipLossConst)) deallocate(OutData%tipLossConst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tipLossConst(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tipLossConst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%hubLossConst)) deallocate(OutData%hubLossConst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%hubLossConst(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%hubLossConst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zHub)) deallocate(OutData%zHub) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zHub(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zHub) - if (RegCheckErr(Buf, RoutineName)) return - end if - call UA_UnpackParam(Buf, OutData%UA) ! UA - call DBEMT_UnpackParam(Buf, OutData%DBEMT) ! DBEMT - call RegUnpack(Buf, OutData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yawCorrFactor) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FixedInductions)) deallocate(OutData%FixedInductions) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FixedInductions(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FixedInductions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FixedInductions) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MomentumCorr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rTipFixMax) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%IntegrateWeight)) deallocate(OutData%IntegrateWeight) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IntegrateWeight) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%lin_nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%airDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%skewWakeMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%aTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useHubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useAIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%useTIDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBladeNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numReIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%maxIndIterations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tipLossConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%hubLossConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zHub); if (RegCheckErr(RF, RoutineName)) return + call UA_UnpackParam(RF, OutData%UA) ! UA + call DBEMT_UnpackParam(RF, OutData%DBEMT) ! DBEMT + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yawCorrFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FixedInductions); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomentumCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rTipFixMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IntegrateWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lin_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BEM_Mod); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -2138,271 +1636,60 @@ subroutine BEMT_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine BEMT_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%theta)) - if (allocated(InData%theta)) then - call RegPackBounds(Buf, 2, lbound(InData%theta, kind=B8Ki), ubound(InData%theta, kind=B8Ki)) - call RegPack(Buf, InData%theta) - end if - call RegPack(Buf, InData%chi0) - call RegPack(Buf, InData%psiSkewOffset) - call RegPack(Buf, allocated(InData%psi_s)) - if (allocated(InData%psi_s)) then - call RegPackBounds(Buf, 1, lbound(InData%psi_s, kind=B8Ki), ubound(InData%psi_s, kind=B8Ki)) - call RegPack(Buf, InData%psi_s) - end if - call RegPack(Buf, InData%omega) - call RegPack(Buf, InData%TSR) - call RegPack(Buf, allocated(InData%Vx)) - if (allocated(InData%Vx)) then - call RegPackBounds(Buf, 2, lbound(InData%Vx, kind=B8Ki), ubound(InData%Vx, kind=B8Ki)) - call RegPack(Buf, InData%Vx) - end if - call RegPack(Buf, allocated(InData%Vy)) - if (allocated(InData%Vy)) then - call RegPackBounds(Buf, 2, lbound(InData%Vy, kind=B8Ki), ubound(InData%Vy, kind=B8Ki)) - call RegPack(Buf, InData%Vy) - end if - call RegPack(Buf, allocated(InData%Vz)) - if (allocated(InData%Vz)) then - call RegPackBounds(Buf, 2, lbound(InData%Vz, kind=B8Ki), ubound(InData%Vz, kind=B8Ki)) - call RegPack(Buf, InData%Vz) - end if - call RegPack(Buf, allocated(InData%omega_z)) - if (allocated(InData%omega_z)) then - call RegPackBounds(Buf, 2, lbound(InData%omega_z, kind=B8Ki), ubound(InData%omega_z, kind=B8Ki)) - call RegPack(Buf, InData%omega_z) - end if - call RegPack(Buf, allocated(InData%xVelCorr)) - if (allocated(InData%xVelCorr)) then - call RegPackBounds(Buf, 2, lbound(InData%xVelCorr, kind=B8Ki), ubound(InData%xVelCorr, kind=B8Ki)) - call RegPack(Buf, InData%xVelCorr) - end if - call RegPack(Buf, allocated(InData%rLocal)) - if (allocated(InData%rLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%rLocal, kind=B8Ki), ubound(InData%rLocal, kind=B8Ki)) - call RegPack(Buf, InData%rLocal) - end if - call RegPack(Buf, InData%Un_disk) - call RegPack(Buf, InData%V0) - call RegPack(Buf, InData%x_hat_disk) - call RegPack(Buf, allocated(InData%UserProp)) - if (allocated(InData%UserProp)) then - call RegPackBounds(Buf, 2, lbound(InData%UserProp, kind=B8Ki), ubound(InData%UserProp, kind=B8Ki)) - call RegPack(Buf, InData%UserProp) - end if - call RegPack(Buf, allocated(InData%CantAngle)) - if (allocated(InData%CantAngle)) then - call RegPackBounds(Buf, 2, lbound(InData%CantAngle, kind=B8Ki), ubound(InData%CantAngle, kind=B8Ki)) - call RegPack(Buf, InData%CantAngle) - end if - call RegPack(Buf, allocated(InData%drdz)) - if (allocated(InData%drdz)) then - call RegPackBounds(Buf, 2, lbound(InData%drdz, kind=B8Ki), ubound(InData%drdz, kind=B8Ki)) - call RegPack(Buf, InData%drdz) - end if - call RegPack(Buf, allocated(InData%toeAngle)) - if (allocated(InData%toeAngle)) then - call RegPackBounds(Buf, 2, lbound(InData%toeAngle, kind=B8Ki), ubound(InData%toeAngle, kind=B8Ki)) - call RegPack(Buf, InData%toeAngle) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%theta) + call RegPack(RF, InData%chi0) + call RegPack(RF, InData%psiSkewOffset) + call RegPackAlloc(RF, InData%psi_s) + call RegPack(RF, InData%omega) + call RegPack(RF, InData%TSR) + call RegPackAlloc(RF, InData%Vx) + call RegPackAlloc(RF, InData%Vy) + call RegPackAlloc(RF, InData%Vz) + call RegPackAlloc(RF, InData%omega_z) + call RegPackAlloc(RF, InData%xVelCorr) + call RegPackAlloc(RF, InData%rLocal) + call RegPack(RF, InData%Un_disk) + call RegPack(RF, InData%V0) + call RegPack(RF, InData%x_hat_disk) + call RegPackAlloc(RF, InData%UserProp) + call RegPackAlloc(RF, InData%CantAngle) + call RegPackAlloc(RF, InData%drdz) + call RegPackAlloc(RF, InData%toeAngle) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%theta)) deallocate(OutData%theta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%theta(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%theta) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%chi0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%psiSkewOffset) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%psi_s)) deallocate(OutData%psi_s) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%psi_s(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%psi_s) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%omega) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TSR) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Vx)) deallocate(OutData%Vx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vy)) deallocate(OutData%Vy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vy(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vy) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vz)) deallocate(OutData%Vz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%omega_z(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%omega_z) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%xVelCorr)) deallocate(OutData%xVelCorr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xVelCorr(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xVelCorr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rLocal) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Un_disk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%V0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%x_hat_disk) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UserProp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CantAngle)) deallocate(OutData%CantAngle) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CantAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CantAngle) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%drdz)) deallocate(OutData%drdz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%drdz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%drdz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%toeAngle)) deallocate(OutData%toeAngle) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%toeAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%toeAngle) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%theta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psiSkewOffset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%psi_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%omega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omega_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xVelCorr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLocal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Un_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_hat_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CantAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%drdz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%toeAngle); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2757,440 +2044,66 @@ subroutine BEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine BEMT_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BEMT_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Vrel)) - if (allocated(InData%Vrel)) then - call RegPackBounds(Buf, 2, lbound(InData%Vrel, kind=B8Ki), ubound(InData%Vrel, kind=B8Ki)) - call RegPack(Buf, InData%Vrel) - end if - call RegPack(Buf, allocated(InData%phi)) - if (allocated(InData%phi)) then - call RegPackBounds(Buf, 2, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) - call RegPack(Buf, InData%phi) - end if - call RegPack(Buf, allocated(InData%axInduction)) - if (allocated(InData%axInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%axInduction, kind=B8Ki), ubound(InData%axInduction, kind=B8Ki)) - call RegPack(Buf, InData%axInduction) - end if - call RegPack(Buf, allocated(InData%tanInduction)) - if (allocated(InData%tanInduction)) then - call RegPackBounds(Buf, 2, lbound(InData%tanInduction, kind=B8Ki), ubound(InData%tanInduction, kind=B8Ki)) - call RegPack(Buf, InData%tanInduction) - end if - call RegPack(Buf, allocated(InData%axInduction_qs)) - if (allocated(InData%axInduction_qs)) then - call RegPackBounds(Buf, 2, lbound(InData%axInduction_qs, kind=B8Ki), ubound(InData%axInduction_qs, kind=B8Ki)) - call RegPack(Buf, InData%axInduction_qs) - end if - call RegPack(Buf, allocated(InData%tanInduction_qs)) - if (allocated(InData%tanInduction_qs)) then - call RegPackBounds(Buf, 2, lbound(InData%tanInduction_qs, kind=B8Ki), ubound(InData%tanInduction_qs, kind=B8Ki)) - call RegPack(Buf, InData%tanInduction_qs) - end if - call RegPack(Buf, allocated(InData%k)) - if (allocated(InData%k)) then - call RegPackBounds(Buf, 2, lbound(InData%k, kind=B8Ki), ubound(InData%k, kind=B8Ki)) - call RegPack(Buf, InData%k) - end if - call RegPack(Buf, allocated(InData%k_p)) - if (allocated(InData%k_p)) then - call RegPackBounds(Buf, 2, lbound(InData%k_p, kind=B8Ki), ubound(InData%k_p, kind=B8Ki)) - call RegPack(Buf, InData%k_p) - end if - call RegPack(Buf, allocated(InData%F)) - if (allocated(InData%F)) then - call RegPackBounds(Buf, 2, lbound(InData%F, kind=B8Ki), ubound(InData%F, kind=B8Ki)) - call RegPack(Buf, InData%F) - end if - call RegPack(Buf, allocated(InData%Re)) - if (allocated(InData%Re)) then - call RegPackBounds(Buf, 2, lbound(InData%Re, kind=B8Ki), ubound(InData%Re, kind=B8Ki)) - call RegPack(Buf, InData%Re) - end if - call RegPack(Buf, allocated(InData%AOA)) - if (allocated(InData%AOA)) then - call RegPackBounds(Buf, 2, lbound(InData%AOA, kind=B8Ki), ubound(InData%AOA, kind=B8Ki)) - call RegPack(Buf, InData%AOA) - end if - call RegPack(Buf, allocated(InData%Cx)) - if (allocated(InData%Cx)) then - call RegPackBounds(Buf, 2, lbound(InData%Cx, kind=B8Ki), ubound(InData%Cx, kind=B8Ki)) - call RegPack(Buf, InData%Cx) - end if - call RegPack(Buf, allocated(InData%Cy)) - if (allocated(InData%Cy)) then - call RegPackBounds(Buf, 2, lbound(InData%Cy, kind=B8Ki), ubound(InData%Cy, kind=B8Ki)) - call RegPack(Buf, InData%Cy) - end if - call RegPack(Buf, allocated(InData%Cz)) - if (allocated(InData%Cz)) then - call RegPackBounds(Buf, 2, lbound(InData%Cz, kind=B8Ki), ubound(InData%Cz, kind=B8Ki)) - call RegPack(Buf, InData%Cz) - end if - call RegPack(Buf, allocated(InData%Cmx)) - if (allocated(InData%Cmx)) then - call RegPackBounds(Buf, 2, lbound(InData%Cmx, kind=B8Ki), ubound(InData%Cmx, kind=B8Ki)) - call RegPack(Buf, InData%Cmx) - end if - call RegPack(Buf, allocated(InData%Cmy)) - if (allocated(InData%Cmy)) then - call RegPackBounds(Buf, 2, lbound(InData%Cmy, kind=B8Ki), ubound(InData%Cmy, kind=B8Ki)) - call RegPack(Buf, InData%Cmy) - end if - call RegPack(Buf, allocated(InData%Cmz)) - if (allocated(InData%Cmz)) then - call RegPackBounds(Buf, 2, lbound(InData%Cmz, kind=B8Ki), ubound(InData%Cmz, kind=B8Ki)) - call RegPack(Buf, InData%Cmz) - end if - call RegPack(Buf, allocated(InData%Cm)) - if (allocated(InData%Cm)) then - call RegPackBounds(Buf, 2, lbound(InData%Cm, kind=B8Ki), ubound(InData%Cm, kind=B8Ki)) - call RegPack(Buf, InData%Cm) - end if - call RegPack(Buf, allocated(InData%Cl)) - if (allocated(InData%Cl)) then - call RegPackBounds(Buf, 2, lbound(InData%Cl, kind=B8Ki), ubound(InData%Cl, kind=B8Ki)) - call RegPack(Buf, InData%Cl) - end if - call RegPack(Buf, allocated(InData%Cd)) - if (allocated(InData%Cd)) then - call RegPackBounds(Buf, 2, lbound(InData%Cd, kind=B8Ki), ubound(InData%Cd, kind=B8Ki)) - call RegPack(Buf, InData%Cd) - end if - call RegPack(Buf, allocated(InData%chi)) - if (allocated(InData%chi)) then - call RegPackBounds(Buf, 2, lbound(InData%chi, kind=B8Ki), ubound(InData%chi, kind=B8Ki)) - call RegPack(Buf, InData%chi) - end if - call RegPack(Buf, allocated(InData%Cpmin)) - if (allocated(InData%Cpmin)) then - call RegPackBounds(Buf, 2, lbound(InData%Cpmin, kind=B8Ki), ubound(InData%Cpmin, kind=B8Ki)) - call RegPack(Buf, InData%Cpmin) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vrel) + call RegPackAlloc(RF, InData%phi) + call RegPackAlloc(RF, InData%axInduction) + call RegPackAlloc(RF, InData%tanInduction) + call RegPackAlloc(RF, InData%axInduction_qs) + call RegPackAlloc(RF, InData%tanInduction_qs) + call RegPackAlloc(RF, InData%k) + call RegPackAlloc(RF, InData%k_p) + call RegPackAlloc(RF, InData%F) + call RegPackAlloc(RF, InData%Re) + call RegPackAlloc(RF, InData%AOA) + call RegPackAlloc(RF, InData%Cx) + call RegPackAlloc(RF, InData%Cy) + call RegPackAlloc(RF, InData%Cz) + call RegPackAlloc(RF, InData%Cmx) + call RegPackAlloc(RF, InData%Cmy) + call RegPackAlloc(RF, InData%Cmz) + call RegPackAlloc(RF, InData%Cm) + call RegPackAlloc(RF, InData%Cl) + call RegPackAlloc(RF, InData%Cd) + call RegPackAlloc(RF, InData%chi) + call RegPackAlloc(RF, InData%Cpmin) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BEMT_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BEMT_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vrel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%phi)) deallocate(OutData%phi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%phi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%axInduction)) deallocate(OutData%axInduction) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%axInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%axInduction) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tanInduction)) deallocate(OutData%tanInduction) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tanInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tanInduction) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%axInduction_qs)) deallocate(OutData%axInduction_qs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%axInduction_qs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction_qs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%axInduction_qs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tanInduction_qs)) deallocate(OutData%tanInduction_qs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tanInduction_qs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction_qs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tanInduction_qs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%k)) deallocate(OutData%k) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%k(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%k) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%k_p)) deallocate(OutData%k_p) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%k_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%k_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%k_p) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F)) deallocate(OutData%F) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Re)) deallocate(OutData%Re) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Re(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Re) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AOA)) deallocate(OutData%AOA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AOA(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AOA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cx)) deallocate(OutData%Cx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cy)) deallocate(OutData%Cy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cy(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cy) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cz)) deallocate(OutData%Cz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cmx)) deallocate(OutData%Cmx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cmx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cmx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cmy)) deallocate(OutData%Cmy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cmy(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cmy) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cmz)) deallocate(OutData%Cmz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cmz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cmz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cm)) deallocate(OutData%Cm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cm(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cl)) deallocate(OutData%Cl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cl(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cl) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cd)) deallocate(OutData%Cd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cd(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%chi)) deallocate(OutData%chi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chi(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cpmin)) deallocate(OutData%Cpmin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cpmin(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cpmin) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tanInduction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axInduction_qs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tanInduction_qs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%k_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AOA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cmx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cmy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cmz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cpmin); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BEMT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index dbc59138e3..17d9640ed6 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -160,53 +160,32 @@ subroutine DBEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine DBEMT_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumBlades) - call RegPack(Buf, InData%NumNodes) - call RegPack(Buf, InData%tau1_const) - call RegPack(Buf, InData%DBEMT_Mod) - call RegPack(Buf, allocated(InData%rLocal)) - if (allocated(InData%rLocal)) then - call RegPackBounds(Buf, 2, lbound(InData%rLocal, kind=B8Ki), ubound(InData%rLocal, kind=B8Ki)) - call RegPack(Buf, InData%rLocal) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumNodes) + call RegPack(RF, InData%tau1_const) + call RegPack(RF, InData%DBEMT_Mod) + call RegPackAlloc(RF, InData%rLocal) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rLocal) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rLocal); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -238,21 +217,21 @@ subroutine DBEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DBEMT_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine DBEMT_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) @@ -277,25 +256,23 @@ subroutine DBEMT_DestroyElementContinuousStateType(ElementContinuousStateTypeDat ErrMsg = '' end subroutine -subroutine DBEMT_PackElementContinuousStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackElementContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_ElementContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackElementContinuousStateType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%vind) - call RegPack(Buf, InData%vind_1) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%vind) + call RegPack(RF, InData%vind_1) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackElementContinuousStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackElementContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_ElementContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackElementContinuousStateType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%vind) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%vind_1) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%vind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vind_1); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -355,50 +332,48 @@ subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine DBEMT_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackContState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%element)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(Buf, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) LB(1:2) = lbound(InData%element, kind=B8Ki) UB(1:2) = ubound(InData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call DBEMT_PackElementContinuousStateType(Buf, InData%element(i1,i2)) + call DBEMT_PackElementContinuousStateType(RF, InData%element(i1,i2)) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%element)) deallocate(OutData%element) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call DBEMT_UnpackElementContinuousStateType(Buf, OutData%element(i1,i2)) ! element + call DBEMT_UnpackElementContinuousStateType(RF, OutData%element(i1,i2)) ! element end do end do end if @@ -425,22 +400,21 @@ subroutine DBEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DBEMT_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -464,22 +438,21 @@ subroutine DBEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DBEMT_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -555,78 +528,42 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end do end subroutine -subroutine DBEMT_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%areStatesInitialized)) - if (allocated(InData%areStatesInitialized)) then - call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized, kind=B8Ki), ubound(InData%areStatesInitialized, kind=B8Ki)) - call RegPack(Buf, InData%areStatesInitialized) - end if - call RegPack(Buf, InData%tau1) - call RegPack(Buf, InData%tau2) - call RegPack(Buf, allocated(InData%n)) - if (allocated(InData%n)) then - call RegPackBounds(Buf, 2, lbound(InData%n, kind=B8Ki), ubound(InData%n, kind=B8Ki)) - call RegPack(Buf, InData%n) - end if + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%areStatesInitialized) + call RegPack(RF, InData%tau1) + call RegPack(RF, InData%tau2) + call RegPackAlloc(RF, InData%n) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call DBEMT_PackContState(Buf, InData%xdot(i1)) + call DBEMT_PackContState(RF, InData%xdot(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%areStatesInitialized)) deallocate(OutData%areStatesInitialized) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%areStatesInitialized) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%tau1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tau2) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%n)) deallocate(OutData%n) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%n(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%areStatesInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%xdot, kind=B8Ki) UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call DBEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call DBEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do end subroutine @@ -651,22 +588,21 @@ subroutine DBEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DBEMT_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FirstWarn_tau1) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FirstWarn_tau1) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FirstWarn_tau1) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FirstWarn_tau1); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -713,62 +649,38 @@ subroutine DBEMT_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine DBEMT_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%lin_nx) - call RegPack(Buf, InData%NumBlades) - call RegPack(Buf, InData%NumNodes) - call RegPack(Buf, InData%k_0ye) - call RegPack(Buf, InData%tau1_const) - call RegPack(Buf, allocated(InData%spanRatio)) - if (allocated(InData%spanRatio)) then - call RegPackBounds(Buf, 2, lbound(InData%spanRatio, kind=B8Ki), ubound(InData%spanRatio, kind=B8Ki)) - call RegPack(Buf, InData%spanRatio) - end if - call RegPack(Buf, InData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%lin_nx) + call RegPack(RF, InData%NumBlades) + call RegPack(RF, InData%NumNodes) + call RegPack(RF, InData%k_0ye) + call RegPack(RF, InData%tau1_const) + call RegPackAlloc(RF, InData%spanRatio) + call RegPack(RF, InData%DBEMT_Mod) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%lin_nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_0ye) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%spanRatio)) deallocate(OutData%spanRatio) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%spanRatio(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%spanRatio) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lin_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_0ye); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tau1_const); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%spanRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DBEMT_Mod); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyElementInputType(SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -793,25 +705,23 @@ subroutine DBEMT_DestroyElementInputType(ElementInputTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DBEMT_PackElementInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackElementInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_ElementInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackElementInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%vind_s) - call RegPack(Buf, InData%spanRatio) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%vind_s) + call RegPack(RF, InData%spanRatio) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackElementInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackElementInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_ElementInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackElementInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%vind_s) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%spanRatio) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%vind_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%spanRatio); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -874,59 +784,54 @@ subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine DBEMT_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AxInd_disk) - call RegPack(Buf, InData%Un_disk) - call RegPack(Buf, InData%R_disk) - call RegPack(Buf, allocated(InData%element)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AxInd_disk) + call RegPack(RF, InData%Un_disk) + call RegPack(RF, InData%R_disk) + call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(Buf, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) LB(1:2) = lbound(InData%element, kind=B8Ki) UB(1:2) = ubound(InData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call DBEMT_PackElementInputType(Buf, InData%element(i1,i2)) + call DBEMT_PackElementInputType(RF, InData%element(i1,i2)) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AxInd_disk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Un_disk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%R_disk) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AxInd_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Un_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R_disk); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%element)) deallocate(OutData%element) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call DBEMT_UnpackElementInputType(Buf, OutData%element(i1,i2)) ! element + call DBEMT_UnpackElementInputType(RF, OutData%element(i1,i2)) ! element end do end do end if @@ -969,41 +874,24 @@ subroutine DBEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine DBEMT_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DBEMT_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%vind)) - if (allocated(InData%vind)) then - call RegPackBounds(Buf, 3, lbound(InData%vind, kind=B8Ki), ubound(InData%vind, kind=B8Ki)) - call RegPack(Buf, InData%vind) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%vind) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DBEMT_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DBEMT_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DBEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%vind)) deallocate(OutData%vind) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vind) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%vind); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index bd59dc4a50..0cd9fbcbe1 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -424,105 +424,56 @@ subroutine FVW_DestroyGridOutType(GridOutTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackGridOutType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackGridOutType(RF, Indata) + type(RegFile), intent(inout) :: RF type(GridOutType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackGridOutType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%name) - call RegPack(Buf, InData%type) - call RegPack(Buf, InData%tStart) - call RegPack(Buf, InData%tEnd) - call RegPack(Buf, InData%DTout) - call RegPack(Buf, InData%xStart) - call RegPack(Buf, InData%yStart) - call RegPack(Buf, InData%zStart) - call RegPack(Buf, InData%xEnd) - call RegPack(Buf, InData%yEnd) - call RegPack(Buf, InData%zEnd) - call RegPack(Buf, InData%nx) - call RegPack(Buf, InData%ny) - call RegPack(Buf, InData%nz) - call RegPack(Buf, allocated(InData%uGrid)) - if (allocated(InData%uGrid)) then - call RegPackBounds(Buf, 4, lbound(InData%uGrid, kind=B8Ki), ubound(InData%uGrid, kind=B8Ki)) - call RegPack(Buf, InData%uGrid) - end if - call RegPack(Buf, allocated(InData%omGrid)) - if (allocated(InData%omGrid)) then - call RegPackBounds(Buf, 4, lbound(InData%omGrid, kind=B8Ki), ubound(InData%omGrid, kind=B8Ki)) - call RegPack(Buf, InData%omGrid) - end if - call RegPack(Buf, InData%tLastOutput) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackGridOutType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%name) + call RegPack(RF, InData%type) + call RegPack(RF, InData%tStart) + call RegPack(RF, InData%tEnd) + call RegPack(RF, InData%DTout) + call RegPack(RF, InData%xStart) + call RegPack(RF, InData%yStart) + call RegPack(RF, InData%zStart) + call RegPack(RF, InData%xEnd) + call RegPack(RF, InData%yEnd) + call RegPack(RF, InData%zEnd) + call RegPack(RF, InData%nx) + call RegPack(RF, InData%ny) + call RegPack(RF, InData%nz) + call RegPackAlloc(RF, InData%uGrid) + call RegPackAlloc(RF, InData%omGrid) + call RegPack(RF, InData%tLastOutput) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackGridOutType(RF, OutData) + type(RegFile), intent(inout) :: RF type(GridOutType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%name) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTout) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%zStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%yEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%zEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nz) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%uGrid)) deallocate(OutData%uGrid) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uGrid) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%omGrid)) deallocate(OutData%omGrid) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%omGrid) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%tLastOutput) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTout); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%yEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tLastOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg) @@ -610,107 +561,36 @@ subroutine FVW_DestroyT_Sgmt(T_SgmtData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackT_Sgmt(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackT_Sgmt(RF, Indata) + type(RegFile), intent(inout) :: RF type(T_Sgmt), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackT_Sgmt' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Points)) - if (allocated(InData%Points)) then - call RegPackBounds(Buf, 2, lbound(InData%Points, kind=B8Ki), ubound(InData%Points, kind=B8Ki)) - call RegPack(Buf, InData%Points) - end if - call RegPack(Buf, allocated(InData%Connct)) - if (allocated(InData%Connct)) then - call RegPackBounds(Buf, 2, lbound(InData%Connct, kind=B8Ki), ubound(InData%Connct, kind=B8Ki)) - call RegPack(Buf, InData%Connct) - end if - call RegPack(Buf, allocated(InData%Gamma)) - if (allocated(InData%Gamma)) then - call RegPackBounds(Buf, 1, lbound(InData%Gamma, kind=B8Ki), ubound(InData%Gamma, kind=B8Ki)) - call RegPack(Buf, InData%Gamma) - end if - call RegPack(Buf, allocated(InData%Epsilon)) - if (allocated(InData%Epsilon)) then - call RegPackBounds(Buf, 1, lbound(InData%Epsilon, kind=B8Ki), ubound(InData%Epsilon, kind=B8Ki)) - call RegPack(Buf, InData%Epsilon) - end if - call RegPack(Buf, InData%RegFunction) - call RegPack(Buf, InData%nAct) - call RegPack(Buf, InData%nActP) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackT_Sgmt(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Points) + call RegPackAlloc(RF, InData%Connct) + call RegPackAlloc(RF, InData%Gamma) + call RegPackAlloc(RF, InData%Epsilon) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%nAct) + call RegPack(RF, InData%nActP) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Sgmt(RF, OutData) + type(RegFile), intent(inout) :: RF type(T_Sgmt), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Points)) deallocate(OutData%Points) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Points(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Points) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Connct)) deallocate(OutData%Connct) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Connct(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Connct) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gamma(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gamma) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Epsilon)) deallocate(OutData%Epsilon) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Epsilon(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Epsilon) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAct) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nActP) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Points); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Connct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Epsilon); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nActP); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg) @@ -782,85 +662,32 @@ subroutine FVW_DestroyT_Part(T_PartData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackT_Part(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackT_Part(RF, Indata) + type(RegFile), intent(inout) :: RF type(T_Part), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackT_Part' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%P)) - if (allocated(InData%P)) then - call RegPackBounds(Buf, 2, lbound(InData%P, kind=B8Ki), ubound(InData%P, kind=B8Ki)) - call RegPack(Buf, InData%P) - end if - call RegPack(Buf, allocated(InData%Alpha)) - if (allocated(InData%Alpha)) then - call RegPackBounds(Buf, 2, lbound(InData%Alpha, kind=B8Ki), ubound(InData%Alpha, kind=B8Ki)) - call RegPack(Buf, InData%Alpha) - end if - call RegPack(Buf, allocated(InData%RegParam)) - if (allocated(InData%RegParam)) then - call RegPackBounds(Buf, 1, lbound(InData%RegParam, kind=B8Ki), ubound(InData%RegParam, kind=B8Ki)) - call RegPack(Buf, InData%RegParam) - end if - call RegPack(Buf, InData%RegFunction) - call RegPack(Buf, InData%nAct) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%P) + call RegPackAlloc(RF, InData%Alpha) + call RegPackAlloc(RF, InData%RegParam) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%nAct) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackT_Part(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackT_Part(RF, OutData) + type(RegFile), intent(inout) :: RF type(T_Part), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%P)) deallocate(OutData%P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Alpha(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Alpha) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RegParam)) deallocate(OutData%RegParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RegParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RegParam) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAct) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAct); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -977,142 +804,38 @@ subroutine FVW_DestroyWng_ParameterType(Wng_ParameterTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackWng_ParameterType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_ParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_ParameterType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%chord_LL)) - if (allocated(InData%chord_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%chord_LL, kind=B8Ki), ubound(InData%chord_LL, kind=B8Ki)) - call RegPack(Buf, InData%chord_LL) - end if - call RegPack(Buf, allocated(InData%chord_CP)) - if (allocated(InData%chord_CP)) then - call RegPackBounds(Buf, 1, lbound(InData%chord_CP, kind=B8Ki), ubound(InData%chord_CP, kind=B8Ki)) - call RegPack(Buf, InData%chord_CP) - end if - call RegPack(Buf, allocated(InData%s_LL)) - if (allocated(InData%s_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%s_LL, kind=B8Ki), ubound(InData%s_LL, kind=B8Ki)) - call RegPack(Buf, InData%s_LL) - end if - call RegPack(Buf, allocated(InData%s_CP)) - if (allocated(InData%s_CP)) then - call RegPackBounds(Buf, 1, lbound(InData%s_CP, kind=B8Ki), ubound(InData%s_CP, kind=B8Ki)) - call RegPack(Buf, InData%s_CP) - end if - call RegPack(Buf, InData%iRotor) - call RegPack(Buf, allocated(InData%AFindx)) - if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) - call RegPack(Buf, InData%AFindx) - end if - call RegPack(Buf, InData%nSpan) - call RegPack(Buf, allocated(InData%PrescribedCirculation)) - if (allocated(InData%PrescribedCirculation)) then - call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation, kind=B8Ki), ubound(InData%PrescribedCirculation, kind=B8Ki)) - call RegPack(Buf, InData%PrescribedCirculation) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackWng_ParameterType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%chord_LL) + call RegPackAlloc(RF, InData%chord_CP) + call RegPackAlloc(RF, InData%s_LL) + call RegPackAlloc(RF, InData%s_CP) + call RegPack(RF, InData%iRotor) + call RegPackAlloc(RF, InData%AFindx) + call RegPack(RF, InData%nSpan) + call RegPackAlloc(RF, InData%PrescribedCirculation) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%chord_LL)) deallocate(OutData%chord_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chord_LL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chord_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%chord_CP)) deallocate(OutData%chord_CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chord_CP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chord_CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%s_LL)) deallocate(OutData%s_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%s_LL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%s_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%s_CP)) deallocate(OutData%s_CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%s_CP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%s_CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iRotor) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFindx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nSpan) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PrescribedCirculation)) deallocate(OutData%PrescribedCirculation) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrescribedCirculation(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrescribedCirculation) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%chord_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chord_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%s_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%s_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iRotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nSpan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrescribedCirculation); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1230,209 +953,143 @@ subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%nRotors) - call RegPack(Buf, InData%nWings) - call RegPack(Buf, allocated(InData%W)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nRotors) + call RegPack(RF, InData%nWings) + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_ParameterType(Buf, InData%W(i1)) + call FVW_PackWng_ParameterType(RF, InData%W(i1)) end do end if - call RegPack(Buf, allocated(InData%Bld2Wings)) - if (allocated(InData%Bld2Wings)) then - call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings, kind=B8Ki), ubound(InData%Bld2Wings, kind=B8Ki)) - call RegPack(Buf, InData%Bld2Wings) - end if - call RegPack(Buf, InData%iNWStart) - call RegPack(Buf, InData%nNWMax) - call RegPack(Buf, InData%nNWFree) - call RegPack(Buf, InData%nFWMax) - call RegPack(Buf, InData%nFWFree) - call RegPack(Buf, InData%FWShedVorticity) - call RegPack(Buf, InData%IntMethod) - call RegPack(Buf, InData%FreeWakeStart) - call RegPack(Buf, InData%FullCircStart) - call RegPack(Buf, InData%CircSolvMethod) - call RegPack(Buf, InData%CircSolvMaxIter) - call RegPack(Buf, InData%CircSolvConvCrit) - call RegPack(Buf, InData%CircSolvRelaxation) - call RegPack(Buf, InData%CircSolvPolar) - call RegPack(Buf, InData%DiffusionMethod) - call RegPack(Buf, InData%CoreSpreadEddyVisc) - call RegPack(Buf, InData%RegDeterMethod) - call RegPack(Buf, InData%RegFunction) - call RegPack(Buf, InData%WakeRegMethod) - call RegPack(Buf, InData%WakeRegParam) - call RegPack(Buf, InData%WingRegParam) - call RegPack(Buf, InData%ShearModel) - call RegPack(Buf, InData%TwrShadowOnWake) - call RegPack(Buf, InData%VelocityMethod) - call RegPack(Buf, InData%TreeBranchFactor) - call RegPack(Buf, InData%PartPerSegment) - call RegPack(Buf, InData%DTaero) - call RegPack(Buf, InData%DTfvw) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%WrVTK) - call RegPack(Buf, InData%VTKBlades) - call RegPack(Buf, InData%DTvtk) - call RegPack(Buf, InData%VTKCoord) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%VTK_OutFileRoot) - call RegPack(Buf, InData%VTK_OutFileBase) - call RegPack(Buf, InData%nGridOut) - call RegPack(Buf, InData%InductionAtCP) - call RegPack(Buf, InData%WakeAtTE) - call RegPack(Buf, InData%DStallOnWake) - call RegPack(Buf, InData%Induction) - call RegPack(Buf, InData%kFrozenNWStart) - call RegPack(Buf, InData%kFrozenNWEnd) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + call RegPackAlloc(RF, InData%Bld2Wings) + call RegPack(RF, InData%iNWStart) + call RegPack(RF, InData%nNWMax) + call RegPack(RF, InData%nNWFree) + call RegPack(RF, InData%nFWMax) + call RegPack(RF, InData%nFWFree) + call RegPack(RF, InData%FWShedVorticity) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%FreeWakeStart) + call RegPack(RF, InData%FullCircStart) + call RegPack(RF, InData%CircSolvMethod) + call RegPack(RF, InData%CircSolvMaxIter) + call RegPack(RF, InData%CircSolvConvCrit) + call RegPack(RF, InData%CircSolvRelaxation) + call RegPack(RF, InData%CircSolvPolar) + call RegPack(RF, InData%DiffusionMethod) + call RegPack(RF, InData%CoreSpreadEddyVisc) + call RegPack(RF, InData%RegDeterMethod) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%WakeRegMethod) + call RegPack(RF, InData%WakeRegParam) + call RegPack(RF, InData%WingRegParam) + call RegPack(RF, InData%ShearModel) + call RegPack(RF, InData%TwrShadowOnWake) + call RegPack(RF, InData%VelocityMethod) + call RegPack(RF, InData%TreeBranchFactor) + call RegPack(RF, InData%PartPerSegment) + call RegPack(RF, InData%DTaero) + call RegPack(RF, InData%DTfvw) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%VTKBlades) + call RegPack(RF, InData%DTvtk) + call RegPack(RF, InData%VTKCoord) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPack(RF, InData%VTK_OutFileBase) + call RegPack(RF, InData%nGridOut) + call RegPack(RF, InData%InductionAtCP) + call RegPack(RF, InData%WakeAtTE) + call RegPack(RF, InData%DStallOnWake) + call RegPack(RF, InData%Induction) + call RegPack(RF, InData%kFrozenNWStart) + call RegPack(RF, InData%kFrozenNWEnd) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%nRotors) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nWings) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nRotors); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nWings); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_ParameterType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_ParameterType(RF, OutData%W(i1)) ! W end do end if - if (allocated(OutData%Bld2Wings)) deallocate(OutData%Bld2Wings) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld2Wings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Bld2Wings) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iNWStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNWMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNWFree) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFWMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFWFree) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FWShedVorticity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FreeWakeStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FullCircStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvMaxIter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvConvCrit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvRelaxation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvPolar) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DiffusionMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RegDeterMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeRegMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeRegParam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WingRegParam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShearModel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrShadowOnWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelocityMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TreeBranchFactor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PartPerSegment) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTaero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTfvw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTvtk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKCoord) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_OutFileBase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nGridOut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InductionAtCP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeAtTE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DStallOnWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Induction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kFrozenNWStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kFrozenNWEnd) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bld2Wings); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iNWStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FWShedVorticity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreeWakeStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullCircStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvMaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvConvCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvRelaxation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvPolar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffusionMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CoreSpreadEddyVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegDeterMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WingRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShearModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadowOnWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelocityMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TreeBranchFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PartPerSegment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTaero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTfvw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTvtk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKCoord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileBase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nGridOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InductionAtCP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeAtTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DStallOnWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Induction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kFrozenNWStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kFrozenNWEnd); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1547,136 +1204,34 @@ subroutine FVW_DestroyWng_ContinuousStateType(Wng_ContinuousStateTypeData, ErrSt end if end subroutine -subroutine FVW_PackWng_ContinuousStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_ContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_ContinuousStateType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Gamma_NW)) - if (allocated(InData%Gamma_NW)) then - call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW, kind=B8Ki), ubound(InData%Gamma_NW, kind=B8Ki)) - call RegPack(Buf, InData%Gamma_NW) - end if - call RegPack(Buf, allocated(InData%Gamma_FW)) - if (allocated(InData%Gamma_FW)) then - call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW, kind=B8Ki), ubound(InData%Gamma_FW, kind=B8Ki)) - call RegPack(Buf, InData%Gamma_FW) - end if - call RegPack(Buf, allocated(InData%Eps_NW)) - if (allocated(InData%Eps_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%Eps_NW, kind=B8Ki), ubound(InData%Eps_NW, kind=B8Ki)) - call RegPack(Buf, InData%Eps_NW) - end if - call RegPack(Buf, allocated(InData%Eps_FW)) - if (allocated(InData%Eps_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%Eps_FW, kind=B8Ki), ubound(InData%Eps_FW, kind=B8Ki)) - call RegPack(Buf, InData%Eps_FW) - end if - call RegPack(Buf, allocated(InData%r_NW)) - if (allocated(InData%r_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%r_NW, kind=B8Ki), ubound(InData%r_NW, kind=B8Ki)) - call RegPack(Buf, InData%r_NW) - end if - call RegPack(Buf, allocated(InData%r_FW)) - if (allocated(InData%r_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%r_FW, kind=B8Ki), ubound(InData%r_FW, kind=B8Ki)) - call RegPack(Buf, InData%r_FW) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Gamma_NW) + call RegPackAlloc(RF, InData%Gamma_FW) + call RegPackAlloc(RF, InData%Eps_NW) + call RegPackAlloc(RF, InData%Eps_FW) + call RegPackAlloc(RF, InData%r_NW) + call RegPackAlloc(RF, InData%r_FW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Gamma_NW)) deallocate(OutData%Gamma_NW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gamma_NW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Gamma_FW)) deallocate(OutData%Gamma_FW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gamma_FW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Eps_NW)) deallocate(OutData%Eps_NW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Eps_NW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Eps_FW)) deallocate(OutData%Eps_FW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Eps_FW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_NW)) deallocate(OutData%r_NW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_NW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_FW)) deallocate(OutData%r_FW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_FW) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Gamma_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gamma_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Eps_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Eps_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_FW); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1757,71 +1312,67 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%W)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_ContinuousStateType(Buf, InData%W(i1)) + call FVW_PackWng_ContinuousStateType(RF, InData%W(i1)) end do end if - call RegPack(Buf, allocated(InData%UA)) + call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(Buf, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) LB(1:1) = lbound(InData%UA, kind=B8Ki) UB(1:1) = ubound(InData%UA, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_PackContState(Buf, InData%UA(i1)) + call UA_PackContState(RF, InData%UA(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_ContinuousStateType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_ContinuousStateType(RF, OutData%W(i1)) ! W end do end if if (allocated(OutData%UA)) deallocate(OutData%UA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%UA(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call UA_UnpackContState(Buf, OutData%UA(i1)) ! UA + call UA_UnpackContState(RF, OutData%UA(i1)) ! UA end do end if end subroutine @@ -1863,41 +1414,24 @@ subroutine FVW_DestroyWng_OutputType(Wng_OutputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackWng_OutputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_OutputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_OutputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Vind)) - if (allocated(InData%Vind)) then - call RegPackBounds(Buf, 2, lbound(InData%Vind, kind=B8Ki), ubound(InData%Vind, kind=B8Ki)) - call RegPack(Buf, InData%Vind) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vind) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackWng_OutputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackWng_OutputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Vind)) deallocate(OutData%Vind) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vind(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vind) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vind); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1953,47 +1487,45 @@ subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%W)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_OutputType(Buf, InData%W(i1)) + call FVW_PackWng_OutputType(RF, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_OutputType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_OutputType(RF, OutData%W(i1)) ! W end do end if end subroutine @@ -2642,787 +2174,137 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackWng_MiscVarType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_MiscVarType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%LE)) - if (allocated(InData%LE)) then - call RegPackBounds(Buf, 2, lbound(InData%LE, kind=B8Ki), ubound(InData%LE, kind=B8Ki)) - call RegPack(Buf, InData%LE) - end if - call RegPack(Buf, allocated(InData%TE)) - if (allocated(InData%TE)) then - call RegPackBounds(Buf, 2, lbound(InData%TE, kind=B8Ki), ubound(InData%TE, kind=B8Ki)) - call RegPack(Buf, InData%TE) - end if - call RegPack(Buf, allocated(InData%r_LL)) - if (allocated(InData%r_LL)) then - call RegPackBounds(Buf, 3, lbound(InData%r_LL, kind=B8Ki), ubound(InData%r_LL, kind=B8Ki)) - call RegPack(Buf, InData%r_LL) - end if - call RegPack(Buf, allocated(InData%CP)) - if (allocated(InData%CP)) then - call RegPackBounds(Buf, 2, lbound(InData%CP, kind=B8Ki), ubound(InData%CP, kind=B8Ki)) - call RegPack(Buf, InData%CP) - end if - call RegPack(Buf, allocated(InData%Tang)) - if (allocated(InData%Tang)) then - call RegPackBounds(Buf, 2, lbound(InData%Tang, kind=B8Ki), ubound(InData%Tang, kind=B8Ki)) - call RegPack(Buf, InData%Tang) - end if - call RegPack(Buf, allocated(InData%Norm)) - if (allocated(InData%Norm)) then - call RegPackBounds(Buf, 2, lbound(InData%Norm, kind=B8Ki), ubound(InData%Norm, kind=B8Ki)) - call RegPack(Buf, InData%Norm) - end if - call RegPack(Buf, allocated(InData%Orth)) - if (allocated(InData%Orth)) then - call RegPackBounds(Buf, 2, lbound(InData%Orth, kind=B8Ki), ubound(InData%Orth, kind=B8Ki)) - call RegPack(Buf, InData%Orth) - end if - call RegPack(Buf, allocated(InData%dl)) - if (allocated(InData%dl)) then - call RegPackBounds(Buf, 2, lbound(InData%dl, kind=B8Ki), ubound(InData%dl, kind=B8Ki)) - call RegPack(Buf, InData%dl) - end if - call RegPack(Buf, allocated(InData%Area)) - if (allocated(InData%Area)) then - call RegPackBounds(Buf, 1, lbound(InData%Area, kind=B8Ki), ubound(InData%Area, kind=B8Ki)) - call RegPack(Buf, InData%Area) - end if - call RegPack(Buf, allocated(InData%diag_LL)) - if (allocated(InData%diag_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%diag_LL, kind=B8Ki), ubound(InData%diag_LL, kind=B8Ki)) - call RegPack(Buf, InData%diag_LL) - end if - call RegPack(Buf, allocated(InData%Vind_CP)) - if (allocated(InData%Vind_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vind_CP, kind=B8Ki), ubound(InData%Vind_CP, kind=B8Ki)) - call RegPack(Buf, InData%Vind_CP) - end if - call RegPack(Buf, allocated(InData%Vtot_CP)) - if (allocated(InData%Vtot_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP, kind=B8Ki), ubound(InData%Vtot_CP, kind=B8Ki)) - call RegPack(Buf, InData%Vtot_CP) - end if - call RegPack(Buf, allocated(InData%Vstr_CP)) - if (allocated(InData%Vstr_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP, kind=B8Ki), ubound(InData%Vstr_CP, kind=B8Ki)) - call RegPack(Buf, InData%Vstr_CP) - end if - call RegPack(Buf, allocated(InData%Vwnd_CP)) - if (allocated(InData%Vwnd_CP)) then - call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP, kind=B8Ki), ubound(InData%Vwnd_CP, kind=B8Ki)) - call RegPack(Buf, InData%Vwnd_CP) - end if - call RegPack(Buf, allocated(InData%Vwnd_NW)) - if (allocated(InData%Vwnd_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW, kind=B8Ki), ubound(InData%Vwnd_NW, kind=B8Ki)) - call RegPack(Buf, InData%Vwnd_NW) - end if - call RegPack(Buf, allocated(InData%Vwnd_FW)) - if (allocated(InData%Vwnd_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW, kind=B8Ki), ubound(InData%Vwnd_FW, kind=B8Ki)) - call RegPack(Buf, InData%Vwnd_FW) - end if - call RegPack(Buf, allocated(InData%Vind_NW)) - if (allocated(InData%Vind_NW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vind_NW, kind=B8Ki), ubound(InData%Vind_NW, kind=B8Ki)) - call RegPack(Buf, InData%Vind_NW) - end if - call RegPack(Buf, allocated(InData%Vind_FW)) - if (allocated(InData%Vind_FW)) then - call RegPackBounds(Buf, 3, lbound(InData%Vind_FW, kind=B8Ki), ubound(InData%Vind_FW, kind=B8Ki)) - call RegPack(Buf, InData%Vind_FW) - end if - call RegPack(Buf, allocated(InData%PitchAndTwist)) - if (allocated(InData%PitchAndTwist)) then - call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist, kind=B8Ki), ubound(InData%PitchAndTwist, kind=B8Ki)) - call RegPack(Buf, InData%PitchAndTwist) - end if - call RegPack(Buf, InData%iTip) - call RegPack(Buf, InData%iRoot) - call RegPack(Buf, allocated(InData%alpha_LL)) - if (allocated(InData%alpha_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha_LL, kind=B8Ki), ubound(InData%alpha_LL, kind=B8Ki)) - call RegPack(Buf, InData%alpha_LL) - end if - call RegPack(Buf, allocated(InData%Vreln_LL)) - if (allocated(InData%Vreln_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL, kind=B8Ki), ubound(InData%Vreln_LL, kind=B8Ki)) - call RegPack(Buf, InData%Vreln_LL) - end if - call RegPack(Buf, allocated(InData%u_UA)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LE) + call RegPackAlloc(RF, InData%TE) + call RegPackAlloc(RF, InData%r_LL) + call RegPackAlloc(RF, InData%CP) + call RegPackAlloc(RF, InData%Tang) + call RegPackAlloc(RF, InData%Norm) + call RegPackAlloc(RF, InData%Orth) + call RegPackAlloc(RF, InData%dl) + call RegPackAlloc(RF, InData%Area) + call RegPackAlloc(RF, InData%diag_LL) + call RegPackAlloc(RF, InData%Vind_CP) + call RegPackAlloc(RF, InData%Vtot_CP) + call RegPackAlloc(RF, InData%Vstr_CP) + call RegPackAlloc(RF, InData%Vwnd_CP) + call RegPackAlloc(RF, InData%Vwnd_NW) + call RegPackAlloc(RF, InData%Vwnd_FW) + call RegPackAlloc(RF, InData%Vind_NW) + call RegPackAlloc(RF, InData%Vind_FW) + call RegPackAlloc(RF, InData%PitchAndTwist) + call RegPack(RF, InData%iTip) + call RegPack(RF, InData%iRoot) + call RegPackAlloc(RF, InData%alpha_LL) + call RegPackAlloc(RF, InData%Vreln_LL) + call RegPack(RF, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(Buf, 2, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) LB(1:2) = lbound(InData%u_UA, kind=B8Ki) UB(1:2) = ubound(InData%u_UA, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call UA_PackInput(Buf, InData%u_UA(i1,i2)) + call UA_PackInput(RF, InData%u_UA(i1,i2)) end do end do end if - call UA_PackMisc(Buf, InData%m_UA) - call UA_PackOutput(Buf, InData%y_UA) - call UA_PackParam(Buf, InData%p_UA) - call RegPack(Buf, allocated(InData%Vind_LL)) - if (allocated(InData%Vind_LL)) then - call RegPackBounds(Buf, 2, lbound(InData%Vind_LL, kind=B8Ki), ubound(InData%Vind_LL, kind=B8Ki)) - call RegPack(Buf, InData%Vind_LL) - end if - call RegPack(Buf, allocated(InData%BN_AxInd)) - if (allocated(InData%BN_AxInd)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd, kind=B8Ki), ubound(InData%BN_AxInd, kind=B8Ki)) - call RegPack(Buf, InData%BN_AxInd) - end if - call RegPack(Buf, allocated(InData%BN_TanInd)) - if (allocated(InData%BN_TanInd)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd, kind=B8Ki), ubound(InData%BN_TanInd, kind=B8Ki)) - call RegPack(Buf, InData%BN_TanInd) - end if - call RegPack(Buf, allocated(InData%BN_Vrel)) - if (allocated(InData%BN_Vrel)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel, kind=B8Ki), ubound(InData%BN_Vrel, kind=B8Ki)) - call RegPack(Buf, InData%BN_Vrel) - end if - call RegPack(Buf, allocated(InData%BN_alpha)) - if (allocated(InData%BN_alpha)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_alpha, kind=B8Ki), ubound(InData%BN_alpha, kind=B8Ki)) - call RegPack(Buf, InData%BN_alpha) - end if - call RegPack(Buf, allocated(InData%BN_phi)) - if (allocated(InData%BN_phi)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_phi, kind=B8Ki), ubound(InData%BN_phi, kind=B8Ki)) - call RegPack(Buf, InData%BN_phi) - end if - call RegPack(Buf, allocated(InData%BN_Re)) - if (allocated(InData%BN_Re)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Re, kind=B8Ki), ubound(InData%BN_Re, kind=B8Ki)) - call RegPack(Buf, InData%BN_Re) - end if - call RegPack(Buf, allocated(InData%BN_URelWind_s)) - if (allocated(InData%BN_URelWind_s)) then - call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s, kind=B8Ki), ubound(InData%BN_URelWind_s, kind=B8Ki)) - call RegPack(Buf, InData%BN_URelWind_s) - end if - call RegPack(Buf, allocated(InData%BN_Cl_Static)) - if (allocated(InData%BN_Cl_Static)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static, kind=B8Ki), ubound(InData%BN_Cl_Static, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cl_Static) - end if - call RegPack(Buf, allocated(InData%BN_Cd_Static)) - if (allocated(InData%BN_Cd_Static)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static, kind=B8Ki), ubound(InData%BN_Cd_Static, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cd_Static) - end if - call RegPack(Buf, allocated(InData%BN_Cm_Static)) - if (allocated(InData%BN_Cm_Static)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static, kind=B8Ki), ubound(InData%BN_Cm_Static, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cm_Static) - end if - call RegPack(Buf, allocated(InData%BN_Cpmin)) - if (allocated(InData%BN_Cpmin)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin, kind=B8Ki), ubound(InData%BN_Cpmin, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cpmin) - end if - call RegPack(Buf, allocated(InData%BN_Cl)) - if (allocated(InData%BN_Cl)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cl, kind=B8Ki), ubound(InData%BN_Cl, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cl) - end if - call RegPack(Buf, allocated(InData%BN_Cd)) - if (allocated(InData%BN_Cd)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cd, kind=B8Ki), ubound(InData%BN_Cd, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cd) - end if - call RegPack(Buf, allocated(InData%BN_Cm)) - if (allocated(InData%BN_Cm)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cm, kind=B8Ki), ubound(InData%BN_Cm, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cm) - end if - call RegPack(Buf, allocated(InData%BN_Cx)) - if (allocated(InData%BN_Cx)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cx, kind=B8Ki), ubound(InData%BN_Cx, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cx) - end if - call RegPack(Buf, allocated(InData%BN_Cy)) - if (allocated(InData%BN_Cy)) then - call RegPackBounds(Buf, 1, lbound(InData%BN_Cy, kind=B8Ki), ubound(InData%BN_Cy, kind=B8Ki)) - call RegPack(Buf, InData%BN_Cy) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + call UA_PackMisc(RF, InData%m_UA) + call UA_PackOutput(RF, InData%y_UA) + call UA_PackParam(RF, InData%p_UA) + call RegPackAlloc(RF, InData%Vind_LL) + call RegPackAlloc(RF, InData%BN_AxInd) + call RegPackAlloc(RF, InData%BN_TanInd) + call RegPackAlloc(RF, InData%BN_Vrel) + call RegPackAlloc(RF, InData%BN_alpha) + call RegPackAlloc(RF, InData%BN_phi) + call RegPackAlloc(RF, InData%BN_Re) + call RegPackAlloc(RF, InData%BN_URelWind_s) + call RegPackAlloc(RF, InData%BN_Cl_Static) + call RegPackAlloc(RF, InData%BN_Cd_Static) + call RegPackAlloc(RF, InData%BN_Cm_Static) + call RegPackAlloc(RF, InData%BN_Cpmin) + call RegPackAlloc(RF, InData%BN_Cl) + call RegPackAlloc(RF, InData%BN_Cd) + call RegPackAlloc(RF, InData%BN_Cm) + call RegPackAlloc(RF, InData%BN_Cx) + call RegPackAlloc(RF, InData%BN_Cy) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_MiscVarType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%LE)) deallocate(OutData%LE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TE)) deallocate(OutData%TE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_LL)) deallocate(OutData%r_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CP)) deallocate(OutData%CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Tang)) deallocate(OutData%Tang) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Tang(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Tang) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Norm)) deallocate(OutData%Norm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Norm(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Norm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Orth)) deallocate(OutData%Orth) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Orth(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Orth) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dl)) deallocate(OutData%dl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dl(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dl) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Area)) deallocate(OutData%Area) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Area(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Area) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%diag_LL)) deallocate(OutData%diag_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%diag_LL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%diag_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vind_CP)) deallocate(OutData%Vind_CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vind_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vind_CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vtot_CP)) deallocate(OutData%Vtot_CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vtot_CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vstr_CP)) deallocate(OutData%Vstr_CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vstr_CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vwnd_CP)) deallocate(OutData%Vwnd_CP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vwnd_CP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vwnd_NW)) deallocate(OutData%Vwnd_NW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vwnd_NW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vwnd_FW)) deallocate(OutData%Vwnd_FW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vwnd_FW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vind_NW)) deallocate(OutData%Vind_NW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vind_NW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vind_FW)) deallocate(OutData%Vind_FW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vind_FW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PitchAndTwist)) deallocate(OutData%PitchAndTwist) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PitchAndTwist(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PitchAndTwist) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iTip) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iRoot) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%alpha_LL)) deallocate(OutData%alpha_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_LL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vreln_LL)) deallocate(OutData%Vreln_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vreln_LL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vreln_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Tang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Norm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Orth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Area); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%diag_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vtot_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vstr_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vwnd_CP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vwnd_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vwnd_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_NW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vind_FW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitchAndTwist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iTip); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vreln_LL); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call UA_UnpackInput(Buf, OutData%u_UA(i1,i2)) ! u_UA + call UA_UnpackInput(RF, OutData%u_UA(i1,i2)) ! u_UA end do end do end if - call UA_UnpackMisc(Buf, OutData%m_UA) ! m_UA - call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA - call UA_UnpackParam(Buf, OutData%p_UA) ! p_UA - if (allocated(OutData%Vind_LL)) deallocate(OutData%Vind_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vind_LL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vind_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_AxInd)) deallocate(OutData%BN_AxInd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_AxInd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_AxInd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_TanInd)) deallocate(OutData%BN_TanInd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_TanInd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_TanInd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Vrel)) deallocate(OutData%BN_Vrel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Vrel(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Vrel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_alpha)) deallocate(OutData%BN_alpha) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_alpha(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_alpha) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_phi)) deallocate(OutData%BN_phi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_phi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_phi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Re)) deallocate(OutData%BN_Re) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Re(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Re) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_URelWind_s)) deallocate(OutData%BN_URelWind_s) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_URelWind_s) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cl_Static)) deallocate(OutData%BN_Cl_Static) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cl_Static(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cl_Static) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cd_Static)) deallocate(OutData%BN_Cd_Static) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cd_Static(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cd_Static) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cm_Static)) deallocate(OutData%BN_Cm_Static) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cm_Static(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cm_Static) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cpmin)) deallocate(OutData%BN_Cpmin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cpmin(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cpmin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cpmin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cl)) deallocate(OutData%BN_Cl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cl(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cl) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cd)) deallocate(OutData%BN_Cd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cm)) deallocate(OutData%BN_Cm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cx)) deallocate(OutData%BN_Cx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BN_Cy)) deallocate(OutData%BN_Cy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BN_Cy(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BN_Cy) - if (RegCheckErr(Buf, RoutineName)) return - end if + call UA_UnpackMisc(RF, OutData%m_UA) ! m_UA + call UA_UnpackOutput(RF, OutData%y_UA) ! y_UA + call UA_UnpackParam(RF, OutData%p_UA) ! p_UA + call RegUnpackAlloc(RF, OutData%Vind_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_AxInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_TanInd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_URelWind_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cl_Static); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cd_Static); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cm_Static); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cpmin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BN_Cy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -3585,176 +2467,109 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%W)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_MiscVarType(Buf, InData%W(i1)) + call FVW_PackWng_MiscVarType(RF, InData%W(i1)) end do end if - call RegPack(Buf, InData%FirstCall) - call RegPack(Buf, InData%nNW) - call RegPack(Buf, InData%nFW) - call RegPack(Buf, InData%iStep) - call RegPack(Buf, InData%VTKstep) - call RegPack(Buf, InData%VTKlastTime) - call RegPack(Buf, allocated(InData%r_wind)) - if (allocated(InData%r_wind)) then - call RegPackBounds(Buf, 2, lbound(InData%r_wind, kind=B8Ki), ubound(InData%r_wind, kind=B8Ki)) - call RegPack(Buf, InData%r_wind) - end if - call RegPack(Buf, InData%ComputeWakeInduced) - call RegPack(Buf, InData%OldWakeTime) - call FVW_PackContState(Buf, InData%dxdt) - call FVW_PackContState(Buf, InData%x1) - call FVW_PackContState(Buf, InData%x2) - call RegPack(Buf, InData%t1) - call RegPack(Buf, InData%t2) - call RegPack(Buf, InData%UA_Flag) - call FVW_PackT_Sgmt(Buf, InData%Sgmt) - call FVW_PackT_Part(Buf, InData%Part) - call RegPack(Buf, allocated(InData%CPs)) - if (allocated(InData%CPs)) then - call RegPackBounds(Buf, 2, lbound(InData%CPs, kind=B8Ki), ubound(InData%CPs, kind=B8Ki)) - call RegPack(Buf, InData%CPs) - end if - call RegPack(Buf, allocated(InData%Uind)) - if (allocated(InData%Uind)) then - call RegPackBounds(Buf, 2, lbound(InData%Uind, kind=B8Ki), ubound(InData%Uind, kind=B8Ki)) - call RegPack(Buf, InData%Uind) - end if - call RegPack(Buf, allocated(InData%GridOutputs)) + call RegPack(RF, InData%FirstCall) + call RegPack(RF, InData%nNW) + call RegPack(RF, InData%nFW) + call RegPack(RF, InData%iStep) + call RegPack(RF, InData%VTKstep) + call RegPack(RF, InData%VTKlastTime) + call RegPackAlloc(RF, InData%r_wind) + call RegPack(RF, InData%ComputeWakeInduced) + call RegPack(RF, InData%OldWakeTime) + call FVW_PackContState(RF, InData%dxdt) + call FVW_PackContState(RF, InData%x1) + call FVW_PackContState(RF, InData%x2) + call RegPack(RF, InData%t1) + call RegPack(RF, InData%t2) + call RegPack(RF, InData%UA_Flag) + call FVW_PackT_Sgmt(RF, InData%Sgmt) + call FVW_PackT_Part(RF, InData%Part) + call RegPackAlloc(RF, InData%CPs) + call RegPackAlloc(RF, InData%Uind) + call RegPack(RF, allocated(InData%GridOutputs)) if (allocated(InData%GridOutputs)) then - call RegPackBounds(Buf, 1, lbound(InData%GridOutputs, kind=B8Ki), ubound(InData%GridOutputs, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%GridOutputs, kind=B8Ki), ubound(InData%GridOutputs, kind=B8Ki)) LB(1:1) = lbound(InData%GridOutputs, kind=B8Ki) UB(1:1) = ubound(InData%GridOutputs, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackGridOutType(Buf, InData%GridOutputs(i1)) + call FVW_PackGridOutType(RF, InData%GridOutputs(i1)) end do end if - call RegPack(Buf, InData%InfoReeval) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%InfoReeval) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_MiscVarType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_MiscVarType(RF, OutData%W(i1)) ! W end do end if - call RegUnpack(Buf, OutData%FirstCall) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iStep) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKstep) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKlastTime) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%r_wind)) deallocate(OutData%r_wind) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_wind(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_wind) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%ComputeWakeInduced) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OldWakeTime) - if (RegCheckErr(Buf, RoutineName)) return - call FVW_UnpackContState(Buf, OutData%dxdt) ! dxdt - call FVW_UnpackContState(Buf, OutData%x1) ! x1 - call FVW_UnpackContState(Buf, OutData%x2) ! x2 - call RegUnpack(Buf, OutData%t1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%t2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return - call FVW_UnpackT_Sgmt(Buf, OutData%Sgmt) ! Sgmt - call FVW_UnpackT_Part(Buf, OutData%Part) ! Part - if (allocated(OutData%CPs)) deallocate(OutData%CPs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CPs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CPs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Uind)) deallocate(OutData%Uind) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Uind(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Uind) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpack(RF, OutData%FirstCall); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKstep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKlastTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_wind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ComputeWakeInduced); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OldWakeTime); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackContState(RF, OutData%dxdt) ! dxdt + call FVW_UnpackContState(RF, OutData%x1) ! x1 + call FVW_UnpackContState(RF, OutData%x2) ! x2 + call RegUnpack(RF, OutData%t1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call FVW_UnpackT_Sgmt(RF, OutData%Sgmt) ! Sgmt + call FVW_UnpackT_Part(RF, OutData%Part) ! Part + call RegUnpackAlloc(RF, OutData%CPs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Uind); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%GridOutputs)) deallocate(OutData%GridOutputs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%GridOutputs(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackGridOutType(Buf, OutData%GridOutputs(i1)) ! GridOutputs + call FVW_UnpackGridOutType(RF, OutData%GridOutputs(i1)) ! GridOutputs end do end if - call RegUnpack(Buf, OutData%InfoReeval) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%InfoReeval); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyRot_InputType(SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3779,25 +2594,23 @@ subroutine FVW_DestroyRot_InputType(Rot_InputTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FVW_PackRot_InputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackRot_InputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Rot_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackRot_InputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%HubOrientation) - call RegPack(Buf, InData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HubOrientation) + call RegPack(RF, InData%HubPosition) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackRot_InputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackRot_InputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Rot_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackRot_InputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%HubOrientation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3852,60 +2665,26 @@ subroutine FVW_DestroyWng_InputType(Wng_InputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackWng_InputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_InputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_InputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Vwnd_LL)) - if (allocated(InData%Vwnd_LL)) then - call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL, kind=B8Ki), ubound(InData%Vwnd_LL, kind=B8Ki)) - call RegPack(Buf, InData%Vwnd_LL) - end if - call RegPack(Buf, allocated(InData%omega_z)) - if (allocated(InData%omega_z)) then - call RegPackBounds(Buf, 1, lbound(InData%omega_z, kind=B8Ki), ubound(InData%omega_z, kind=B8Ki)) - call RegPack(Buf, InData%omega_z) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vwnd_LL) + call RegPackAlloc(RF, InData%omega_z) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackWng_InputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackWng_InputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Vwnd_LL)) deallocate(OutData%Vwnd_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vwnd_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%omega_z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%omega_z) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vwnd_LL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omega_z); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -4026,116 +2805,93 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%rotors)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(Buf, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) LB(1:1) = lbound(InData%rotors, kind=B8Ki) UB(1:1) = ubound(InData%rotors, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackRot_InputType(Buf, InData%rotors(i1)) + call FVW_PackRot_InputType(RF, InData%rotors(i1)) end do end if - call RegPack(Buf, allocated(InData%W)) + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_InputType(Buf, InData%W(i1)) + call FVW_PackWng_InputType(RF, InData%W(i1)) end do end if - call RegPack(Buf, allocated(InData%WingsMesh)) + call RegPack(RF, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%WingsMesh(i1)) + call MeshPack(RF, InData%WingsMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%V_wind)) - if (allocated(InData%V_wind)) then - call RegPackBounds(Buf, 2, lbound(InData%V_wind, kind=B8Ki), ubound(InData%V_wind, kind=B8Ki)) - call RegPack(Buf, InData%V_wind) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%V_wind) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%rotors(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackRot_InputType(Buf, OutData%rotors(i1)) ! rotors + call FVW_UnpackRot_InputType(RF, OutData%rotors(i1)) ! rotors end do end if if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_InputType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_InputType(RF, OutData%W(i1)) ! W end do end if if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh + call MeshUnpack(RF, OutData%WingsMesh(i1)) ! WingsMesh end do end if - if (allocated(OutData%V_wind)) deallocate(OutData%V_wind) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_wind(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_wind) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%V_wind); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -4192,50 +2948,47 @@ subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dummy) - call RegPack(Buf, allocated(InData%UA)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(Buf, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) LB(1:1) = lbound(InData%UA, kind=B8Ki) UB(1:1) = ubound(InData%UA, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_PackDiscState(Buf, InData%UA(i1)) + call UA_PackDiscState(RF, InData%UA(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%UA)) deallocate(OutData%UA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%UA(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call UA_UnpackDiscState(Buf, OutData%UA(i1)) ! UA + call UA_UnpackDiscState(RF, OutData%UA(i1)) ! UA end do end if end subroutine @@ -4277,41 +3030,24 @@ subroutine FVW_DestroyWng_ConstraintStateType(Wng_ConstraintStateTypeData, ErrSt end if end subroutine -subroutine FVW_PackWng_ConstraintStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_ConstraintStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_ConstraintStateType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Gamma_LL)) - if (allocated(InData%Gamma_LL)) then - call RegPackBounds(Buf, 1, lbound(InData%Gamma_LL, kind=B8Ki), ubound(InData%Gamma_LL, kind=B8Ki)) - call RegPack(Buf, InData%Gamma_LL) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Gamma_LL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackWng_ConstraintStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackWng_ConstraintStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Gamma_LL)) deallocate(OutData%Gamma_LL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gamma_LL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gamma_LL) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Gamma_LL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -4368,52 +3104,49 @@ subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%W)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_ConstraintStateType(Buf, InData%W(i1)) + call FVW_PackWng_ConstraintStateType(RF, InData%W(i1)) end do end if - call RegPack(Buf, InData%residual) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%residual) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_ConstraintStateType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_ConstraintStateType(RF, OutData%W(i1)) ! W end do end if - call RegUnpack(Buf, OutData%residual) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%residual); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -4470,50 +3203,47 @@ subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dummy) - call RegPack(Buf, allocated(InData%UA)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(Buf, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) LB(1:1) = lbound(InData%UA, kind=B8Ki) UB(1:1) = ubound(InData%UA, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_PackOtherState(Buf, InData%UA(i1)) + call UA_PackOtherState(RF, InData%UA(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%UA)) deallocate(OutData%UA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%UA(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call UA_UnpackOtherState(Buf, OutData%UA(i1)) ! UA + call UA_UnpackOtherState(RF, OutData%UA(i1)) ! UA end do end if end subroutine @@ -4588,88 +3318,34 @@ subroutine FVW_DestroyWng_InitInputType(Wng_InitInputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackWng_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackWng_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wng_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AFindx)) - if (allocated(InData%AFindx)) then - call RegPackBounds(Buf, 2, lbound(InData%AFindx, kind=B8Ki), ubound(InData%AFindx, kind=B8Ki)) - call RegPack(Buf, InData%AFindx) - end if - call RegPack(Buf, allocated(InData%chord)) - if (allocated(InData%chord)) then - call RegPackBounds(Buf, 1, lbound(InData%chord, kind=B8Ki), ubound(InData%chord, kind=B8Ki)) - call RegPack(Buf, InData%chord) - end if - call RegPack(Buf, allocated(InData%RElm)) - if (allocated(InData%RElm)) then - call RegPackBounds(Buf, 1, lbound(InData%RElm, kind=B8Ki), ubound(InData%RElm, kind=B8Ki)) - call RegPack(Buf, InData%RElm) - end if - call RegPack(Buf, InData%iRotor) - call RegPack(Buf, InData%UAOff_innerNode) - call RegPack(Buf, InData%UAOff_outerNode) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackWng_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AFindx) + call RegPackAlloc(RF, InData%chord) + call RegPackAlloc(RF, InData%RElm) + call RegPack(RF, InData%iRotor) + call RegPack(RF, InData%UAOff_innerNode) + call RegPack(RF, InData%UAOff_outerNode) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wng_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFindx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%chord)) deallocate(OutData%chord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%chord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%chord) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RElm)) deallocate(OutData%RElm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RElm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RElm) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iRotor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAOff_innerNode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAOff_outerNode) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AFindx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RElm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iRotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAOff_innerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAOff_outerNode); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -4762,109 +3438,93 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine FVW_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInitInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FVWFileName) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%W)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FVWFileName) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(Buf, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) LB(1:1) = lbound(InData%W, kind=B8Ki) UB(1:1) = ubound(InData%W, kind=B8Ki) do i1 = LB(1), UB(1) - call FVW_PackWng_InitInputType(Buf, InData%W(i1)) + call FVW_PackWng_InitInputType(RF, InData%W(i1)) end do end if - call RegPack(Buf, allocated(InData%WingsMesh)) + call RegPack(RF, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%WingsMesh(i1)) + call MeshPack(RF, InData%WingsMesh(i1)) end do end if - call RegPack(Buf, InData%numBladeNodes) - call RegPack(Buf, InData%DTaero) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%UAMod) - call RegPack(Buf, InData%UA_Flag) - call RegPack(Buf, InData%Flookup) - call RegPack(Buf, InData%a_s) - call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + call RegPack(RF, InData%numBladeNodes) + call RegPack(RF, InData%DTaero) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%UA_Flag) + call RegPack(RF, InData%Flookup) + call RegPack(RF, InData%a_s) + call RegPack(RF, InData%SumPrint) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FVWFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FVWFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%W(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackWng_InitInputType(Buf, OutData%W(i1)) ! W + call FVW_UnpackWng_InitInputType(RF, OutData%W(i1)) ! W end do end if if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh + call MeshUnpack(RF, OutData%WingsMesh(i1)) ! WingsMesh end do end if - call RegUnpack(Buf, OutData%numBladeNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTaero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a_s) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%numBladeNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTaero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UA_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -4919,115 +3579,83 @@ subroutine FVW_DestroyInputFile(InputFileData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FVW_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%CircSolvMethod) - call RegPack(Buf, InData%CirculationFile) - call RegPack(Buf, InData%CircSolvMaxIter) - call RegPack(Buf, InData%CircSolvConvCrit) - call RegPack(Buf, InData%CircSolvRelaxation) - call RegPack(Buf, InData%IntMethod) - call RegPack(Buf, InData%FreeWake) - call RegPack(Buf, InData%FreeWakeStart) - call RegPack(Buf, InData%FullCircStart) - call RegPack(Buf, InData%DTfvw) - call RegPack(Buf, InData%CircSolvPolar) - call RegPack(Buf, InData%nNWPanels) - call RegPack(Buf, InData%nNWPanelsFree) - call RegPack(Buf, InData%nFWPanels) - call RegPack(Buf, InData%nFWPanelsFree) - call RegPack(Buf, InData%FWShedVorticity) - call RegPack(Buf, InData%DiffusionMethod) - call RegPack(Buf, InData%CoreSpreadEddyVisc) - call RegPack(Buf, InData%RegDeterMethod) - call RegPack(Buf, InData%RegFunction) - call RegPack(Buf, InData%WakeRegMethod) - call RegPack(Buf, InData%WakeRegParam) - call RegPack(Buf, InData%WingRegParam) - call RegPack(Buf, InData%ShearModel) - call RegPack(Buf, InData%TwrShadowOnWake) - call RegPack(Buf, InData%VelocityMethod) - call RegPack(Buf, InData%TreeBranchFactor) - call RegPack(Buf, InData%PartPerSegment) - call RegPack(Buf, InData%WrVTK) - call RegPack(Buf, InData%VTKBlades) - call RegPack(Buf, InData%DTvtk) - call RegPack(Buf, InData%VTKCoord) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FVW_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CircSolvMethod) + call RegPack(RF, InData%CirculationFile) + call RegPack(RF, InData%CircSolvMaxIter) + call RegPack(RF, InData%CircSolvConvCrit) + call RegPack(RF, InData%CircSolvRelaxation) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%FreeWake) + call RegPack(RF, InData%FreeWakeStart) + call RegPack(RF, InData%FullCircStart) + call RegPack(RF, InData%DTfvw) + call RegPack(RF, InData%CircSolvPolar) + call RegPack(RF, InData%nNWPanels) + call RegPack(RF, InData%nNWPanelsFree) + call RegPack(RF, InData%nFWPanels) + call RegPack(RF, InData%nFWPanelsFree) + call RegPack(RF, InData%FWShedVorticity) + call RegPack(RF, InData%DiffusionMethod) + call RegPack(RF, InData%CoreSpreadEddyVisc) + call RegPack(RF, InData%RegDeterMethod) + call RegPack(RF, InData%RegFunction) + call RegPack(RF, InData%WakeRegMethod) + call RegPack(RF, InData%WakeRegParam) + call RegPack(RF, InData%WingRegParam) + call RegPack(RF, InData%ShearModel) + call RegPack(RF, InData%TwrShadowOnWake) + call RegPack(RF, InData%VelocityMethod) + call RegPack(RF, InData%TreeBranchFactor) + call RegPack(RF, InData%PartPerSegment) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%VTKBlades) + call RegPack(RF, InData%DTvtk) + call RegPack(RF, InData%VTKCoord) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInputFile' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%CircSolvMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CirculationFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvMaxIter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvConvCrit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvRelaxation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FreeWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FreeWakeStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FullCircStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTfvw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CircSolvPolar) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNWPanels) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNWPanelsFree) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFWPanels) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFWPanelsFree) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FWShedVorticity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DiffusionMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RegDeterMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeRegMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakeRegParam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WingRegParam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShearModel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrShadowOnWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelocityMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TreeBranchFactor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PartPerSegment) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTvtk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKCoord) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CircSolvMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CirculationFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvMaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvConvCrit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvRelaxation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreeWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreeWakeStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FullCircStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTfvw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CircSolvPolar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWPanels); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNWPanelsFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWPanels); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFWPanelsFree); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FWShedVorticity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffusionMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CoreSpreadEddyVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegDeterMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RegFunction); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakeRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WingRegParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShearModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadowOnWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelocityMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TreeBranchFactor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PartPerSegment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTvtk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKCoord); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -5051,22 +3679,21 @@ subroutine FVW_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FVW_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FVW_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FVW_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FVW_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FVW_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FVW_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index af725dc88d..8fad9bcdcf 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -324,106 +324,46 @@ subroutine UA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%OutRootName) - call RegPack(Buf, allocated(InData%c)) - if (allocated(InData%c)) then - call RegPackBounds(Buf, 2, lbound(InData%c, kind=B8Ki), ubound(InData%c, kind=B8Ki)) - call RegPack(Buf, InData%c) - end if - call RegPack(Buf, InData%numBlades) - call RegPack(Buf, InData%nNodesPerBlade) - call RegPack(Buf, InData%UAMod) - call RegPack(Buf, InData%a_s) - call RegPack(Buf, InData%Flookup) - call RegPack(Buf, InData%ShedEffect) - call RegPack(Buf, InData%WrSum) - call RegPack(Buf, allocated(InData%UAOff_innerNode)) - if (allocated(InData%UAOff_innerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode, kind=B8Ki), ubound(InData%UAOff_innerNode, kind=B8Ki)) - call RegPack(Buf, InData%UAOff_innerNode) - end if - call RegPack(Buf, allocated(InData%UAOff_outerNode)) - if (allocated(InData%UAOff_outerNode)) then - call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode, kind=B8Ki), ubound(InData%UAOff_outerNode, kind=B8Ki)) - call RegPack(Buf, InData%UAOff_outerNode) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPack(RF, InData%OutRootName) + call RegPackAlloc(RF, InData%c) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%nNodesPerBlade) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%a_s) + call RegPack(RF, InData%Flookup) + call RegPack(RF, InData%ShedEffect) + call RegPack(RF, InData%WrSum) + call RegPackAlloc(RF, InData%UAOff_innerNode) + call RegPackAlloc(RF, InData%UAOff_outerNode) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%c)) deallocate(OutData%c) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%c(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%c) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNodesPerBlade) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a_s) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShedEffect) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrSum) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UAOff_innerNode(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UAOff_innerNode) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UAOff_outerNode(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UAOff_outerNode) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodesPerBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShedEffect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UAOff_innerNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UAOff_outerNode); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -486,62 +426,28 @@ subroutine UA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Version) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Version) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Version) ! Version + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyKelvinChainType(SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg) @@ -615,172 +521,121 @@ subroutine UA_DestroyKelvinChainType(KelvinChainTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine UA_PackKelvinChainType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackKelvinChainType(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_KelvinChainType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackKelvinChainType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Cn_prime) - call RegPack(Buf, InData%C_nalpha_circ) - call RegPack(Buf, InData%Kalpha_f) - call RegPack(Buf, InData%Kq_f) - call RegPack(Buf, InData%alpha_filt_cur) - call RegPack(Buf, InData%alpha_e) - call RegPack(Buf, InData%dalpha0) - call RegPack(Buf, InData%alpha_f) - call RegPack(Buf, InData%Kq) - call RegPack(Buf, InData%q_cur) - call RegPack(Buf, InData%q_f_cur) - call RegPack(Buf, InData%X1) - call RegPack(Buf, InData%X2) - call RegPack(Buf, InData%X3) - call RegPack(Buf, InData%X4) - call RegPack(Buf, InData%Kprime_alpha) - call RegPack(Buf, InData%Kprime_q) - call RegPack(Buf, InData%K3prime_q) - call RegPack(Buf, InData%Kprimeprime_q) - call RegPack(Buf, InData%Dp) - call RegPack(Buf, InData%Cn_pot) - call RegPack(Buf, InData%Cc_pot) - call RegPack(Buf, InData%Cn_alpha_q_circ) - call RegPack(Buf, InData%Cn_alpha_q_nc) - call RegPack(Buf, InData%Cm_q_circ) - call RegPack(Buf, InData%Cn_alpha_nc) - call RegPack(Buf, InData%Cn_q_circ) - call RegPack(Buf, InData%Cn_q_nc) - call RegPack(Buf, InData%Cm_q_nc) - call RegPack(Buf, InData%fprimeprime) - call RegPack(Buf, InData%Df) - call RegPack(Buf, InData%Df_c) - call RegPack(Buf, InData%Df_m) - call RegPack(Buf, InData%Dalphaf) - call RegPack(Buf, InData%fprime) - call RegPack(Buf, InData%fprime_c) - call RegPack(Buf, InData%fprimeprime_c) - call RegPack(Buf, InData%fprime_m) - call RegPack(Buf, InData%fprimeprime_m) - call RegPack(Buf, InData%Cn_v) - call RegPack(Buf, InData%C_V) - call RegPack(Buf, InData%Cn_FS) - call RegPack(Buf, InData%T_f) - call RegPack(Buf, InData%T_fc) - call RegPack(Buf, InData%T_fm) - call RegPack(Buf, InData%T_V) - call RegPack(Buf, InData%k_alpha) - call RegPack(Buf, InData%k_q) - call RegPack(Buf, InData%T_alpha) - call RegPack(Buf, InData%T_q) - call RegPack(Buf, InData%ds) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Cn_prime) + call RegPack(RF, InData%C_nalpha_circ) + call RegPack(RF, InData%Kalpha_f) + call RegPack(RF, InData%Kq_f) + call RegPack(RF, InData%alpha_filt_cur) + call RegPack(RF, InData%alpha_e) + call RegPack(RF, InData%dalpha0) + call RegPack(RF, InData%alpha_f) + call RegPack(RF, InData%Kq) + call RegPack(RF, InData%q_cur) + call RegPack(RF, InData%q_f_cur) + call RegPack(RF, InData%X1) + call RegPack(RF, InData%X2) + call RegPack(RF, InData%X3) + call RegPack(RF, InData%X4) + call RegPack(RF, InData%Kprime_alpha) + call RegPack(RF, InData%Kprime_q) + call RegPack(RF, InData%K3prime_q) + call RegPack(RF, InData%Kprimeprime_q) + call RegPack(RF, InData%Dp) + call RegPack(RF, InData%Cn_pot) + call RegPack(RF, InData%Cc_pot) + call RegPack(RF, InData%Cn_alpha_q_circ) + call RegPack(RF, InData%Cn_alpha_q_nc) + call RegPack(RF, InData%Cm_q_circ) + call RegPack(RF, InData%Cn_alpha_nc) + call RegPack(RF, InData%Cn_q_circ) + call RegPack(RF, InData%Cn_q_nc) + call RegPack(RF, InData%Cm_q_nc) + call RegPack(RF, InData%fprimeprime) + call RegPack(RF, InData%Df) + call RegPack(RF, InData%Df_c) + call RegPack(RF, InData%Df_m) + call RegPack(RF, InData%Dalphaf) + call RegPack(RF, InData%fprime) + call RegPack(RF, InData%fprime_c) + call RegPack(RF, InData%fprimeprime_c) + call RegPack(RF, InData%fprime_m) + call RegPack(RF, InData%fprimeprime_m) + call RegPack(RF, InData%Cn_v) + call RegPack(RF, InData%C_V) + call RegPack(RF, InData%Cn_FS) + call RegPack(RF, InData%T_f) + call RegPack(RF, InData%T_fc) + call RegPack(RF, InData%T_fm) + call RegPack(RF, InData%T_V) + call RegPack(RF, InData%k_alpha) + call RegPack(RF, InData%k_q) + call RegPack(RF, InData%T_alpha) + call RegPack(RF, InData%T_q) + call RegPack(RF, InData%ds) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackKelvinChainType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackKelvinChainType(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_KelvinChainType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackKelvinChainType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Cn_prime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_nalpha_circ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kalpha_f) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kq_f) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha_filt_cur) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha_e) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dalpha0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha_f) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%q_cur) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%q_f_cur) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X4) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kprime_alpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kprime_q) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%K3prime_q) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kprimeprime_q) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Dp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_pot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cc_pot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_alpha_q_circ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_alpha_q_nc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm_q_circ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_alpha_nc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_q_circ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_q_nc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm_q_nc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fprimeprime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Df) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Df_c) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Df_m) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Dalphaf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fprime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fprime_c) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fprimeprime_c) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fprime_m) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%fprimeprime_m) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_v) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_V) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cn_FS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_f) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_fc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_fm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_V) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_alpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_q) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_alpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_q) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ds) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Cn_prime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_nalpha_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kalpha_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kq_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha_filt_cur); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dalpha0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%q_cur); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%q_f_cur); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X4); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kprime_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kprime_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K3prime_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kprimeprime_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_pot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cc_pot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_alpha_q_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_alpha_q_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm_q_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_alpha_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_q_circ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_q_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm_q_nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprimeprime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Df); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Df_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Df_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dalphaf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprime_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprimeprime_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprime_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%fprimeprime_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cn_FS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_fc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_fm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ds); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) @@ -804,22 +659,21 @@ subroutine UA_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrMsg = '' end subroutine -subroutine UA_PackElementContinuousStateType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackElementContinuousStateType(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_ElementContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackElementContinuousStateType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackElementContinuousStateType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackElementContinuousStateType(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_ElementContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackElementContinuousStateType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%x) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -879,50 +733,48 @@ subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackContState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%element)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(Buf, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) LB(1:2) = lbound(InData%element, kind=B8Ki) UB(1:2) = ubound(InData%element, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call UA_PackElementContinuousStateType(Buf, InData%element(i1,i2)) + call UA_PackElementContinuousStateType(RF, InData%element(i1,i2)) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackContState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%element)) deallocate(OutData%element) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call UA_UnpackElementContinuousStateType(Buf, OutData%element(i1,i2)) ! element + call UA_UnpackElementContinuousStateType(RF, OutData%element(i1,i2)) ! element end do end do end if @@ -1460,668 +1312,90 @@ subroutine UA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%alpha_minus1)) - if (allocated(InData%alpha_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1, kind=B8Ki), ubound(InData%alpha_minus1, kind=B8Ki)) - call RegPack(Buf, InData%alpha_minus1) - end if - call RegPack(Buf, allocated(InData%alpha_filt_minus1)) - if (allocated(InData%alpha_filt_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1, kind=B8Ki), ubound(InData%alpha_filt_minus1, kind=B8Ki)) - call RegPack(Buf, InData%alpha_filt_minus1) - end if - call RegPack(Buf, allocated(InData%alpha_dot)) - if (allocated(InData%alpha_dot)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_dot, kind=B8Ki), ubound(InData%alpha_dot, kind=B8Ki)) - call RegPack(Buf, InData%alpha_dot) - end if - call RegPack(Buf, allocated(InData%alpha_dot_minus1)) - if (allocated(InData%alpha_dot_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1, kind=B8Ki), ubound(InData%alpha_dot_minus1, kind=B8Ki)) - call RegPack(Buf, InData%alpha_dot_minus1) - end if - call RegPack(Buf, allocated(InData%q_minus1)) - if (allocated(InData%q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%q_minus1, kind=B8Ki), ubound(InData%q_minus1, kind=B8Ki)) - call RegPack(Buf, InData%q_minus1) - end if - call RegPack(Buf, allocated(InData%Kalpha_f_minus1)) - if (allocated(InData%Kalpha_f_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1, kind=B8Ki), ubound(InData%Kalpha_f_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Kalpha_f_minus1) - end if - call RegPack(Buf, allocated(InData%Kq_f_minus1)) - if (allocated(InData%Kq_f_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1, kind=B8Ki), ubound(InData%Kq_f_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Kq_f_minus1) - end if - call RegPack(Buf, allocated(InData%q_f_minus1)) - if (allocated(InData%q_f_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1, kind=B8Ki), ubound(InData%q_f_minus1, kind=B8Ki)) - call RegPack(Buf, InData%q_f_minus1) - end if - call RegPack(Buf, allocated(InData%X1_minus1)) - if (allocated(InData%X1_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X1_minus1, kind=B8Ki), ubound(InData%X1_minus1, kind=B8Ki)) - call RegPack(Buf, InData%X1_minus1) - end if - call RegPack(Buf, allocated(InData%X2_minus1)) - if (allocated(InData%X2_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X2_minus1, kind=B8Ki), ubound(InData%X2_minus1, kind=B8Ki)) - call RegPack(Buf, InData%X2_minus1) - end if - call RegPack(Buf, allocated(InData%X3_minus1)) - if (allocated(InData%X3_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X3_minus1, kind=B8Ki), ubound(InData%X3_minus1, kind=B8Ki)) - call RegPack(Buf, InData%X3_minus1) - end if - call RegPack(Buf, allocated(InData%X4_minus1)) - if (allocated(InData%X4_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%X4_minus1, kind=B8Ki), ubound(InData%X4_minus1, kind=B8Ki)) - call RegPack(Buf, InData%X4_minus1) - end if - call RegPack(Buf, allocated(InData%Kprime_alpha_minus1)) - if (allocated(InData%Kprime_alpha_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1, kind=B8Ki), ubound(InData%Kprime_alpha_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Kprime_alpha_minus1) - end if - call RegPack(Buf, allocated(InData%Kprime_q_minus1)) - if (allocated(InData%Kprime_q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1, kind=B8Ki), ubound(InData%Kprime_q_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Kprime_q_minus1) - end if - call RegPack(Buf, allocated(InData%Kprimeprime_q_minus1)) - if (allocated(InData%Kprimeprime_q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1, kind=B8Ki), ubound(InData%Kprimeprime_q_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Kprimeprime_q_minus1) - end if - call RegPack(Buf, allocated(InData%K3prime_q_minus1)) - if (allocated(InData%K3prime_q_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1, kind=B8Ki), ubound(InData%K3prime_q_minus1, kind=B8Ki)) - call RegPack(Buf, InData%K3prime_q_minus1) - end if - call RegPack(Buf, allocated(InData%Dp_minus1)) - if (allocated(InData%Dp_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1, kind=B8Ki), ubound(InData%Dp_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Dp_minus1) - end if - call RegPack(Buf, allocated(InData%Cn_pot_minus1)) - if (allocated(InData%Cn_pot_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1, kind=B8Ki), ubound(InData%Cn_pot_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Cn_pot_minus1) - end if - call RegPack(Buf, allocated(InData%fprimeprime_minus1)) - if (allocated(InData%fprimeprime_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1, kind=B8Ki), ubound(InData%fprimeprime_minus1, kind=B8Ki)) - call RegPack(Buf, InData%fprimeprime_minus1) - end if - call RegPack(Buf, allocated(InData%fprimeprime_c_minus1)) - if (allocated(InData%fprimeprime_c_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1, kind=B8Ki), ubound(InData%fprimeprime_c_minus1, kind=B8Ki)) - call RegPack(Buf, InData%fprimeprime_c_minus1) - end if - call RegPack(Buf, allocated(InData%fprimeprime_m_minus1)) - if (allocated(InData%fprimeprime_m_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1, kind=B8Ki), ubound(InData%fprimeprime_m_minus1, kind=B8Ki)) - call RegPack(Buf, InData%fprimeprime_m_minus1) - end if - call RegPack(Buf, allocated(InData%Df_minus1)) - if (allocated(InData%Df_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Df_minus1, kind=B8Ki), ubound(InData%Df_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Df_minus1) - end if - call RegPack(Buf, allocated(InData%Df_c_minus1)) - if (allocated(InData%Df_c_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1, kind=B8Ki), ubound(InData%Df_c_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Df_c_minus1) - end if - call RegPack(Buf, allocated(InData%Df_m_minus1)) - if (allocated(InData%Df_m_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1, kind=B8Ki), ubound(InData%Df_m_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Df_m_minus1) - end if - call RegPack(Buf, allocated(InData%Dalphaf_minus1)) - if (allocated(InData%Dalphaf_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1, kind=B8Ki), ubound(InData%Dalphaf_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Dalphaf_minus1) - end if - call RegPack(Buf, allocated(InData%alphaf_minus1)) - if (allocated(InData%alphaf_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1, kind=B8Ki), ubound(InData%alphaf_minus1, kind=B8Ki)) - call RegPack(Buf, InData%alphaf_minus1) - end if - call RegPack(Buf, allocated(InData%fprime_minus1)) - if (allocated(InData%fprime_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1, kind=B8Ki), ubound(InData%fprime_minus1, kind=B8Ki)) - call RegPack(Buf, InData%fprime_minus1) - end if - call RegPack(Buf, allocated(InData%fprime_c_minus1)) - if (allocated(InData%fprime_c_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1, kind=B8Ki), ubound(InData%fprime_c_minus1, kind=B8Ki)) - call RegPack(Buf, InData%fprime_c_minus1) - end if - call RegPack(Buf, allocated(InData%fprime_m_minus1)) - if (allocated(InData%fprime_m_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1, kind=B8Ki), ubound(InData%fprime_m_minus1, kind=B8Ki)) - call RegPack(Buf, InData%fprime_m_minus1) - end if - call RegPack(Buf, allocated(InData%tau_V)) - if (allocated(InData%tau_V)) then - call RegPackBounds(Buf, 2, lbound(InData%tau_V, kind=B8Ki), ubound(InData%tau_V, kind=B8Ki)) - call RegPack(Buf, InData%tau_V) - end if - call RegPack(Buf, allocated(InData%tau_V_minus1)) - if (allocated(InData%tau_V_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1, kind=B8Ki), ubound(InData%tau_V_minus1, kind=B8Ki)) - call RegPack(Buf, InData%tau_V_minus1) - end if - call RegPack(Buf, allocated(InData%Cn_v_minus1)) - if (allocated(InData%Cn_v_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1, kind=B8Ki), ubound(InData%Cn_v_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Cn_v_minus1) - end if - call RegPack(Buf, allocated(InData%C_V_minus1)) - if (allocated(InData%C_V_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1, kind=B8Ki), ubound(InData%C_V_minus1, kind=B8Ki)) - call RegPack(Buf, InData%C_V_minus1) - end if - call RegPack(Buf, allocated(InData%Cn_prime_minus1)) - if (allocated(InData%Cn_prime_minus1)) then - call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1, kind=B8Ki), ubound(InData%Cn_prime_minus1, kind=B8Ki)) - call RegPack(Buf, InData%Cn_prime_minus1) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%alpha_minus1) + call RegPackAlloc(RF, InData%alpha_filt_minus1) + call RegPackAlloc(RF, InData%alpha_dot) + call RegPackAlloc(RF, InData%alpha_dot_minus1) + call RegPackAlloc(RF, InData%q_minus1) + call RegPackAlloc(RF, InData%Kalpha_f_minus1) + call RegPackAlloc(RF, InData%Kq_f_minus1) + call RegPackAlloc(RF, InData%q_f_minus1) + call RegPackAlloc(RF, InData%X1_minus1) + call RegPackAlloc(RF, InData%X2_minus1) + call RegPackAlloc(RF, InData%X3_minus1) + call RegPackAlloc(RF, InData%X4_minus1) + call RegPackAlloc(RF, InData%Kprime_alpha_minus1) + call RegPackAlloc(RF, InData%Kprime_q_minus1) + call RegPackAlloc(RF, InData%Kprimeprime_q_minus1) + call RegPackAlloc(RF, InData%K3prime_q_minus1) + call RegPackAlloc(RF, InData%Dp_minus1) + call RegPackAlloc(RF, InData%Cn_pot_minus1) + call RegPackAlloc(RF, InData%fprimeprime_minus1) + call RegPackAlloc(RF, InData%fprimeprime_c_minus1) + call RegPackAlloc(RF, InData%fprimeprime_m_minus1) + call RegPackAlloc(RF, InData%Df_minus1) + call RegPackAlloc(RF, InData%Df_c_minus1) + call RegPackAlloc(RF, InData%Df_m_minus1) + call RegPackAlloc(RF, InData%Dalphaf_minus1) + call RegPackAlloc(RF, InData%alphaf_minus1) + call RegPackAlloc(RF, InData%fprime_minus1) + call RegPackAlloc(RF, InData%fprime_c_minus1) + call RegPackAlloc(RF, InData%fprime_m_minus1) + call RegPackAlloc(RF, InData%tau_V) + call RegPackAlloc(RF, InData%tau_V_minus1) + call RegPackAlloc(RF, InData%Cn_v_minus1) + call RegPackAlloc(RF, InData%C_V_minus1) + call RegPackAlloc(RF, InData%Cn_prime_minus1) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackDiscState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%alpha_minus1)) deallocate(OutData%alpha_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha_filt_minus1)) deallocate(OutData%alpha_filt_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_filt_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha_dot)) deallocate(OutData%alpha_dot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_dot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_dot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha_dot_minus1)) deallocate(OutData%alpha_dot_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_dot_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%q_minus1)) deallocate(OutData%q_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%q_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Kalpha_f_minus1)) deallocate(OutData%Kalpha_f_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Kalpha_f_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Kq_f_minus1)) deallocate(OutData%Kq_f_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Kq_f_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%q_f_minus1)) deallocate(OutData%q_f_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%q_f_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%X1_minus1)) deallocate(OutData%X1_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X1_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X1_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%X2_minus1)) deallocate(OutData%X2_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X2_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X2_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%X3_minus1)) deallocate(OutData%X3_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X3_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X3_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%X4_minus1)) deallocate(OutData%X4_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X4_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X4_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Kprime_alpha_minus1)) deallocate(OutData%Kprime_alpha_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Kprime_alpha_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Kprime_q_minus1)) deallocate(OutData%Kprime_q_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Kprime_q_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Kprimeprime_q_minus1)) deallocate(OutData%Kprimeprime_q_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Kprimeprime_q_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%K3prime_q_minus1)) deallocate(OutData%K3prime_q_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%K3prime_q_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Dp_minus1)) deallocate(OutData%Dp_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Dp_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cn_pot_minus1)) deallocate(OutData%Cn_pot_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cn_pot_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fprimeprime_minus1)) deallocate(OutData%fprimeprime_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fprimeprime_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fprimeprime_c_minus1)) deallocate(OutData%fprimeprime_c_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fprimeprime_c_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fprimeprime_m_minus1)) deallocate(OutData%fprimeprime_m_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fprimeprime_m_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Df_minus1)) deallocate(OutData%Df_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Df_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Df_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Df_c_minus1)) deallocate(OutData%Df_c_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Df_c_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Df_m_minus1)) deallocate(OutData%Df_m_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Df_m_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Dalphaf_minus1)) deallocate(OutData%Dalphaf_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Dalphaf_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alphaf_minus1)) deallocate(OutData%alphaf_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alphaf_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fprime_minus1)) deallocate(OutData%fprime_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fprime_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fprime_c_minus1)) deallocate(OutData%fprime_c_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fprime_c_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fprime_m_minus1)) deallocate(OutData%fprime_m_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fprime_m_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tau_V)) deallocate(OutData%tau_V) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tau_V(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tau_V) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tau_V_minus1)) deallocate(OutData%tau_V_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tau_V_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cn_v_minus1)) deallocate(OutData%Cn_v_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cn_v_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C_V_minus1)) deallocate(OutData%C_V_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C_V_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cn_prime_minus1)) deallocate(OutData%Cn_prime_minus1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cn_prime_minus1) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%alpha_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_filt_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_dot_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kalpha_f_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kq_f_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q_f_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X1_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X2_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X3_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X4_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kprime_alpha_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kprime_q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kprimeprime_q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K3prime_q_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dp_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cn_pot_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprimeprime_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprimeprime_c_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprimeprime_m_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Df_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Df_c_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Df_m_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dalphaf_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alphaf_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprime_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprime_c_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fprime_m_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tau_V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tau_V_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cn_v_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_V_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cn_prime_minus1); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -2145,22 +1419,21 @@ subroutine UA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine UA_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstraintState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstraintState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstraintState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstraintState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -2412,292 +1685,71 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%FirstPass)) - if (allocated(InData%FirstPass)) then - call RegPackBounds(Buf, 2, lbound(InData%FirstPass, kind=B8Ki), ubound(InData%FirstPass, kind=B8Ki)) - call RegPack(Buf, InData%FirstPass) - end if - call RegPack(Buf, allocated(InData%sigma1)) - if (allocated(InData%sigma1)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma1, kind=B8Ki), ubound(InData%sigma1, kind=B8Ki)) - call RegPack(Buf, InData%sigma1) - end if - call RegPack(Buf, allocated(InData%sigma1c)) - if (allocated(InData%sigma1c)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma1c, kind=B8Ki), ubound(InData%sigma1c, kind=B8Ki)) - call RegPack(Buf, InData%sigma1c) - end if - call RegPack(Buf, allocated(InData%sigma1m)) - if (allocated(InData%sigma1m)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma1m, kind=B8Ki), ubound(InData%sigma1m, kind=B8Ki)) - call RegPack(Buf, InData%sigma1m) - end if - call RegPack(Buf, allocated(InData%sigma3)) - if (allocated(InData%sigma3)) then - call RegPackBounds(Buf, 2, lbound(InData%sigma3, kind=B8Ki), ubound(InData%sigma3, kind=B8Ki)) - call RegPack(Buf, InData%sigma3) - end if - call RegPack(Buf, allocated(InData%n)) - if (allocated(InData%n)) then - call RegPackBounds(Buf, 2, lbound(InData%n, kind=B8Ki), ubound(InData%n, kind=B8Ki)) - call RegPack(Buf, InData%n) - end if + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%FirstPass) + call RegPackAlloc(RF, InData%sigma1) + call RegPackAlloc(RF, InData%sigma1c) + call RegPackAlloc(RF, InData%sigma1m) + call RegPackAlloc(RF, InData%sigma3) + call RegPackAlloc(RF, InData%n) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_PackContState(Buf, InData%xdot(i1)) + call UA_PackContState(RF, InData%xdot(i1)) end do LB(1:1) = lbound(InData%xHistory, kind=B8Ki) UB(1:1) = ubound(InData%xHistory, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_PackContState(Buf, InData%xHistory(i1)) + call UA_PackContState(RF, InData%xHistory(i1)) end do - call RegPack(Buf, allocated(InData%t_vortexBegin)) - if (allocated(InData%t_vortexBegin)) then - call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin, kind=B8Ki), ubound(InData%t_vortexBegin, kind=B8Ki)) - call RegPack(Buf, InData%t_vortexBegin) - end if - call RegPack(Buf, allocated(InData%SignOfOmega)) - if (allocated(InData%SignOfOmega)) then - call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega, kind=B8Ki), ubound(InData%SignOfOmega, kind=B8Ki)) - call RegPack(Buf, InData%SignOfOmega) - end if - call RegPack(Buf, allocated(InData%PositivePressure)) - if (allocated(InData%PositivePressure)) then - call RegPackBounds(Buf, 2, lbound(InData%PositivePressure, kind=B8Ki), ubound(InData%PositivePressure, kind=B8Ki)) - call RegPack(Buf, InData%PositivePressure) - end if - call RegPack(Buf, allocated(InData%vortexOn)) - if (allocated(InData%vortexOn)) then - call RegPackBounds(Buf, 2, lbound(InData%vortexOn, kind=B8Ki), ubound(InData%vortexOn, kind=B8Ki)) - call RegPack(Buf, InData%vortexOn) - end if - call RegPack(Buf, allocated(InData%BelowThreshold)) - if (allocated(InData%BelowThreshold)) then - call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold, kind=B8Ki), ubound(InData%BelowThreshold, kind=B8Ki)) - call RegPack(Buf, InData%BelowThreshold) - end if - call RegPack(Buf, allocated(InData%activeL)) - if (allocated(InData%activeL)) then - call RegPackBounds(Buf, 2, lbound(InData%activeL, kind=B8Ki), ubound(InData%activeL, kind=B8Ki)) - call RegPack(Buf, InData%activeL) - end if - call RegPack(Buf, allocated(InData%activeD)) - if (allocated(InData%activeD)) then - call RegPackBounds(Buf, 2, lbound(InData%activeD, kind=B8Ki), ubound(InData%activeD, kind=B8Ki)) - call RegPack(Buf, InData%activeD) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%t_vortexBegin) + call RegPackAlloc(RF, InData%SignOfOmega) + call RegPackAlloc(RF, InData%PositivePressure) + call RegPackAlloc(RF, InData%vortexOn) + call RegPackAlloc(RF, InData%BelowThreshold) + call RegPackAlloc(RF, InData%activeL) + call RegPackAlloc(RF, InData%activeD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOtherState' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%FirstPass)) deallocate(OutData%FirstPass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FirstPass(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FirstPass) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%sigma1)) deallocate(OutData%sigma1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%sigma1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%sigma1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%sigma1c)) deallocate(OutData%sigma1c) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%sigma1c(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%sigma1c) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%sigma1m)) deallocate(OutData%sigma1m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%sigma1m(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%sigma1m) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%sigma3)) deallocate(OutData%sigma3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%sigma3(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%sigma3) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%n)) deallocate(OutData%n) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%n(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%FirstPass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma1c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma1m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%sigma3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%xdot, kind=B8Ki) UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call UA_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do LB(1:1) = lbound(OutData%xHistory, kind=B8Ki) UB(1:1) = ubound(OutData%xHistory, kind=B8Ki) do i1 = LB(1), UB(1) - call UA_UnpackContState(Buf, OutData%xHistory(i1)) ! xHistory + call UA_UnpackContState(RF, OutData%xHistory(i1)) ! xHistory end do - if (allocated(OutData%t_vortexBegin)) deallocate(OutData%t_vortexBegin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_vortexBegin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%t_vortexBegin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SignOfOmega)) deallocate(OutData%SignOfOmega) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SignOfOmega.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SignOfOmega) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PositivePressure)) deallocate(OutData%PositivePressure) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PositivePressure(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositivePressure.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PositivePressure) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vortexOn)) deallocate(OutData%vortexOn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vortexOn(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vortexOn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vortexOn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BelowThreshold)) deallocate(OutData%BelowThreshold) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BelowThreshold.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BelowThreshold) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%activeL)) deallocate(OutData%activeL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%activeL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%activeL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%activeD)) deallocate(OutData%activeD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%activeD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%activeD) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%t_vortexBegin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SignOfOmega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PositivePressure); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vortexOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BelowThreshold); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%activeL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%activeD); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -2815,145 +1867,40 @@ subroutine UA_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FirstWarn_M) - call RegPack(Buf, InData%FirstWarn_UA) - call RegPack(Buf, InData%FirstWarn_UA_off) - call RegPack(Buf, allocated(InData%TESF)) - if (allocated(InData%TESF)) then - call RegPackBounds(Buf, 2, lbound(InData%TESF, kind=B8Ki), ubound(InData%TESF, kind=B8Ki)) - call RegPack(Buf, InData%TESF) - end if - call RegPack(Buf, allocated(InData%LESF)) - if (allocated(InData%LESF)) then - call RegPackBounds(Buf, 2, lbound(InData%LESF, kind=B8Ki), ubound(InData%LESF, kind=B8Ki)) - call RegPack(Buf, InData%LESF) - end if - call RegPack(Buf, allocated(InData%VRTX)) - if (allocated(InData%VRTX)) then - call RegPackBounds(Buf, 2, lbound(InData%VRTX, kind=B8Ki), ubound(InData%VRTX, kind=B8Ki)) - call RegPack(Buf, InData%VRTX) - end if - call RegPack(Buf, allocated(InData%T_Sh)) - if (allocated(InData%T_Sh)) then - call RegPackBounds(Buf, 2, lbound(InData%T_Sh, kind=B8Ki), ubound(InData%T_Sh, kind=B8Ki)) - call RegPack(Buf, InData%T_Sh) - end if - call RegPack(Buf, allocated(InData%BEDSEP)) - if (allocated(InData%BEDSEP)) then - call RegPackBounds(Buf, 2, lbound(InData%BEDSEP, kind=B8Ki), ubound(InData%BEDSEP, kind=B8Ki)) - call RegPack(Buf, InData%BEDSEP) - end if - call RegPack(Buf, allocated(InData%weight)) - if (allocated(InData%weight)) then - call RegPackBounds(Buf, 2, lbound(InData%weight, kind=B8Ki), ubound(InData%weight, kind=B8Ki)) - call RegPack(Buf, InData%weight) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FirstWarn_M) + call RegPack(RF, InData%FirstWarn_UA) + call RegPack(RF, InData%FirstWarn_UA_off) + call RegPackAlloc(RF, InData%TESF) + call RegPackAlloc(RF, InData%LESF) + call RegPackAlloc(RF, InData%VRTX) + call RegPackAlloc(RF, InData%T_Sh) + call RegPackAlloc(RF, InData%BEDSEP) + call RegPackAlloc(RF, InData%weight) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackMisc' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FirstWarn_M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstWarn_UA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstWarn_UA_off) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TESF)) deallocate(OutData%TESF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TESF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TESF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LESF)) deallocate(OutData%LESF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LESF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LESF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VRTX)) deallocate(OutData%VRTX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VRTX(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VRTX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%T_Sh)) deallocate(OutData%T_Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%T_Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%T_Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BEDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BEDSEP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%weight)) deallocate(OutData%weight) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%weight(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%weight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%weight) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FirstWarn_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_UA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_UA_off); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TESF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LESF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VRTX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T_Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BEDSEP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%weight); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -3038,124 +1985,58 @@ subroutine UA_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dt) - call RegPack(Buf, allocated(InData%c)) - if (allocated(InData%c)) then - call RegPackBounds(Buf, 2, lbound(InData%c, kind=B8Ki), ubound(InData%c, kind=B8Ki)) - call RegPack(Buf, InData%c) - end if - call RegPack(Buf, InData%numBlades) - call RegPack(Buf, InData%nNodesPerBlade) - call RegPack(Buf, InData%UAMod) - call RegPack(Buf, InData%Flookup) - call RegPack(Buf, InData%a_s) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%OutSwtch) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutSFmt) - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%UnOutFile) - call RegPack(Buf, InData%ShedEffect) - call RegPack(Buf, InData%lin_nx) - call RegPack(Buf, allocated(InData%UA_off_forGood)) - if (allocated(InData%UA_off_forGood)) then - call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood, kind=B8Ki), ubound(InData%UA_off_forGood, kind=B8Ki)) - call RegPack(Buf, InData%UA_off_forGood) - end if - call RegPack(Buf, allocated(InData%lin_xIndx)) - if (allocated(InData%lin_xIndx)) then - call RegPackBounds(Buf, 2, lbound(InData%lin_xIndx, kind=B8Ki), ubound(InData%lin_xIndx, kind=B8Ki)) - call RegPack(Buf, InData%lin_xIndx) - end if - call RegPack(Buf, InData%dx) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPackAlloc(RF, InData%c) + call RegPack(RF, InData%numBlades) + call RegPack(RF, InData%nNodesPerBlade) + call RegPack(RF, InData%UAMod) + call RegPack(RF, InData%Flookup) + call RegPack(RF, InData%a_s) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UnOutFile) + call RegPack(RF, InData%ShedEffect) + call RegPack(RF, InData%lin_nx) + call RegPackAlloc(RF, InData%UA_off_forGood) + call RegPackAlloc(RF, InData%lin_xIndx) + call RegPack(RF, InData%dx) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%c)) deallocate(OutData%c) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%c(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%c) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNodesPerBlade) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a_s) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShedEffect) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%lin_nx) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%UA_off_forGood)) deallocate(OutData%UA_off_forGood) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_off_forGood.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UA_off_forGood) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%lin_xIndx)) deallocate(OutData%lin_xIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%lin_xIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_xIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%lin_xIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numBlades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodesPerBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UAMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flookup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShedEffect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lin_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UA_off_forGood); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lin_xIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -3184,37 +2065,31 @@ subroutine UA_DestroyInput(InputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine UA_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%U) - call RegPack(Buf, InData%alpha) - call RegPack(Buf, InData%Re) - call RegPack(Buf, InData%UserProp) - call RegPack(Buf, InData%v_ac) - call RegPack(Buf, InData%omega) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%U) + call RegPack(RF, InData%alpha) + call RegPack(RF, InData%Re) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%v_ac) + call RegPack(RF, InData%omega) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%U) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Re) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%v_ac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%omega) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Re); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v_ac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%omega); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3259,56 +2134,34 @@ subroutine UA_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine UA_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(UA_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Cn) - call RegPack(Buf, InData%Cc) - call RegPack(Buf, InData%Cm) - call RegPack(Buf, InData%Cl) - call RegPack(Buf, InData%Cd) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Cn) + call RegPack(RF, InData%Cc) + call RegPack(RF, InData%Cm) + call RegPack(RF, InData%Cl) + call RegPack(RF, InData%Cd) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine UA_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine UA_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(UA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Cn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cd) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Cn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine UA_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index add62bbcfe..9bf6ced3fa 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -495,31 +495,27 @@ subroutine AD14_DestroyMarker(MarkerData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackMarker(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackMarker(RF, Indata) + type(RegFile), intent(inout) :: RF type(Marker), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackMarker' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Position) - call RegPack(Buf, InData%Orientation) - call RegPack(Buf, InData%TranslationVel) - call RegPack(Buf, InData%RotationVel) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Position) + call RegPack(RF, InData%Orientation) + call RegPack(RF, InData%TranslationVel) + call RegPack(RF, InData%RotationVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackMarker(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackMarker(RF, OutData) + type(RegFile), intent(inout) :: RF type(Marker), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackMarker' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Position) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Orientation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TranslationVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotationVel) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Orientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TranslationVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotationVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyAeroConfig(SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg) @@ -611,66 +607,63 @@ subroutine AD14_DestroyAeroConfig(AeroConfigData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackAeroConfig(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackAeroConfig(RF, Indata) + type(RegFile), intent(inout) :: RF type(AeroConfig), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackAeroConfig' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Blade)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Blade)) if (allocated(InData%Blade)) then - call RegPackBounds(Buf, 1, lbound(InData%Blade, kind=B8Ki), ubound(InData%Blade, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Blade, kind=B8Ki), ubound(InData%Blade, kind=B8Ki)) LB(1:1) = lbound(InData%Blade, kind=B8Ki) UB(1:1) = ubound(InData%Blade, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_PackMarker(Buf, InData%Blade(i1)) + call AD14_PackMarker(RF, InData%Blade(i1)) end do end if - call AD14_PackMarker(Buf, InData%Hub) - call AD14_PackMarker(Buf, InData%RotorFurl) - call AD14_PackMarker(Buf, InData%Nacelle) - call AD14_PackMarker(Buf, InData%TailFin) - call AD14_PackMarker(Buf, InData%Tower) - call AD14_PackMarker(Buf, InData%SubStructure) - call AD14_PackMarker(Buf, InData%Foundation) - call RegPack(Buf, InData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return + call AD14_PackMarker(RF, InData%Hub) + call AD14_PackMarker(RF, InData%RotorFurl) + call AD14_PackMarker(RF, InData%Nacelle) + call AD14_PackMarker(RF, InData%TailFin) + call AD14_PackMarker(RF, InData%Tower) + call AD14_PackMarker(RF, InData%SubStructure) + call AD14_PackMarker(RF, InData%Foundation) + call RegPack(RF, InData%BladeLength) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackAeroConfig(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackAeroConfig(RF, OutData) + type(RegFile), intent(inout) :: RF type(AeroConfig), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackAeroConfig' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%Blade)) deallocate(OutData%Blade) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Blade(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD14_UnpackMarker(Buf, OutData%Blade(i1)) ! Blade + call AD14_UnpackMarker(RF, OutData%Blade(i1)) ! Blade end do end if - call AD14_UnpackMarker(Buf, OutData%Hub) ! Hub - call AD14_UnpackMarker(Buf, OutData%RotorFurl) ! RotorFurl - call AD14_UnpackMarker(Buf, OutData%Nacelle) ! Nacelle - call AD14_UnpackMarker(Buf, OutData%TailFin) ! TailFin - call AD14_UnpackMarker(Buf, OutData%Tower) ! Tower - call AD14_UnpackMarker(Buf, OutData%SubStructure) ! SubStructure - call AD14_UnpackMarker(Buf, OutData%Foundation) ! Foundation - call RegUnpack(Buf, OutData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return + call AD14_UnpackMarker(RF, OutData%Hub) ! Hub + call AD14_UnpackMarker(RF, OutData%RotorFurl) ! RotorFurl + call AD14_UnpackMarker(RF, OutData%Nacelle) ! Nacelle + call AD14_UnpackMarker(RF, OutData%TailFin) ! TailFin + call AD14_UnpackMarker(RF, OutData%Tower) ! Tower + call AD14_UnpackMarker(RF, OutData%SubStructure) ! SubStructure + call AD14_UnpackMarker(RF, OutData%Foundation) ! Foundation + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg) @@ -757,104 +750,34 @@ subroutine AD14_DestroyAirFoil(AirFoilData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackAirFoil(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackAirFoil(RF, Indata) + type(RegFile), intent(inout) :: RF type(AirFoil), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackAirFoil' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AL)) - if (allocated(InData%AL)) then - call RegPackBounds(Buf, 2, lbound(InData%AL, kind=B8Ki), ubound(InData%AL, kind=B8Ki)) - call RegPack(Buf, InData%AL) - end if - call RegPack(Buf, allocated(InData%CD)) - if (allocated(InData%CD)) then - call RegPackBounds(Buf, 3, lbound(InData%CD, kind=B8Ki), ubound(InData%CD, kind=B8Ki)) - call RegPack(Buf, InData%CD) - end if - call RegPack(Buf, allocated(InData%CL)) - if (allocated(InData%CL)) then - call RegPackBounds(Buf, 3, lbound(InData%CL, kind=B8Ki), ubound(InData%CL, kind=B8Ki)) - call RegPack(Buf, InData%CL) - end if - call RegPack(Buf, allocated(InData%CM)) - if (allocated(InData%CM)) then - call RegPackBounds(Buf, 3, lbound(InData%CM, kind=B8Ki), ubound(InData%CM, kind=B8Ki)) - call RegPack(Buf, InData%CM) - end if - call RegPack(Buf, InData%PMC) - call RegPack(Buf, InData%MulTabLoc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AL) + call RegPackAlloc(RF, InData%CD) + call RegPackAlloc(RF, InData%CL) + call RegPackAlloc(RF, InData%CM) + call RegPack(RF, InData%PMC) + call RegPack(RF, InData%MulTabLoc) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackAirFoil(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackAirFoil(RF, OutData) + type(RegFile), intent(inout) :: RF type(AirFoil), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackAirFoil' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AL)) deallocate(OutData%AL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CD)) deallocate(OutData%CD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CD(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CL)) deallocate(OutData%CL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CM)) deallocate(OutData%CM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CM) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PMC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MulTabLoc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PMC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MulTabLoc); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg) @@ -957,126 +880,38 @@ subroutine AD14_DestroyAirFoilParms(AirFoilParmsData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackAirFoilParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackAirFoilParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(AirFoilParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackAirFoilParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MaxTable) - call RegPack(Buf, allocated(InData%NTables)) - if (allocated(InData%NTables)) then - call RegPackBounds(Buf, 1, lbound(InData%NTables, kind=B8Ki), ubound(InData%NTables, kind=B8Ki)) - call RegPack(Buf, InData%NTables) - end if - call RegPack(Buf, allocated(InData%NLift)) - if (allocated(InData%NLift)) then - call RegPackBounds(Buf, 1, lbound(InData%NLift, kind=B8Ki), ubound(InData%NLift, kind=B8Ki)) - call RegPack(Buf, InData%NLift) - end if - call RegPack(Buf, InData%NumCL) - call RegPack(Buf, InData%NumFoil) - call RegPack(Buf, allocated(InData%NFoil)) - if (allocated(InData%NFoil)) then - call RegPackBounds(Buf, 1, lbound(InData%NFoil, kind=B8Ki), ubound(InData%NFoil, kind=B8Ki)) - call RegPack(Buf, InData%NFoil) - end if - call RegPack(Buf, allocated(InData%MulTabMet)) - if (allocated(InData%MulTabMet)) then - call RegPackBounds(Buf, 2, lbound(InData%MulTabMet, kind=B8Ki), ubound(InData%MulTabMet, kind=B8Ki)) - call RegPack(Buf, InData%MulTabMet) - end if - call RegPack(Buf, allocated(InData%FoilNm)) - if (allocated(InData%FoilNm)) then - call RegPackBounds(Buf, 1, lbound(InData%FoilNm, kind=B8Ki), ubound(InData%FoilNm, kind=B8Ki)) - call RegPack(Buf, InData%FoilNm) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MaxTable) + call RegPackAlloc(RF, InData%NTables) + call RegPackAlloc(RF, InData%NLift) + call RegPack(RF, InData%NumCL) + call RegPack(RF, InData%NumFoil) + call RegPackAlloc(RF, InData%NFoil) + call RegPackAlloc(RF, InData%MulTabMet) + call RegPackAlloc(RF, InData%FoilNm) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackAirFoilParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackAirFoilParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(AirFoilParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackAirFoilParms' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MaxTable) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NTables)) deallocate(OutData%NTables) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NTables(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NTables) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NLift)) deallocate(OutData%NLift) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NLift(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NLift) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumCL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumFoil) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NFoil)) deallocate(OutData%NFoil) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NFoil(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NFoil) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MulTabMet)) deallocate(OutData%MulTabMet) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MulTabMet(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MulTabMet) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FoilNm)) deallocate(OutData%FoilNm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FoilNm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FoilNm) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MaxTable); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NTables); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NLift); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumFoil); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NFoil); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MulTabMet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FoilNm); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg) @@ -1889,1054 +1724,157 @@ subroutine AD14_DestroyBeddoes(BeddoesData, ErrStat, ErrMsg) if (allocated(BeddoesData%XN)) then deallocate(BeddoesData%XN) end if - if (allocated(BeddoesData%YN)) then - deallocate(BeddoesData%YN) - end if -end subroutine - -subroutine AD14_PackBeddoes(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(Beddoes), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD14_PackBeddoes' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%ADOT)) - if (allocated(InData%ADOT)) then - call RegPackBounds(Buf, 2, lbound(InData%ADOT, kind=B8Ki), ubound(InData%ADOT, kind=B8Ki)) - call RegPack(Buf, InData%ADOT) - end if - call RegPack(Buf, allocated(InData%ADOT1)) - if (allocated(InData%ADOT1)) then - call RegPackBounds(Buf, 2, lbound(InData%ADOT1, kind=B8Ki), ubound(InData%ADOT1, kind=B8Ki)) - call RegPack(Buf, InData%ADOT1) - end if - call RegPack(Buf, allocated(InData%AFE)) - if (allocated(InData%AFE)) then - call RegPackBounds(Buf, 2, lbound(InData%AFE, kind=B8Ki), ubound(InData%AFE, kind=B8Ki)) - call RegPack(Buf, InData%AFE) - end if - call RegPack(Buf, allocated(InData%AFE1)) - if (allocated(InData%AFE1)) then - call RegPackBounds(Buf, 2, lbound(InData%AFE1, kind=B8Ki), ubound(InData%AFE1, kind=B8Ki)) - call RegPack(Buf, InData%AFE1) - end if - call RegPack(Buf, InData%AN) - call RegPack(Buf, allocated(InData%ANE)) - if (allocated(InData%ANE)) then - call RegPackBounds(Buf, 2, lbound(InData%ANE, kind=B8Ki), ubound(InData%ANE, kind=B8Ki)) - call RegPack(Buf, InData%ANE) - end if - call RegPack(Buf, allocated(InData%ANE1)) - if (allocated(InData%ANE1)) then - call RegPackBounds(Buf, 2, lbound(InData%ANE1, kind=B8Ki), ubound(InData%ANE1, kind=B8Ki)) - call RegPack(Buf, InData%ANE1) - end if - call RegPack(Buf, allocated(InData%AOD)) - if (allocated(InData%AOD)) then - call RegPackBounds(Buf, 2, lbound(InData%AOD, kind=B8Ki), ubound(InData%AOD, kind=B8Ki)) - call RegPack(Buf, InData%AOD) - end if - call RegPack(Buf, allocated(InData%AOL)) - if (allocated(InData%AOL)) then - call RegPackBounds(Buf, 2, lbound(InData%AOL, kind=B8Ki), ubound(InData%AOL, kind=B8Ki)) - call RegPack(Buf, InData%AOL) - end if - call RegPack(Buf, allocated(InData%BEDSEP)) - if (allocated(InData%BEDSEP)) then - call RegPackBounds(Buf, 2, lbound(InData%BEDSEP, kind=B8Ki), ubound(InData%BEDSEP, kind=B8Ki)) - call RegPack(Buf, InData%BEDSEP) - end if - call RegPack(Buf, allocated(InData%OLDSEP)) - if (allocated(InData%OLDSEP)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDSEP, kind=B8Ki), ubound(InData%OLDSEP, kind=B8Ki)) - call RegPack(Buf, InData%OLDSEP) - end if - call RegPack(Buf, InData%CC) - call RegPack(Buf, allocated(InData%CDO)) - if (allocated(InData%CDO)) then - call RegPackBounds(Buf, 2, lbound(InData%CDO, kind=B8Ki), ubound(InData%CDO, kind=B8Ki)) - call RegPack(Buf, InData%CDO) - end if - call RegPack(Buf, InData%CMI) - call RegPack(Buf, InData%CMQ) - call RegPack(Buf, InData%CN) - call RegPack(Buf, allocated(InData%CNA)) - if (allocated(InData%CNA)) then - call RegPackBounds(Buf, 2, lbound(InData%CNA, kind=B8Ki), ubound(InData%CNA, kind=B8Ki)) - call RegPack(Buf, InData%CNA) - end if - call RegPack(Buf, InData%CNCP) - call RegPack(Buf, InData%CNIQ) - call RegPack(Buf, allocated(InData%CNP)) - if (allocated(InData%CNP)) then - call RegPackBounds(Buf, 2, lbound(InData%CNP, kind=B8Ki), ubound(InData%CNP, kind=B8Ki)) - call RegPack(Buf, InData%CNP) - end if - call RegPack(Buf, allocated(InData%CNP1)) - if (allocated(InData%CNP1)) then - call RegPackBounds(Buf, 2, lbound(InData%CNP1, kind=B8Ki), ubound(InData%CNP1, kind=B8Ki)) - call RegPack(Buf, InData%CNP1) - end if - call RegPack(Buf, allocated(InData%CNPD)) - if (allocated(InData%CNPD)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPD, kind=B8Ki), ubound(InData%CNPD, kind=B8Ki)) - call RegPack(Buf, InData%CNPD) - end if - call RegPack(Buf, allocated(InData%CNPD1)) - if (allocated(InData%CNPD1)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPD1, kind=B8Ki), ubound(InData%CNPD1, kind=B8Ki)) - call RegPack(Buf, InData%CNPD1) - end if - call RegPack(Buf, allocated(InData%CNPOT)) - if (allocated(InData%CNPOT)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPOT, kind=B8Ki), ubound(InData%CNPOT, kind=B8Ki)) - call RegPack(Buf, InData%CNPOT) - end if - call RegPack(Buf, allocated(InData%CNPOT1)) - if (allocated(InData%CNPOT1)) then - call RegPackBounds(Buf, 2, lbound(InData%CNPOT1, kind=B8Ki), ubound(InData%CNPOT1, kind=B8Ki)) - call RegPack(Buf, InData%CNPOT1) - end if - call RegPack(Buf, allocated(InData%CNS)) - if (allocated(InData%CNS)) then - call RegPackBounds(Buf, 2, lbound(InData%CNS, kind=B8Ki), ubound(InData%CNS, kind=B8Ki)) - call RegPack(Buf, InData%CNS) - end if - call RegPack(Buf, allocated(InData%CNSL)) - if (allocated(InData%CNSL)) then - call RegPackBounds(Buf, 2, lbound(InData%CNSL, kind=B8Ki), ubound(InData%CNSL, kind=B8Ki)) - call RegPack(Buf, InData%CNSL) - end if - call RegPack(Buf, allocated(InData%CNV)) - if (allocated(InData%CNV)) then - call RegPackBounds(Buf, 2, lbound(InData%CNV, kind=B8Ki), ubound(InData%CNV, kind=B8Ki)) - call RegPack(Buf, InData%CNV) - end if - call RegPack(Buf, allocated(InData%CVN)) - if (allocated(InData%CVN)) then - call RegPackBounds(Buf, 2, lbound(InData%CVN, kind=B8Ki), ubound(InData%CVN, kind=B8Ki)) - call RegPack(Buf, InData%CVN) - end if - call RegPack(Buf, allocated(InData%CVN1)) - if (allocated(InData%CVN1)) then - call RegPackBounds(Buf, 2, lbound(InData%CVN1, kind=B8Ki), ubound(InData%CVN1, kind=B8Ki)) - call RegPack(Buf, InData%CVN1) - end if - call RegPack(Buf, allocated(InData%DF)) - if (allocated(InData%DF)) then - call RegPackBounds(Buf, 2, lbound(InData%DF, kind=B8Ki), ubound(InData%DF, kind=B8Ki)) - call RegPack(Buf, InData%DF) - end if - call RegPack(Buf, allocated(InData%DFAFE)) - if (allocated(InData%DFAFE)) then - call RegPackBounds(Buf, 2, lbound(InData%DFAFE, kind=B8Ki), ubound(InData%DFAFE, kind=B8Ki)) - call RegPack(Buf, InData%DFAFE) - end if - call RegPack(Buf, allocated(InData%DFAFE1)) - if (allocated(InData%DFAFE1)) then - call RegPackBounds(Buf, 2, lbound(InData%DFAFE1, kind=B8Ki), ubound(InData%DFAFE1, kind=B8Ki)) - call RegPack(Buf, InData%DFAFE1) - end if - call RegPack(Buf, allocated(InData%DFC)) - if (allocated(InData%DFC)) then - call RegPackBounds(Buf, 2, lbound(InData%DFC, kind=B8Ki), ubound(InData%DFC, kind=B8Ki)) - call RegPack(Buf, InData%DFC) - end if - call RegPack(Buf, allocated(InData%DN)) - if (allocated(InData%DN)) then - call RegPackBounds(Buf, 2, lbound(InData%DN, kind=B8Ki), ubound(InData%DN, kind=B8Ki)) - call RegPack(Buf, InData%DN) - end if - call RegPack(Buf, allocated(InData%DPP)) - if (allocated(InData%DPP)) then - call RegPackBounds(Buf, 2, lbound(InData%DPP, kind=B8Ki), ubound(InData%DPP, kind=B8Ki)) - call RegPack(Buf, InData%DPP) - end if - call RegPack(Buf, allocated(InData%DQ)) - if (allocated(InData%DQ)) then - call RegPackBounds(Buf, 2, lbound(InData%DQ, kind=B8Ki), ubound(InData%DQ, kind=B8Ki)) - call RegPack(Buf, InData%DQ) - end if - call RegPack(Buf, allocated(InData%DQP)) - if (allocated(InData%DQP)) then - call RegPackBounds(Buf, 2, lbound(InData%DQP, kind=B8Ki), ubound(InData%DQP, kind=B8Ki)) - call RegPack(Buf, InData%DQP) - end if - call RegPack(Buf, allocated(InData%DQP1)) - if (allocated(InData%DQP1)) then - call RegPackBounds(Buf, 2, lbound(InData%DQP1, kind=B8Ki), ubound(InData%DQP1, kind=B8Ki)) - call RegPack(Buf, InData%DQP1) - end if - call RegPack(Buf, InData%DS) - call RegPack(Buf, InData%FK) - call RegPack(Buf, InData%FP) - call RegPack(Buf, InData%FPC) - call RegPack(Buf, allocated(InData%FSP)) - if (allocated(InData%FSP)) then - call RegPackBounds(Buf, 2, lbound(InData%FSP, kind=B8Ki), ubound(InData%FSP, kind=B8Ki)) - call RegPack(Buf, InData%FSP) - end if - call RegPack(Buf, allocated(InData%FSP1)) - if (allocated(InData%FSP1)) then - call RegPackBounds(Buf, 2, lbound(InData%FSP1, kind=B8Ki), ubound(InData%FSP1, kind=B8Ki)) - call RegPack(Buf, InData%FSP1) - end if - call RegPack(Buf, allocated(InData%FSPC)) - if (allocated(InData%FSPC)) then - call RegPackBounds(Buf, 2, lbound(InData%FSPC, kind=B8Ki), ubound(InData%FSPC, kind=B8Ki)) - call RegPack(Buf, InData%FSPC) - end if - call RegPack(Buf, allocated(InData%FSPC1)) - if (allocated(InData%FSPC1)) then - call RegPackBounds(Buf, 2, lbound(InData%FSPC1, kind=B8Ki), ubound(InData%FSPC1, kind=B8Ki)) - call RegPack(Buf, InData%FSPC1) - end if - call RegPack(Buf, allocated(InData%FTB)) - if (allocated(InData%FTB)) then - call RegPackBounds(Buf, 3, lbound(InData%FTB, kind=B8Ki), ubound(InData%FTB, kind=B8Ki)) - call RegPack(Buf, InData%FTB) - end if - call RegPack(Buf, allocated(InData%FTBC)) - if (allocated(InData%FTBC)) then - call RegPackBounds(Buf, 3, lbound(InData%FTBC, kind=B8Ki), ubound(InData%FTBC, kind=B8Ki)) - call RegPack(Buf, InData%FTBC) - end if - call RegPack(Buf, allocated(InData%OLDCNV)) - if (allocated(InData%OLDCNV)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDCNV, kind=B8Ki), ubound(InData%OLDCNV, kind=B8Ki)) - call RegPack(Buf, InData%OLDCNV) - end if - call RegPack(Buf, allocated(InData%OLDDF)) - if (allocated(InData%OLDDF)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDF, kind=B8Ki), ubound(InData%OLDDF, kind=B8Ki)) - call RegPack(Buf, InData%OLDDF) - end if - call RegPack(Buf, allocated(InData%OLDDFC)) - if (allocated(InData%OLDDFC)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDFC, kind=B8Ki), ubound(InData%OLDDFC, kind=B8Ki)) - call RegPack(Buf, InData%OLDDFC) - end if - call RegPack(Buf, allocated(InData%OLDDN)) - if (allocated(InData%OLDDN)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDN, kind=B8Ki), ubound(InData%OLDDN, kind=B8Ki)) - call RegPack(Buf, InData%OLDDN) - end if - call RegPack(Buf, allocated(InData%OLDDPP)) - if (allocated(InData%OLDDPP)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDPP, kind=B8Ki), ubound(InData%OLDDPP, kind=B8Ki)) - call RegPack(Buf, InData%OLDDPP) - end if - call RegPack(Buf, allocated(InData%OLDDQ)) - if (allocated(InData%OLDDQ)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDDQ, kind=B8Ki), ubound(InData%OLDDQ, kind=B8Ki)) - call RegPack(Buf, InData%OLDDQ) - end if - call RegPack(Buf, allocated(InData%OLDTAU)) - if (allocated(InData%OLDTAU)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDTAU, kind=B8Ki), ubound(InData%OLDTAU, kind=B8Ki)) - call RegPack(Buf, InData%OLDTAU) - end if - call RegPack(Buf, allocated(InData%OLDXN)) - if (allocated(InData%OLDXN)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDXN, kind=B8Ki), ubound(InData%OLDXN, kind=B8Ki)) - call RegPack(Buf, InData%OLDXN) - end if - call RegPack(Buf, allocated(InData%OLDYN)) - if (allocated(InData%OLDYN)) then - call RegPackBounds(Buf, 2, lbound(InData%OLDYN, kind=B8Ki), ubound(InData%OLDYN, kind=B8Ki)) - call RegPack(Buf, InData%OLDYN) - end if - call RegPack(Buf, allocated(InData%QX)) - if (allocated(InData%QX)) then - call RegPackBounds(Buf, 2, lbound(InData%QX, kind=B8Ki), ubound(InData%QX, kind=B8Ki)) - call RegPack(Buf, InData%QX) - end if - call RegPack(Buf, allocated(InData%QX1)) - if (allocated(InData%QX1)) then - call RegPackBounds(Buf, 2, lbound(InData%QX1, kind=B8Ki), ubound(InData%QX1, kind=B8Ki)) - call RegPack(Buf, InData%QX1) - end if - call RegPack(Buf, allocated(InData%TAU)) - if (allocated(InData%TAU)) then - call RegPackBounds(Buf, 2, lbound(InData%TAU, kind=B8Ki), ubound(InData%TAU, kind=B8Ki)) - call RegPack(Buf, InData%TAU) - end if - call RegPack(Buf, allocated(InData%XN)) - if (allocated(InData%XN)) then - call RegPackBounds(Buf, 2, lbound(InData%XN, kind=B8Ki), ubound(InData%XN, kind=B8Ki)) - call RegPack(Buf, InData%XN) - end if - call RegPack(Buf, allocated(InData%YN)) - if (allocated(InData%YN)) then - call RegPackBounds(Buf, 2, lbound(InData%YN, kind=B8Ki), ubound(InData%YN, kind=B8Ki)) - call RegPack(Buf, InData%YN) - end if - call RegPack(Buf, InData%SHIFT) - call RegPack(Buf, InData%VOR) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine AD14_UnPackBeddoes(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(Beddoes), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD14_UnPackBeddoes' - integer(B8Ki) :: LB(3), UB(3) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%ADOT)) deallocate(OutData%ADOT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ADOT(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ADOT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ADOT1)) deallocate(OutData%ADOT1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ADOT1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ADOT1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AFE)) deallocate(OutData%AFE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AFE1)) deallocate(OutData%AFE1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AFE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AFE1) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AN) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ANE)) deallocate(OutData%ANE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ANE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ANE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ANE1)) deallocate(OutData%ANE1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ANE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ANE1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AOD)) deallocate(OutData%AOD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AOD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AOD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AOL)) deallocate(OutData%AOL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AOL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AOL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BEDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BEDSEP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDSEP)) deallocate(OutData%OLDSEP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDSEP) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%CC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%CDO)) deallocate(OutData%CDO) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CDO(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CDO) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%CMI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CMQ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CN) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%CNA)) deallocate(OutData%CNA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNA(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNA) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%CNCP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CNIQ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%CNP)) deallocate(OutData%CNP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNP1)) deallocate(OutData%CNP1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNP1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNPD)) deallocate(OutData%CNPD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNPD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNPD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNPD1)) deallocate(OutData%CNPD1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNPD1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNPD1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNPOT)) deallocate(OutData%CNPOT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNPOT(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNPOT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNPOT1)) deallocate(OutData%CNPOT1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNPOT1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNPOT1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNS)) deallocate(OutData%CNS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNSL)) deallocate(OutData%CNSL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNSL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNSL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNV)) deallocate(OutData%CNV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNV(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CVN)) deallocate(OutData%CVN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CVN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CVN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CVN1)) deallocate(OutData%CVN1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CVN1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CVN1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DF)) deallocate(OutData%DF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DFAFE)) deallocate(OutData%DFAFE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DFAFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DFAFE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DFAFE1)) deallocate(OutData%DFAFE1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DFAFE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DFAFE1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DFC)) deallocate(OutData%DFC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DFC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DFC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DN)) deallocate(OutData%DN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DPP)) deallocate(OutData%DPP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DPP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DPP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DQ)) deallocate(OutData%DQ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DQ(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DQ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DQP)) deallocate(OutData%DQP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DQP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DQP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DQP1)) deallocate(OutData%DQP1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DQP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DQP1) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%DS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FPC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FSP)) deallocate(OutData%FSP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FSP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FSP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FSP1)) deallocate(OutData%FSP1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FSP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FSP1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FSPC)) deallocate(OutData%FSPC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FSPC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FSPC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FSPC1)) deallocate(OutData%FSPC1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FSPC1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FSPC1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FTB)) deallocate(OutData%FTB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FTB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FTB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FTBC)) deallocate(OutData%FTBC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FTBC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FTBC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDCNV)) deallocate(OutData%OLDCNV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDCNV(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDCNV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDDF)) deallocate(OutData%OLDDF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDDF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDDF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDDFC)) deallocate(OutData%OLDDFC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDDFC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDDFC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDDN)) deallocate(OutData%OLDDN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDDN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDDN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDDPP)) deallocate(OutData%OLDDPP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDDPP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDDPP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDDQ)) deallocate(OutData%OLDDQ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDDQ(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDDQ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDTAU)) deallocate(OutData%OLDTAU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDTAU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDTAU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDXN)) deallocate(OutData%OLDXN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDXN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDXN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLDYN)) deallocate(OutData%OLDYN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLDYN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLDYN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QX)) deallocate(OutData%QX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QX(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QX1)) deallocate(OutData%QX1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QX1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QX1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TAU)) deallocate(OutData%TAU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TAU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TAU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%XN)) deallocate(OutData%XN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%XN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%XN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%YN)) deallocate(OutData%YN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%YN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%YN) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SHIFT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VOR) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(BeddoesData%YN)) then + deallocate(BeddoesData%YN) + end if +end subroutine + +subroutine AD14_PackBeddoes(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Beddoes), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBeddoes' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%ADOT) + call RegPackAlloc(RF, InData%ADOT1) + call RegPackAlloc(RF, InData%AFE) + call RegPackAlloc(RF, InData%AFE1) + call RegPack(RF, InData%AN) + call RegPackAlloc(RF, InData%ANE) + call RegPackAlloc(RF, InData%ANE1) + call RegPackAlloc(RF, InData%AOD) + call RegPackAlloc(RF, InData%AOL) + call RegPackAlloc(RF, InData%BEDSEP) + call RegPackAlloc(RF, InData%OLDSEP) + call RegPack(RF, InData%CC) + call RegPackAlloc(RF, InData%CDO) + call RegPack(RF, InData%CMI) + call RegPack(RF, InData%CMQ) + call RegPack(RF, InData%CN) + call RegPackAlloc(RF, InData%CNA) + call RegPack(RF, InData%CNCP) + call RegPack(RF, InData%CNIQ) + call RegPackAlloc(RF, InData%CNP) + call RegPackAlloc(RF, InData%CNP1) + call RegPackAlloc(RF, InData%CNPD) + call RegPackAlloc(RF, InData%CNPD1) + call RegPackAlloc(RF, InData%CNPOT) + call RegPackAlloc(RF, InData%CNPOT1) + call RegPackAlloc(RF, InData%CNS) + call RegPackAlloc(RF, InData%CNSL) + call RegPackAlloc(RF, InData%CNV) + call RegPackAlloc(RF, InData%CVN) + call RegPackAlloc(RF, InData%CVN1) + call RegPackAlloc(RF, InData%DF) + call RegPackAlloc(RF, InData%DFAFE) + call RegPackAlloc(RF, InData%DFAFE1) + call RegPackAlloc(RF, InData%DFC) + call RegPackAlloc(RF, InData%DN) + call RegPackAlloc(RF, InData%DPP) + call RegPackAlloc(RF, InData%DQ) + call RegPackAlloc(RF, InData%DQP) + call RegPackAlloc(RF, InData%DQP1) + call RegPack(RF, InData%DS) + call RegPack(RF, InData%FK) + call RegPack(RF, InData%FP) + call RegPack(RF, InData%FPC) + call RegPackAlloc(RF, InData%FSP) + call RegPackAlloc(RF, InData%FSP1) + call RegPackAlloc(RF, InData%FSPC) + call RegPackAlloc(RF, InData%FSPC1) + call RegPackAlloc(RF, InData%FTB) + call RegPackAlloc(RF, InData%FTBC) + call RegPackAlloc(RF, InData%OLDCNV) + call RegPackAlloc(RF, InData%OLDDF) + call RegPackAlloc(RF, InData%OLDDFC) + call RegPackAlloc(RF, InData%OLDDN) + call RegPackAlloc(RF, InData%OLDDPP) + call RegPackAlloc(RF, InData%OLDDQ) + call RegPackAlloc(RF, InData%OLDTAU) + call RegPackAlloc(RF, InData%OLDXN) + call RegPackAlloc(RF, InData%OLDYN) + call RegPackAlloc(RF, InData%QX) + call RegPackAlloc(RF, InData%QX1) + call RegPackAlloc(RF, InData%TAU) + call RegPackAlloc(RF, InData%XN) + call RegPackAlloc(RF, InData%YN) + call RegPack(RF, InData%SHIFT) + call RegPack(RF, InData%VOR) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBeddoes(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Beddoes), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBeddoes' + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%ADOT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ADOT1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AFE1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ANE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ANE1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AOD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AOL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BEDSEP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDSEP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CDO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CMI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CMQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CNCP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CNIQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNP1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNPD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNPD1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNPOT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNPOT1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNSL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CVN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CVN1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DFAFE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DFAFE1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DFC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DPP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DQP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DQP1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FPC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSP1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSPC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSPC1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FTB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FTBC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDCNV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDDF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDDFC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDDN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDDPP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDDQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDTAU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDXN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLDYN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QX1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TAU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%XN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%YN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHIFT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VOR); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyBeddoesParms(SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg) @@ -2964,34 +1902,29 @@ subroutine AD14_DestroyBeddoesParms(BeddoesParmsData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackBeddoesParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackBeddoesParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(BeddoesParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackBeddoesParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AS) - call RegPack(Buf, InData%TF) - call RegPack(Buf, InData%TP) - call RegPack(Buf, InData%TV) - call RegPack(Buf, InData%TVL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AS) + call RegPack(RF, InData%TF) + call RegPack(RF, InData%TP) + call RegPack(RF, InData%TV) + call RegPack(RF, InData%TVL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackBeddoesParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackBeddoesParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(BeddoesParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackBeddoesParms' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TVL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TVL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg) @@ -3048,66 +1981,30 @@ subroutine AD14_DestroyBladeParms(BladeParmsData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackBladeParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackBladeParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(BladeParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackBladeParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%C)) - if (allocated(InData%C)) then - call RegPackBounds(Buf, 1, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) - call RegPack(Buf, InData%C) - end if - call RegPack(Buf, allocated(InData%DR)) - if (allocated(InData%DR)) then - call RegPackBounds(Buf, 1, lbound(InData%DR, kind=B8Ki), ubound(InData%DR, kind=B8Ki)) - call RegPack(Buf, InData%DR) - end if - call RegPack(Buf, InData%R) - call RegPack(Buf, InData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%C) + call RegPackAlloc(RF, InData%DR) + call RegPack(RF, InData%R) + call RegPack(RF, InData%BladeLength) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackBladeParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackBladeParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(BladeParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackBladeParms' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%C)) deallocate(OutData%C) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DR)) deallocate(OutData%DR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DR(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DR) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%R) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg) @@ -3186,132 +2083,74 @@ subroutine AD14_DestroyDynInflow(DynInflowData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackDynInflow(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackDynInflow(RF, Indata) + type(RegFile), intent(inout) :: RF type(DynInflow), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackDynInflow' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dAlph_dt) - call RegPack(Buf, InData%dBeta_dt) - call RegPack(Buf, InData%DTO) - call RegPack(Buf, InData%old_Alph) - call RegPack(Buf, InData%old_Beta) - call RegPack(Buf, InData%old_LmdM) - call RegPack(Buf, InData%oldKai) - call RegPack(Buf, InData%PhiLqC) - call RegPack(Buf, InData%PhiLqS) - call RegPack(Buf, InData%Pzero) - call RegPack(Buf, allocated(InData%RMC_SAVE)) - if (allocated(InData%RMC_SAVE)) then - call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE, kind=B8Ki), ubound(InData%RMC_SAVE, kind=B8Ki)) - call RegPack(Buf, InData%RMC_SAVE) - end if - call RegPack(Buf, allocated(InData%RMS_SAVE)) - if (allocated(InData%RMS_SAVE)) then - call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE, kind=B8Ki), ubound(InData%RMS_SAVE, kind=B8Ki)) - call RegPack(Buf, InData%RMS_SAVE) - end if - call RegPack(Buf, InData%TipSpeed) - call RegPack(Buf, InData%totalInf) - call RegPack(Buf, InData%Vparam) - call RegPack(Buf, InData%Vtotal) - call RegPack(Buf, InData%xAlpha) - call RegPack(Buf, InData%xBeta) - call RegPack(Buf, InData%xKai) - call RegPack(Buf, InData%XLAMBDA_M) - call RegPack(Buf, InData%xLcos) - call RegPack(Buf, InData%xLsin) - call RegPack(Buf, InData%MminR) - call RegPack(Buf, InData%MminusR) - call RegPack(Buf, InData%MplusR) - call RegPack(Buf, InData%GAMMA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dAlph_dt) + call RegPack(RF, InData%dBeta_dt) + call RegPack(RF, InData%DTO) + call RegPack(RF, InData%old_Alph) + call RegPack(RF, InData%old_Beta) + call RegPack(RF, InData%old_LmdM) + call RegPack(RF, InData%oldKai) + call RegPack(RF, InData%PhiLqC) + call RegPack(RF, InData%PhiLqS) + call RegPack(RF, InData%Pzero) + call RegPackAlloc(RF, InData%RMC_SAVE) + call RegPackAlloc(RF, InData%RMS_SAVE) + call RegPack(RF, InData%TipSpeed) + call RegPack(RF, InData%totalInf) + call RegPack(RF, InData%Vparam) + call RegPack(RF, InData%Vtotal) + call RegPack(RF, InData%xAlpha) + call RegPack(RF, InData%xBeta) + call RegPack(RF, InData%xKai) + call RegPack(RF, InData%XLAMBDA_M) + call RegPack(RF, InData%xLcos) + call RegPack(RF, InData%xLsin) + call RegPack(RF, InData%MminR) + call RegPack(RF, InData%MminusR) + call RegPack(RF, InData%MplusR) + call RegPack(RF, InData%GAMMA) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackDynInflow(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackDynInflow(RF, OutData) + type(RegFile), intent(inout) :: RF type(DynInflow), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackDynInflow' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dAlph_dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dBeta_dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTO) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%old_Alph) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%old_Beta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%old_LmdM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%oldKai) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PhiLqC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PhiLqS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pzero) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%RMC_SAVE)) deallocate(OutData%RMC_SAVE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RMC_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RMC_SAVE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RMS_SAVE)) deallocate(OutData%RMS_SAVE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RMS_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RMS_SAVE) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TipSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%totalInf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Vparam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Vtotal) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xAlpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xBeta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xKai) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%XLAMBDA_M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xLcos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xLsin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MminR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MminusR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MplusR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GAMMA) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dAlph_dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dBeta_dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%old_Alph); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%old_Beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%old_LmdM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%oldKai); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PhiLqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PhiLqS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pzero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RMC_SAVE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RMS_SAVE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalInf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vparam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vtotal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xBeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xKai); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XLAMBDA_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xLcos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xLsin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MminR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MminusR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MplusR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GAMMA); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyDynInflowParms(SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg) @@ -3336,25 +2175,23 @@ subroutine AD14_DestroyDynInflowParms(DynInflowParmsData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackDynInflowParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackDynInflowParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(DynInflowParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackDynInflowParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MAXINFLO) - call RegPack(Buf, InData%xMinv) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MAXINFLO) + call RegPack(RF, InData%xMinv) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackDynInflowParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackDynInflowParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(DynInflowParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackDynInflowParms' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MAXINFLO) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%xMinv) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MAXINFLO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%xMinv); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg) @@ -3484,155 +2321,36 @@ subroutine AD14_DestroyElement(ElementData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackElement(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackElement(RF, Indata) + type(RegFile), intent(inout) :: RF type(Element), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackElement' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%A)) - if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) - call RegPack(Buf, InData%A) - end if - call RegPack(Buf, allocated(InData%AP)) - if (allocated(InData%AP)) then - call RegPackBounds(Buf, 2, lbound(InData%AP, kind=B8Ki), ubound(InData%AP, kind=B8Ki)) - call RegPack(Buf, InData%AP) - end if - call RegPack(Buf, allocated(InData%ALPHA)) - if (allocated(InData%ALPHA)) then - call RegPackBounds(Buf, 2, lbound(InData%ALPHA, kind=B8Ki), ubound(InData%ALPHA, kind=B8Ki)) - call RegPack(Buf, InData%ALPHA) - end if - call RegPack(Buf, allocated(InData%W2)) - if (allocated(InData%W2)) then - call RegPackBounds(Buf, 2, lbound(InData%W2, kind=B8Ki), ubound(InData%W2, kind=B8Ki)) - call RegPack(Buf, InData%W2) - end if - call RegPack(Buf, allocated(InData%OLD_A_NS)) - if (allocated(InData%OLD_A_NS)) then - call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS, kind=B8Ki), ubound(InData%OLD_A_NS, kind=B8Ki)) - call RegPack(Buf, InData%OLD_A_NS) - end if - call RegPack(Buf, allocated(InData%OLD_AP_NS)) - if (allocated(InData%OLD_AP_NS)) then - call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS, kind=B8Ki), ubound(InData%OLD_AP_NS, kind=B8Ki)) - call RegPack(Buf, InData%OLD_AP_NS) - end if - call RegPack(Buf, allocated(InData%PITNOW)) - if (allocated(InData%PITNOW)) then - call RegPackBounds(Buf, 2, lbound(InData%PITNOW, kind=B8Ki), ubound(InData%PITNOW, kind=B8Ki)) - call RegPack(Buf, InData%PITNOW) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%AP) + call RegPackAlloc(RF, InData%ALPHA) + call RegPackAlloc(RF, InData%W2) + call RegPackAlloc(RF, InData%OLD_A_NS) + call RegPackAlloc(RF, InData%OLD_AP_NS) + call RegPackAlloc(RF, InData%PITNOW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackElement(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackElement(RF, OutData) + type(RegFile), intent(inout) :: RF type(Element), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackElement' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%A)) deallocate(OutData%A) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%A) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AP)) deallocate(OutData%AP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ALPHA)) deallocate(OutData%ALPHA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ALPHA(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ALPHA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%W2)) deallocate(OutData%W2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%W2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%W2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLD_A_NS)) deallocate(OutData%OLD_A_NS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLD_A_NS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLD_A_NS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OLD_AP_NS)) deallocate(OutData%OLD_AP_NS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OLD_AP_NS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OLD_AP_NS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PITNOW)) deallocate(OutData%PITNOW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PITNOW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PITNOW) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ALPHA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLD_A_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OLD_AP_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PITNOW); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg) @@ -3718,101 +2436,32 @@ subroutine AD14_DestroyElementParms(ElementParmsData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackElementParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackElementParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(ElementParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackElementParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NELM) - call RegPack(Buf, allocated(InData%TWIST)) - if (allocated(InData%TWIST)) then - call RegPackBounds(Buf, 1, lbound(InData%TWIST, kind=B8Ki), ubound(InData%TWIST, kind=B8Ki)) - call RegPack(Buf, InData%TWIST) - end if - call RegPack(Buf, allocated(InData%RELM)) - if (allocated(InData%RELM)) then - call RegPackBounds(Buf, 1, lbound(InData%RELM, kind=B8Ki), ubound(InData%RELM, kind=B8Ki)) - call RegPack(Buf, InData%RELM) - end if - call RegPack(Buf, allocated(InData%HLCNST)) - if (allocated(InData%HLCNST)) then - call RegPackBounds(Buf, 1, lbound(InData%HLCNST, kind=B8Ki), ubound(InData%HLCNST, kind=B8Ki)) - call RegPack(Buf, InData%HLCNST) - end if - call RegPack(Buf, allocated(InData%TLCNST)) - if (allocated(InData%TLCNST)) then - call RegPackBounds(Buf, 1, lbound(InData%TLCNST, kind=B8Ki), ubound(InData%TLCNST, kind=B8Ki)) - call RegPack(Buf, InData%TLCNST) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NELM) + call RegPackAlloc(RF, InData%TWIST) + call RegPackAlloc(RF, InData%RELM) + call RegPackAlloc(RF, InData%HLCNST) + call RegPackAlloc(RF, InData%TLCNST) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackElementParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackElementParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(ElementParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackElementParms' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NELM) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TWIST)) deallocate(OutData%TWIST) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TWIST(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TWIST) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RELM)) deallocate(OutData%RELM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RELM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RELM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HLCNST)) deallocate(OutData%HLCNST) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HLCNST(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HLCNST) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TLCNST)) deallocate(OutData%TLCNST) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TLCNST(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TLCNST) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NELM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TWIST); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RELM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HLCNST); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TLCNST); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg) @@ -4172,455 +2821,76 @@ subroutine AD14_DestroyElOutParms(ElOutParmsData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackElOutParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackElOutParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(ElOutParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackElOutParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AAA)) - if (allocated(InData%AAA)) then - call RegPackBounds(Buf, 1, lbound(InData%AAA, kind=B8Ki), ubound(InData%AAA, kind=B8Ki)) - call RegPack(Buf, InData%AAA) - end if - call RegPack(Buf, allocated(InData%AAP)) - if (allocated(InData%AAP)) then - call RegPackBounds(Buf, 1, lbound(InData%AAP, kind=B8Ki), ubound(InData%AAP, kind=B8Ki)) - call RegPack(Buf, InData%AAP) - end if - call RegPack(Buf, allocated(InData%ALF)) - if (allocated(InData%ALF)) then - call RegPackBounds(Buf, 1, lbound(InData%ALF, kind=B8Ki), ubound(InData%ALF, kind=B8Ki)) - call RegPack(Buf, InData%ALF) - end if - call RegPack(Buf, allocated(InData%CDD)) - if (allocated(InData%CDD)) then - call RegPackBounds(Buf, 1, lbound(InData%CDD, kind=B8Ki), ubound(InData%CDD, kind=B8Ki)) - call RegPack(Buf, InData%CDD) - end if - call RegPack(Buf, allocated(InData%CLL)) - if (allocated(InData%CLL)) then - call RegPackBounds(Buf, 1, lbound(InData%CLL, kind=B8Ki), ubound(InData%CLL, kind=B8Ki)) - call RegPack(Buf, InData%CLL) - end if - call RegPack(Buf, allocated(InData%CMM)) - if (allocated(InData%CMM)) then - call RegPackBounds(Buf, 1, lbound(InData%CMM, kind=B8Ki), ubound(InData%CMM, kind=B8Ki)) - call RegPack(Buf, InData%CMM) - end if - call RegPack(Buf, allocated(InData%CNN)) - if (allocated(InData%CNN)) then - call RegPackBounds(Buf, 1, lbound(InData%CNN, kind=B8Ki), ubound(InData%CNN, kind=B8Ki)) - call RegPack(Buf, InData%CNN) - end if - call RegPack(Buf, allocated(InData%CTT)) - if (allocated(InData%CTT)) then - call RegPackBounds(Buf, 1, lbound(InData%CTT, kind=B8Ki), ubound(InData%CTT, kind=B8Ki)) - call RegPack(Buf, InData%CTT) - end if - call RegPack(Buf, allocated(InData%DFNSAV)) - if (allocated(InData%DFNSAV)) then - call RegPackBounds(Buf, 1, lbound(InData%DFNSAV, kind=B8Ki), ubound(InData%DFNSAV, kind=B8Ki)) - call RegPack(Buf, InData%DFNSAV) - end if - call RegPack(Buf, allocated(InData%DFTSAV)) - if (allocated(InData%DFTSAV)) then - call RegPackBounds(Buf, 1, lbound(InData%DFTSAV, kind=B8Ki), ubound(InData%DFTSAV, kind=B8Ki)) - call RegPack(Buf, InData%DFTSAV) - end if - call RegPack(Buf, allocated(InData%DynPres)) - if (allocated(InData%DynPres)) then - call RegPackBounds(Buf, 1, lbound(InData%DynPres, kind=B8Ki), ubound(InData%DynPres, kind=B8Ki)) - call RegPack(Buf, InData%DynPres) - end if - call RegPack(Buf, allocated(InData%PMM)) - if (allocated(InData%PMM)) then - call RegPackBounds(Buf, 1, lbound(InData%PMM, kind=B8Ki), ubound(InData%PMM, kind=B8Ki)) - call RegPack(Buf, InData%PMM) - end if - call RegPack(Buf, allocated(InData%PITSAV)) - if (allocated(InData%PITSAV)) then - call RegPackBounds(Buf, 1, lbound(InData%PITSAV, kind=B8Ki), ubound(InData%PITSAV, kind=B8Ki)) - call RegPack(Buf, InData%PITSAV) - end if - call RegPack(Buf, allocated(InData%ReyNum)) - if (allocated(InData%ReyNum)) then - call RegPackBounds(Buf, 1, lbound(InData%ReyNum, kind=B8Ki), ubound(InData%ReyNum, kind=B8Ki)) - call RegPack(Buf, InData%ReyNum) - end if - call RegPack(Buf, allocated(InData%Gamma)) - if (allocated(InData%Gamma)) then - call RegPackBounds(Buf, 1, lbound(InData%Gamma, kind=B8Ki), ubound(InData%Gamma, kind=B8Ki)) - call RegPack(Buf, InData%Gamma) - end if - call RegPack(Buf, allocated(InData%SaveVX)) - if (allocated(InData%SaveVX)) then - call RegPackBounds(Buf, 2, lbound(InData%SaveVX, kind=B8Ki), ubound(InData%SaveVX, kind=B8Ki)) - call RegPack(Buf, InData%SaveVX) - end if - call RegPack(Buf, allocated(InData%SaveVY)) - if (allocated(InData%SaveVY)) then - call RegPackBounds(Buf, 2, lbound(InData%SaveVY, kind=B8Ki), ubound(InData%SaveVY, kind=B8Ki)) - call RegPack(Buf, InData%SaveVY) - end if - call RegPack(Buf, allocated(InData%SaveVZ)) - if (allocated(InData%SaveVZ)) then - call RegPackBounds(Buf, 2, lbound(InData%SaveVZ, kind=B8Ki), ubound(InData%SaveVZ, kind=B8Ki)) - call RegPack(Buf, InData%SaveVZ) - end if - call RegPack(Buf, InData%VXSAV) - call RegPack(Buf, InData%VYSAV) - call RegPack(Buf, InData%VZSAV) - call RegPack(Buf, InData%NumWndElOut) - call RegPack(Buf, allocated(InData%WndElPrList)) - if (allocated(InData%WndElPrList)) then - call RegPackBounds(Buf, 1, lbound(InData%WndElPrList, kind=B8Ki), ubound(InData%WndElPrList, kind=B8Ki)) - call RegPack(Buf, InData%WndElPrList) - end if - call RegPack(Buf, allocated(InData%WndElPrNum)) - if (allocated(InData%WndElPrNum)) then - call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum, kind=B8Ki), ubound(InData%WndElPrNum, kind=B8Ki)) - call RegPack(Buf, InData%WndElPrNum) - end if - call RegPack(Buf, allocated(InData%ElPrList)) - if (allocated(InData%ElPrList)) then - call RegPackBounds(Buf, 1, lbound(InData%ElPrList, kind=B8Ki), ubound(InData%ElPrList, kind=B8Ki)) - call RegPack(Buf, InData%ElPrList) - end if - call RegPack(Buf, allocated(InData%ElPrNum)) - if (allocated(InData%ElPrNum)) then - call RegPackBounds(Buf, 1, lbound(InData%ElPrNum, kind=B8Ki), ubound(InData%ElPrNum, kind=B8Ki)) - call RegPack(Buf, InData%ElPrNum) - end if - call RegPack(Buf, InData%NumElOut) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AAA) + call RegPackAlloc(RF, InData%AAP) + call RegPackAlloc(RF, InData%ALF) + call RegPackAlloc(RF, InData%CDD) + call RegPackAlloc(RF, InData%CLL) + call RegPackAlloc(RF, InData%CMM) + call RegPackAlloc(RF, InData%CNN) + call RegPackAlloc(RF, InData%CTT) + call RegPackAlloc(RF, InData%DFNSAV) + call RegPackAlloc(RF, InData%DFTSAV) + call RegPackAlloc(RF, InData%DynPres) + call RegPackAlloc(RF, InData%PMM) + call RegPackAlloc(RF, InData%PITSAV) + call RegPackAlloc(RF, InData%ReyNum) + call RegPackAlloc(RF, InData%Gamma) + call RegPackAlloc(RF, InData%SaveVX) + call RegPackAlloc(RF, InData%SaveVY) + call RegPackAlloc(RF, InData%SaveVZ) + call RegPack(RF, InData%VXSAV) + call RegPack(RF, InData%VYSAV) + call RegPack(RF, InData%VZSAV) + call RegPack(RF, InData%NumWndElOut) + call RegPackAlloc(RF, InData%WndElPrList) + call RegPackAlloc(RF, InData%WndElPrNum) + call RegPackAlloc(RF, InData%ElPrList) + call RegPackAlloc(RF, InData%ElPrNum) + call RegPack(RF, InData%NumElOut) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackElOutParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackElOutParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(ElOutParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackElOutParms' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AAA)) deallocate(OutData%AAA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AAA(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AAA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AAP)) deallocate(OutData%AAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AAP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ALF)) deallocate(OutData%ALF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ALF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ALF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CDD)) deallocate(OutData%CDD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CDD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CDD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CLL)) deallocate(OutData%CLL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CLL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CLL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CMM)) deallocate(OutData%CMM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CMM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CMM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CNN)) deallocate(OutData%CNN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CNN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CNN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CTT)) deallocate(OutData%CTT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CTT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CTT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DFNSAV)) deallocate(OutData%DFNSAV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DFNSAV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DFNSAV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DFTSAV)) deallocate(OutData%DFTSAV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DFTSAV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DFTSAV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DynPres)) deallocate(OutData%DynPres) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DynPres(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DynPres) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMM)) deallocate(OutData%PMM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PITSAV)) deallocate(OutData%PITSAV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PITSAV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PITSAV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ReyNum)) deallocate(OutData%ReyNum) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ReyNum(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ReyNum) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gamma(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gamma) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SaveVX)) deallocate(OutData%SaveVX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SaveVX(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SaveVX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SaveVY)) deallocate(OutData%SaveVY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SaveVY(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SaveVY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SaveVZ)) deallocate(OutData%SaveVZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SaveVZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SaveVZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%VXSAV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VYSAV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VZSAV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumWndElOut) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WndElPrList)) deallocate(OutData%WndElPrList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WndElPrList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WndElPrList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WndElPrNum)) deallocate(OutData%WndElPrNum) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WndElPrNum(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WndElPrNum) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ElPrList)) deallocate(OutData%ElPrList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElPrList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElPrList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElPrNum(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElPrNum) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumElOut) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AAA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ALF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CDD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CNN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CTT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DFNSAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DFTSAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DynPres); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PITSAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ReyNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gamma); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SaveVX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SaveVY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SaveVZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VXSAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VYSAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VZSAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumWndElOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WndElPrList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WndElPrNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElPrList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElPrNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumElOut); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyInducedVel(SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg) @@ -4644,22 +2914,21 @@ subroutine AD14_DestroyInducedVel(InducedVelData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackInducedVel(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackInducedVel(RF, Indata) + type(RegFile), intent(inout) :: RF type(InducedVel), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInducedVel' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%SumInFl) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SumInFl) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackInducedVel(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackInducedVel(RF, OutData) + type(RegFile), intent(inout) :: RF type(InducedVel), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInducedVel' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%SumInFl) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SumInFl); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyInducedVelParms(SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg) @@ -4689,40 +2958,33 @@ subroutine AD14_DestroyInducedVelParms(InducedVelParmsData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackInducedVelParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackInducedVelParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(InducedVelParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInducedVelParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AToler) - call RegPack(Buf, InData%EqAIDmult) - call RegPack(Buf, InData%EquilDA) - call RegPack(Buf, InData%EquilDT) - call RegPack(Buf, InData%TLoss) - call RegPack(Buf, InData%GTech) - call RegPack(Buf, InData%HLoss) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AToler) + call RegPack(RF, InData%EqAIDmult) + call RegPack(RF, InData%EquilDA) + call RegPack(RF, InData%EquilDT) + call RegPack(RF, InData%TLoss) + call RegPack(RF, InData%GTech) + call RegPack(RF, InData%HLoss) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackInducedVelParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackInducedVelParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(InducedVelParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInducedVelParms' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AToler) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EqAIDmult) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EquilDA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EquilDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GTech) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HLoss) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AToler); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EqAIDmult); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilDA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GTech); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HLoss); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyRotor(SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg) @@ -4754,46 +3016,37 @@ subroutine AD14_DestroyRotor(RotorData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackRotor(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackRotor(RF, Indata) + type(RegFile), intent(inout) :: RF type(Rotor), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackRotor' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AVGINFL) - call RegPack(Buf, InData%CTILT) - call RegPack(Buf, InData%CYaw) - call RegPack(Buf, InData%REVS) - call RegPack(Buf, InData%STILT) - call RegPack(Buf, InData%SYaw) - call RegPack(Buf, InData%TILT) - call RegPack(Buf, InData%YawAng) - call RegPack(Buf, InData%YawVEL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AVGINFL) + call RegPack(RF, InData%CTILT) + call RegPack(RF, InData%CYaw) + call RegPack(RF, InData%REVS) + call RegPack(RF, InData%STILT) + call RegPack(RF, InData%SYaw) + call RegPack(RF, InData%TILT) + call RegPack(RF, InData%YawAng) + call RegPack(RF, InData%YawVEL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackRotor(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackRotor(RF, OutData) + type(RegFile), intent(inout) :: RF type(Rotor), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackRotor' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AVGINFL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTILT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CYaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%REVS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STILT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SYaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TILT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawAng) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawVEL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AVGINFL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTILT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%REVS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STILT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TILT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawVEL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyRotorParms(SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg) @@ -4817,22 +3070,21 @@ subroutine AD14_DestroyRotorParms(RotorParmsData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackRotorParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackRotorParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(RotorParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackRotorParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%HH) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HH) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackRotorParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackRotorParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(RotorParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackRotorParms' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%HH) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HH); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg) @@ -4963,184 +3215,66 @@ subroutine AD14_DestroyTwrPropsParms(TwrPropsParmsData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackTwrPropsParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackTwrPropsParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(TwrPropsParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackTwrPropsParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%TwrHtFr)) - if (allocated(InData%TwrHtFr)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr, kind=B8Ki), ubound(InData%TwrHtFr, kind=B8Ki)) - call RegPack(Buf, InData%TwrHtFr) - end if - call RegPack(Buf, allocated(InData%TwrWid)) - if (allocated(InData%TwrWid)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrWid, kind=B8Ki), ubound(InData%TwrWid, kind=B8Ki)) - call RegPack(Buf, InData%TwrWid) - end if - call RegPack(Buf, allocated(InData%TwrCD)) - if (allocated(InData%TwrCD)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrCD, kind=B8Ki), ubound(InData%TwrCD, kind=B8Ki)) - call RegPack(Buf, InData%TwrCD) - end if - call RegPack(Buf, allocated(InData%TwrRe)) - if (allocated(InData%TwrRe)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrRe, kind=B8Ki), ubound(InData%TwrRe, kind=B8Ki)) - call RegPack(Buf, InData%TwrRe) - end if - call RegPack(Buf, InData%VTwr) - call RegPack(Buf, InData%Tower_Wake_Constant) - call RegPack(Buf, allocated(InData%NTwrCDCol)) - if (allocated(InData%NTwrCDCol)) then - call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol, kind=B8Ki), ubound(InData%NTwrCDCol, kind=B8Ki)) - call RegPack(Buf, InData%NTwrCDCol) - end if - call RegPack(Buf, InData%NTwrHT) - call RegPack(Buf, InData%NTwrRe) - call RegPack(Buf, InData%NTwrCD) - call RegPack(Buf, InData%TwrPotent) - call RegPack(Buf, InData%TwrShadow) - call RegPack(Buf, InData%ShadHWid) - call RegPack(Buf, InData%TShadC1) - call RegPack(Buf, InData%TShadC2) - call RegPack(Buf, InData%TwrShad) - call RegPack(Buf, InData%PJM_Version) - call RegPack(Buf, InData%TwrFile) - call RegPack(Buf, InData%T_Shad_Refpt) - call RegPack(Buf, InData%CalcTwrAero) - call RegPack(Buf, InData%NumTwrNodes) - call RegPack(Buf, allocated(InData%TwrNodeWidth)) - if (allocated(InData%TwrNodeWidth)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth, kind=B8Ki), ubound(InData%TwrNodeWidth, kind=B8Ki)) - call RegPack(Buf, InData%TwrNodeWidth) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%TwrHtFr) + call RegPackAlloc(RF, InData%TwrWid) + call RegPackAlloc(RF, InData%TwrCD) + call RegPackAlloc(RF, InData%TwrRe) + call RegPack(RF, InData%VTwr) + call RegPack(RF, InData%Tower_Wake_Constant) + call RegPackAlloc(RF, InData%NTwrCDCol) + call RegPack(RF, InData%NTwrHT) + call RegPack(RF, InData%NTwrRe) + call RegPack(RF, InData%NTwrCD) + call RegPack(RF, InData%TwrPotent) + call RegPack(RF, InData%TwrShadow) + call RegPack(RF, InData%ShadHWid) + call RegPack(RF, InData%TShadC1) + call RegPack(RF, InData%TShadC2) + call RegPack(RF, InData%TwrShad) + call RegPack(RF, InData%PJM_Version) + call RegPack(RF, InData%TwrFile) + call RegPack(RF, InData%T_Shad_Refpt) + call RegPack(RF, InData%CalcTwrAero) + call RegPack(RF, InData%NumTwrNodes) + call RegPackAlloc(RF, InData%TwrNodeWidth) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackTwrPropsParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackTwrPropsParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(TwrPropsParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackTwrPropsParms' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%TwrHtFr)) deallocate(OutData%TwrHtFr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrHtFr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrHtFr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrWid)) deallocate(OutData%TwrWid) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrWid(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrWid) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrCD)) deallocate(OutData%TwrCD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrCD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrCD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrRe)) deallocate(OutData%TwrRe) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrRe(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrRe) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%VTwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tower_Wake_Constant) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NTwrCDCol)) deallocate(OutData%NTwrCDCol) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NTwrCDCol(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NTwrCDCol) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NTwrHT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTwrRe) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTwrCD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrPotent) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrShadow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShadHWid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TShadC1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TShadC2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrShad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PJM_Version) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T_Shad_Refpt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CalcTwrAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTwrNodes) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TwrNodeWidth)) deallocate(OutData%TwrNodeWidth) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrNodeWidth(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrNodeWidth) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%TwrHtFr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrWid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tower_Wake_Constant); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NTwrCDCol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwrHT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwrRe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwrCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrPotent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShadow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShadHWid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TShadC1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TShadC2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrShad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PJM_Version); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T_Shad_Refpt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CalcTwrAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTwrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrNodeWidth); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyWind(SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg) @@ -5169,37 +3303,31 @@ subroutine AD14_DestroyWind(WindData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackWind(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackWind(RF, Indata) + type(RegFile), intent(inout) :: RF type(Wind), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackWind' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%ANGFLW) - call RegPack(Buf, InData%CDEL) - call RegPack(Buf, InData%VROTORX) - call RegPack(Buf, InData%VROTORY) - call RegPack(Buf, InData%VROTORZ) - call RegPack(Buf, InData%SDEL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ANGFLW) + call RegPack(RF, InData%CDEL) + call RegPack(RF, InData%VROTORX) + call RegPack(RF, InData%VROTORY) + call RegPack(RF, InData%VROTORZ) + call RegPack(RF, InData%SDEL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackWind(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackWind(RF, OutData) + type(RegFile), intent(inout) :: RF type(Wind), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackWind' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%ANGFLW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CDEL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VROTORX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VROTORY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VROTORZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SDEL) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ANGFLW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CDEL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VROTORX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VROTORY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VROTORZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SDEL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyWindParms(SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg) @@ -5224,25 +3352,23 @@ subroutine AD14_DestroyWindParms(WindParmsData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackWindParms(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackWindParms(RF, Indata) + type(RegFile), intent(inout) :: RF type(WindParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackWindParms' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Rho) - call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Rho) + call RegPack(RF, InData%KinVisc) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackWindParms(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackWindParms(RF, OutData) + type(RegFile), intent(inout) :: RF type(WindParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackWindParms' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Rho) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyPositionType(SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg) @@ -5266,22 +3392,21 @@ subroutine AD14_DestroyPositionType(PositionTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackPositionType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackPositionType(RF, Indata) + type(RegFile), intent(inout) :: RF type(PositionType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackPositionType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Pos) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Pos) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackPositionType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackPositionType(RF, OutData) + type(RegFile), intent(inout) :: RF type(PositionType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackPositionType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Pos) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Pos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyOrientationType(SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg) @@ -5305,22 +3430,21 @@ subroutine AD14_DestroyOrientationType(OrientationTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine AD14_PackOrientationType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackOrientationType(RF, Indata) + type(RegFile), intent(inout) :: RF type(OrientationType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackOrientationType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Orient) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Orient) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackOrientationType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackOrientationType(RF, OutData) + type(RegFile), intent(inout) :: RF type(OrientationType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackOrientationType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Orient) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Orient); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -5383,75 +3507,48 @@ subroutine AD14_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Title) - call RegPack(Buf, InData%OutRootName) - call RegPack(Buf, InData%ADFileName) - call RegPack(Buf, InData%WrSumFile) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, InData%BladeLength) - call RegPack(Buf, InData%LinearizeFlag) - call RegPack(Buf, InData%UseDWM) - call AD14_PackAeroConfig(Buf, InData%TurbineComponents) - call RegPack(Buf, InData%NumTwrNodes) - call RegPack(Buf, allocated(InData%TwrNodeLocs)) - if (allocated(InData%TwrNodeLocs)) then - call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs, kind=B8Ki), ubound(InData%TwrNodeLocs, kind=B8Ki)) - call RegPack(Buf, InData%TwrNodeLocs) - end if - call RegPack(Buf, InData%HubHt) - call DWM_PackInitInput(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Title) + call RegPack(RF, InData%OutRootName) + call RegPack(RF, InData%ADFileName) + call RegPack(RF, InData%WrSumFile) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%LinearizeFlag) + call RegPack(RF, InData%UseDWM) + call AD14_PackAeroConfig(RF, InData%TurbineComponents) + call RegPack(RF, InData%NumTwrNodes) + call RegPackAlloc(RF, InData%TwrNodeLocs) + call RegPack(RF, InData%HubHt) + call DWM_PackInitInput(RF, InData%DWM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInitInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Title) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ADFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrSumFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinearizeFlag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseDWM) - if (RegCheckErr(Buf, RoutineName)) return - call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents - call RegUnpack(Buf, OutData%NumTwrNodes) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TwrNodeLocs)) deallocate(OutData%TwrNodeLocs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrNodeLocs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrNodeLocs) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return - call DWM_UnpackInitInput(Buf, OutData%DWM) ! DWM + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Title); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ADFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrSumFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinearizeFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return + call AD14_UnpackAeroConfig(RF, OutData%TurbineComponents) ! TurbineComponents + call RegUnpack(RF, OutData%NumTwrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrNodeLocs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call DWM_UnpackInitInput(RF, OutData%DWM) ! DWM end subroutine subroutine AD14_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -5489,26 +3586,25 @@ subroutine AD14_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call DWM_PackInitOutput(Buf, InData%DWM) - call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call DWM_PackInitOutput(RF, InData%DWM) + call RegPack(RF, InData%AirDens) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call DWM_UnpackInitOutput(Buf, OutData%DWM) ! DWM - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call DWM_UnpackInitOutput(RF, OutData%DWM) ! DWM + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -5540,21 +3636,21 @@ subroutine AD14_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call DWM_PackContState(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call DWM_PackContState(RF, InData%DWM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call DWM_UnpackContState(Buf, OutData%DWM) ! DWM + if (RF%ErrStat /= ErrID_None) return + call DWM_UnpackContState(RF, OutData%DWM) ! DWM end subroutine subroutine AD14_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -5586,21 +3682,21 @@ subroutine AD14_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call DWM_PackDiscState(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call DWM_PackDiscState(RF, InData%DWM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call DWM_UnpackDiscState(Buf, OutData%DWM) ! DWM + if (RF%ErrStat /= ErrID_None) return + call DWM_UnpackDiscState(RF, OutData%DWM) ! DWM end subroutine subroutine AD14_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -5632,21 +3728,21 @@ subroutine AD14_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call DWM_PackConstrState(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call DWM_PackConstrState(RF, InData%DWM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call DWM_UnpackConstrState(Buf, OutData%DWM) ! DWM + if (RF%ErrStat /= ErrID_None) return + call DWM_UnpackConstrState(RF, OutData%DWM) ! DWM end subroutine subroutine AD14_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -5678,21 +3774,21 @@ subroutine AD14_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call DWM_PackOtherState(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call DWM_PackOtherState(RF, InData%DWM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call DWM_UnpackOtherState(Buf, OutData%DWM) ! DWM + if (RF%ErrStat /= ErrID_None) return + call DWM_UnpackOtherState(RF, OutData%DWM) ! DWM end subroutine subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -5836,149 +3932,82 @@ subroutine AD14_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call DWM_PackMisc(Buf, InData%DWM) - call DWM_PackInput(Buf, InData%DWM_Inputs) - call DWM_PackOutput(Buf, InData%DWM_Outputs) - call RegPack(Buf, InData%DT) - call RegPack(Buf, allocated(InData%ElPrNum)) - if (allocated(InData%ElPrNum)) then - call RegPackBounds(Buf, 1, lbound(InData%ElPrNum, kind=B8Ki), ubound(InData%ElPrNum, kind=B8Ki)) - call RegPack(Buf, InData%ElPrNum) - end if - call RegPack(Buf, InData%OldTime) - call RegPack(Buf, InData%HubLoss) - call RegPack(Buf, InData%Loss) - call RegPack(Buf, InData%TipLoss) - call RegPack(Buf, InData%TLpt7) - call RegPack(Buf, InData%FirstPassGTL) - call RegPack(Buf, InData%SuperSonic) - call RegPack(Buf, InData%AFLAGVinderr) - call RegPack(Buf, InData%AFLAGTwrInflu) - call RegPack(Buf, InData%OnePassDynDbg) - call RegPack(Buf, InData%NoLoadsCalculated) - call RegPack(Buf, InData%NERRORS) - call AD14_PackAirFoil(Buf, InData%AirFoil) - call AD14_PackBeddoes(Buf, InData%Beddoes) - call AD14_PackDynInflow(Buf, InData%DynInflow) - call AD14_PackElement(Buf, InData%Element) - call AD14_PackRotor(Buf, InData%Rotor) - call AD14_PackWind(Buf, InData%Wind) - call AD14_PackInducedVel(Buf, InData%InducedVel) - call AD14_PackElOutParms(Buf, InData%ElOut) - call RegPack(Buf, InData%Skew) - call RegPack(Buf, InData%DynInit) - call RegPack(Buf, InData%FirstWarn) - call RegPack(Buf, allocated(InData%StoredForces)) - if (allocated(InData%StoredForces)) then - call RegPackBounds(Buf, 3, lbound(InData%StoredForces, kind=B8Ki), ubound(InData%StoredForces, kind=B8Ki)) - call RegPack(Buf, InData%StoredForces) - end if - call RegPack(Buf, allocated(InData%StoredMoments)) - if (allocated(InData%StoredMoments)) then - call RegPackBounds(Buf, 3, lbound(InData%StoredMoments, kind=B8Ki), ubound(InData%StoredMoments, kind=B8Ki)) - call RegPack(Buf, InData%StoredMoments) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call DWM_PackMisc(RF, InData%DWM) + call DWM_PackInput(RF, InData%DWM_Inputs) + call DWM_PackOutput(RF, InData%DWM_Outputs) + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%ElPrNum) + call RegPack(RF, InData%OldTime) + call RegPack(RF, InData%HubLoss) + call RegPack(RF, InData%Loss) + call RegPack(RF, InData%TipLoss) + call RegPack(RF, InData%TLpt7) + call RegPack(RF, InData%FirstPassGTL) + call RegPack(RF, InData%SuperSonic) + call RegPack(RF, InData%AFLAGVinderr) + call RegPack(RF, InData%AFLAGTwrInflu) + call RegPack(RF, InData%OnePassDynDbg) + call RegPack(RF, InData%NoLoadsCalculated) + call RegPack(RF, InData%NERRORS) + call AD14_PackAirFoil(RF, InData%AirFoil) + call AD14_PackBeddoes(RF, InData%Beddoes) + call AD14_PackDynInflow(RF, InData%DynInflow) + call AD14_PackElement(RF, InData%Element) + call AD14_PackRotor(RF, InData%Rotor) + call AD14_PackWind(RF, InData%Wind) + call AD14_PackInducedVel(RF, InData%InducedVel) + call AD14_PackElOutParms(RF, InData%ElOut) + call RegPack(RF, InData%Skew) + call RegPack(RF, InData%DynInit) + call RegPack(RF, InData%FirstWarn) + call RegPackAlloc(RF, InData%StoredForces) + call RegPackAlloc(RF, InData%StoredMoments) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackMisc' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call DWM_UnpackMisc(Buf, OutData%DWM) ! DWM - call DWM_UnpackInput(Buf, OutData%DWM_Inputs) ! DWM_Inputs - call DWM_UnpackOutput(Buf, OutData%DWM_Outputs) ! DWM_Outputs - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElPrNum(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElPrNum) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%OldTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Loss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TipLoss) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TLpt7) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstPassGTL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SuperSonic) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AFLAGVinderr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AFLAGTwrInflu) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OnePassDynDbg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NoLoadsCalculated) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NERRORS) - if (RegCheckErr(Buf, RoutineName)) return - call AD14_UnpackAirFoil(Buf, OutData%AirFoil) ! AirFoil - call AD14_UnpackBeddoes(Buf, OutData%Beddoes) ! Beddoes - call AD14_UnpackDynInflow(Buf, OutData%DynInflow) ! DynInflow - call AD14_UnpackElement(Buf, OutData%Element) ! Element - call AD14_UnpackRotor(Buf, OutData%Rotor) ! Rotor - call AD14_UnpackWind(Buf, OutData%Wind) ! Wind - call AD14_UnpackInducedVel(Buf, OutData%InducedVel) ! InducedVel - call AD14_UnpackElOutParms(Buf, OutData%ElOut) ! ElOut - call RegUnpack(Buf, OutData%Skew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DynInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstWarn) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%StoredForces)) deallocate(OutData%StoredForces) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StoredForces(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StoredForces) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StoredMoments)) deallocate(OutData%StoredMoments) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StoredMoments(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StoredMoments) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call DWM_UnpackMisc(RF, OutData%DWM) ! DWM + call DWM_UnpackInput(RF, OutData%DWM_Inputs) ! DWM_Inputs + call DWM_UnpackOutput(RF, OutData%DWM_Outputs) ! DWM_Outputs + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElPrNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OldTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Loss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipLoss); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TLpt7); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstPassGTL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SuperSonic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFLAGVinderr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AFLAGTwrInflu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OnePassDynDbg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NoLoadsCalculated); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NERRORS); if (RegCheckErr(RF, RoutineName)) return + call AD14_UnpackAirFoil(RF, OutData%AirFoil) ! AirFoil + call AD14_UnpackBeddoes(RF, OutData%Beddoes) ! Beddoes + call AD14_UnpackDynInflow(RF, OutData%DynInflow) ! DynInflow + call AD14_UnpackElement(RF, OutData%Element) ! Element + call AD14_UnpackRotor(RF, OutData%Rotor) ! Rotor + call AD14_UnpackWind(RF, OutData%Wind) ! Wind + call AD14_UnpackInducedVel(RF, OutData%InducedVel) ! InducedVel + call AD14_UnpackElOutParms(RF, OutData%ElOut) ! ElOut + call RegUnpack(RF, OutData%Skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DynInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StoredForces); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StoredMoments); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -6080,114 +4109,89 @@ subroutine AD14_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Title) - call RegPack(Buf, InData%SIUnit) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%MultiTab) - call RegPack(Buf, InData%LinearizeFlag) - call RegPack(Buf, InData%OutputPlottingInfo) - call RegPack(Buf, InData%UseDWM) - call RegPack(Buf, InData%TwoPiNB) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, InData%NBlInpSt) - call RegPack(Buf, InData%ElemPrn) - call RegPack(Buf, InData%DStall) - call RegPack(Buf, InData%PMoment) - call RegPack(Buf, InData%Reynolds) - call RegPack(Buf, InData%DynInfl) - call RegPack(Buf, InData%Wake) - call RegPack(Buf, InData%Swirl) - call RegPack(Buf, InData%DtAero) - call RegPack(Buf, InData%HubRad) - call RegPack(Buf, InData%UnEc) - call RegPack(Buf, InData%UnElem) - call RegPack(Buf, InData%UnWndOut) - call RegPack(Buf, InData%MAXICOUNT) - call RegPack(Buf, InData%WrOptFile) - call RegPack(Buf, InData%DEFAULT_Wind) - call AD14_PackAirFoilParms(Buf, InData%AirFoil) - call AD14_PackBladeParms(Buf, InData%Blade) - call AD14_PackBeddoesParms(Buf, InData%Beddoes) - call AD14_PackDynInflowParms(Buf, InData%DynInflow) - call AD14_PackElementParms(Buf, InData%Element) - call AD14_PackTwrPropsParms(Buf, InData%TwrProps) - call AD14_PackInducedVelParms(Buf, InData%InducedVel) - call AD14_PackWindParms(Buf, InData%Wind) - call AD14_PackRotorParms(Buf, InData%Rotor) - call DWM_PackParam(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Title) + call RegPack(RF, InData%SIUnit) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%MultiTab) + call RegPack(RF, InData%LinearizeFlag) + call RegPack(RF, InData%OutputPlottingInfo) + call RegPack(RF, InData%UseDWM) + call RegPack(RF, InData%TwoPiNB) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NBlInpSt) + call RegPack(RF, InData%ElemPrn) + call RegPack(RF, InData%DStall) + call RegPack(RF, InData%PMoment) + call RegPack(RF, InData%Reynolds) + call RegPack(RF, InData%DynInfl) + call RegPack(RF, InData%Wake) + call RegPack(RF, InData%Swirl) + call RegPack(RF, InData%DtAero) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%UnEc) + call RegPack(RF, InData%UnElem) + call RegPack(RF, InData%UnWndOut) + call RegPack(RF, InData%MAXICOUNT) + call RegPack(RF, InData%WrOptFile) + call RegPack(RF, InData%DEFAULT_Wind) + call AD14_PackAirFoilParms(RF, InData%AirFoil) + call AD14_PackBladeParms(RF, InData%Blade) + call AD14_PackBeddoesParms(RF, InData%Beddoes) + call AD14_PackDynInflowParms(RF, InData%DynInflow) + call AD14_PackElementParms(RF, InData%Element) + call AD14_PackTwrPropsParms(RF, InData%TwrProps) + call AD14_PackInducedVelParms(RF, InData%InducedVel) + call AD14_PackWindParms(RF, InData%Wind) + call AD14_PackRotorParms(RF, InData%Rotor) + call DWM_PackParam(RF, InData%DWM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackParam' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Title) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIUnit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MultiTab) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinearizeFlag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutputPlottingInfo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseDWM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwoPiNB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBlInpSt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElemPrn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DStall) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PMoment) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Reynolds) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DynInfl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Wake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Swirl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DtAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnEc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnElem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnWndOut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MAXICOUNT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrOptFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DEFAULT_Wind) - if (RegCheckErr(Buf, RoutineName)) return - call AD14_UnpackAirFoilParms(Buf, OutData%AirFoil) ! AirFoil - call AD14_UnpackBladeParms(Buf, OutData%Blade) ! Blade - call AD14_UnpackBeddoesParms(Buf, OutData%Beddoes) ! Beddoes - call AD14_UnpackDynInflowParms(Buf, OutData%DynInflow) ! DynInflow - call AD14_UnpackElementParms(Buf, OutData%Element) ! Element - call AD14_UnpackTwrPropsParms(Buf, OutData%TwrProps) ! TwrProps - call AD14_UnpackInducedVelParms(Buf, OutData%InducedVel) ! InducedVel - call AD14_UnpackWindParms(Buf, OutData%Wind) ! Wind - call AD14_UnpackRotorParms(Buf, OutData%Rotor) ! Rotor - call DWM_UnpackParam(Buf, OutData%DWM) ! DWM + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Title); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIUnit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MultiTab); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinearizeFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutputPlottingInfo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwoPiNB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElemPrn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DStall); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Reynolds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DynInfl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Swirl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DtAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnEc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnElem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnWndOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MAXICOUNT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrOptFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DEFAULT_Wind); if (RegCheckErr(RF, RoutineName)) return + call AD14_UnpackAirFoilParms(RF, OutData%AirFoil) ! AirFoil + call AD14_UnpackBladeParms(RF, OutData%Blade) ! Blade + call AD14_UnpackBeddoesParms(RF, OutData%Beddoes) ! Beddoes + call AD14_UnpackDynInflowParms(RF, OutData%DynInflow) ! DynInflow + call AD14_UnpackElementParms(RF, OutData%Element) ! Element + call AD14_UnpackTwrPropsParms(RF, OutData%TwrProps) ! TwrProps + call AD14_UnpackInducedVelParms(RF, OutData%InducedVel) ! InducedVel + call AD14_UnpackWindParms(RF, OutData%Wind) ! Wind + call AD14_UnpackRotorParms(RF, OutData%Rotor) ! Rotor + call DWM_UnpackParam(RF, OutData%DWM) ! DWM end subroutine subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -6284,94 +4288,57 @@ subroutine AD14_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine AD14_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%InputMarkers)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%InputMarkers)) if (allocated(InData%InputMarkers)) then - call RegPackBounds(Buf, 1, lbound(InData%InputMarkers, kind=B8Ki), ubound(InData%InputMarkers, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%InputMarkers, kind=B8Ki), ubound(InData%InputMarkers, kind=B8Ki)) LB(1:1) = lbound(InData%InputMarkers, kind=B8Ki) UB(1:1) = ubound(InData%InputMarkers, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%InputMarkers(i1)) + call MeshPack(RF, InData%InputMarkers(i1)) end do end if - call MeshPack(Buf, InData%Twr_InputMarkers) - call AD14_PackAeroConfig(Buf, InData%TurbineComponents) - call RegPack(Buf, allocated(InData%MulTabLoc)) - if (allocated(InData%MulTabLoc)) then - call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc, kind=B8Ki), ubound(InData%MulTabLoc, kind=B8Ki)) - call RegPack(Buf, InData%MulTabLoc) - end if - call RegPack(Buf, allocated(InData%InflowVelocity)) - if (allocated(InData%InflowVelocity)) then - call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity, kind=B8Ki), ubound(InData%InflowVelocity, kind=B8Ki)) - call RegPack(Buf, InData%InflowVelocity) - end if - call RegPack(Buf, InData%AvgInfVel) - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%Twr_InputMarkers) + call AD14_PackAeroConfig(RF, InData%TurbineComponents) + call RegPackAlloc(RF, InData%MulTabLoc) + call RegPackAlloc(RF, InData%InflowVelocity) + call RegPack(RF, InData%AvgInfVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%InputMarkers)) deallocate(OutData%InputMarkers) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%InputMarkers(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%InputMarkers(i1)) ! InputMarkers + call MeshUnpack(RF, OutData%InputMarkers(i1)) ! InputMarkers end do end if - call MeshUnpack(Buf, OutData%Twr_InputMarkers) ! Twr_InputMarkers - call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents - if (allocated(OutData%MulTabLoc)) deallocate(OutData%MulTabLoc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MulTabLoc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MulTabLoc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InflowVelocity)) deallocate(OutData%InflowVelocity) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InflowVelocity(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InflowVelocity) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AvgInfVel) - if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(RF, OutData%Twr_InputMarkers) ! Twr_InputMarkers + call AD14_UnpackAeroConfig(RF, OutData%TurbineComponents) ! TurbineComponents + call RegUnpackAlloc(RF, OutData%MulTabLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InflowVelocity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgInfVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD14_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -6432,51 +4399,49 @@ subroutine AD14_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD14_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AD14_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%OutputLoads)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%OutputLoads)) if (allocated(InData%OutputLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%OutputLoads, kind=B8Ki), ubound(InData%OutputLoads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutputLoads, kind=B8Ki), ubound(InData%OutputLoads, kind=B8Ki)) LB(1:1) = lbound(InData%OutputLoads, kind=B8Ki) UB(1:1) = ubound(InData%OutputLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%OutputLoads(i1)) + call MeshPack(RF, InData%OutputLoads(i1)) end do end if - call MeshPack(Buf, InData%Twr_OutputLoads) - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%Twr_OutputLoads) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD14_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AD14_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AD14_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%OutputLoads)) deallocate(OutData%OutputLoads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutputLoads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%OutputLoads(i1)) ! OutputLoads + call MeshUnpack(RF, OutData%OutputLoads(i1)) ! OutputLoads end do end if - call MeshUnpack(Buf, OutData%Twr_OutputLoads) ! Twr_OutputLoads + call MeshUnpack(RF, OutData%Twr_OutputLoads) ! Twr_OutputLoads end subroutine subroutine AD14_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index c9756e1f5b..9b729c5e33 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -350,28 +350,25 @@ subroutine DWM_DestroyCVSD(CVSDData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DWM_PackCVSD(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackCVSD(RF, Indata) + type(RegFile), intent(inout) :: RF type(CVSD), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackCVSD' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%counter) - call RegPack(Buf, InData%Denominator) - call RegPack(Buf, InData%Numerator) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%counter) + call RegPack(RF, InData%Denominator) + call RegPack(RF, InData%Numerator) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackCVSD(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackCVSD(RF, OutData) + type(RegFile), intent(inout) :: RF type(CVSD), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackCVSD' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%counter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Denominator) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Numerator) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%counter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Denominator); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Numerator); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg) @@ -459,107 +456,36 @@ subroutine DWM_Destroyturbine_average_velocity_data(turbine_average_velocity_dat end if end subroutine -subroutine DWM_Packturbine_average_velocity_data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_Packturbine_average_velocity_data(RF, Indata) + type(RegFile), intent(inout) :: RF type(turbine_average_velocity_data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packturbine_average_velocity_data' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%average_velocity_array_temp)) - if (allocated(InData%average_velocity_array_temp)) then - call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp, kind=B8Ki), ubound(InData%average_velocity_array_temp, kind=B8Ki)) - call RegPack(Buf, InData%average_velocity_array_temp) - end if - call RegPack(Buf, allocated(InData%average_velocity_array)) - if (allocated(InData%average_velocity_array)) then - call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array, kind=B8Ki), ubound(InData%average_velocity_array, kind=B8Ki)) - call RegPack(Buf, InData%average_velocity_array) - end if - call RegPack(Buf, allocated(InData%swept_area)) - if (allocated(InData%swept_area)) then - call RegPackBounds(Buf, 1, lbound(InData%swept_area, kind=B8Ki), ubound(InData%swept_area, kind=B8Ki)) - call RegPack(Buf, InData%swept_area) - end if - call RegPack(Buf, InData%time_step_velocity) - call RegPack(Buf, allocated(InData%time_step_velocity_array)) - if (allocated(InData%time_step_velocity_array)) then - call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array, kind=B8Ki), ubound(InData%time_step_velocity_array, kind=B8Ki)) - call RegPack(Buf, InData%time_step_velocity_array) - end if - call RegPack(Buf, InData%time_step_pass_velocity) - call RegPack(Buf, InData%time_step_force) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%average_velocity_array_temp) + call RegPackAlloc(RF, InData%average_velocity_array) + call RegPackAlloc(RF, InData%swept_area) + call RegPack(RF, InData%time_step_velocity) + call RegPackAlloc(RF, InData%time_step_velocity_array) + call RegPack(RF, InData%time_step_pass_velocity) + call RegPack(RF, InData%time_step_force) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackturbine_average_velocity_data(RF, OutData) + type(RegFile), intent(inout) :: RF type(turbine_average_velocity_data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackturbine_average_velocity_data' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%average_velocity_array_temp)) deallocate(OutData%average_velocity_array_temp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%average_velocity_array_temp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%average_velocity_array_temp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%average_velocity_array)) deallocate(OutData%average_velocity_array) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%average_velocity_array(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%average_velocity_array) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%swept_area)) deallocate(OutData%swept_area) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%swept_area(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%swept_area) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%time_step_velocity) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%time_step_velocity_array)) deallocate(OutData%time_step_velocity_array) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%time_step_velocity_array(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%time_step_velocity_array) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%time_step_pass_velocity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%time_step_force) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%average_velocity_array_temp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%average_velocity_array); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%swept_area); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time_step_velocity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%time_step_velocity_array); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time_step_pass_velocity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time_step_force); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyWake_Deficit_Data(SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg) @@ -604,56 +530,34 @@ subroutine DWM_DestroyWake_Deficit_Data(Wake_Deficit_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine DWM_PackWake_Deficit_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackWake_Deficit_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_Wake_Deficit_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackWake_Deficit_Data' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%np_x) - call RegPack(Buf, InData%X_length) - call RegPack(Buf, allocated(InData%Turb_Stress_DWM)) - if (allocated(InData%Turb_Stress_DWM)) then - call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM, kind=B8Ki), ubound(InData%Turb_Stress_DWM, kind=B8Ki)) - call RegPack(Buf, InData%Turb_Stress_DWM) - end if - call RegPack(Buf, InData%n_x_vector) - call RegPack(Buf, InData%n_r_vector) - call RegPack(Buf, InData%ppR) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackWake_Deficit_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%np_x) + call RegPack(RF, InData%X_length) + call RegPackAlloc(RF, InData%Turb_Stress_DWM) + call RegPack(RF, InData%n_x_vector) + call RegPack(RF, InData%n_r_vector) + call RegPack(RF, InData%ppR) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackWake_Deficit_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_Wake_Deficit_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackWake_Deficit_Data' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%np_x) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X_length) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Turb_Stress_DWM)) deallocate(OutData%Turb_Stress_DWM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Turb_Stress_DWM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Turb_Stress_DWM) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%n_x_vector) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_r_vector) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ppR) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%np_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_length); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Turb_Stress_DWM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_x_vector); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_r_vector); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ppR); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyMeanderData(SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg) @@ -678,25 +582,23 @@ subroutine DWM_DestroyMeanderData(MeanderDataData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DWM_PackMeanderData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackMeanderData(RF, Indata) + type(RegFile), intent(inout) :: RF type(MeanderData), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackMeanderData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%scale_factor) - call RegPack(Buf, InData%moving_time) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%scale_factor) + call RegPack(RF, InData%moving_time) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackMeanderData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackMeanderData(RF, OutData) + type(RegFile), intent(inout) :: RF type(MeanderData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackMeanderData' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%scale_factor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%moving_time) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%scale_factor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%moving_time); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg) @@ -965,338 +867,62 @@ subroutine DWM_Destroyread_turbine_position_data(read_turbine_position_dataData, end if end subroutine -subroutine DWM_Packread_turbine_position_data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_Packread_turbine_position_data(RF, Indata) + type(RegFile), intent(inout) :: RF type(read_turbine_position_data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packread_turbine_position_data' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%SimulationOrder_index) - call RegPack(Buf, allocated(InData%Turbine_sort_order)) - if (allocated(InData%Turbine_sort_order)) then - call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order, kind=B8Ki), ubound(InData%Turbine_sort_order, kind=B8Ki)) - call RegPack(Buf, InData%Turbine_sort_order) - end if - call RegPack(Buf, InData%WT_index) - call RegPack(Buf, allocated(InData%TurbineInfluenceData)) - if (allocated(InData%TurbineInfluenceData)) then - call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData, kind=B8Ki), ubound(InData%TurbineInfluenceData, kind=B8Ki)) - call RegPack(Buf, InData%TurbineInfluenceData) - end if - call RegPack(Buf, allocated(InData%upwind_turbine_index)) - if (allocated(InData%upwind_turbine_index)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index, kind=B8Ki), ubound(InData%upwind_turbine_index, kind=B8Ki)) - call RegPack(Buf, InData%upwind_turbine_index) - end if - call RegPack(Buf, allocated(InData%downwind_turbine_index)) - if (allocated(InData%downwind_turbine_index)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index, kind=B8Ki), ubound(InData%downwind_turbine_index, kind=B8Ki)) - call RegPack(Buf, InData%downwind_turbine_index) - end if - call RegPack(Buf, InData%upwindturbine_number) - call RegPack(Buf, InData%downwindturbine_number) - call RegPack(Buf, allocated(InData%turbine_windorigin_length)) - if (allocated(InData%turbine_windorigin_length)) then - call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length, kind=B8Ki), ubound(InData%turbine_windorigin_length, kind=B8Ki)) - call RegPack(Buf, InData%turbine_windorigin_length) - end if - call RegPack(Buf, allocated(InData%upwind_turbine_projected_distance)) - if (allocated(InData%upwind_turbine_projected_distance)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance, kind=B8Ki), ubound(InData%upwind_turbine_projected_distance, kind=B8Ki)) - call RegPack(Buf, InData%upwind_turbine_projected_distance) - end if - call RegPack(Buf, allocated(InData%downwind_turbine_projected_distance)) - if (allocated(InData%downwind_turbine_projected_distance)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance, kind=B8Ki), ubound(InData%downwind_turbine_projected_distance, kind=B8Ki)) - call RegPack(Buf, InData%downwind_turbine_projected_distance) - end if - call RegPack(Buf, allocated(InData%turbine_angle)) - if (allocated(InData%turbine_angle)) then - call RegPackBounds(Buf, 2, lbound(InData%turbine_angle, kind=B8Ki), ubound(InData%turbine_angle, kind=B8Ki)) - call RegPack(Buf, InData%turbine_angle) - end if - call RegPack(Buf, allocated(InData%upwind_align_angle)) - if (allocated(InData%upwind_align_angle)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle, kind=B8Ki), ubound(InData%upwind_align_angle, kind=B8Ki)) - call RegPack(Buf, InData%upwind_align_angle) - end if - call RegPack(Buf, allocated(InData%downwind_align_angle)) - if (allocated(InData%downwind_align_angle)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle, kind=B8Ki), ubound(InData%downwind_align_angle, kind=B8Ki)) - call RegPack(Buf, InData%downwind_align_angle) - end if - call RegPack(Buf, allocated(InData%upwind_turbine_Xcoor)) - if (allocated(InData%upwind_turbine_Xcoor)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor, kind=B8Ki), ubound(InData%upwind_turbine_Xcoor, kind=B8Ki)) - call RegPack(Buf, InData%upwind_turbine_Xcoor) - end if - call RegPack(Buf, allocated(InData%upwind_turbine_Ycoor)) - if (allocated(InData%upwind_turbine_Ycoor)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor, kind=B8Ki), ubound(InData%upwind_turbine_Ycoor, kind=B8Ki)) - call RegPack(Buf, InData%upwind_turbine_Ycoor) - end if - call RegPack(Buf, allocated(InData%wind_farm_Xcoor)) - if (allocated(InData%wind_farm_Xcoor)) then - call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor, kind=B8Ki), ubound(InData%wind_farm_Xcoor, kind=B8Ki)) - call RegPack(Buf, InData%wind_farm_Xcoor) - end if - call RegPack(Buf, allocated(InData%wind_farm_Ycoor)) - if (allocated(InData%wind_farm_Ycoor)) then - call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor, kind=B8Ki), ubound(InData%wind_farm_Ycoor, kind=B8Ki)) - call RegPack(Buf, InData%wind_farm_Ycoor) - end if - call RegPack(Buf, allocated(InData%downwind_turbine_Xcoor)) - if (allocated(InData%downwind_turbine_Xcoor)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor, kind=B8Ki), ubound(InData%downwind_turbine_Xcoor, kind=B8Ki)) - call RegPack(Buf, InData%downwind_turbine_Xcoor) - end if - call RegPack(Buf, allocated(InData%downwind_turbine_Ycoor)) - if (allocated(InData%downwind_turbine_Ycoor)) then - call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor, kind=B8Ki), ubound(InData%downwind_turbine_Ycoor, kind=B8Ki)) - call RegPack(Buf, InData%downwind_turbine_Ycoor) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SimulationOrder_index) + call RegPackAlloc(RF, InData%Turbine_sort_order) + call RegPack(RF, InData%WT_index) + call RegPackAlloc(RF, InData%TurbineInfluenceData) + call RegPackAlloc(RF, InData%upwind_turbine_index) + call RegPackAlloc(RF, InData%downwind_turbine_index) + call RegPack(RF, InData%upwindturbine_number) + call RegPack(RF, InData%downwindturbine_number) + call RegPackAlloc(RF, InData%turbine_windorigin_length) + call RegPackAlloc(RF, InData%upwind_turbine_projected_distance) + call RegPackAlloc(RF, InData%downwind_turbine_projected_distance) + call RegPackAlloc(RF, InData%turbine_angle) + call RegPackAlloc(RF, InData%upwind_align_angle) + call RegPackAlloc(RF, InData%downwind_align_angle) + call RegPackAlloc(RF, InData%upwind_turbine_Xcoor) + call RegPackAlloc(RF, InData%upwind_turbine_Ycoor) + call RegPackAlloc(RF, InData%wind_farm_Xcoor) + call RegPackAlloc(RF, InData%wind_farm_Ycoor) + call RegPackAlloc(RF, InData%downwind_turbine_Xcoor) + call RegPackAlloc(RF, InData%downwind_turbine_Ycoor) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackread_turbine_position_data(RF, OutData) + type(RegFile), intent(inout) :: RF type(read_turbine_position_data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackread_turbine_position_data' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%SimulationOrder_index) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Turbine_sort_order)) deallocate(OutData%Turbine_sort_order) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Turbine_sort_order(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Turbine_sort_order) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WT_index) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TurbineInfluenceData)) deallocate(OutData%TurbineInfluenceData) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TurbineInfluenceData(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TurbineInfluenceData) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_turbine_index)) deallocate(OutData%upwind_turbine_index) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_turbine_index(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_turbine_index) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%downwind_turbine_index)) deallocate(OutData%downwind_turbine_index) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%downwind_turbine_index(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%downwind_turbine_index) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%upwindturbine_number) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%downwindturbine_number) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%turbine_windorigin_length)) deallocate(OutData%turbine_windorigin_length) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%turbine_windorigin_length(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%turbine_windorigin_length) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_turbine_projected_distance)) deallocate(OutData%upwind_turbine_projected_distance) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_turbine_projected_distance(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_turbine_projected_distance) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%downwind_turbine_projected_distance)) deallocate(OutData%downwind_turbine_projected_distance) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%downwind_turbine_projected_distance(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%downwind_turbine_projected_distance) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%turbine_angle)) deallocate(OutData%turbine_angle) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%turbine_angle(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%turbine_angle) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_align_angle)) deallocate(OutData%upwind_align_angle) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_align_angle(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_align_angle) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%downwind_align_angle)) deallocate(OutData%downwind_align_angle) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%downwind_align_angle(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%downwind_align_angle) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_turbine_Xcoor)) deallocate(OutData%upwind_turbine_Xcoor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_turbine_Xcoor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_turbine_Xcoor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_turbine_Ycoor)) deallocate(OutData%upwind_turbine_Ycoor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_turbine_Ycoor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_turbine_Ycoor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%wind_farm_Xcoor)) deallocate(OutData%wind_farm_Xcoor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%wind_farm_Xcoor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%wind_farm_Xcoor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%wind_farm_Ycoor)) deallocate(OutData%wind_farm_Ycoor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%wind_farm_Ycoor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%wind_farm_Ycoor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%downwind_turbine_Xcoor)) deallocate(OutData%downwind_turbine_Xcoor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%downwind_turbine_Xcoor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%downwind_turbine_Xcoor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%downwind_turbine_Ycoor)) deallocate(OutData%downwind_turbine_Ycoor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%downwind_turbine_Ycoor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%downwind_turbine_Ycoor) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SimulationOrder_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Turbine_sort_order); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WT_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineInfluenceData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_turbine_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%downwind_turbine_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%upwindturbine_number); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%downwindturbine_number); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%turbine_windorigin_length); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_turbine_projected_distance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%downwind_turbine_projected_distance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%turbine_angle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_align_angle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%downwind_align_angle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_turbine_Xcoor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_turbine_Ycoor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%wind_farm_Xcoor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%wind_farm_Ycoor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%downwind_turbine_Xcoor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%downwind_turbine_Ycoor); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyWeiMethod(SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg) @@ -1337,44 +963,26 @@ subroutine DWM_DestroyWeiMethod(WeiMethodData, ErrStat, ErrMsg) end if end subroutine -subroutine DWM_PackWeiMethod(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackWeiMethod(RF, Indata) + type(RegFile), intent(inout) :: RF type(WeiMethod), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackWeiMethod' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%sweptarea)) - if (allocated(InData%sweptarea)) then - call RegPackBounds(Buf, 1, lbound(InData%sweptarea, kind=B8Ki), ubound(InData%sweptarea, kind=B8Ki)) - call RegPack(Buf, InData%sweptarea) - end if - call RegPack(Buf, InData%weighting_denominator) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%sweptarea) + call RegPack(RF, InData%weighting_denominator) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackWeiMethod(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackWeiMethod(RF, OutData) + type(RegFile), intent(inout) :: RF type(WeiMethod), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackWeiMethod' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%sweptarea)) deallocate(OutData%sweptarea) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%sweptarea(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%sweptarea) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%weighting_denominator) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%sweptarea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%weighting_denominator); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyTIDownstream(SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg) @@ -1443,128 +1051,82 @@ subroutine DWM_DestroyTIDownstream(TIDownstreamData, ErrStat, ErrMsg) end if end subroutine -subroutine DWM_PackTIDownstream(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackTIDownstream(RF, Indata) + type(RegFile), intent(inout) :: RF type(TIDownstream), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackTIDownstream' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%TI_downstream_matrix)) - if (allocated(InData%TI_downstream_matrix)) then - call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix, kind=B8Ki), ubound(InData%TI_downstream_matrix, kind=B8Ki)) - call RegPack(Buf, InData%TI_downstream_matrix) - end if - call RegPack(Buf, InData%i) - call RegPack(Buf, InData%j) - call RegPack(Buf, InData%k) - call RegPack(Buf, InData%cross_plane_position_ds) - call RegPack(Buf, InData%cross_plane_position_TI) - call RegPack(Buf, InData%distance_index) - call RegPack(Buf, InData%counter1) - call RegPack(Buf, InData%counter2) - call RegPack(Buf, InData%initial_timestep) - call RegPack(Buf, InData%y_axis_turbine) - call RegPack(Buf, InData%z_axis_turbine) - call RegPack(Buf, InData%distance) - call RegPack(Buf, InData%TI_downstream_node) - call RegPack(Buf, InData%TI_node_temp) - call RegPack(Buf, InData%TI_node) - call RegPack(Buf, InData%TI_accumulation) - call RegPack(Buf, InData%TI_apprant_accumulation) - call RegPack(Buf, InData%TI_average) - call RegPack(Buf, InData%TI_apprant) - call RegPack(Buf, InData%HubHt) - call RegPack(Buf, InData%wake_center_y) - call RegPack(Buf, InData%wake_center_z) - call RegPack(Buf, InData%Rscale) - call RegPack(Buf, InData%y) - call RegPack(Buf, InData%z) - call RegPack(Buf, InData%zero_spacing) - call RegPack(Buf, InData%temp1) - call RegPack(Buf, InData%temp2) - call RegPack(Buf, InData%temp3) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackTIDownstream(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%TI_downstream_matrix) + call RegPack(RF, InData%i) + call RegPack(RF, InData%j) + call RegPack(RF, InData%k) + call RegPack(RF, InData%cross_plane_position_ds) + call RegPack(RF, InData%cross_plane_position_TI) + call RegPack(RF, InData%distance_index) + call RegPack(RF, InData%counter1) + call RegPack(RF, InData%counter2) + call RegPack(RF, InData%initial_timestep) + call RegPack(RF, InData%y_axis_turbine) + call RegPack(RF, InData%z_axis_turbine) + call RegPack(RF, InData%distance) + call RegPack(RF, InData%TI_downstream_node) + call RegPack(RF, InData%TI_node_temp) + call RegPack(RF, InData%TI_node) + call RegPack(RF, InData%TI_accumulation) + call RegPack(RF, InData%TI_apprant_accumulation) + call RegPack(RF, InData%TI_average) + call RegPack(RF, InData%TI_apprant) + call RegPack(RF, InData%HubHt) + call RegPack(RF, InData%wake_center_y) + call RegPack(RF, InData%wake_center_z) + call RegPack(RF, InData%Rscale) + call RegPack(RF, InData%y) + call RegPack(RF, InData%z) + call RegPack(RF, InData%zero_spacing) + call RegPack(RF, InData%temp1) + call RegPack(RF, InData%temp2) + call RegPack(RF, InData%temp3) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackTIDownstream(RF, OutData) + type(RegFile), intent(inout) :: RF type(TIDownstream), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackTIDownstream' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%TI_downstream_matrix)) deallocate(OutData%TI_downstream_matrix) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI_downstream_matrix(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI_downstream_matrix) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%j) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%cross_plane_position_ds) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%cross_plane_position_TI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%distance_index) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%counter1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%counter2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%initial_timestep) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%y_axis_turbine) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z_axis_turbine) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%distance) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_downstream_node) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_node_temp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_node) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_accumulation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_apprant_accumulation) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_average) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_apprant) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%wake_center_y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%wake_center_z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Rscale) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%zero_spacing) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%temp1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%temp2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%temp3) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%TI_downstream_matrix); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%j); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cross_plane_position_ds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cross_plane_position_TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%distance_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%counter1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%counter2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initial_timestep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%y_axis_turbine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z_axis_turbine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%distance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_downstream_node); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_node_temp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_node); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_accumulation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_apprant_accumulation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_average); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_apprant); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%wake_center_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%wake_center_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rscale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zero_spacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%temp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%temp2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%temp3); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyTurbKaimal(SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg) @@ -1594,40 +1156,33 @@ subroutine DWM_DestroyTurbKaimal(TurbKaimalData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DWM_PackTurbKaimal(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackTurbKaimal(RF, Indata) + type(RegFile), intent(inout) :: RF type(TurbKaimal), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackTurbKaimal' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%fs) - call RegPack(Buf, InData%temp_n) - call RegPack(Buf, InData%i) - call RegPack(Buf, InData%low_f) - call RegPack(Buf, InData%high_f) - call RegPack(Buf, InData%lk_facor) - call RegPack(Buf, InData%STD) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackTurbKaimal(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%fs) + call RegPack(RF, InData%temp_n) + call RegPack(RF, InData%i) + call RegPack(RF, InData%low_f) + call RegPack(RF, InData%high_f) + call RegPack(RF, InData%lk_facor) + call RegPack(RF, InData%STD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackTurbKaimal(RF, OutData) + type(RegFile), intent(inout) :: RF type(TurbKaimal), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackTurbKaimal' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%fs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%temp_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%low_f) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%high_f) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%lk_facor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%fs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%temp_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%low_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%high_f); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%lk_facor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STD); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg) @@ -1735,141 +1290,48 @@ subroutine DWM_DestroyShinozuka(ShinozukaData, ErrStat, ErrMsg) end if end subroutine -subroutine DWM_PackShinozuka(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackShinozuka(RF, Indata) + type(RegFile), intent(inout) :: RF type(Shinozuka), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackShinozuka' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%f_syn)) - if (allocated(InData%f_syn)) then - call RegPackBounds(Buf, 1, lbound(InData%f_syn, kind=B8Ki), ubound(InData%f_syn, kind=B8Ki)) - call RegPack(Buf, InData%f_syn) - end if - call RegPack(Buf, allocated(InData%t_syn)) - if (allocated(InData%t_syn)) then - call RegPackBounds(Buf, 1, lbound(InData%t_syn, kind=B8Ki), ubound(InData%t_syn, kind=B8Ki)) - call RegPack(Buf, InData%t_syn) - end if - call RegPack(Buf, allocated(InData%phi)) - if (allocated(InData%phi)) then - call RegPackBounds(Buf, 1, lbound(InData%phi, kind=B8Ki), ubound(InData%phi, kind=B8Ki)) - call RegPack(Buf, InData%phi) - end if - call RegPack(Buf, allocated(InData%p_k)) - if (allocated(InData%p_k)) then - call RegPackBounds(Buf, 1, lbound(InData%p_k, kind=B8Ki), ubound(InData%p_k, kind=B8Ki)) - call RegPack(Buf, InData%p_k) - end if - call RegPack(Buf, allocated(InData%a_k)) - if (allocated(InData%a_k)) then - call RegPackBounds(Buf, 1, lbound(InData%a_k, kind=B8Ki), ubound(InData%a_k, kind=B8Ki)) - call RegPack(Buf, InData%a_k) - end if - call RegPack(Buf, InData%num_points) - call RegPack(Buf, InData%ILo) - call RegPack(Buf, InData%i) - call RegPack(Buf, InData%j) - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%t_min) - call RegPack(Buf, InData%t_max) - call RegPack(Buf, InData%df) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackShinozuka(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%f_syn) + call RegPackAlloc(RF, InData%t_syn) + call RegPackAlloc(RF, InData%phi) + call RegPackAlloc(RF, InData%p_k) + call RegPackAlloc(RF, InData%a_k) + call RegPack(RF, InData%num_points) + call RegPack(RF, InData%ILo) + call RegPack(RF, InData%i) + call RegPack(RF, InData%j) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%t_min) + call RegPack(RF, InData%t_max) + call RegPack(RF, InData%df) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackShinozuka(RF, OutData) + type(RegFile), intent(inout) :: RF type(Shinozuka), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackShinozuka' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%f_syn)) deallocate(OutData%f_syn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%f_syn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%f_syn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%t_syn)) deallocate(OutData%t_syn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%t_syn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%t_syn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%phi)) deallocate(OutData%phi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%phi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%phi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%p_k)) deallocate(OutData%p_k) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%p_k(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%p_k) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%a_k)) deallocate(OutData%a_k) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%a_k(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%a_k) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%num_points) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ILo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%i) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%j) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%t_min) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%t_max) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%df) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%f_syn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t_syn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a_k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%num_points); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ILo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%j); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t_min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t_max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%df); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_Copysmooth_out_wake_data(Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg) @@ -1893,22 +1355,21 @@ subroutine DWM_Destroysmooth_out_wake_data(smooth_out_wake_dataData, ErrStat, Er ErrMsg = '' end subroutine -subroutine DWM_Packsmooth_out_wake_data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_Packsmooth_out_wake_data(RF, Indata) + type(RegFile), intent(inout) :: RF type(smooth_out_wake_data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packsmooth_out_wake_data' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%length_velocity_array) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%length_velocity_array) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPacksmooth_out_wake_data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPacksmooth_out_wake_data(RF, OutData) + type(RegFile), intent(inout) :: RF type(smooth_out_wake_data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%length_velocity_array) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%length_velocity_array); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopySWSV(SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg) @@ -1937,37 +1398,31 @@ subroutine DWM_DestroySWSV(SWSVData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DWM_PackSWSV(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackSWSV(RF, Indata) + type(RegFile), intent(inout) :: RF type(SWSV), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackSWSV' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%p1) - call RegPack(Buf, InData%p2) - call RegPack(Buf, InData%distance) - call RegPack(Buf, InData%y0) - call RegPack(Buf, InData%z0) - call RegPack(Buf, InData%unit) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackSWSV(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%p1) + call RegPack(RF, InData%p2) + call RegPack(RF, InData%distance) + call RegPack(RF, InData%y0) + call RegPack(RF, InData%z0) + call RegPack(RF, InData%unit) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackSWSV(RF, OutData) + type(RegFile), intent(inout) :: RF type(SWSV), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackSWSV' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%p1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%p2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%distance) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%y0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%unit) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%p1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%distance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%y0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%unit); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg) @@ -2157,231 +1612,44 @@ subroutine DWM_Destroyread_upwind_result(read_upwind_resultData, ErrStat, ErrMsg end if end subroutine -subroutine DWM_Packread_upwind_result(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_Packread_upwind_result(RF, Indata) + type(RegFile), intent(inout) :: RF type(read_upwind_result), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packread_upwind_result' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%upwind_U)) - if (allocated(InData%upwind_U)) then - call RegPackBounds(Buf, 2, lbound(InData%upwind_U, kind=B8Ki), ubound(InData%upwind_U, kind=B8Ki)) - call RegPack(Buf, InData%upwind_U) - end if - call RegPack(Buf, allocated(InData%upwind_wakecenter)) - if (allocated(InData%upwind_wakecenter)) then - call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter, kind=B8Ki), ubound(InData%upwind_wakecenter, kind=B8Ki)) - call RegPack(Buf, InData%upwind_wakecenter) - end if - call RegPack(Buf, allocated(InData%upwind_meanU)) - if (allocated(InData%upwind_meanU)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU, kind=B8Ki), ubound(InData%upwind_meanU, kind=B8Ki)) - call RegPack(Buf, InData%upwind_meanU) - end if - call RegPack(Buf, allocated(InData%upwind_TI)) - if (allocated(InData%upwind_TI)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_TI, kind=B8Ki), ubound(InData%upwind_TI, kind=B8Ki)) - call RegPack(Buf, InData%upwind_TI) - end if - call RegPack(Buf, allocated(InData%upwind_small_TI)) - if (allocated(InData%upwind_small_TI)) then - call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI, kind=B8Ki), ubound(InData%upwind_small_TI, kind=B8Ki)) - call RegPack(Buf, InData%upwind_small_TI) - end if - call RegPack(Buf, allocated(InData%upwind_smoothWake)) - if (allocated(InData%upwind_smoothWake)) then - call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake, kind=B8Ki), ubound(InData%upwind_smoothWake, kind=B8Ki)) - call RegPack(Buf, InData%upwind_smoothWake) - end if - call RegPack(Buf, allocated(InData%velocity_aerodyn)) - if (allocated(InData%velocity_aerodyn)) then - call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn, kind=B8Ki), ubound(InData%velocity_aerodyn, kind=B8Ki)) - call RegPack(Buf, InData%velocity_aerodyn) - end if - call RegPack(Buf, allocated(InData%TI_downstream)) - if (allocated(InData%TI_downstream)) then - call RegPackBounds(Buf, 1, lbound(InData%TI_downstream, kind=B8Ki), ubound(InData%TI_downstream, kind=B8Ki)) - call RegPack(Buf, InData%TI_downstream) - end if - call RegPack(Buf, allocated(InData%small_scale_TI_downstream)) - if (allocated(InData%small_scale_TI_downstream)) then - call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream, kind=B8Ki), ubound(InData%small_scale_TI_downstream, kind=B8Ki)) - call RegPack(Buf, InData%small_scale_TI_downstream) - end if - call RegPack(Buf, allocated(InData%smoothed_velocity_array)) - if (allocated(InData%smoothed_velocity_array)) then - call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array, kind=B8Ki), ubound(InData%smoothed_velocity_array, kind=B8Ki)) - call RegPack(Buf, InData%smoothed_velocity_array) - end if - call RegPack(Buf, allocated(InData%vel_matrix)) - if (allocated(InData%vel_matrix)) then - call RegPackBounds(Buf, 3, lbound(InData%vel_matrix, kind=B8Ki), ubound(InData%vel_matrix, kind=B8Ki)) - call RegPack(Buf, InData%vel_matrix) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackread_upwind_result(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%upwind_U) + call RegPackAlloc(RF, InData%upwind_wakecenter) + call RegPackAlloc(RF, InData%upwind_meanU) + call RegPackAlloc(RF, InData%upwind_TI) + call RegPackAlloc(RF, InData%upwind_small_TI) + call RegPackAlloc(RF, InData%upwind_smoothWake) + call RegPackAlloc(RF, InData%velocity_aerodyn) + call RegPackAlloc(RF, InData%TI_downstream) + call RegPackAlloc(RF, InData%small_scale_TI_downstream) + call RegPackAlloc(RF, InData%smoothed_velocity_array) + call RegPackAlloc(RF, InData%vel_matrix) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackread_upwind_result(RF, OutData) + type(RegFile), intent(inout) :: RF type(read_upwind_result), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackread_upwind_result' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%upwind_U)) deallocate(OutData%upwind_U) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_U(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_U) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_wakecenter)) deallocate(OutData%upwind_wakecenter) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_wakecenter(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_wakecenter) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_meanU)) deallocate(OutData%upwind_meanU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_meanU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_meanU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_TI)) deallocate(OutData%upwind_TI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_TI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_TI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_small_TI)) deallocate(OutData%upwind_small_TI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_small_TI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_small_TI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%upwind_smoothWake)) deallocate(OutData%upwind_smoothWake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%upwind_smoothWake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%upwind_smoothWake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%velocity_aerodyn)) deallocate(OutData%velocity_aerodyn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%velocity_aerodyn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%velocity_aerodyn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TI_downstream)) deallocate(OutData%TI_downstream) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI_downstream(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI_downstream) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%small_scale_TI_downstream)) deallocate(OutData%small_scale_TI_downstream) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%small_scale_TI_downstream(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%small_scale_TI_downstream) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%smoothed_velocity_array) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vel_matrix)) deallocate(OutData%vel_matrix) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vel_matrix(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vel_matrix) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%upwind_U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_wakecenter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_meanU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_small_TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%upwind_smoothWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%velocity_aerodyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_downstream); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%small_scale_TI_downstream); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%smoothed_velocity_array); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vel_matrix); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_Copywake_meandered_center(Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg) @@ -2421,41 +1689,24 @@ subroutine DWM_Destroywake_meandered_center(wake_meandered_centerData, ErrStat, end if end subroutine -subroutine DWM_Packwake_meandered_center(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_Packwake_meandered_center(RF, Indata) + type(RegFile), intent(inout) :: RF type(wake_meandered_center), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packwake_meandered_center' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%wake_width)) - if (allocated(InData%wake_width)) then - call RegPackBounds(Buf, 1, lbound(InData%wake_width, kind=B8Ki), ubound(InData%wake_width, kind=B8Ki)) - call RegPack(Buf, InData%wake_width) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%wake_width) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackwake_meandered_center(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackwake_meandered_center(RF, OutData) + type(RegFile), intent(inout) :: RF type(wake_meandered_center), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackwake_meandered_center' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%wake_width)) deallocate(OutData%wake_width) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%wake_width(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%wake_width) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%wake_width); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_Copyturbine_blade(Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg) @@ -2481,28 +1732,25 @@ subroutine DWM_Destroyturbine_blade(turbine_bladeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine DWM_Packturbine_blade(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_Packturbine_blade(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_turbine_blade), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packturbine_blade' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Aerodyn_turbine_num) - call RegPack(Buf, InData%Blade_index) - call RegPack(Buf, InData%Element_index) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Aerodyn_turbine_num) + call RegPack(RF, InData%Blade_index) + call RegPack(RF, InData%Element_index) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackturbine_blade(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackturbine_blade(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_turbine_blade), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackturbine_blade' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Aerodyn_turbine_num) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Blade_index) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Element_index) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Aerodyn_turbine_num); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Blade_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Element_index); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2621,165 +1869,76 @@ subroutine DWM_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%velocityU)) - if (allocated(InData%velocityU)) then - call RegPackBounds(Buf, 1, lbound(InData%velocityU, kind=B8Ki), ubound(InData%velocityU, kind=B8Ki)) - call RegPack(Buf, InData%velocityU) - end if - call RegPack(Buf, allocated(InData%smoothed_wake)) - if (allocated(InData%smoothed_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake, kind=B8Ki), ubound(InData%smoothed_wake, kind=B8Ki)) - call RegPack(Buf, InData%smoothed_wake) - end if - call RegPack(Buf, allocated(InData%WakePosition)) - if (allocated(InData%WakePosition)) then - call RegPackBounds(Buf, 3, lbound(InData%WakePosition, kind=B8Ki), ubound(InData%WakePosition, kind=B8Ki)) - call RegPack(Buf, InData%WakePosition) - end if - call RegPack(Buf, InData%WakePosition_1) - call RegPack(Buf, InData%WakePosition_2) - call RegPack(Buf, InData%smooth_flag) - call RegPack(Buf, InData%p_p_r) - call RegPack(Buf, InData%NumWT) - call RegPack(Buf, InData%Tinfluencer) - call RegPack(Buf, InData%RotorR) - call RegPack(Buf, InData%r_domain) - call RegPack(Buf, InData%x_domain) - call RegPack(Buf, InData%Uambient) - call RegPack(Buf, InData%TI_amb) - call RegPack(Buf, InData%TI_wake) - call RegPack(Buf, InData%hub_height) - call RegPack(Buf, InData%length_velocityU) - call RegPack(Buf, InData%WFLowerBd) - call RegPack(Buf, InData%Wind_file_Mean_u) - call RegPack(Buf, InData%Winddir) - call RegPack(Buf, InData%air_density) - call RegPack(Buf, InData%RR) - call RegPack(Buf, allocated(InData%ElementRad)) - if (allocated(InData%ElementRad)) then - call RegPackBounds(Buf, 1, lbound(InData%ElementRad, kind=B8Ki), ubound(InData%ElementRad, kind=B8Ki)) - call RegPack(Buf, InData%ElementRad) - end if - call RegPack(Buf, InData%Bnum) - call RegPack(Buf, InData%ElementNum) - call DWM_Packread_turbine_position_data(Buf, InData%RTPD) - call InflowWind_PackParam(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%velocityU) + call RegPackAlloc(RF, InData%smoothed_wake) + call RegPackAlloc(RF, InData%WakePosition) + call RegPack(RF, InData%WakePosition_1) + call RegPack(RF, InData%WakePosition_2) + call RegPack(RF, InData%smooth_flag) + call RegPack(RF, InData%p_p_r) + call RegPack(RF, InData%NumWT) + call RegPack(RF, InData%Tinfluencer) + call RegPack(RF, InData%RotorR) + call RegPack(RF, InData%r_domain) + call RegPack(RF, InData%x_domain) + call RegPack(RF, InData%Uambient) + call RegPack(RF, InData%TI_amb) + call RegPack(RF, InData%TI_wake) + call RegPack(RF, InData%hub_height) + call RegPack(RF, InData%length_velocityU) + call RegPack(RF, InData%WFLowerBd) + call RegPack(RF, InData%Wind_file_Mean_u) + call RegPack(RF, InData%Winddir) + call RegPack(RF, InData%air_density) + call RegPack(RF, InData%RR) + call RegPackAlloc(RF, InData%ElementRad) + call RegPack(RF, InData%Bnum) + call RegPack(RF, InData%ElementNum) + call DWM_Packread_turbine_position_data(RF, InData%RTPD) + call InflowWind_PackParam(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackParam' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%velocityU)) deallocate(OutData%velocityU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%velocityU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%velocityU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%smoothed_wake)) deallocate(OutData%smoothed_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%smoothed_wake(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%smoothed_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WakePosition)) deallocate(OutData%WakePosition) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WakePosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WakePosition) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WakePosition_1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WakePosition_2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%smooth_flag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%p_p_r) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumWT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tinfluencer) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotorR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%r_domain) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%x_domain) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Uambient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_amb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_wake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%hub_height) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%length_velocityU) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WFLowerBd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Wind_file_Mean_u) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Winddir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%air_density) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RR) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ElementRad)) deallocate(OutData%ElementRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElementRad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElementRad) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Bnum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElementNum) - if (RegCheckErr(Buf, RoutineName)) return - call DWM_Unpackread_turbine_position_data(Buf, OutData%RTPD) ! RTPD - call InflowWind_UnpackParam(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%velocityU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%smoothed_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WakePosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakePosition_1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WakePosition_2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%smooth_flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_p_r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumWT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tinfluencer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r_domain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%x_domain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uambient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hub_height); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%length_velocityU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WFLowerBd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wind_file_Mean_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Winddir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%air_density); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElementRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Bnum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElementNum); if (RegCheckErr(RF, RoutineName)) return + call DWM_Unpackread_turbine_position_data(RF, OutData%RTPD) ! RTPD + call InflowWind_UnpackParam(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -2811,21 +1970,21 @@ subroutine DWM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call InflowWind_PackOtherState(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call InflowWind_PackOtherState(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call InflowWind_UnpackOtherState(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call InflowWind_UnpackOtherState(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -2959,119 +2118,74 @@ subroutine DWM_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call InflowWind_PackMisc(Buf, InData%IfW) - call RegPack(Buf, InData%position_y) - call RegPack(Buf, InData%position_z) - call RegPack(Buf, InData%velocity_wake_mean) - call RegPack(Buf, InData%shifted_velocity_Aerodyn) - call RegPack(Buf, InData%U_velocity) - call RegPack(Buf, InData%V_velocity) - call RegPack(Buf, allocated(InData%Nforce)) - if (allocated(InData%Nforce)) then - call RegPackBounds(Buf, 2, lbound(InData%Nforce, kind=B8Ki), ubound(InData%Nforce, kind=B8Ki)) - call RegPack(Buf, InData%Nforce) - end if - call RegPack(Buf, allocated(InData%blade_dr)) - if (allocated(InData%blade_dr)) then - call RegPackBounds(Buf, 1, lbound(InData%blade_dr, kind=B8Ki), ubound(InData%blade_dr, kind=B8Ki)) - call RegPack(Buf, InData%blade_dr) - end if - call RegPack(Buf, InData%NacYaw) - call RegPack(Buf, InData%TI_original) - call DWM_Packturbine_average_velocity_data(Buf, InData%TAVD) - call DWM_PackCVSD(Buf, InData%CalVelScale_data) - call DWM_PackMeanderData(Buf, InData%meandering_data) - call DWM_PackWeiMethod(Buf, InData%weighting_method) - call DWM_PackTIDownstream(Buf, InData%TI_downstream_data) - call DWM_PackTurbKaimal(Buf, InData%Turbulence_KS) - call DWM_PackShinozuka(Buf, InData%shinozuka_data) - call DWM_Packsmooth_out_wake_data(Buf, InData%SmoothOut) - call DWM_PackSWSV(Buf, InData%smooth_wake_shifted_velocity_data) - call DWM_PackWake_Deficit_Data(Buf, InData%DWDD) - call RegPack(Buf, InData%ct_tilde) - call RegPack(Buf, InData%FAST_Time) - call RegPack(Buf, InData%SDtimestep) - call DWM_Packturbine_blade(Buf, InData%DWM_tb) - call DWM_Packwake_meandered_center(Buf, InData%WMC) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call InflowWind_PackMisc(RF, InData%IfW) + call RegPack(RF, InData%position_y) + call RegPack(RF, InData%position_z) + call RegPack(RF, InData%velocity_wake_mean) + call RegPack(RF, InData%shifted_velocity_Aerodyn) + call RegPack(RF, InData%U_velocity) + call RegPack(RF, InData%V_velocity) + call RegPackAlloc(RF, InData%Nforce) + call RegPackAlloc(RF, InData%blade_dr) + call RegPack(RF, InData%NacYaw) + call RegPack(RF, InData%TI_original) + call DWM_Packturbine_average_velocity_data(RF, InData%TAVD) + call DWM_PackCVSD(RF, InData%CalVelScale_data) + call DWM_PackMeanderData(RF, InData%meandering_data) + call DWM_PackWeiMethod(RF, InData%weighting_method) + call DWM_PackTIDownstream(RF, InData%TI_downstream_data) + call DWM_PackTurbKaimal(RF, InData%Turbulence_KS) + call DWM_PackShinozuka(RF, InData%shinozuka_data) + call DWM_Packsmooth_out_wake_data(RF, InData%SmoothOut) + call DWM_PackSWSV(RF, InData%smooth_wake_shifted_velocity_data) + call DWM_PackWake_Deficit_Data(RF, InData%DWDD) + call RegPack(RF, InData%ct_tilde) + call RegPack(RF, InData%FAST_Time) + call RegPack(RF, InData%SDtimestep) + call DWM_Packturbine_blade(RF, InData%DWM_tb) + call DWM_Packwake_meandered_center(RF, InData%WMC) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackMisc' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call InflowWind_UnpackMisc(Buf, OutData%IfW) ! IfW - call RegUnpack(Buf, OutData%position_y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%position_z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%velocity_wake_mean) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%shifted_velocity_Aerodyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%U_velocity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%V_velocity) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Nforce)) deallocate(OutData%Nforce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nforce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nforce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%blade_dr)) deallocate(OutData%blade_dr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%blade_dr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%blade_dr) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NacYaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_original) - if (RegCheckErr(Buf, RoutineName)) return - call DWM_Unpackturbine_average_velocity_data(Buf, OutData%TAVD) ! TAVD - call DWM_UnpackCVSD(Buf, OutData%CalVelScale_data) ! CalVelScale_data - call DWM_UnpackMeanderData(Buf, OutData%meandering_data) ! meandering_data - call DWM_UnpackWeiMethod(Buf, OutData%weighting_method) ! weighting_method - call DWM_UnpackTIDownstream(Buf, OutData%TI_downstream_data) ! TI_downstream_data - call DWM_UnpackTurbKaimal(Buf, OutData%Turbulence_KS) ! Turbulence_KS - call DWM_UnpackShinozuka(Buf, OutData%shinozuka_data) ! shinozuka_data - call DWM_Unpacksmooth_out_wake_data(Buf, OutData%SmoothOut) ! SmoothOut - call DWM_UnpackSWSV(Buf, OutData%smooth_wake_shifted_velocity_data) ! smooth_wake_shifted_velocity_data - call DWM_UnpackWake_Deficit_Data(Buf, OutData%DWDD) ! DWDD - call RegUnpack(Buf, OutData%ct_tilde) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FAST_Time) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SDtimestep) - if (RegCheckErr(Buf, RoutineName)) return - call DWM_Unpackturbine_blade(Buf, OutData%DWM_tb) ! DWM_tb - call DWM_Unpackwake_meandered_center(Buf, OutData%WMC) ! WMC + if (RF%ErrStat /= ErrID_None) return + call InflowWind_UnpackMisc(RF, OutData%IfW) ! IfW + call RegUnpack(RF, OutData%position_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%position_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%velocity_wake_mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%shifted_velocity_Aerodyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U_velocity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%V_velocity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nforce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%blade_dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_original); if (RegCheckErr(RF, RoutineName)) return + call DWM_Unpackturbine_average_velocity_data(RF, OutData%TAVD) ! TAVD + call DWM_UnpackCVSD(RF, OutData%CalVelScale_data) ! CalVelScale_data + call DWM_UnpackMeanderData(RF, OutData%meandering_data) ! meandering_data + call DWM_UnpackWeiMethod(RF, OutData%weighting_method) ! weighting_method + call DWM_UnpackTIDownstream(RF, OutData%TI_downstream_data) ! TI_downstream_data + call DWM_UnpackTurbKaimal(RF, OutData%Turbulence_KS) ! Turbulence_KS + call DWM_UnpackShinozuka(RF, OutData%shinozuka_data) ! shinozuka_data + call DWM_Unpacksmooth_out_wake_data(RF, OutData%SmoothOut) ! SmoothOut + call DWM_UnpackSWSV(RF, OutData%smooth_wake_shifted_velocity_data) ! smooth_wake_shifted_velocity_data + call DWM_UnpackWake_Deficit_Data(RF, OutData%DWDD) ! DWDD + call RegUnpack(RF, OutData%ct_tilde); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FAST_Time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SDtimestep); if (RegCheckErr(RF, RoutineName)) return + call DWM_Unpackturbine_blade(RF, OutData%DWM_tb) ! DWM_tb + call DWM_Unpackwake_meandered_center(RF, OutData%WMC) ! WMC end subroutine subroutine DWM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -3108,23 +2222,23 @@ subroutine DWM_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call DWM_Packread_upwind_result(Buf, InData%Upwind_result) - call InflowWind_PackInput(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call DWM_Packread_upwind_result(RF, InData%Upwind_result) + call InflowWind_PackInput(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call DWM_Unpackread_upwind_result(Buf, OutData%Upwind_result) ! Upwind_result - call InflowWind_UnpackInput(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call DWM_Unpackread_upwind_result(RF, OutData%Upwind_result) ! Upwind_result + call InflowWind_UnpackInput(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3285,200 +2399,56 @@ subroutine DWM_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%turbine_thrust_force)) - if (allocated(InData%turbine_thrust_force)) then - call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force, kind=B8Ki), ubound(InData%turbine_thrust_force, kind=B8Ki)) - call RegPack(Buf, InData%turbine_thrust_force) - end if - call RegPack(Buf, allocated(InData%induction_factor)) - if (allocated(InData%induction_factor)) then - call RegPackBounds(Buf, 1, lbound(InData%induction_factor, kind=B8Ki), ubound(InData%induction_factor, kind=B8Ki)) - call RegPack(Buf, InData%induction_factor) - end if - call RegPack(Buf, allocated(InData%r_initial)) - if (allocated(InData%r_initial)) then - call RegPackBounds(Buf, 1, lbound(InData%r_initial, kind=B8Ki), ubound(InData%r_initial, kind=B8Ki)) - call RegPack(Buf, InData%r_initial) - end if - call RegPack(Buf, allocated(InData%U_initial)) - if (allocated(InData%U_initial)) then - call RegPackBounds(Buf, 1, lbound(InData%U_initial, kind=B8Ki), ubound(InData%U_initial, kind=B8Ki)) - call RegPack(Buf, InData%U_initial) - end if - call RegPack(Buf, allocated(InData%Mean_FFWS_array)) - if (allocated(InData%Mean_FFWS_array)) then - call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array, kind=B8Ki), ubound(InData%Mean_FFWS_array, kind=B8Ki)) - call RegPack(Buf, InData%Mean_FFWS_array) - end if - call RegPack(Buf, InData%Mean_FFWS) - call RegPack(Buf, InData%TI) - call RegPack(Buf, InData%TI_downstream) - call RegPack(Buf, allocated(InData%wake_u)) - if (allocated(InData%wake_u)) then - call RegPackBounds(Buf, 2, lbound(InData%wake_u, kind=B8Ki), ubound(InData%wake_u, kind=B8Ki)) - call RegPack(Buf, InData%wake_u) - end if - call RegPack(Buf, allocated(InData%wake_position)) - if (allocated(InData%wake_position)) then - call RegPackBounds(Buf, 3, lbound(InData%wake_position, kind=B8Ki), ubound(InData%wake_position, kind=B8Ki)) - call RegPack(Buf, InData%wake_position) - end if - call RegPack(Buf, allocated(InData%smoothed_velocity_array)) - if (allocated(InData%smoothed_velocity_array)) then - call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array, kind=B8Ki), ubound(InData%smoothed_velocity_array, kind=B8Ki)) - call RegPack(Buf, InData%smoothed_velocity_array) - end if - call RegPack(Buf, InData%AtmUscale) - call RegPack(Buf, InData%du_dz_ABL) - call RegPack(Buf, InData%total_SDgenpwr) - call RegPack(Buf, InData%mean_SDgenpwr) - call RegPack(Buf, InData%avg_ct) - call InflowWind_PackOutput(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine DWM_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%turbine_thrust_force) + call RegPackAlloc(RF, InData%induction_factor) + call RegPackAlloc(RF, InData%r_initial) + call RegPackAlloc(RF, InData%U_initial) + call RegPackAlloc(RF, InData%Mean_FFWS_array) + call RegPack(RF, InData%Mean_FFWS) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%TI_downstream) + call RegPackAlloc(RF, InData%wake_u) + call RegPackAlloc(RF, InData%wake_position) + call RegPackAlloc(RF, InData%smoothed_velocity_array) + call RegPack(RF, InData%AtmUscale) + call RegPack(RF, InData%du_dz_ABL) + call RegPack(RF, InData%total_SDgenpwr) + call RegPack(RF, InData%mean_SDgenpwr) + call RegPack(RF, InData%avg_ct) + call InflowWind_PackOutput(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine DWM_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackOutput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%turbine_thrust_force)) deallocate(OutData%turbine_thrust_force) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%turbine_thrust_force(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%turbine_thrust_force) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%induction_factor)) deallocate(OutData%induction_factor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%induction_factor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%induction_factor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_initial)) deallocate(OutData%r_initial) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_initial(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_initial) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_initial)) deallocate(OutData%U_initial) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_initial(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_initial) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Mean_FFWS_array)) deallocate(OutData%Mean_FFWS_array) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mean_FFWS_array(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mean_FFWS_array) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Mean_FFWS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_downstream) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%wake_u)) deallocate(OutData%wake_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%wake_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%wake_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%wake_position)) deallocate(OutData%wake_position) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%wake_position(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%wake_position) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%smoothed_velocity_array) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AtmUscale) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%du_dz_ABL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%total_SDgenpwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%mean_SDgenpwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%avg_ct) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_UnpackOutput(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%turbine_thrust_force); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%induction_factor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_initial); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_initial); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mean_FFWS_array); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mean_FFWS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_downstream); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%wake_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%wake_position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%smoothed_velocity_array); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AtmUscale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%du_dz_ABL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%total_SDgenpwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mean_SDgenpwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avg_ct); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackOutput(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -3511,24 +2481,23 @@ subroutine DWM_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - call InflowWind_PackContState(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + call InflowWind_PackContState(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_UnpackContState(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackContState(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -3561,24 +2530,23 @@ subroutine DWM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - call InflowWind_PackDiscState(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + call InflowWind_PackDiscState(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_UnpackDiscState(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackDiscState(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -3611,24 +2579,23 @@ subroutine DWM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - call InflowWind_PackConstrState(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + call InflowWind_PackConstrState(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_UnpackConstrState(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackConstrState(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -3661,24 +2628,23 @@ subroutine DWM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - call InflowWind_PackInitInput(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + call InflowWind_PackInitInput(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_UnpackInitInput(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackInitInput(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3711,24 +2677,23 @@ subroutine DWM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine DWM_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(DWM_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - call InflowWind_PackInitOutput(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + call InflowWind_PackInitOutput(RF, InData%IfW) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine DWM_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine DWM_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(DWM_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_UnpackInitOutput(Buf, OutData%IfW) ! IfW + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackInitOutput(RF, OutData%IfW) ! IfW end subroutine subroutine DWM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 3845a5e793..fdc1135a1f 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -285,25 +285,18 @@ subroutine AWAE_DestroyHighWindGrid(HighWindGridData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackHighWindGrid(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackHighWindGrid(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_HighWindGrid), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackHighWindGrid' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, associated(InData%data)) - if (associated(InData%data)) then - call RegPackBounds(Buf, 5, lbound(InData%data, kind=B8Ki), ubound(InData%data, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%data) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackPtr(RF, InData%data) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackHighWindGrid(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackHighWindGrid(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_HighWindGrid), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' integer(B8Ki) :: LB(5), UB(5) @@ -311,31 +304,8 @@ subroutine AWAE_UnPackHighWindGrid(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%data)) deallocate(OutData%data) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%data, UB(1:5)-LB(1:5)) - OutData%data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%data - else - allocate(OutData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%data) - call RegUnpack(Buf, OutData%data) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%data => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%data); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg) @@ -362,25 +332,18 @@ subroutine AWAE_DestroyHighWindGridPtr(HighWindGridPtrData, ErrStat, ErrMsg) nullify(HighWindGridPtrData%data) end subroutine -subroutine AWAE_PackHighWindGridPtr(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackHighWindGridPtr(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_HighWindGridPtr), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackHighWindGridPtr' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, associated(InData%data)) - if (associated(InData%data)) then - call RegPackBounds(Buf, 5, lbound(InData%data, kind=B8Ki), ubound(InData%data, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%data) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackPtr(RF, InData%data) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackHighWindGridPtr(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_HighWindGridPtr), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' integer(B8Ki) :: LB(5), UB(5) @@ -388,31 +351,8 @@ subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%data)) deallocate(OutData%data) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%data, UB(1:5)-LB(1:5)) - OutData%data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%data - else - allocate(OutData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%data) - call RegUnpack(Buf, OutData%data) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%data => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%data); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) @@ -617,302 +557,102 @@ subroutine AWAE_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackInputFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_InputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInputFileType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dr) - call RegPack(Buf, InData%dt_low) - call RegPack(Buf, InData%NumTurbines) - call RegPack(Buf, InData%NumRadii) - call RegPack(Buf, InData%NumPlanes) - call RegPack(Buf, InData%WindFilePath) - call RegPack(Buf, InData%WrDisWind) - call RegPack(Buf, InData%NOutDisWindXY) - call RegPack(Buf, allocated(InData%OutDisWindZ)) - if (allocated(InData%OutDisWindZ)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ, kind=B8Ki), ubound(InData%OutDisWindZ, kind=B8Ki)) - call RegPack(Buf, InData%OutDisWindZ) - end if - call RegPack(Buf, InData%NOutDisWindYZ) - call RegPack(Buf, allocated(InData%OutDisWindX)) - if (allocated(InData%OutDisWindX)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX, kind=B8Ki), ubound(InData%OutDisWindX, kind=B8Ki)) - call RegPack(Buf, InData%OutDisWindX) - end if - call RegPack(Buf, InData%NOutDisWindXZ) - call RegPack(Buf, allocated(InData%OutDisWindY)) - if (allocated(InData%OutDisWindY)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY, kind=B8Ki), ubound(InData%OutDisWindY, kind=B8Ki)) - call RegPack(Buf, InData%OutDisWindY) - end if - call RegPack(Buf, InData%WrDisDT) - call RegPack(Buf, InData%ChkWndFiles) - call RegPack(Buf, InData%Mod_Meander) - call RegPack(Buf, InData%C_Meander) - call RegPack(Buf, InData%Mod_AmbWind) - call RegPack(Buf, InData%InflowFile) - call RegPack(Buf, InData%dt_high) - call RegPack(Buf, allocated(InData%X0_high)) - if (allocated(InData%X0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%X0_high, kind=B8Ki), ubound(InData%X0_high, kind=B8Ki)) - call RegPack(Buf, InData%X0_high) - end if - call RegPack(Buf, allocated(InData%Y0_high)) - if (allocated(InData%Y0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0_high, kind=B8Ki), ubound(InData%Y0_high, kind=B8Ki)) - call RegPack(Buf, InData%Y0_high) - end if - call RegPack(Buf, allocated(InData%Z0_high)) - if (allocated(InData%Z0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Z0_high, kind=B8Ki), ubound(InData%Z0_high, kind=B8Ki)) - call RegPack(Buf, InData%Z0_high) - end if - call RegPack(Buf, allocated(InData%dX_high)) - if (allocated(InData%dX_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dX_high, kind=B8Ki), ubound(InData%dX_high, kind=B8Ki)) - call RegPack(Buf, InData%dX_high) - end if - call RegPack(Buf, allocated(InData%dY_high)) - if (allocated(InData%dY_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dY_high, kind=B8Ki), ubound(InData%dY_high, kind=B8Ki)) - call RegPack(Buf, InData%dY_high) - end if - call RegPack(Buf, allocated(InData%dZ_high)) - if (allocated(InData%dZ_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dZ_high, kind=B8Ki), ubound(InData%dZ_high, kind=B8Ki)) - call RegPack(Buf, InData%dZ_high) - end if - call RegPack(Buf, InData%nX_high) - call RegPack(Buf, InData%nY_high) - call RegPack(Buf, InData%nZ_high) - call RegPack(Buf, InData%dX_low) - call RegPack(Buf, InData%dY_low) - call RegPack(Buf, InData%dZ_low) - call RegPack(Buf, InData%nX_low) - call RegPack(Buf, InData%nY_low) - call RegPack(Buf, InData%nZ_low) - call RegPack(Buf, InData%X0_low) - call RegPack(Buf, InData%Y0_low) - call RegPack(Buf, InData%Z0_low) - call RegPack(Buf, allocated(InData%WT_Position)) - if (allocated(InData%WT_Position)) then - call RegPackBounds(Buf, 2, lbound(InData%WT_Position, kind=B8Ki), ubound(InData%WT_Position, kind=B8Ki)) - call RegPack(Buf, InData%WT_Position) - end if - call RegPack(Buf, InData%Mod_Projection) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dr) + call RegPack(RF, InData%dt_low) + call RegPack(RF, InData%NumTurbines) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%NumPlanes) + call RegPack(RF, InData%WindFilePath) + call RegPack(RF, InData%WrDisWind) + call RegPack(RF, InData%NOutDisWindXY) + call RegPackAlloc(RF, InData%OutDisWindZ) + call RegPack(RF, InData%NOutDisWindYZ) + call RegPackAlloc(RF, InData%OutDisWindX) + call RegPack(RF, InData%NOutDisWindXZ) + call RegPackAlloc(RF, InData%OutDisWindY) + call RegPack(RF, InData%WrDisDT) + call RegPack(RF, InData%ChkWndFiles) + call RegPack(RF, InData%Mod_Meander) + call RegPack(RF, InData%C_Meander) + call RegPack(RF, InData%Mod_AmbWind) + call RegPack(RF, InData%InflowFile) + call RegPack(RF, InData%dt_high) + call RegPackAlloc(RF, InData%X0_high) + call RegPackAlloc(RF, InData%Y0_high) + call RegPackAlloc(RF, InData%Z0_high) + call RegPackAlloc(RF, InData%dX_high) + call RegPackAlloc(RF, InData%dY_high) + call RegPackAlloc(RF, InData%dZ_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPackAlloc(RF, InData%WT_Position) + call RegPack(RF, InData%Mod_Projection) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackInputFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTurbines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindFilePath) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrDisWind) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NOutDisWindXY) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutDisWindZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutDisWindZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NOutDisWindYZ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutDisWindX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutDisWindX) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NOutDisWindXZ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutDisWindY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutDisWindY) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WrDisDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ChkWndFiles) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_Meander) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_Meander) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_AmbWind) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InflowFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt_high) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Z0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dX_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dY_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dZ_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z0_low) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WT_Position) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Mod_Projection) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindFilePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrDisWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindYZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrDisDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ChkWndFiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_AmbWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WT_Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Projection); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -947,30 +687,27 @@ subroutine AWAE_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AWAE_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call AWAE_PackInputFileType(Buf, InData%InputFileData) - call RegPack(Buf, InData%n_high_low) - call RegPack(Buf, InData%NumDT) - call RegPack(Buf, InData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call AWAE_PackInputFileType(RF, InData%InputFileData) + call RegPack(RF, InData%n_high_low) + call RegPack(RF, InData%NumDT) + call RegPack(RF, InData%OutFileRoot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call AWAE_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData - call RegUnpack(Buf, OutData%n_high_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call AWAE_UnpackInputFileType(RF, OutData%InputFileData) ! InputFileData + call RegUnpack(RF, OutData%n_high_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1133,199 +870,83 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%X0_high)) - if (allocated(InData%X0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%X0_high, kind=B8Ki), ubound(InData%X0_high, kind=B8Ki)) - call RegPack(Buf, InData%X0_high) - end if - call RegPack(Buf, allocated(InData%Y0_high)) - if (allocated(InData%Y0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0_high, kind=B8Ki), ubound(InData%Y0_high, kind=B8Ki)) - call RegPack(Buf, InData%Y0_high) - end if - call RegPack(Buf, allocated(InData%Z0_high)) - if (allocated(InData%Z0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Z0_high, kind=B8Ki), ubound(InData%Z0_high, kind=B8Ki)) - call RegPack(Buf, InData%Z0_high) - end if - call RegPack(Buf, allocated(InData%dX_high)) - if (allocated(InData%dX_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dX_high, kind=B8Ki), ubound(InData%dX_high, kind=B8Ki)) - call RegPack(Buf, InData%dX_high) - end if - call RegPack(Buf, allocated(InData%dY_high)) - if (allocated(InData%dY_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dY_high, kind=B8Ki), ubound(InData%dY_high, kind=B8Ki)) - call RegPack(Buf, InData%dY_high) - end if - call RegPack(Buf, allocated(InData%dZ_high)) - if (allocated(InData%dZ_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dZ_high, kind=B8Ki), ubound(InData%dZ_high, kind=B8Ki)) - call RegPack(Buf, InData%dZ_high) - end if - call RegPack(Buf, InData%nX_high) - call RegPack(Buf, InData%nY_high) - call RegPack(Buf, InData%nZ_high) - call RegPack(Buf, InData%dX_low) - call RegPack(Buf, InData%dY_low) - call RegPack(Buf, InData%dZ_low) - call RegPack(Buf, InData%nX_low) - call RegPack(Buf, InData%nY_low) - call RegPack(Buf, InData%nZ_low) - call RegPack(Buf, InData%X0_low) - call RegPack(Buf, InData%Y0_low) - call RegPack(Buf, InData%Z0_low) - call RegPack(Buf, allocated(InData%Vdist_High)) + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%X0_high) + call RegPackAlloc(RF, InData%Y0_high) + call RegPackAlloc(RF, InData%Z0_high) + call RegPackAlloc(RF, InData%dX_high) + call RegPackAlloc(RF, InData%dY_high) + call RegPackAlloc(RF, InData%dZ_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPack(RF, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(Buf, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) do i1 = LB(1), UB(1) - call AWAE_PackHighWindGridPtr(Buf, InData%Vdist_High(i1)) + call AWAE_PackHighWindGridPtr(RF, InData%Vdist_High(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Z0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dX_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dY_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dZ_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z0_low) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%X0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AWAE_UnpackHighWindGridPtr(Buf, OutData%Vdist_High(i1)) ! Vdist_High + call AWAE_UnpackHighWindGridPtr(RF, OutData%Vdist_High(i1)) ! Vdist_High end do end if end subroutine @@ -1383,47 +1004,45 @@ subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%IfW)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) LB(1:1) = lbound(InData%IfW, kind=B8Ki) UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackContState(Buf, InData%IfW(i1)) + call InflowWind_PackContState(RF, InData%IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%IfW)) deallocate(OutData%IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(Buf, OutData%IfW(i1)) ! IfW + call InflowWind_UnpackContState(RF, OutData%IfW(i1)) ! IfW end do end if end subroutine @@ -1481,47 +1100,45 @@ subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%IfW)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) LB(1:1) = lbound(InData%IfW, kind=B8Ki) UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(Buf, InData%IfW(i1)) + call InflowWind_PackDiscState(RF, InData%IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%IfW)) deallocate(OutData%IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(Buf, OutData%IfW(i1)) ! IfW + call InflowWind_UnpackDiscState(RF, OutData%IfW(i1)) ! IfW end do end if end subroutine @@ -1579,47 +1196,45 @@ subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%IfW)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) LB(1:1) = lbound(InData%IfW, kind=B8Ki) UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(Buf, InData%IfW(i1)) + call InflowWind_PackConstrState(RF, InData%IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%IfW)) deallocate(OutData%IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(Buf, OutData%IfW(i1)) ! IfW + call InflowWind_UnpackConstrState(RF, OutData%IfW(i1)) ! IfW end do end if end subroutine @@ -1677,47 +1292,45 @@ subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%IfW)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) LB(1:1) = lbound(InData%IfW, kind=B8Ki) UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(Buf, InData%IfW(i1)) + call InflowWind_PackOtherState(RF, InData%IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%IfW)) deallocate(OutData%IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(Buf, OutData%IfW(i1)) ! IfW + call InflowWind_UnpackOtherState(RF, OutData%IfW(i1)) ! IfW end do end if end subroutine @@ -2030,347 +1643,105 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AWAE_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackMisc' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Vamb_low)) - if (allocated(InData%Vamb_low)) then - call RegPackBounds(Buf, 4, lbound(InData%Vamb_low, kind=B8Ki), ubound(InData%Vamb_low, kind=B8Ki)) - call RegPack(Buf, InData%Vamb_low) - end if - call RegPack(Buf, allocated(InData%Vamb_lowpol)) - if (allocated(InData%Vamb_lowpol)) then - call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol, kind=B8Ki), ubound(InData%Vamb_lowpol, kind=B8Ki)) - call RegPack(Buf, InData%Vamb_lowpol) - end if - call RegPack(Buf, allocated(InData%Vdist_low)) - if (allocated(InData%Vdist_low)) then - call RegPackBounds(Buf, 4, lbound(InData%Vdist_low, kind=B8Ki), ubound(InData%Vdist_low, kind=B8Ki)) - call RegPack(Buf, InData%Vdist_low) - end if - call RegPack(Buf, allocated(InData%Vdist_low_full)) - if (allocated(InData%Vdist_low_full)) then - call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full, kind=B8Ki), ubound(InData%Vdist_low_full, kind=B8Ki)) - call RegPack(Buf, InData%Vdist_low_full) - end if - call RegPack(Buf, allocated(InData%Vamb_High)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vamb_low) + call RegPackAlloc(RF, InData%Vamb_lowpol) + call RegPackAlloc(RF, InData%Vdist_low) + call RegPackAlloc(RF, InData%Vdist_low_full) + call RegPack(RF, allocated(InData%Vamb_High)) if (allocated(InData%Vamb_High)) then - call RegPackBounds(Buf, 1, lbound(InData%Vamb_High, kind=B8Ki), ubound(InData%Vamb_High, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Vamb_High, kind=B8Ki), ubound(InData%Vamb_High, kind=B8Ki)) LB(1:1) = lbound(InData%Vamb_High, kind=B8Ki) UB(1:1) = ubound(InData%Vamb_High, kind=B8Ki) do i1 = LB(1), UB(1) - call AWAE_PackHighWindGrid(Buf, InData%Vamb_High(i1)) + call AWAE_PackHighWindGrid(RF, InData%Vamb_High(i1)) end do end if - call RegPack(Buf, allocated(InData%parallelFlag)) - if (allocated(InData%parallelFlag)) then - call RegPackBounds(Buf, 2, lbound(InData%parallelFlag, kind=B8Ki), ubound(InData%parallelFlag, kind=B8Ki)) - call RegPack(Buf, InData%parallelFlag) - end if - call RegPack(Buf, allocated(InData%r_s)) - if (allocated(InData%r_s)) then - call RegPackBounds(Buf, 2, lbound(InData%r_s, kind=B8Ki), ubound(InData%r_s, kind=B8Ki)) - call RegPack(Buf, InData%r_s) - end if - call RegPack(Buf, allocated(InData%r_e)) - if (allocated(InData%r_e)) then - call RegPackBounds(Buf, 2, lbound(InData%r_e, kind=B8Ki), ubound(InData%r_e, kind=B8Ki)) - call RegPack(Buf, InData%r_e) - end if - call RegPack(Buf, allocated(InData%rhat_s)) - if (allocated(InData%rhat_s)) then - call RegPackBounds(Buf, 3, lbound(InData%rhat_s, kind=B8Ki), ubound(InData%rhat_s, kind=B8Ki)) - call RegPack(Buf, InData%rhat_s) - end if - call RegPack(Buf, allocated(InData%rhat_e)) - if (allocated(InData%rhat_e)) then - call RegPackBounds(Buf, 3, lbound(InData%rhat_e, kind=B8Ki), ubound(InData%rhat_e, kind=B8Ki)) - call RegPack(Buf, InData%rhat_e) - end if - call RegPack(Buf, allocated(InData%pvec_cs)) - if (allocated(InData%pvec_cs)) then - call RegPackBounds(Buf, 3, lbound(InData%pvec_cs, kind=B8Ki), ubound(InData%pvec_cs, kind=B8Ki)) - call RegPack(Buf, InData%pvec_cs) - end if - call RegPack(Buf, allocated(InData%pvec_ce)) - if (allocated(InData%pvec_ce)) then - call RegPackBounds(Buf, 3, lbound(InData%pvec_ce, kind=B8Ki), ubound(InData%pvec_ce, kind=B8Ki)) - call RegPack(Buf, InData%pvec_ce) - end if - call RegPack(Buf, allocated(InData%outVizXYPlane)) - if (allocated(InData%outVizXYPlane)) then - call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane, kind=B8Ki), ubound(InData%outVizXYPlane, kind=B8Ki)) - call RegPack(Buf, InData%outVizXYPlane) - end if - call RegPack(Buf, allocated(InData%outVizYZPlane)) - if (allocated(InData%outVizYZPlane)) then - call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane, kind=B8Ki), ubound(InData%outVizYZPlane, kind=B8Ki)) - call RegPack(Buf, InData%outVizYZPlane) - end if - call RegPack(Buf, allocated(InData%outVizXZPlane)) - if (allocated(InData%outVizXZPlane)) then - call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane, kind=B8Ki), ubound(InData%outVizXZPlane, kind=B8Ki)) - call RegPack(Buf, InData%outVizXZPlane) - end if - call RegPack(Buf, allocated(InData%IfW)) + call RegPackAlloc(RF, InData%parallelFlag) + call RegPackAlloc(RF, InData%r_s) + call RegPackAlloc(RF, InData%r_e) + call RegPackAlloc(RF, InData%rhat_s) + call RegPackAlloc(RF, InData%rhat_e) + call RegPackAlloc(RF, InData%pvec_cs) + call RegPackAlloc(RF, InData%pvec_ce) + call RegPackAlloc(RF, InData%outVizXYPlane) + call RegPackAlloc(RF, InData%outVizYZPlane) + call RegPackAlloc(RF, InData%outVizXZPlane) + call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) LB(1:1) = lbound(InData%IfW, kind=B8Ki) UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackMisc(Buf, InData%IfW(i1)) + call InflowWind_PackMisc(RF, InData%IfW(i1)) end do end if - call InflowWind_PackInput(Buf, InData%u_IfW_Low) - call InflowWind_PackInput(Buf, InData%u_IfW_High) - call InflowWind_PackOutput(Buf, InData%y_IfW_Low) - call InflowWind_PackOutput(Buf, InData%y_IfW_High) - if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_PackInput(RF, InData%u_IfW_Low) + call InflowWind_PackInput(RF, InData%u_IfW_High) + call InflowWind_PackOutput(RF, InData%y_IfW_Low) + call InflowWind_PackOutput(RF, InData%y_IfW_High) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Vamb_low)) deallocate(OutData%Vamb_low) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vamb_low) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vamb_lowpol)) deallocate(OutData%Vamb_lowpol) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_lowpol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vamb_lowpol) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vdist_low)) deallocate(OutData%Vdist_low) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vdist_low) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vdist_low_full)) deallocate(OutData%Vdist_low_full) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vdist_low_full) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vamb_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vamb_lowpol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vdist_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vdist_low_full); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%Vamb_High)) deallocate(OutData%Vamb_High) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Vamb_High(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AWAE_UnpackHighWindGrid(Buf, OutData%Vamb_High(i1)) ! Vamb_High + call AWAE_UnpackHighWindGrid(RF, OutData%Vamb_High(i1)) ! Vamb_High end do end if - if (allocated(OutData%parallelFlag)) deallocate(OutData%parallelFlag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%parallelFlag(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%parallelFlag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%parallelFlag) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_s)) deallocate(OutData%r_s) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_s(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_s) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_e)) deallocate(OutData%r_e) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_e(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_e.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_e) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rhat_s)) deallocate(OutData%rhat_s) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rhat_s) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rhat_e)) deallocate(OutData%rhat_e) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_e.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rhat_e) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%pvec_cs)) deallocate(OutData%pvec_cs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_cs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%pvec_cs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%pvec_ce)) deallocate(OutData%pvec_ce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_ce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%pvec_ce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%outVizXYPlane)) deallocate(OutData%outVizXYPlane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXYPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%outVizXYPlane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%outVizYZPlane)) deallocate(OutData%outVizYZPlane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizYZPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%outVizYZPlane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%outVizXZPlane)) deallocate(OutData%outVizXZPlane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXZPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%outVizXZPlane) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%parallelFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rhat_s); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rhat_e); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pvec_cs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pvec_ce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outVizXYPlane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outVizYZPlane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%outVizXZPlane); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%IfW)) deallocate(OutData%IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackMisc(Buf, OutData%IfW(i1)) ! IfW + call InflowWind_UnpackMisc(RF, OutData%IfW(i1)) ! IfW end do end if - call InflowWind_UnpackInput(Buf, OutData%u_IfW_Low) ! u_IfW_Low - call InflowWind_UnpackInput(Buf, OutData%u_IfW_High) ! u_IfW_High - call InflowWind_UnpackOutput(Buf, OutData%y_IfW_Low) ! y_IfW_Low - call InflowWind_UnpackOutput(Buf, OutData%y_IfW_High) ! y_IfW_High + call InflowWind_UnpackInput(RF, OutData%u_IfW_Low) ! u_IfW_Low + call InflowWind_UnpackInput(RF, OutData%u_IfW_High) ! u_IfW_High + call InflowWind_UnpackOutput(RF, OutData%y_IfW_Low) ! y_IfW_Low + call InflowWind_UnpackOutput(RF, OutData%y_IfW_High) ! y_IfW_High end subroutine subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2673,426 +2044,149 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WindFilePath) - call RegPack(Buf, InData%NumTurbines) - call RegPack(Buf, InData%NumRadii) - call RegPack(Buf, InData%NumPlanes) - call RegPack(Buf, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPack(Buf, InData%y) - end if - call RegPack(Buf, allocated(InData%z)) - if (allocated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - call RegPack(Buf, InData%z) - end if - call RegPack(Buf, InData%Mod_AmbWind) - call RegPack(Buf, InData%nX_low) - call RegPack(Buf, InData%nY_low) - call RegPack(Buf, InData%nZ_low) - call RegPack(Buf, InData%NumGrid_low) - call RegPack(Buf, InData%n_rp_max) - call RegPack(Buf, InData%dpol) - call RegPack(Buf, InData%dXYZ_low) - call RegPack(Buf, InData%dX_low) - call RegPack(Buf, InData%dY_low) - call RegPack(Buf, InData%dZ_low) - call RegPack(Buf, InData%X0_low) - call RegPack(Buf, InData%Y0_low) - call RegPack(Buf, InData%Z0_low) - call RegPack(Buf, allocated(InData%X0_high)) - if (allocated(InData%X0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%X0_high, kind=B8Ki), ubound(InData%X0_high, kind=B8Ki)) - call RegPack(Buf, InData%X0_high) - end if - call RegPack(Buf, allocated(InData%Y0_high)) - if (allocated(InData%Y0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0_high, kind=B8Ki), ubound(InData%Y0_high, kind=B8Ki)) - call RegPack(Buf, InData%Y0_high) - end if - call RegPack(Buf, allocated(InData%Z0_high)) - if (allocated(InData%Z0_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Z0_high, kind=B8Ki), ubound(InData%Z0_high, kind=B8Ki)) - call RegPack(Buf, InData%Z0_high) - end if - call RegPack(Buf, allocated(InData%dX_high)) - if (allocated(InData%dX_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dX_high, kind=B8Ki), ubound(InData%dX_high, kind=B8Ki)) - call RegPack(Buf, InData%dX_high) - end if - call RegPack(Buf, allocated(InData%dY_high)) - if (allocated(InData%dY_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dY_high, kind=B8Ki), ubound(InData%dY_high, kind=B8Ki)) - call RegPack(Buf, InData%dY_high) - end if - call RegPack(Buf, allocated(InData%dZ_high)) - if (allocated(InData%dZ_high)) then - call RegPackBounds(Buf, 1, lbound(InData%dZ_high, kind=B8Ki), ubound(InData%dZ_high, kind=B8Ki)) - call RegPack(Buf, InData%dZ_high) - end if - call RegPack(Buf, InData%nX_high) - call RegPack(Buf, InData%nY_high) - call RegPack(Buf, InData%nZ_high) - call RegPack(Buf, allocated(InData%Grid_low)) - if (allocated(InData%Grid_low)) then - call RegPackBounds(Buf, 2, lbound(InData%Grid_low, kind=B8Ki), ubound(InData%Grid_low, kind=B8Ki)) - call RegPack(Buf, InData%Grid_low) - end if - call RegPack(Buf, allocated(InData%Grid_high)) - if (allocated(InData%Grid_high)) then - call RegPackBounds(Buf, 3, lbound(InData%Grid_high, kind=B8Ki), ubound(InData%Grid_high, kind=B8Ki)) - call RegPack(Buf, InData%Grid_high) - end if - call RegPack(Buf, allocated(InData%WT_Position)) - if (allocated(InData%WT_Position)) then - call RegPackBounds(Buf, 2, lbound(InData%WT_Position, kind=B8Ki), ubound(InData%WT_Position, kind=B8Ki)) - call RegPack(Buf, InData%WT_Position) - end if - call RegPack(Buf, InData%n_high_low) - call RegPack(Buf, InData%dt_low) - call RegPack(Buf, InData%dt_high) - call RegPack(Buf, InData%NumDT) - call RegPack(Buf, InData%Mod_Meander) - call RegPack(Buf, InData%C_Meander) - call RegPack(Buf, InData%C_ScaleDiam) - call RegPack(Buf, InData%Mod_Projection) - call RegPack(Buf, allocated(InData%IfW)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFilePath) + call RegPack(RF, InData%NumTurbines) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%NumPlanes) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%z) + call RegPack(RF, InData%Mod_AmbWind) + call RegPack(RF, InData%nX_low) + call RegPack(RF, InData%nY_low) + call RegPack(RF, InData%nZ_low) + call RegPack(RF, InData%NumGrid_low) + call RegPack(RF, InData%n_rp_max) + call RegPack(RF, InData%dpol) + call RegPack(RF, InData%dXYZ_low) + call RegPack(RF, InData%dX_low) + call RegPack(RF, InData%dY_low) + call RegPack(RF, InData%dZ_low) + call RegPack(RF, InData%X0_low) + call RegPack(RF, InData%Y0_low) + call RegPack(RF, InData%Z0_low) + call RegPackAlloc(RF, InData%X0_high) + call RegPackAlloc(RF, InData%Y0_high) + call RegPackAlloc(RF, InData%Z0_high) + call RegPackAlloc(RF, InData%dX_high) + call RegPackAlloc(RF, InData%dY_high) + call RegPackAlloc(RF, InData%dZ_high) + call RegPack(RF, InData%nX_high) + call RegPack(RF, InData%nY_high) + call RegPack(RF, InData%nZ_high) + call RegPackAlloc(RF, InData%Grid_low) + call RegPackAlloc(RF, InData%Grid_high) + call RegPackAlloc(RF, InData%WT_Position) + call RegPack(RF, InData%n_high_low) + call RegPack(RF, InData%dt_low) + call RegPack(RF, InData%dt_high) + call RegPack(RF, InData%NumDT) + call RegPack(RF, InData%Mod_Meander) + call RegPack(RF, InData%C_Meander) + call RegPack(RF, InData%C_ScaleDiam) + call RegPack(RF, InData%Mod_Projection) + call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) LB(1:1) = lbound(InData%IfW, kind=B8Ki) UB(1:1) = ubound(InData%IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackParam(Buf, InData%IfW(i1)) + call InflowWind_PackParam(RF, InData%IfW(i1)) end do end if - call RegPack(Buf, InData%WrDisSkp1) - call RegPack(Buf, InData%WrDisWind) - call RegPack(Buf, InData%NOutDisWindXY) - call RegPack(Buf, allocated(InData%OutDisWindZ)) - if (allocated(InData%OutDisWindZ)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ, kind=B8Ki), ubound(InData%OutDisWindZ, kind=B8Ki)) - call RegPack(Buf, InData%OutDisWindZ) - end if - call RegPack(Buf, InData%NOutDisWindYZ) - call RegPack(Buf, allocated(InData%OutDisWindX)) - if (allocated(InData%OutDisWindX)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX, kind=B8Ki), ubound(InData%OutDisWindX, kind=B8Ki)) - call RegPack(Buf, InData%OutDisWindX) - end if - call RegPack(Buf, InData%NOutDisWindXZ) - call RegPack(Buf, allocated(InData%OutDisWindY)) - if (allocated(InData%OutDisWindY)) then - call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY, kind=B8Ki), ubound(InData%OutDisWindY, kind=B8Ki)) - call RegPack(Buf, InData%OutDisWindY) - end if - call RegPack(Buf, InData%OutFileRoot) - call RegPack(Buf, InData%OutFileVTKRoot) - call RegPack(Buf, InData%VTK_tWidth) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%WrDisSkp1) + call RegPack(RF, InData%WrDisWind) + call RegPack(RF, InData%NOutDisWindXY) + call RegPackAlloc(RF, InData%OutDisWindZ) + call RegPack(RF, InData%NOutDisWindYZ) + call RegPackAlloc(RF, InData%OutDisWindX) + call RegPack(RF, InData%NOutDisWindXZ) + call RegPackAlloc(RF, InData%OutDisWindY) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%OutFileVTKRoot) + call RegPack(RF, InData%VTK_tWidth) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WindFilePath) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTurbines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%z) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Mod_AmbWind) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumGrid_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_rp_max) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dpol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dXYZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z0_low) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%X0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Z0_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dX_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dY_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dZ_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Grid_low)) deallocate(OutData%Grid_low) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Grid_low(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Grid_low) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Grid_high)) deallocate(OutData%Grid_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Grid_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WT_Position) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%n_high_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt_high) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_Meander) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_Meander) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_ScaleDiam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_Projection) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFilePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_AmbWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumGrid_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_rp_max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dpol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dXYZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dX_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dY_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dZ_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%X0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Z0_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nX_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nY_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nZ_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Grid_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Grid_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WT_Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_high_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Meander); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_ScaleDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Projection); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%IfW)) deallocate(OutData%IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackParam(Buf, OutData%IfW(i1)) ! IfW + call InflowWind_UnpackParam(RF, OutData%IfW(i1)) ! IfW end do end if - call RegUnpack(Buf, OutData%WrDisSkp1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrDisWind) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NOutDisWindXY) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutDisWindZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutDisWindZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NOutDisWindYZ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutDisWindX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutDisWindX) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NOutDisWindXZ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutDisWindY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutDisWindY) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFileVTKRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_tWidth) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%WrDisSkp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrDisWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindYZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutDisWindXZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutDisWindY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileVTKRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3193,106 +2287,53 @@ subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOutput' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Vdist_High)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(Buf, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) do i1 = LB(1), UB(1) - call AWAE_PackHighWindGrid(Buf, InData%Vdist_High(i1)) + call AWAE_PackHighWindGrid(RF, InData%Vdist_High(i1)) end do end if - call RegPack(Buf, allocated(InData%V_plane)) - if (allocated(InData%V_plane)) then - call RegPackBounds(Buf, 3, lbound(InData%V_plane, kind=B8Ki), ubound(InData%V_plane, kind=B8Ki)) - call RegPack(Buf, InData%V_plane) - end if - call RegPack(Buf, allocated(InData%TI_amb)) - if (allocated(InData%TI_amb)) then - call RegPackBounds(Buf, 1, lbound(InData%TI_amb, kind=B8Ki), ubound(InData%TI_amb, kind=B8Ki)) - call RegPack(Buf, InData%TI_amb) - end if - call RegPack(Buf, allocated(InData%Vx_wind_disk)) - if (allocated(InData%Vx_wind_disk)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk, kind=B8Ki), ubound(InData%Vx_wind_disk, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wind_disk) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%V_plane) + call RegPackAlloc(RF, InData%TI_amb) + call RegPackAlloc(RF, InData%Vx_wind_disk) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AWAE_UnpackHighWindGrid(Buf, OutData%Vdist_High(i1)) ! Vdist_High + call AWAE_UnpackHighWindGrid(RF, OutData%Vdist_High(i1)) ! Vdist_High end do end if - if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TI_amb)) deallocate(OutData%TI_amb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI_amb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI_amb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wind_disk)) deallocate(OutData%Vx_wind_disk) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wind_disk(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wind_disk) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%V_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wind_disk); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -3422,155 +2463,36 @@ subroutine AWAE_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine AWAE_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(AWAE_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%xhat_plane)) - if (allocated(InData%xhat_plane)) then - call RegPackBounds(Buf, 3, lbound(InData%xhat_plane, kind=B8Ki), ubound(InData%xhat_plane, kind=B8Ki)) - call RegPack(Buf, InData%xhat_plane) - end if - call RegPack(Buf, allocated(InData%p_plane)) - if (allocated(InData%p_plane)) then - call RegPackBounds(Buf, 3, lbound(InData%p_plane, kind=B8Ki), ubound(InData%p_plane, kind=B8Ki)) - call RegPack(Buf, InData%p_plane) - end if - call RegPack(Buf, allocated(InData%Vx_wake)) - if (allocated(InData%Vx_wake)) then - call RegPackBounds(Buf, 4, lbound(InData%Vx_wake, kind=B8Ki), ubound(InData%Vx_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wake) - end if - call RegPack(Buf, allocated(InData%Vy_wake)) - if (allocated(InData%Vy_wake)) then - call RegPackBounds(Buf, 4, lbound(InData%Vy_wake, kind=B8Ki), ubound(InData%Vy_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vy_wake) - end if - call RegPack(Buf, allocated(InData%Vz_wake)) - if (allocated(InData%Vz_wake)) then - call RegPackBounds(Buf, 4, lbound(InData%Vz_wake, kind=B8Ki), ubound(InData%Vz_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vz_wake) - end if - call RegPack(Buf, allocated(InData%D_wake)) - if (allocated(InData%D_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%D_wake, kind=B8Ki), ubound(InData%D_wake, kind=B8Ki)) - call RegPack(Buf, InData%D_wake) - end if - call RegPack(Buf, allocated(InData%WAT_k_mt)) - if (allocated(InData%WAT_k_mt)) then - call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt, kind=B8Ki), ubound(InData%WAT_k_mt, kind=B8Ki)) - call RegPack(Buf, InData%WAT_k_mt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xhat_plane) + call RegPackAlloc(RF, InData%p_plane) + call RegPackAlloc(RF, InData%Vx_wake) + call RegPackAlloc(RF, InData%Vy_wake) + call RegPackAlloc(RF, InData%Vz_wake) + call RegPackAlloc(RF, InData%D_wake) + call RegPackAlloc(RF, InData%WAT_k_mt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AWAE_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine AWAE_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(AWAE_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInput' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xhat_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%p_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vy_wake)) deallocate(OutData%Vy_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vy_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vz_wake)) deallocate(OutData%Vz_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vz_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WAT_k_mt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xhat_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WAT_k_mt); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 6e3e5b9acf..305961ca01 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -370,58 +370,45 @@ subroutine BD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine BD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%gravity) - call RegPack(Buf, InData%GlbPos) - call RegPack(Buf, InData%GlbRot) - call RegPack(Buf, InData%RootDisp) - call RegPack(Buf, InData%RootOri) - call RegPack(Buf, InData%RootVel) - call RegPack(Buf, InData%HubPos) - call RegPack(Buf, InData%HubRot) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%DynamicSolve) - call RegPack(Buf, InData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%GlbPos) + call RegPack(RF, InData%GlbRot) + call RegPack(RF, InData%RootDisp) + call RegPack(RF, InData%RootOri) + call RegPack(RF, InData%RootVel) + call RegPack(RF, InData%HubPos) + call RegPack(RF, InData%HubRot) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%DynamicSolve) + call RegPack(RF, InData%CompAeroMaps) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GlbPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GlbRot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootOri) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubRot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DynamicSolve) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootOri); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DynamicSolve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -620,236 +607,48 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%kp_coordinate)) - if (allocated(InData%kp_coordinate)) then - call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate, kind=B8Ki), ubound(InData%kp_coordinate, kind=B8Ki)) - call RegPack(Buf, InData%kp_coordinate) - end if - call RegPack(Buf, InData%kp_total) - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%kp_coordinate) + call RegPack(RF, InData%kp_total) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%kp_coordinate) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%kp_total) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%kp_coordinate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kp_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -923,91 +722,36 @@ subroutine BD_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackBladeInputData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackBladeInputData(RF, Indata) + type(RegFile), intent(inout) :: RF type(BladeInputData), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackBladeInputData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%station_total) - call RegPack(Buf, InData%format_index) - call RegPack(Buf, allocated(InData%station_eta)) - if (allocated(InData%station_eta)) then - call RegPackBounds(Buf, 1, lbound(InData%station_eta, kind=B8Ki), ubound(InData%station_eta, kind=B8Ki)) - call RegPack(Buf, InData%station_eta) - end if - call RegPack(Buf, allocated(InData%stiff0)) - if (allocated(InData%stiff0)) then - call RegPackBounds(Buf, 3, lbound(InData%stiff0, kind=B8Ki), ubound(InData%stiff0, kind=B8Ki)) - call RegPack(Buf, InData%stiff0) - end if - call RegPack(Buf, allocated(InData%mass0)) - if (allocated(InData%mass0)) then - call RegPackBounds(Buf, 3, lbound(InData%mass0, kind=B8Ki), ubound(InData%mass0, kind=B8Ki)) - call RegPack(Buf, InData%mass0) - end if - call RegPack(Buf, InData%beta) - call RegPack(Buf, InData%damp_flag) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%station_total) + call RegPack(RF, InData%format_index) + call RegPackAlloc(RF, InData%station_eta) + call RegPackAlloc(RF, InData%stiff0) + call RegPackAlloc(RF, InData%mass0) + call RegPack(RF, InData%beta) + call RegPack(RF, InData%damp_flag) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackBladeInputData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackBladeInputData(RF, OutData) + type(RegFile), intent(inout) :: RF type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%station_total) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%format_index) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%station_eta)) deallocate(OutData%station_eta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%station_eta(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%station_eta) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%stiff0)) deallocate(OutData%stiff0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%stiff0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%mass0)) deallocate(OutData%mass0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%mass0) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%beta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%damp_flag) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%station_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%format_index); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%station_eta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%stiff0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%mass0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%damp_flag); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -1146,212 +890,96 @@ subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%member_total) - call RegPack(Buf, InData%kp_total) - call RegPack(Buf, allocated(InData%kp_member)) - if (allocated(InData%kp_member)) then - call RegPackBounds(Buf, 1, lbound(InData%kp_member, kind=B8Ki), ubound(InData%kp_member, kind=B8Ki)) - call RegPack(Buf, InData%kp_member) - end if - call RegPack(Buf, InData%order_elem) - call RegPack(Buf, InData%load_retries) - call RegPack(Buf, InData%NRMax) - call RegPack(Buf, InData%quadrature) - call RegPack(Buf, InData%n_fact) - call RegPack(Buf, InData%refine) - call RegPack(Buf, InData%rhoinf) - call RegPack(Buf, InData%DTBeam) - call BD_PackBladeInputData(Buf, InData%InpBl) - call RegPack(Buf, InData%BldFile) - call RegPack(Buf, InData%UsePitchAct) - call RegPack(Buf, InData%QuasiStaticInit) - call RegPack(Buf, InData%stop_tol) - call RegPack(Buf, InData%tngt_stf_pert) - call RegPack(Buf, InData%tngt_stf_difftol) - call RegPack(Buf, allocated(InData%kp_coordinate)) - if (allocated(InData%kp_coordinate)) then - call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate, kind=B8Ki), ubound(InData%kp_coordinate, kind=B8Ki)) - call RegPack(Buf, InData%kp_coordinate) - end if - call RegPack(Buf, InData%pitchJ) - call RegPack(Buf, InData%pitchK) - call RegPack(Buf, InData%pitchC) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%RotStates) - call RegPack(Buf, InData%RelStates) - call RegPack(Buf, InData%tngt_stf_fd) - call RegPack(Buf, InData%tngt_stf_comp) - call RegPack(Buf, InData%NNodeOuts) - call RegPack(Buf, InData%OutNd) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%BldNd_NumOuts) - call RegPack(Buf, allocated(InData%BldNd_OutList)) - if (allocated(InData%BldNd_OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList, kind=B8Ki), ubound(InData%BldNd_OutList, kind=B8Ki)) - call RegPack(Buf, InData%BldNd_OutList) - end if - call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) - if (allocated(InData%BldNd_BlOutNd)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd, kind=B8Ki), ubound(InData%BldNd_BlOutNd, kind=B8Ki)) - call RegPack(Buf, InData%BldNd_BlOutNd) - end if - call RegPack(Buf, InData%BldNd_BlOutNd_Str) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%member_total) + call RegPack(RF, InData%kp_total) + call RegPackAlloc(RF, InData%kp_member) + call RegPack(RF, InData%order_elem) + call RegPack(RF, InData%load_retries) + call RegPack(RF, InData%NRMax) + call RegPack(RF, InData%quadrature) + call RegPack(RF, InData%n_fact) + call RegPack(RF, InData%refine) + call RegPack(RF, InData%rhoinf) + call RegPack(RF, InData%DTBeam) + call BD_PackBladeInputData(RF, InData%InpBl) + call RegPack(RF, InData%BldFile) + call RegPack(RF, InData%UsePitchAct) + call RegPack(RF, InData%QuasiStaticInit) + call RegPack(RF, InData%stop_tol) + call RegPack(RF, InData%tngt_stf_pert) + call RegPack(RF, InData%tngt_stf_difftol) + call RegPackAlloc(RF, InData%kp_coordinate) + call RegPack(RF, InData%pitchJ) + call RegPack(RF, InData%pitchK) + call RegPack(RF, InData%pitchC) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%RotStates) + call RegPack(RF, InData%RelStates) + call RegPack(RF, InData%tngt_stf_fd) + call RegPack(RF, InData%tngt_stf_comp) + call RegPack(RF, InData%NNodeOuts) + call RegPack(RF, InData%OutNd) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPackAlloc(RF, InData%BldNd_OutList) + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPack(RF, InData%BldNd_BlOutNd_Str) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInputFile' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%member_total) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kp_total) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%kp_member)) deallocate(OutData%kp_member) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%kp_member(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%kp_member) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%order_elem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%load_retries) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NRMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%quadrature) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_fact) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%refine) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhoinf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTBeam) - if (RegCheckErr(Buf, RoutineName)) return - call BD_UnpackBladeInputData(Buf, OutData%InpBl) ! InpBl - call RegUnpack(Buf, OutData%BldFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UsePitchAct) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%QuasiStaticInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%stop_tol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_pert) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_difftol) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%kp_coordinate) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%pitchJ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RelStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_fd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_comp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NNodeOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldNd_OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldNd_BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%member_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kp_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%kp_member); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%order_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%load_retries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NRMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%quadrature); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_fact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%refine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTBeam); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackBladeInputData(RF, OutData%InpBl) ! InpBl + call RegUnpack(RF, OutData%BldFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePitchAct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%QuasiStaticInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stop_tol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_pert); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_difftol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%kp_coordinate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_comp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NNodeOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BlOutNd_Str); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1406,60 +1034,26 @@ subroutine BD_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%q)) - if (allocated(InData%q)) then - call RegPackBounds(Buf, 2, lbound(InData%q, kind=B8Ki), ubound(InData%q, kind=B8Ki)) - call RegPack(Buf, InData%q) - end if - call RegPack(Buf, allocated(InData%dqdt)) - if (allocated(InData%dqdt)) then - call RegPackBounds(Buf, 2, lbound(InData%dqdt, kind=B8Ki), ubound(InData%dqdt, kind=B8Ki)) - call RegPack(Buf, InData%dqdt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%dqdt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackContState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%q)) deallocate(OutData%q) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%q) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dqdt)) deallocate(OutData%dqdt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dqdt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dqdt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dqdt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -1484,25 +1078,23 @@ subroutine BD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine BD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%thetaP) - call RegPack(Buf, InData%thetaPD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%thetaP) + call RegPack(RF, InData%thetaPD) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%thetaP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%thetaPD) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%thetaP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%thetaPD); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1526,22 +1118,21 @@ subroutine BD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine BD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1601,75 +1192,36 @@ subroutine BD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%acc)) - if (allocated(InData%acc)) then - call RegPackBounds(Buf, 2, lbound(InData%acc, kind=B8Ki), ubound(InData%acc, kind=B8Ki)) - call RegPack(Buf, InData%acc) - end if - call RegPack(Buf, allocated(InData%xcc)) - if (allocated(InData%xcc)) then - call RegPackBounds(Buf, 2, lbound(InData%xcc, kind=B8Ki), ubound(InData%xcc, kind=B8Ki)) - call RegPack(Buf, InData%xcc) - end if - call RegPack(Buf, InData%InitAcc) - call RegPack(Buf, InData%RunQuasiStaticInit) - call RegPack(Buf, InData%GlbPos) - call RegPack(Buf, InData%GlbRot) - call RegPack(Buf, InData%Glb_crv) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%acc) + call RegPackAlloc(RF, InData%xcc) + call RegPack(RF, InData%InitAcc) + call RegPack(RF, InData%RunQuasiStaticInit) + call RegPack(RF, InData%GlbPos) + call RegPack(RF, InData%GlbRot) + call RegPack(RF, InData%Glb_crv) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOtherState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%acc)) deallocate(OutData%acc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%acc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%acc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%xcc)) deallocate(OutData%xcc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xcc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xcc) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%InitAcc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RunQuasiStaticInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GlbPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GlbRot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Glb_crv) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%acc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RunQuasiStaticInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GlbRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Glb_crv); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg) @@ -1724,60 +1276,26 @@ subroutine BD_DestroyqpParam(qpParamData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackqpParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackqpParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(qpParam), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackqpParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%mmm)) - if (allocated(InData%mmm)) then - call RegPackBounds(Buf, 2, lbound(InData%mmm, kind=B8Ki), ubound(InData%mmm, kind=B8Ki)) - call RegPack(Buf, InData%mmm) - end if - call RegPack(Buf, allocated(InData%mEta)) - if (allocated(InData%mEta)) then - call RegPackBounds(Buf, 3, lbound(InData%mEta, kind=B8Ki), ubound(InData%mEta, kind=B8Ki)) - call RegPack(Buf, InData%mEta) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%mmm) + call RegPackAlloc(RF, InData%mEta) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackqpParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackqpParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(qpParam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackqpParam' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%mmm)) deallocate(OutData%mmm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%mmm(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%mmm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%mEta)) deallocate(OutData%mEta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%mEta) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%mmm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%mEta); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2302,716 +1820,221 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%coef) - call RegPack(Buf, InData%rhoinf) - call RegPack(Buf, allocated(InData%uuN0)) - if (allocated(InData%uuN0)) then - call RegPackBounds(Buf, 3, lbound(InData%uuN0, kind=B8Ki), ubound(InData%uuN0, kind=B8Ki)) - call RegPack(Buf, InData%uuN0) - end if - call RegPack(Buf, allocated(InData%twN0)) - if (allocated(InData%twN0)) then - call RegPackBounds(Buf, 2, lbound(InData%twN0, kind=B8Ki), ubound(InData%twN0, kind=B8Ki)) - call RegPack(Buf, InData%twN0) - end if - call RegPack(Buf, allocated(InData%Stif0_QP)) - if (allocated(InData%Stif0_QP)) then - call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP, kind=B8Ki), ubound(InData%Stif0_QP, kind=B8Ki)) - call RegPack(Buf, InData%Stif0_QP) - end if - call RegPack(Buf, allocated(InData%Mass0_QP)) - if (allocated(InData%Mass0_QP)) then - call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP, kind=B8Ki), ubound(InData%Mass0_QP, kind=B8Ki)) - call RegPack(Buf, InData%Mass0_QP) - end if - call RegPack(Buf, InData%gravity) - call RegPack(Buf, allocated(InData%segment_eta)) - if (allocated(InData%segment_eta)) then - call RegPackBounds(Buf, 1, lbound(InData%segment_eta, kind=B8Ki), ubound(InData%segment_eta, kind=B8Ki)) - call RegPack(Buf, InData%segment_eta) - end if - call RegPack(Buf, allocated(InData%member_eta)) - if (allocated(InData%member_eta)) then - call RegPackBounds(Buf, 1, lbound(InData%member_eta, kind=B8Ki), ubound(InData%member_eta, kind=B8Ki)) - call RegPack(Buf, InData%member_eta) - end if - call RegPack(Buf, InData%blade_length) - call RegPack(Buf, InData%blade_mass) - call RegPack(Buf, InData%blade_CG) - call RegPack(Buf, InData%blade_IN) - call RegPack(Buf, InData%beta) - call RegPack(Buf, InData%tol) - call RegPack(Buf, allocated(InData%QPtN)) - if (allocated(InData%QPtN)) then - call RegPackBounds(Buf, 1, lbound(InData%QPtN, kind=B8Ki), ubound(InData%QPtN, kind=B8Ki)) - call RegPack(Buf, InData%QPtN) - end if - call RegPack(Buf, allocated(InData%QPtWeight)) - if (allocated(InData%QPtWeight)) then - call RegPackBounds(Buf, 1, lbound(InData%QPtWeight, kind=B8Ki), ubound(InData%QPtWeight, kind=B8Ki)) - call RegPack(Buf, InData%QPtWeight) - end if - call RegPack(Buf, allocated(InData%Shp)) - if (allocated(InData%Shp)) then - call RegPackBounds(Buf, 2, lbound(InData%Shp, kind=B8Ki), ubound(InData%Shp, kind=B8Ki)) - call RegPack(Buf, InData%Shp) - end if - call RegPack(Buf, allocated(InData%ShpDer)) - if (allocated(InData%ShpDer)) then - call RegPackBounds(Buf, 2, lbound(InData%ShpDer, kind=B8Ki), ubound(InData%ShpDer, kind=B8Ki)) - call RegPack(Buf, InData%ShpDer) - end if - call RegPack(Buf, allocated(InData%Jacobian)) - if (allocated(InData%Jacobian)) then - call RegPackBounds(Buf, 2, lbound(InData%Jacobian, kind=B8Ki), ubound(InData%Jacobian, kind=B8Ki)) - call RegPack(Buf, InData%Jacobian) - end if - call RegPack(Buf, allocated(InData%uu0)) - if (allocated(InData%uu0)) then - call RegPackBounds(Buf, 3, lbound(InData%uu0, kind=B8Ki), ubound(InData%uu0, kind=B8Ki)) - call RegPack(Buf, InData%uu0) - end if - call RegPack(Buf, allocated(InData%E10)) - if (allocated(InData%E10)) then - call RegPackBounds(Buf, 3, lbound(InData%E10, kind=B8Ki), ubound(InData%E10, kind=B8Ki)) - call RegPack(Buf, InData%E10) - end if - call RegPack(Buf, InData%nodes_per_elem) - call RegPack(Buf, allocated(InData%node_elem_idx)) - if (allocated(InData%node_elem_idx)) then - call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx, kind=B8Ki), ubound(InData%node_elem_idx, kind=B8Ki)) - call RegPack(Buf, InData%node_elem_idx) - end if - call RegPack(Buf, InData%refine) - call RegPack(Buf, InData%dof_node) - call RegPack(Buf, InData%dof_elem) - call RegPack(Buf, InData%rot_elem) - call RegPack(Buf, InData%elem_total) - call RegPack(Buf, InData%node_total) - call RegPack(Buf, InData%dof_total) - call RegPack(Buf, InData%nqp) - call RegPack(Buf, InData%analysis_type) - call RegPack(Buf, InData%damp_flag) - call RegPack(Buf, InData%ld_retries) - call RegPack(Buf, InData%niter) - call RegPack(Buf, InData%quadrature) - call RegPack(Buf, InData%n_fact) - call RegPack(Buf, InData%OutInputs) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt) + call RegPack(RF, InData%coef) + call RegPack(RF, InData%rhoinf) + call RegPackAlloc(RF, InData%uuN0) + call RegPackAlloc(RF, InData%twN0) + call RegPackAlloc(RF, InData%Stif0_QP) + call RegPackAlloc(RF, InData%Mass0_QP) + call RegPack(RF, InData%gravity) + call RegPackAlloc(RF, InData%segment_eta) + call RegPackAlloc(RF, InData%member_eta) + call RegPack(RF, InData%blade_length) + call RegPack(RF, InData%blade_mass) + call RegPack(RF, InData%blade_CG) + call RegPack(RF, InData%blade_IN) + call RegPack(RF, InData%beta) + call RegPack(RF, InData%tol) + call RegPackAlloc(RF, InData%QPtN) + call RegPackAlloc(RF, InData%QPtWeight) + call RegPackAlloc(RF, InData%Shp) + call RegPackAlloc(RF, InData%ShpDer) + call RegPackAlloc(RF, InData%Jacobian) + call RegPackAlloc(RF, InData%uu0) + call RegPackAlloc(RF, InData%E10) + call RegPack(RF, InData%nodes_per_elem) + call RegPackAlloc(RF, InData%node_elem_idx) + call RegPack(RF, InData%refine) + call RegPack(RF, InData%dof_node) + call RegPack(RF, InData%dof_elem) + call RegPack(RF, InData%rot_elem) + call RegPack(RF, InData%elem_total) + call RegPack(RF, InData%node_total) + call RegPack(RF, InData%dof_total) + call RegPack(RF, InData%nqp) + call RegPack(RF, InData%analysis_type) + call RegPack(RF, InData%damp_flag) + call RegPack(RF, InData%ld_retries) + call RegPack(RF, InData%niter) + call RegPack(RF, InData%quadrature) + call RegPack(RF, InData%n_fact) + call RegPack(RF, InData%OutInputs) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%NNodeOuts) - call RegPack(Buf, InData%OutNd) - call RegPack(Buf, allocated(InData%NdIndx)) - if (allocated(InData%NdIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%NdIndx, kind=B8Ki), ubound(InData%NdIndx, kind=B8Ki)) - call RegPack(Buf, InData%NdIndx) - end if - call RegPack(Buf, allocated(InData%NdIndxInverse)) - if (allocated(InData%NdIndxInverse)) then - call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse, kind=B8Ki), ubound(InData%NdIndxInverse, kind=B8Ki)) - call RegPack(Buf, InData%NdIndxInverse) - end if - call RegPack(Buf, allocated(InData%OutNd2NdElem)) - if (allocated(InData%OutNd2NdElem)) then - call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem, kind=B8Ki), ubound(InData%OutNd2NdElem, kind=B8Ki)) - call RegPack(Buf, InData%OutNd2NdElem) - end if - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%UsePitchAct) - call RegPack(Buf, InData%pitchJ) - call RegPack(Buf, InData%pitchK) - call RegPack(Buf, InData%pitchC) - call RegPack(Buf, InData%torqM) - call BD_PackqpParam(Buf, InData%qp) - call RegPack(Buf, InData%qp_indx_offset) - call RegPack(Buf, InData%BldMotionNodeLoc) - call RegPack(Buf, InData%tngt_stf_fd) - call RegPack(Buf, InData%tngt_stf_comp) - call RegPack(Buf, InData%tngt_stf_pert) - call RegPack(Buf, InData%tngt_stf_difftol) - call RegPack(Buf, InData%BldNd_NumOuts) - call RegPack(Buf, InData%BldNd_TotNumOuts) - call RegPack(Buf, allocated(InData%BldNd_OutParam)) + call RegPack(RF, InData%NNodeOuts) + call RegPack(RF, InData%OutNd) + call RegPackAlloc(RF, InData%NdIndx) + call RegPackAlloc(RF, InData%NdIndxInverse) + call RegPackAlloc(RF, InData%OutNd2NdElem) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%UsePitchAct) + call RegPack(RF, InData%pitchJ) + call RegPack(RF, InData%pitchK) + call RegPack(RF, InData%pitchC) + call RegPack(RF, InData%torqM) + call BD_PackqpParam(RF, InData%qp) + call RegPack(RF, InData%qp_indx_offset) + call RegPack(RF, InData%BldMotionNodeLoc) + call RegPack(RF, InData%tngt_stf_fd) + call RegPack(RF, InData%tngt_stf_comp) + call RegPack(RF, InData%tngt_stf_pert) + call RegPack(RF, InData%tngt_stf_difftol) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do end if - call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) - if (allocated(InData%BldNd_BlOutNd)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd, kind=B8Ki), ubound(InData%BldNd_BlOutNd, kind=B8Ki)) - call RegPack(Buf, InData%BldNd_BlOutNd) - end if - call RegPack(Buf, allocated(InData%QPtw_Shp_Shp_Jac)) - if (allocated(InData%QPtw_Shp_Shp_Jac)) then - call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac, kind=B8Ki), ubound(InData%QPtw_Shp_Shp_Jac, kind=B8Ki)) - call RegPack(Buf, InData%QPtw_Shp_Shp_Jac) - end if - call RegPack(Buf, allocated(InData%QPtw_Shp_ShpDer)) - if (allocated(InData%QPtw_Shp_ShpDer)) then - call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer, kind=B8Ki), ubound(InData%QPtw_Shp_ShpDer, kind=B8Ki)) - call RegPack(Buf, InData%QPtw_Shp_ShpDer) - end if - call RegPack(Buf, allocated(InData%QPtw_ShpDer_ShpDer_Jac)) - if (allocated(InData%QPtw_ShpDer_ShpDer_Jac)) then - call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki), ubound(InData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki)) - call RegPack(Buf, InData%QPtw_ShpDer_ShpDer_Jac) - end if - call RegPack(Buf, allocated(InData%QPtw_Shp_Jac)) - if (allocated(InData%QPtw_Shp_Jac)) then - call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac, kind=B8Ki), ubound(InData%QPtw_Shp_Jac, kind=B8Ki)) - call RegPack(Buf, InData%QPtw_Shp_Jac) - end if - call RegPack(Buf, allocated(InData%QPtw_ShpDer)) - if (allocated(InData%QPtw_ShpDer)) then - call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer, kind=B8Ki), ubound(InData%QPtw_ShpDer, kind=B8Ki)) - call RegPack(Buf, InData%QPtw_ShpDer) - end if - call RegPack(Buf, allocated(InData%FEweight)) - if (allocated(InData%FEweight)) then - call RegPackBounds(Buf, 2, lbound(InData%FEweight, kind=B8Ki), ubound(InData%FEweight, kind=B8Ki)) - call RegPack(Buf, InData%FEweight) - end if - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, InData%dx) - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%Jac_nx) - call RegPack(Buf, InData%RotStates) - call RegPack(Buf, InData%RelStates) - call RegPack(Buf, InData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%BldNd_BlOutNd) + call RegPackAlloc(RF, InData%QPtw_Shp_Shp_Jac) + call RegPackAlloc(RF, InData%QPtw_Shp_ShpDer) + call RegPackAlloc(RF, InData%QPtw_ShpDer_ShpDer_Jac) + call RegPackAlloc(RF, InData%QPtw_Shp_Jac) + call RegPackAlloc(RF, InData%QPtw_ShpDer) + call RegPackAlloc(RF, InData%FEweight) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPack(RF, InData%RotStates) + call RegPack(RF, InData%RelStates) + call RegPack(RF, InData%CompAeroMaps) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%coef) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhoinf) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%uuN0)) deallocate(OutData%uuN0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uuN0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%twN0)) deallocate(OutData%twN0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%twN0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%twN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%twN0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Stif0_QP)) deallocate(OutData%Stif0_QP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Stif0_QP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Mass0_QP)) deallocate(OutData%Mass0_QP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mass0_QP) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%gravity) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%segment_eta)) deallocate(OutData%segment_eta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%segment_eta(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%segment_eta) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%member_eta)) deallocate(OutData%member_eta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%member_eta(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%member_eta) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%blade_length) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%blade_mass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%blade_CG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%blade_IN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%beta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tol) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%QPtN)) deallocate(OutData%QPtN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QPtWeight)) deallocate(OutData%QPtWeight) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtWeight(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtWeight) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Shp)) deallocate(OutData%Shp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Shp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Shp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ShpDer)) deallocate(OutData%ShpDer) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ShpDer(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ShpDer) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jacobian)) deallocate(OutData%Jacobian) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jacobian(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jacobian) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%uu0)) deallocate(OutData%uu0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uu0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%E10)) deallocate(OutData%E10) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%E10) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nodes_per_elem) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%node_elem_idx)) deallocate(OutData%node_elem_idx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%node_elem_idx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%refine) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dof_node) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dof_elem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rot_elem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%elem_total) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%node_total) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dof_total) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nqp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%analysis_type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%damp_flag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ld_retries) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%niter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%quadrature) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_fact) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutInputs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%coef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoinf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uuN0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%twN0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stif0_QP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mass0_QP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%segment_eta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%member_eta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_length); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_mass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_CG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%blade_IN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Shp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShpDer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jacobian); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uu0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%E10); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nodes_per_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%node_elem_idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%refine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dof_node); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dof_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rot_elem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%elem_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%node_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dof_total); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nqp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%analysis_type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%damp_flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ld_retries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%niter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%quadrature); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_fact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%NNodeOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutNd) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NdIndx)) deallocate(OutData%NdIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NdIndx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NdIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NdIndxInverse)) deallocate(OutData%NdIndxInverse) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NdIndxInverse(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NdIndxInverse) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OutNd2NdElem)) deallocate(OutData%OutNd2NdElem) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutNd2NdElem) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UsePitchAct) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchJ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitchC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%torqM) - if (RegCheckErr(Buf, RoutineName)) return - call BD_UnpackqpParam(Buf, OutData%qp) ! qp - call RegUnpack(Buf, OutData%qp_indx_offset) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldMotionNodeLoc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_fd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_comp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_pert) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tngt_stf_difftol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_TotNumOuts) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NNodeOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NdIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NdIndxInverse); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutNd2NdElem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePitchAct); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitchC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%torqM); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackqpParam(RF, OutData%qp) ! qp + call RegUnpack(RF, OutData%qp_indx_offset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldMotionNodeLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_comp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_pert); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tngt_stf_difftol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldNd_BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QPtw_Shp_Shp_Jac)) deallocate(OutData%QPtw_Shp_Shp_Jac) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtw_Shp_Shp_Jac) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QPtw_Shp_ShpDer)) deallocate(OutData%QPtw_Shp_ShpDer) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtw_Shp_ShpDer) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QPtw_ShpDer_ShpDer_Jac)) deallocate(OutData%QPtw_ShpDer_ShpDer_Jac) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtw_ShpDer_ShpDer_Jac) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QPtw_Shp_Jac)) deallocate(OutData%QPtw_Shp_Jac) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtw_Shp_Jac) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QPtw_ShpDer)) deallocate(OutData%QPtw_ShpDer) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QPtw_ShpDer) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FEweight)) deallocate(OutData%FEweight) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FEweight(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FEweight) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RelStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_BlOutNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_Shp_Shp_Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_Shp_ShpDer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_ShpDer_ShpDer_Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_Shp_Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QPtw_ShpDer); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FEweight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RelStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -3058,27 +2081,27 @@ subroutine BD_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine BD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%RootMotion) - call MeshPack(Buf, InData%PointLoad) - call MeshPack(Buf, InData%DistrLoad) - call MeshPack(Buf, InData%HubMotion) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%RootMotion) + call MeshPack(RF, InData%PointLoad) + call MeshPack(RF, InData%DistrLoad) + call MeshPack(RF, InData%HubMotion) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%RootMotion) ! RootMotion - call MeshUnpack(Buf, OutData%PointLoad) ! PointLoad - call MeshUnpack(Buf, OutData%DistrLoad) ! DistrLoad - call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%RootMotion) ! RootMotion + call MeshUnpack(RF, OutData%PointLoad) ! PointLoad + call MeshUnpack(RF, OutData%DistrLoad) ! DistrLoad + call MeshUnpack(RF, OutData%HubMotion) ! HubMotion end subroutine subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3133,51 +2156,32 @@ subroutine BD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%ReactionForce) - call MeshPack(Buf, InData%BldMotion) - call RegPack(Buf, InData%RootMxr) - call RegPack(Buf, InData%RootMyr) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%ReactionForce) + call MeshPack(RF, InData%BldMotion) + call RegPack(RF, InData%RootMxr) + call RegPack(RF, InData%RootMyr) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%ReactionForce) ! ReactionForce - call MeshUnpack(Buf, OutData%BldMotion) ! BldMotion - call RegUnpack(Buf, OutData%RootMxr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMyr) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%ReactionForce) ! ReactionForce + call MeshUnpack(RF, OutData%BldMotion) ! BldMotion + call RegUnpack(RF, OutData%RootMxr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg) @@ -3667,611 +2671,84 @@ subroutine BD_DestroyEqMotionQP(EqMotionQPData, ErrStat, ErrMsg) end if end subroutine -subroutine BD_PackEqMotionQP(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackEqMotionQP(RF, Indata) + type(RegFile), intent(inout) :: RF type(EqMotionQP), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackEqMotionQP' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%uuu)) - if (allocated(InData%uuu)) then - call RegPackBounds(Buf, 3, lbound(InData%uuu, kind=B8Ki), ubound(InData%uuu, kind=B8Ki)) - call RegPack(Buf, InData%uuu) - end if - call RegPack(Buf, allocated(InData%uup)) - if (allocated(InData%uup)) then - call RegPackBounds(Buf, 3, lbound(InData%uup, kind=B8Ki), ubound(InData%uup, kind=B8Ki)) - call RegPack(Buf, InData%uup) - end if - call RegPack(Buf, allocated(InData%vvv)) - if (allocated(InData%vvv)) then - call RegPackBounds(Buf, 3, lbound(InData%vvv, kind=B8Ki), ubound(InData%vvv, kind=B8Ki)) - call RegPack(Buf, InData%vvv) - end if - call RegPack(Buf, allocated(InData%vvp)) - if (allocated(InData%vvp)) then - call RegPackBounds(Buf, 3, lbound(InData%vvp, kind=B8Ki), ubound(InData%vvp, kind=B8Ki)) - call RegPack(Buf, InData%vvp) - end if - call RegPack(Buf, allocated(InData%aaa)) - if (allocated(InData%aaa)) then - call RegPackBounds(Buf, 3, lbound(InData%aaa, kind=B8Ki), ubound(InData%aaa, kind=B8Ki)) - call RegPack(Buf, InData%aaa) - end if - call RegPack(Buf, allocated(InData%RR0)) - if (allocated(InData%RR0)) then - call RegPackBounds(Buf, 4, lbound(InData%RR0, kind=B8Ki), ubound(InData%RR0, kind=B8Ki)) - call RegPack(Buf, InData%RR0) - end if - call RegPack(Buf, allocated(InData%kappa)) - if (allocated(InData%kappa)) then - call RegPackBounds(Buf, 3, lbound(InData%kappa, kind=B8Ki), ubound(InData%kappa, kind=B8Ki)) - call RegPack(Buf, InData%kappa) - end if - call RegPack(Buf, allocated(InData%E1)) - if (allocated(InData%E1)) then - call RegPackBounds(Buf, 3, lbound(InData%E1, kind=B8Ki), ubound(InData%E1, kind=B8Ki)) - call RegPack(Buf, InData%E1) - end if - call RegPack(Buf, allocated(InData%Stif)) - if (allocated(InData%Stif)) then - call RegPackBounds(Buf, 4, lbound(InData%Stif, kind=B8Ki), ubound(InData%Stif, kind=B8Ki)) - call RegPack(Buf, InData%Stif) - end if - call RegPack(Buf, allocated(InData%Fb)) - if (allocated(InData%Fb)) then - call RegPackBounds(Buf, 3, lbound(InData%Fb, kind=B8Ki), ubound(InData%Fb, kind=B8Ki)) - call RegPack(Buf, InData%Fb) - end if - call RegPack(Buf, allocated(InData%Fc)) - if (allocated(InData%Fc)) then - call RegPackBounds(Buf, 3, lbound(InData%Fc, kind=B8Ki), ubound(InData%Fc, kind=B8Ki)) - call RegPack(Buf, InData%Fc) - end if - call RegPack(Buf, allocated(InData%Fd)) - if (allocated(InData%Fd)) then - call RegPackBounds(Buf, 3, lbound(InData%Fd, kind=B8Ki), ubound(InData%Fd, kind=B8Ki)) - call RegPack(Buf, InData%Fd) - end if - call RegPack(Buf, allocated(InData%Fg)) - if (allocated(InData%Fg)) then - call RegPackBounds(Buf, 3, lbound(InData%Fg, kind=B8Ki), ubound(InData%Fg, kind=B8Ki)) - call RegPack(Buf, InData%Fg) - end if - call RegPack(Buf, allocated(InData%Fi)) - if (allocated(InData%Fi)) then - call RegPackBounds(Buf, 3, lbound(InData%Fi, kind=B8Ki), ubound(InData%Fi, kind=B8Ki)) - call RegPack(Buf, InData%Fi) - end if - call RegPack(Buf, allocated(InData%Ftemp)) - if (allocated(InData%Ftemp)) then - call RegPackBounds(Buf, 3, lbound(InData%Ftemp, kind=B8Ki), ubound(InData%Ftemp, kind=B8Ki)) - call RegPack(Buf, InData%Ftemp) - end if - call RegPack(Buf, allocated(InData%RR0mEta)) - if (allocated(InData%RR0mEta)) then - call RegPackBounds(Buf, 3, lbound(InData%RR0mEta, kind=B8Ki), ubound(InData%RR0mEta, kind=B8Ki)) - call RegPack(Buf, InData%RR0mEta) - end if - call RegPack(Buf, allocated(InData%rho)) - if (allocated(InData%rho)) then - call RegPackBounds(Buf, 4, lbound(InData%rho, kind=B8Ki), ubound(InData%rho, kind=B8Ki)) - call RegPack(Buf, InData%rho) - end if - call RegPack(Buf, allocated(InData%betaC)) - if (allocated(InData%betaC)) then - call RegPackBounds(Buf, 4, lbound(InData%betaC, kind=B8Ki), ubound(InData%betaC, kind=B8Ki)) - call RegPack(Buf, InData%betaC) - end if - call RegPack(Buf, allocated(InData%Gi)) - if (allocated(InData%Gi)) then - call RegPackBounds(Buf, 4, lbound(InData%Gi, kind=B8Ki), ubound(InData%Gi, kind=B8Ki)) - call RegPack(Buf, InData%Gi) - end if - call RegPack(Buf, allocated(InData%Ki)) - if (allocated(InData%Ki)) then - call RegPackBounds(Buf, 4, lbound(InData%Ki, kind=B8Ki), ubound(InData%Ki, kind=B8Ki)) - call RegPack(Buf, InData%Ki) - end if - call RegPack(Buf, allocated(InData%Mi)) - if (allocated(InData%Mi)) then - call RegPackBounds(Buf, 4, lbound(InData%Mi, kind=B8Ki), ubound(InData%Mi, kind=B8Ki)) - call RegPack(Buf, InData%Mi) - end if - call RegPack(Buf, allocated(InData%Oe)) - if (allocated(InData%Oe)) then - call RegPackBounds(Buf, 4, lbound(InData%Oe, kind=B8Ki), ubound(InData%Oe, kind=B8Ki)) - call RegPack(Buf, InData%Oe) - end if - call RegPack(Buf, allocated(InData%Pe)) - if (allocated(InData%Pe)) then - call RegPackBounds(Buf, 4, lbound(InData%Pe, kind=B8Ki), ubound(InData%Pe, kind=B8Ki)) - call RegPack(Buf, InData%Pe) - end if - call RegPack(Buf, allocated(InData%Qe)) - if (allocated(InData%Qe)) then - call RegPackBounds(Buf, 4, lbound(InData%Qe, kind=B8Ki), ubound(InData%Qe, kind=B8Ki)) - call RegPack(Buf, InData%Qe) - end if - call RegPack(Buf, allocated(InData%Gd)) - if (allocated(InData%Gd)) then - call RegPackBounds(Buf, 4, lbound(InData%Gd, kind=B8Ki), ubound(InData%Gd, kind=B8Ki)) - call RegPack(Buf, InData%Gd) - end if - call RegPack(Buf, allocated(InData%Od)) - if (allocated(InData%Od)) then - call RegPackBounds(Buf, 4, lbound(InData%Od, kind=B8Ki), ubound(InData%Od, kind=B8Ki)) - call RegPack(Buf, InData%Od) - end if - call RegPack(Buf, allocated(InData%Pd)) - if (allocated(InData%Pd)) then - call RegPackBounds(Buf, 4, lbound(InData%Pd, kind=B8Ki), ubound(InData%Pd, kind=B8Ki)) - call RegPack(Buf, InData%Pd) - end if - call RegPack(Buf, allocated(InData%Qd)) - if (allocated(InData%Qd)) then - call RegPackBounds(Buf, 4, lbound(InData%Qd, kind=B8Ki), ubound(InData%Qd, kind=B8Ki)) - call RegPack(Buf, InData%Qd) - end if - call RegPack(Buf, allocated(InData%Sd)) - if (allocated(InData%Sd)) then - call RegPackBounds(Buf, 4, lbound(InData%Sd, kind=B8Ki), ubound(InData%Sd, kind=B8Ki)) - call RegPack(Buf, InData%Sd) - end if - call RegPack(Buf, allocated(InData%Xd)) - if (allocated(InData%Xd)) then - call RegPackBounds(Buf, 4, lbound(InData%Xd, kind=B8Ki), ubound(InData%Xd, kind=B8Ki)) - call RegPack(Buf, InData%Xd) - end if - call RegPack(Buf, allocated(InData%Yd)) - if (allocated(InData%Yd)) then - call RegPackBounds(Buf, 4, lbound(InData%Yd, kind=B8Ki), ubound(InData%Yd, kind=B8Ki)) - call RegPack(Buf, InData%Yd) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%uuu) + call RegPackAlloc(RF, InData%uup) + call RegPackAlloc(RF, InData%vvv) + call RegPackAlloc(RF, InData%vvp) + call RegPackAlloc(RF, InData%aaa) + call RegPackAlloc(RF, InData%RR0) + call RegPackAlloc(RF, InData%kappa) + call RegPackAlloc(RF, InData%E1) + call RegPackAlloc(RF, InData%Stif) + call RegPackAlloc(RF, InData%Fb) + call RegPackAlloc(RF, InData%Fc) + call RegPackAlloc(RF, InData%Fd) + call RegPackAlloc(RF, InData%Fg) + call RegPackAlloc(RF, InData%Fi) + call RegPackAlloc(RF, InData%Ftemp) + call RegPackAlloc(RF, InData%RR0mEta) + call RegPackAlloc(RF, InData%rho) + call RegPackAlloc(RF, InData%betaC) + call RegPackAlloc(RF, InData%Gi) + call RegPackAlloc(RF, InData%Ki) + call RegPackAlloc(RF, InData%Mi) + call RegPackAlloc(RF, InData%Oe) + call RegPackAlloc(RF, InData%Pe) + call RegPackAlloc(RF, InData%Qe) + call RegPackAlloc(RF, InData%Gd) + call RegPackAlloc(RF, InData%Od) + call RegPackAlloc(RF, InData%Pd) + call RegPackAlloc(RF, InData%Qd) + call RegPackAlloc(RF, InData%Sd) + call RegPackAlloc(RF, InData%Xd) + call RegPackAlloc(RF, InData%Yd) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackEqMotionQP(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackEqMotionQP(RF, OutData) + type(RegFile), intent(inout) :: RF type(EqMotionQP), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%uuu)) deallocate(OutData%uuu) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uuu) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%uup)) deallocate(OutData%uup) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uup) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vvv)) deallocate(OutData%vvv) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vvv) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vvp)) deallocate(OutData%vvp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vvp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%aaa)) deallocate(OutData%aaa) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%aaa) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RR0)) deallocate(OutData%RR0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RR0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%kappa)) deallocate(OutData%kappa) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%kappa) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%E1)) deallocate(OutData%E1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%E1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Stif)) deallocate(OutData%Stif) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Stif) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fb)) deallocate(OutData%Fb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fc)) deallocate(OutData%Fc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fd)) deallocate(OutData%Fd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fg)) deallocate(OutData%Fg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fi)) deallocate(OutData%Fi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ftemp)) deallocate(OutData%Ftemp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ftemp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RR0mEta)) deallocate(OutData%RR0mEta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RR0mEta) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rho)) deallocate(OutData%rho) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rho) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%betaC)) deallocate(OutData%betaC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%betaC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Gi)) deallocate(OutData%Gi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ki)) deallocate(OutData%Ki) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ki) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Mi)) deallocate(OutData%Mi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Oe)) deallocate(OutData%Oe) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Oe) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pe)) deallocate(OutData%Pe) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pe) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Qe)) deallocate(OutData%Qe) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Qe) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Gd)) deallocate(OutData%Gd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Gd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Od)) deallocate(OutData%Od) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Od) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pd)) deallocate(OutData%Pd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Qd)) deallocate(OutData%Qd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Qd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Sd)) deallocate(OutData%Sd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Sd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Xd)) deallocate(OutData%Xd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Xd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Yd)) deallocate(OutData%Yd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Yd) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%uuu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uup); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vvv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vvp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%aaa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RR0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%kappa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%E1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ftemp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RR0mEta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%betaC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ki); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Oe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Qe); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Gd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Od); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Qd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Sd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Yd); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -4785,609 +3262,98 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine BD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(BD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%u_DistrLoad_at_y) - call MeshPack(Buf, InData%y_BldMotion_at_u) - call NWTC_Library_PackMeshMapType(Buf, InData%Map_u_DistrLoad_to_y) - call NWTC_Library_PackMeshMapType(Buf, InData%Map_y_BldMotion_to_u) - call RegPack(Buf, InData%Un_Sum) - call BD_PackEqMotionQP(Buf, InData%qp) - call RegPack(Buf, allocated(InData%lin_A)) - if (allocated(InData%lin_A)) then - call RegPackBounds(Buf, 2, lbound(InData%lin_A, kind=B8Ki), ubound(InData%lin_A, kind=B8Ki)) - call RegPack(Buf, InData%lin_A) - end if - call RegPack(Buf, allocated(InData%lin_C)) - if (allocated(InData%lin_C)) then - call RegPackBounds(Buf, 2, lbound(InData%lin_C, kind=B8Ki), ubound(InData%lin_C, kind=B8Ki)) - call RegPack(Buf, InData%lin_C) - end if - call RegPack(Buf, allocated(InData%Nrrr)) - if (allocated(InData%Nrrr)) then - call RegPackBounds(Buf, 3, lbound(InData%Nrrr, kind=B8Ki), ubound(InData%Nrrr, kind=B8Ki)) - call RegPack(Buf, InData%Nrrr) - end if - call RegPack(Buf, allocated(InData%elf)) - if (allocated(InData%elf)) then - call RegPackBounds(Buf, 2, lbound(InData%elf, kind=B8Ki), ubound(InData%elf, kind=B8Ki)) - call RegPack(Buf, InData%elf) - end if - call RegPack(Buf, allocated(InData%EFint)) - if (allocated(InData%EFint)) then - call RegPackBounds(Buf, 3, lbound(InData%EFint, kind=B8Ki), ubound(InData%EFint, kind=B8Ki)) - call RegPack(Buf, InData%EFint) - end if - call RegPack(Buf, allocated(InData%elk)) - if (allocated(InData%elk)) then - call RegPackBounds(Buf, 4, lbound(InData%elk, kind=B8Ki), ubound(InData%elk, kind=B8Ki)) - call RegPack(Buf, InData%elk) - end if - call RegPack(Buf, allocated(InData%elg)) - if (allocated(InData%elg)) then - call RegPackBounds(Buf, 4, lbound(InData%elg, kind=B8Ki), ubound(InData%elg, kind=B8Ki)) - call RegPack(Buf, InData%elg) - end if - call RegPack(Buf, allocated(InData%elm)) - if (allocated(InData%elm)) then - call RegPackBounds(Buf, 4, lbound(InData%elm, kind=B8Ki), ubound(InData%elm, kind=B8Ki)) - call RegPack(Buf, InData%elm) - end if - call RegPack(Buf, allocated(InData%DistrLoad_QP)) - if (allocated(InData%DistrLoad_QP)) then - call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP, kind=B8Ki), ubound(InData%DistrLoad_QP, kind=B8Ki)) - call RegPack(Buf, InData%DistrLoad_QP) - end if - call RegPack(Buf, allocated(InData%PointLoadLcl)) - if (allocated(InData%PointLoadLcl)) then - call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl, kind=B8Ki), ubound(InData%PointLoadLcl, kind=B8Ki)) - call RegPack(Buf, InData%PointLoadLcl) - end if - call RegPack(Buf, allocated(InData%StifK)) - if (allocated(InData%StifK)) then - call RegPackBounds(Buf, 4, lbound(InData%StifK, kind=B8Ki), ubound(InData%StifK, kind=B8Ki)) - call RegPack(Buf, InData%StifK) - end if - call RegPack(Buf, allocated(InData%MassM)) - if (allocated(InData%MassM)) then - call RegPackBounds(Buf, 4, lbound(InData%MassM, kind=B8Ki), ubound(InData%MassM, kind=B8Ki)) - call RegPack(Buf, InData%MassM) - end if - call RegPack(Buf, allocated(InData%DampG)) - if (allocated(InData%DampG)) then - call RegPackBounds(Buf, 4, lbound(InData%DampG, kind=B8Ki), ubound(InData%DampG, kind=B8Ki)) - call RegPack(Buf, InData%DampG) - end if - call RegPack(Buf, allocated(InData%StifK_fd)) - if (allocated(InData%StifK_fd)) then - call RegPackBounds(Buf, 4, lbound(InData%StifK_fd, kind=B8Ki), ubound(InData%StifK_fd, kind=B8Ki)) - call RegPack(Buf, InData%StifK_fd) - end if - call RegPack(Buf, allocated(InData%MassM_fd)) - if (allocated(InData%MassM_fd)) then - call RegPackBounds(Buf, 4, lbound(InData%MassM_fd, kind=B8Ki), ubound(InData%MassM_fd, kind=B8Ki)) - call RegPack(Buf, InData%MassM_fd) - end if - call RegPack(Buf, allocated(InData%DampG_fd)) - if (allocated(InData%DampG_fd)) then - call RegPackBounds(Buf, 4, lbound(InData%DampG_fd, kind=B8Ki), ubound(InData%DampG_fd, kind=B8Ki)) - call RegPack(Buf, InData%DampG_fd) - end if - call RegPack(Buf, allocated(InData%RHS)) - if (allocated(InData%RHS)) then - call RegPackBounds(Buf, 2, lbound(InData%RHS, kind=B8Ki), ubound(InData%RHS, kind=B8Ki)) - call RegPack(Buf, InData%RHS) - end if - call RegPack(Buf, allocated(InData%RHS_p)) - if (allocated(InData%RHS_p)) then - call RegPackBounds(Buf, 2, lbound(InData%RHS_p, kind=B8Ki), ubound(InData%RHS_p, kind=B8Ki)) - call RegPack(Buf, InData%RHS_p) - end if - call RegPack(Buf, allocated(InData%RHS_m)) - if (allocated(InData%RHS_m)) then - call RegPackBounds(Buf, 2, lbound(InData%RHS_m, kind=B8Ki), ubound(InData%RHS_m, kind=B8Ki)) - call RegPack(Buf, InData%RHS_m) - end if - call RegPack(Buf, allocated(InData%BldInternalForceFE)) - if (allocated(InData%BldInternalForceFE)) then - call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE, kind=B8Ki), ubound(InData%BldInternalForceFE, kind=B8Ki)) - call RegPack(Buf, InData%BldInternalForceFE) - end if - call RegPack(Buf, allocated(InData%BldInternalForceQP)) - if (allocated(InData%BldInternalForceQP)) then - call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP, kind=B8Ki), ubound(InData%BldInternalForceQP, kind=B8Ki)) - call RegPack(Buf, InData%BldInternalForceQP) - end if - call RegPack(Buf, allocated(InData%FirstNodeReactionLclForceMoment)) - if (allocated(InData%FirstNodeReactionLclForceMoment)) then - call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment, kind=B8Ki), ubound(InData%FirstNodeReactionLclForceMoment, kind=B8Ki)) - call RegPack(Buf, InData%FirstNodeReactionLclForceMoment) - end if - call RegPack(Buf, allocated(InData%Solution)) - if (allocated(InData%Solution)) then - call RegPackBounds(Buf, 2, lbound(InData%Solution, kind=B8Ki), ubound(InData%Solution, kind=B8Ki)) - call RegPack(Buf, InData%Solution) - end if - call RegPack(Buf, allocated(InData%LP_StifK)) - if (allocated(InData%LP_StifK)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_StifK, kind=B8Ki), ubound(InData%LP_StifK, kind=B8Ki)) - call RegPack(Buf, InData%LP_StifK) - end if - call RegPack(Buf, allocated(InData%LP_MassM)) - if (allocated(InData%LP_MassM)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_MassM, kind=B8Ki), ubound(InData%LP_MassM, kind=B8Ki)) - call RegPack(Buf, InData%LP_MassM) - end if - call RegPack(Buf, allocated(InData%LP_MassM_LU)) - if (allocated(InData%LP_MassM_LU)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU, kind=B8Ki), ubound(InData%LP_MassM_LU, kind=B8Ki)) - call RegPack(Buf, InData%LP_MassM_LU) - end if - call RegPack(Buf, allocated(InData%LP_RHS)) - if (allocated(InData%LP_RHS)) then - call RegPackBounds(Buf, 1, lbound(InData%LP_RHS, kind=B8Ki), ubound(InData%LP_RHS, kind=B8Ki)) - call RegPack(Buf, InData%LP_RHS) - end if - call RegPack(Buf, allocated(InData%LP_StifK_LU)) - if (allocated(InData%LP_StifK_LU)) then - call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU, kind=B8Ki), ubound(InData%LP_StifK_LU, kind=B8Ki)) - call RegPack(Buf, InData%LP_StifK_LU) - end if - call RegPack(Buf, allocated(InData%LP_RHS_LU)) - if (allocated(InData%LP_RHS_LU)) then - call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU, kind=B8Ki), ubound(InData%LP_RHS_LU, kind=B8Ki)) - call RegPack(Buf, InData%LP_RHS_LU) - end if - call RegPack(Buf, allocated(InData%LP_indx)) - if (allocated(InData%LP_indx)) then - call RegPackBounds(Buf, 1, lbound(InData%LP_indx, kind=B8Ki), ubound(InData%LP_indx, kind=B8Ki)) - call RegPack(Buf, InData%LP_indx) - end if - call BD_PackInput(Buf, InData%u) - call BD_PackInput(Buf, InData%u2) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%u_DistrLoad_at_y) + call MeshPack(RF, InData%y_BldMotion_at_u) + call NWTC_Library_PackMeshMapType(RF, InData%Map_u_DistrLoad_to_y) + call NWTC_Library_PackMeshMapType(RF, InData%Map_y_BldMotion_to_u) + call RegPack(RF, InData%Un_Sum) + call BD_PackEqMotionQP(RF, InData%qp) + call RegPackAlloc(RF, InData%lin_A) + call RegPackAlloc(RF, InData%lin_C) + call RegPackAlloc(RF, InData%Nrrr) + call RegPackAlloc(RF, InData%elf) + call RegPackAlloc(RF, InData%EFint) + call RegPackAlloc(RF, InData%elk) + call RegPackAlloc(RF, InData%elg) + call RegPackAlloc(RF, InData%elm) + call RegPackAlloc(RF, InData%DistrLoad_QP) + call RegPackAlloc(RF, InData%PointLoadLcl) + call RegPackAlloc(RF, InData%StifK) + call RegPackAlloc(RF, InData%MassM) + call RegPackAlloc(RF, InData%DampG) + call RegPackAlloc(RF, InData%StifK_fd) + call RegPackAlloc(RF, InData%MassM_fd) + call RegPackAlloc(RF, InData%DampG_fd) + call RegPackAlloc(RF, InData%RHS) + call RegPackAlloc(RF, InData%RHS_p) + call RegPackAlloc(RF, InData%RHS_m) + call RegPackAlloc(RF, InData%BldInternalForceFE) + call RegPackAlloc(RF, InData%BldInternalForceQP) + call RegPackAlloc(RF, InData%FirstNodeReactionLclForceMoment) + call RegPackAlloc(RF, InData%Solution) + call RegPackAlloc(RF, InData%LP_StifK) + call RegPackAlloc(RF, InData%LP_MassM) + call RegPackAlloc(RF, InData%LP_MassM_LU) + call RegPackAlloc(RF, InData%LP_RHS) + call RegPackAlloc(RF, InData%LP_StifK_LU) + call RegPackAlloc(RF, InData%LP_RHS_LU) + call RegPackAlloc(RF, InData%LP_indx) + call BD_PackInput(RF, InData%u) + call BD_PackInput(RF, InData%u2) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine BD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine BD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(BD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackMisc' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%u_DistrLoad_at_y) ! u_DistrLoad_at_y - call MeshUnpack(Buf, OutData%y_BldMotion_at_u) ! y_BldMotion_at_u - call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_u_DistrLoad_to_y) ! Map_u_DistrLoad_to_y - call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_y_BldMotion_to_u) ! Map_y_BldMotion_to_u - call RegUnpack(Buf, OutData%Un_Sum) - if (RegCheckErr(Buf, RoutineName)) return - call BD_UnpackEqMotionQP(Buf, OutData%qp) ! qp - if (allocated(OutData%lin_A)) deallocate(OutData%lin_A) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%lin_A(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%lin_A) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%lin_C)) deallocate(OutData%lin_C) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%lin_C(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%lin_C) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Nrrr)) deallocate(OutData%Nrrr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nrrr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%elf)) deallocate(OutData%elf) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%elf(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%elf) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%EFint)) deallocate(OutData%EFint) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%EFint) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%elk)) deallocate(OutData%elk) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%elk) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%elg)) deallocate(OutData%elg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%elg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%elm)) deallocate(OutData%elm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%elm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DistrLoad_QP)) deallocate(OutData%DistrLoad_QP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DistrLoad_QP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PointLoadLcl)) deallocate(OutData%PointLoadLcl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PointLoadLcl) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StifK)) deallocate(OutData%StifK) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StifK) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MassM)) deallocate(OutData%MassM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MassM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DampG)) deallocate(OutData%DampG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DampG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StifK_fd)) deallocate(OutData%StifK_fd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StifK_fd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MassM_fd)) deallocate(OutData%MassM_fd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MassM_fd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DampG_fd)) deallocate(OutData%DampG_fd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DampG_fd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RHS)) deallocate(OutData%RHS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RHS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RHS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RHS_p)) deallocate(OutData%RHS_p) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RHS_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RHS_p) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RHS_m)) deallocate(OutData%RHS_m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RHS_m(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RHS_m) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BldInternalForceFE)) deallocate(OutData%BldInternalForceFE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldInternalForceFE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BldInternalForceQP)) deallocate(OutData%BldInternalForceQP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldInternalForceQP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FirstNodeReactionLclForceMoment)) deallocate(OutData%FirstNodeReactionLclForceMoment) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FirstNodeReactionLclForceMoment(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FirstNodeReactionLclForceMoment) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Solution)) deallocate(OutData%Solution) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Solution(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Solution) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_StifK)) deallocate(OutData%LP_StifK) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_StifK(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_StifK) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_MassM)) deallocate(OutData%LP_MassM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_MassM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_MassM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_MassM_LU)) deallocate(OutData%LP_MassM_LU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_MassM_LU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_RHS)) deallocate(OutData%LP_RHS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_RHS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_RHS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_StifK_LU)) deallocate(OutData%LP_StifK_LU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_StifK_LU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_RHS_LU)) deallocate(OutData%LP_RHS_LU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_RHS_LU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_RHS_LU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LP_indx)) deallocate(OutData%LP_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LP_indx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LP_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call BD_UnpackInput(Buf, OutData%u) ! u - call BD_UnpackInput(Buf, OutData%u2) ! u2 + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%u_DistrLoad_at_y) ! u_DistrLoad_at_y + call MeshUnpack(RF, OutData%y_BldMotion_at_u) ! y_BldMotion_at_u + call NWTC_Library_UnpackMeshMapType(RF, OutData%Map_u_DistrLoad_to_y) ! Map_u_DistrLoad_to_y + call NWTC_Library_UnpackMeshMapType(RF, OutData%Map_y_BldMotion_to_u) ! Map_y_BldMotion_to_u + call RegUnpack(RF, OutData%Un_Sum); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackEqMotionQP(RF, OutData%qp) ! qp + call RegUnpackAlloc(RF, OutData%lin_A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lin_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nrrr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EFint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%elm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DistrLoad_QP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointLoadLcl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StifK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StifK_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassM_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampG_fd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RHS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RHS_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RHS_m); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldInternalForceFE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldInternalForceQP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FirstNodeReactionLclForceMoment); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Solution); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_StifK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_MassM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_MassM_LU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_RHS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_StifK_LU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_RHS_LU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LP_indx); if (RegCheckErr(RF, RoutineName)) return + call BD_UnpackInput(RF, OutData%u) ! u + call BD_UnpackInput(RF, OutData%u2) ! u2 end subroutine subroutine BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 563fd371c6..e6d3309010 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -854,49 +854,39 @@ subroutine ED_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine ED_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%ADInputFile) - call RegPack(Buf, InData%CompElast) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%CompAeroMaps) - call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%ADInputFile) + call RegPack(RF, InData%CompElast) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%RotSpeed) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ADInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompElast) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ADInputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompElast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1138,313 +1128,78 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, allocated(InData%BlPitch)) - if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) - call RegPack(Buf, InData%BlPitch) - end if - call RegPack(Buf, InData%BladeLength) - call RegPack(Buf, InData%TowerHeight) - call RegPack(Buf, InData%TowerBaseHeight) - call RegPack(Buf, InData%HubHt) - call RegPack(Buf, allocated(InData%BldRNodes)) - if (allocated(InData%BldRNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%BldRNodes, kind=B8Ki), ubound(InData%BldRNodes, kind=B8Ki)) - call RegPack(Buf, InData%BldRNodes) - end if - call RegPack(Buf, allocated(InData%TwrHNodes)) - if (allocated(InData%TwrHNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes, kind=B8Ki), ubound(InData%TwrHNodes, kind=B8Ki)) - call RegPack(Buf, InData%TwrHNodes) - end if - call RegPack(Buf, InData%PlatformPos) - call RegPack(Buf, InData%TwrBaseRefPos) - call RegPack(Buf, InData%TwrBaseTransDisp) - call RegPack(Buf, InData%TwrBaseRefOrient) - call RegPack(Buf, InData%TwrBaseOrient) - call RegPack(Buf, InData%HubRad) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%isFixed_GenDOF) - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, InData%GearBox_index) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%NumBl) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerHeight) + call RegPack(RF, InData%TowerBaseHeight) + call RegPack(RF, InData%HubHt) + call RegPackAlloc(RF, InData%BldRNodes) + call RegPackAlloc(RF, InData%TwrHNodes) + call RegPack(RF, InData%PlatformPos) + call RegPack(RF, InData%TwrBaseRefPos) + call RegPack(RF, InData%TwrBaseTransDisp) + call RegPack(RF, InData%TwrBaseRefOrient) + call RegPack(RF, InData%TwrBaseOrient) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%isFixed_GenDOF) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, InData%GearBox_index) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitch) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerHeight) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerBaseHeight) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldRNodes)) deallocate(OutData%BldRNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldRNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldRNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrHNodes)) deallocate(OutData%TwrHNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrHNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrHNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PlatformPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseRefPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseTransDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseRefOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%isFixed_GenDOF) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%GearBox_index) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBaseHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldRNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrHNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%isFixed_GenDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -1608,205 +1363,48 @@ subroutine ED_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackBladeInputData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackBladeInputData(RF, Indata) + type(RegFile), intent(inout) :: RF type(BladeInputData), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackBladeInputData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NBlInpSt) - call RegPack(Buf, allocated(InData%BlFract)) - if (allocated(InData%BlFract)) then - call RegPackBounds(Buf, 1, lbound(InData%BlFract, kind=B8Ki), ubound(InData%BlFract, kind=B8Ki)) - call RegPack(Buf, InData%BlFract) - end if - call RegPack(Buf, allocated(InData%PitchAx)) - if (allocated(InData%PitchAx)) then - call RegPackBounds(Buf, 1, lbound(InData%PitchAx, kind=B8Ki), ubound(InData%PitchAx, kind=B8Ki)) - call RegPack(Buf, InData%PitchAx) - end if - call RegPack(Buf, allocated(InData%StrcTwst)) - if (allocated(InData%StrcTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%StrcTwst, kind=B8Ki), ubound(InData%StrcTwst, kind=B8Ki)) - call RegPack(Buf, InData%StrcTwst) - end if - call RegPack(Buf, allocated(InData%BMassDen)) - if (allocated(InData%BMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%BMassDen, kind=B8Ki), ubound(InData%BMassDen, kind=B8Ki)) - call RegPack(Buf, InData%BMassDen) - end if - call RegPack(Buf, allocated(InData%FlpStff)) - if (allocated(InData%FlpStff)) then - call RegPackBounds(Buf, 1, lbound(InData%FlpStff, kind=B8Ki), ubound(InData%FlpStff, kind=B8Ki)) - call RegPack(Buf, InData%FlpStff) - end if - call RegPack(Buf, allocated(InData%EdgStff)) - if (allocated(InData%EdgStff)) then - call RegPackBounds(Buf, 1, lbound(InData%EdgStff, kind=B8Ki), ubound(InData%EdgStff, kind=B8Ki)) - call RegPack(Buf, InData%EdgStff) - end if - call RegPack(Buf, InData%BldFlDmp) - call RegPack(Buf, InData%BldEdDmp) - call RegPack(Buf, InData%FlStTunr) - call RegPack(Buf, allocated(InData%BldFl1Sh)) - if (allocated(InData%BldFl1Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh, kind=B8Ki), ubound(InData%BldFl1Sh, kind=B8Ki)) - call RegPack(Buf, InData%BldFl1Sh) - end if - call RegPack(Buf, allocated(InData%BldFl2Sh)) - if (allocated(InData%BldFl2Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh, kind=B8Ki), ubound(InData%BldFl2Sh, kind=B8Ki)) - call RegPack(Buf, InData%BldFl2Sh) - end if - call RegPack(Buf, allocated(InData%BldEdgSh)) - if (allocated(InData%BldEdgSh)) then - call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh, kind=B8Ki), ubound(InData%BldEdgSh, kind=B8Ki)) - call RegPack(Buf, InData%BldEdgSh) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBlInpSt) + call RegPackAlloc(RF, InData%BlFract) + call RegPackAlloc(RF, InData%PitchAx) + call RegPackAlloc(RF, InData%StrcTwst) + call RegPackAlloc(RF, InData%BMassDen) + call RegPackAlloc(RF, InData%FlpStff) + call RegPackAlloc(RF, InData%EdgStff) + call RegPack(RF, InData%BldFlDmp) + call RegPack(RF, InData%BldEdDmp) + call RegPack(RF, InData%FlStTunr) + call RegPackAlloc(RF, InData%BldFl1Sh) + call RegPackAlloc(RF, InData%BldFl2Sh) + call RegPackAlloc(RF, InData%BldEdgSh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackBladeInputData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackBladeInputData(RF, OutData) + type(RegFile), intent(inout) :: RF type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NBlInpSt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlFract)) deallocate(OutData%BlFract) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlFract(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlFract) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PitchAx)) deallocate(OutData%PitchAx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PitchAx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PitchAx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StrcTwst)) deallocate(OutData%StrcTwst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StrcTwst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StrcTwst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BMassDen)) deallocate(OutData%BMassDen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BMassDen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BMassDen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FlpStff)) deallocate(OutData%FlpStff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FlpStff(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FlpStff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%EdgStff)) deallocate(OutData%EdgStff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%EdgStff(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%EdgStff) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BldFlDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldEdDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FlStTunr) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldFl1Sh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldFl1Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldFl2Sh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldFl2Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldEdgSh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldEdgSh) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBlInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlFract); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitchAx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StrcTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FlpStff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%EdgStff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldFlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldEdDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FlStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldEdgSh); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg) @@ -1877,82 +1475,30 @@ subroutine ED_DestroyBladeMeshInputData(BladeMeshInputDataData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackBladeMeshInputData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackBladeMeshInputData(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_BladeMeshInputData), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackBladeMeshInputData' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%BldNodes) - call RegPack(Buf, allocated(InData%RNodes)) - if (allocated(InData%RNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%RNodes, kind=B8Ki), ubound(InData%RNodes, kind=B8Ki)) - call RegPack(Buf, InData%RNodes) - end if - call RegPack(Buf, allocated(InData%AeroTwst)) - if (allocated(InData%AeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%AeroTwst, kind=B8Ki), ubound(InData%AeroTwst, kind=B8Ki)) - call RegPack(Buf, InData%AeroTwst) - end if - call RegPack(Buf, allocated(InData%Chord)) - if (allocated(InData%Chord)) then - call RegPackBounds(Buf, 1, lbound(InData%Chord, kind=B8Ki), ubound(InData%Chord, kind=B8Ki)) - call RegPack(Buf, InData%Chord) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%BldNodes) + call RegPackAlloc(RF, InData%RNodes) + call RegPackAlloc(RF, InData%AeroTwst) + call RegPackAlloc(RF, InData%Chord) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackBladeMeshInputData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackBladeMeshInputData(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_BladeMeshInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%BldNodes) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AeroTwst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AeroTwst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Chord)) deallocate(OutData%Chord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Chord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Chord) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Chord); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -2370,746 +1916,379 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInputFile' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%FlapDOF1) - call RegPack(Buf, InData%FlapDOF2) - call RegPack(Buf, InData%EdgeDOF) - call RegPack(Buf, InData%TeetDOF) - call RegPack(Buf, InData%DrTrDOF) - call RegPack(Buf, InData%GenDOF) - call RegPack(Buf, InData%YawDOF) - call RegPack(Buf, InData%TwFADOF1) - call RegPack(Buf, InData%TwFADOF2) - call RegPack(Buf, InData%TwSSDOF1) - call RegPack(Buf, InData%TwSSDOF2) - call RegPack(Buf, InData%PtfmSgDOF) - call RegPack(Buf, InData%PtfmSwDOF) - call RegPack(Buf, InData%PtfmHvDOF) - call RegPack(Buf, InData%PtfmRDOF) - call RegPack(Buf, InData%PtfmPDOF) - call RegPack(Buf, InData%PtfmYDOF) - call RegPack(Buf, InData%OoPDefl) - call RegPack(Buf, InData%IPDefl) - call RegPack(Buf, allocated(InData%BlPitch)) - if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) - call RegPack(Buf, InData%BlPitch) - end if - call RegPack(Buf, InData%TeetDefl) - call RegPack(Buf, InData%Azimuth) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%NacYaw) - call RegPack(Buf, InData%TTDspFA) - call RegPack(Buf, InData%TTDspSS) - call RegPack(Buf, InData%PtfmSurge) - call RegPack(Buf, InData%PtfmSway) - call RegPack(Buf, InData%PtfmHeave) - call RegPack(Buf, InData%PtfmRoll) - call RegPack(Buf, InData%PtfmPitch) - call RegPack(Buf, InData%PtfmYaw) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, InData%TipRad) - call RegPack(Buf, InData%HubRad) - call RegPack(Buf, allocated(InData%PreCone)) - if (allocated(InData%PreCone)) then - call RegPackBounds(Buf, 1, lbound(InData%PreCone, kind=B8Ki), ubound(InData%PreCone, kind=B8Ki)) - call RegPack(Buf, InData%PreCone) - end if - call RegPack(Buf, InData%HubCM) - call RegPack(Buf, InData%UndSling) - call RegPack(Buf, InData%Delta3) - call RegPack(Buf, InData%AzimB1Up) - call RegPack(Buf, InData%OverHang) - call RegPack(Buf, InData%ShftGagL) - call RegPack(Buf, InData%ShftTilt) - call RegPack(Buf, InData%NacCMxn) - call RegPack(Buf, InData%NacCMyn) - call RegPack(Buf, InData%NacCMzn) - call RegPack(Buf, InData%NcIMUxn) - call RegPack(Buf, InData%NcIMUyn) - call RegPack(Buf, InData%NcIMUzn) - call RegPack(Buf, InData%Twr2Shft) - call RegPack(Buf, InData%TowerHt) - call RegPack(Buf, InData%TowerBsHt) - call RegPack(Buf, InData%PtfmCMxt) - call RegPack(Buf, InData%PtfmCMyt) - call RegPack(Buf, InData%PtfmCMzt) - call RegPack(Buf, InData%PtfmRefzt) - call RegPack(Buf, allocated(InData%TipMass)) - if (allocated(InData%TipMass)) then - call RegPackBounds(Buf, 1, lbound(InData%TipMass, kind=B8Ki), ubound(InData%TipMass, kind=B8Ki)) - call RegPack(Buf, InData%TipMass) - end if - call RegPack(Buf, InData%HubMass) - call RegPack(Buf, InData%HubIner) - call RegPack(Buf, InData%GenIner) - call RegPack(Buf, InData%NacMass) - call RegPack(Buf, InData%NacYIner) - call RegPack(Buf, InData%YawBrMass) - call RegPack(Buf, InData%PtfmMass) - call RegPack(Buf, InData%PtfmRIner) - call RegPack(Buf, InData%PtfmPIner) - call RegPack(Buf, InData%PtfmYIner) - call RegPack(Buf, InData%BldNodes) - call RegPack(Buf, allocated(InData%InpBlMesh)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%FlapDOF1) + call RegPack(RF, InData%FlapDOF2) + call RegPack(RF, InData%EdgeDOF) + call RegPack(RF, InData%TeetDOF) + call RegPack(RF, InData%DrTrDOF) + call RegPack(RF, InData%GenDOF) + call RegPack(RF, InData%YawDOF) + call RegPack(RF, InData%TwFADOF1) + call RegPack(RF, InData%TwFADOF2) + call RegPack(RF, InData%TwSSDOF1) + call RegPack(RF, InData%TwSSDOF2) + call RegPack(RF, InData%PtfmSgDOF) + call RegPack(RF, InData%PtfmSwDOF) + call RegPack(RF, InData%PtfmHvDOF) + call RegPack(RF, InData%PtfmRDOF) + call RegPack(RF, InData%PtfmPDOF) + call RegPack(RF, InData%PtfmYDOF) + call RegPack(RF, InData%OoPDefl) + call RegPack(RF, InData%IPDefl) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%TeetDefl) + call RegPack(RF, InData%Azimuth) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%NacYaw) + call RegPack(RF, InData%TTDspFA) + call RegPack(RF, InData%TTDspSS) + call RegPack(RF, InData%PtfmSurge) + call RegPack(RF, InData%PtfmSway) + call RegPack(RF, InData%PtfmHeave) + call RegPack(RF, InData%PtfmRoll) + call RegPack(RF, InData%PtfmPitch) + call RegPack(RF, InData%PtfmYaw) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%TipRad) + call RegPack(RF, InData%HubRad) + call RegPackAlloc(RF, InData%PreCone) + call RegPack(RF, InData%HubCM) + call RegPack(RF, InData%UndSling) + call RegPack(RF, InData%Delta3) + call RegPack(RF, InData%AzimB1Up) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ShftGagL) + call RegPack(RF, InData%ShftTilt) + call RegPack(RF, InData%NacCMxn) + call RegPack(RF, InData%NacCMyn) + call RegPack(RF, InData%NacCMzn) + call RegPack(RF, InData%NcIMUxn) + call RegPack(RF, InData%NcIMUyn) + call RegPack(RF, InData%NcIMUzn) + call RegPack(RF, InData%Twr2Shft) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%TowerBsHt) + call RegPack(RF, InData%PtfmCMxt) + call RegPack(RF, InData%PtfmCMyt) + call RegPack(RF, InData%PtfmCMzt) + call RegPack(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%TipMass) + call RegPack(RF, InData%HubMass) + call RegPack(RF, InData%HubIner) + call RegPack(RF, InData%GenIner) + call RegPack(RF, InData%NacMass) + call RegPack(RF, InData%NacYIner) + call RegPack(RF, InData%YawBrMass) + call RegPack(RF, InData%PtfmMass) + call RegPack(RF, InData%PtfmRIner) + call RegPack(RF, InData%PtfmPIner) + call RegPack(RF, InData%PtfmYIner) + call RegPack(RF, InData%BldNodes) + call RegPack(RF, allocated(InData%InpBlMesh)) if (allocated(InData%InpBlMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh, kind=B8Ki), ubound(InData%InpBlMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%InpBlMesh, kind=B8Ki), ubound(InData%InpBlMesh, kind=B8Ki)) LB(1:1) = lbound(InData%InpBlMesh, kind=B8Ki) UB(1:1) = ubound(InData%InpBlMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackBladeMeshInputData(Buf, InData%InpBlMesh(i1)) + call ED_PackBladeMeshInputData(RF, InData%InpBlMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%InpBl)) + call RegPack(RF, allocated(InData%InpBl)) if (allocated(InData%InpBl)) then - call RegPackBounds(Buf, 1, lbound(InData%InpBl, kind=B8Ki), ubound(InData%InpBl, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%InpBl, kind=B8Ki), ubound(InData%InpBl, kind=B8Ki)) LB(1:1) = lbound(InData%InpBl, kind=B8Ki) UB(1:1) = ubound(InData%InpBl, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackBladeInputData(Buf, InData%InpBl(i1)) + call ED_PackBladeInputData(RF, InData%InpBl(i1)) end do end if - call RegPack(Buf, InData%TeetMod) - call RegPack(Buf, InData%TeetDmpP) - call RegPack(Buf, InData%TeetDmp) - call RegPack(Buf, InData%TeetCDmp) - call RegPack(Buf, InData%TeetSStP) - call RegPack(Buf, InData%TeetHStP) - call RegPack(Buf, InData%TeetSSSp) - call RegPack(Buf, InData%TeetHSSp) - call RegPack(Buf, InData%GBoxEff) - call RegPack(Buf, InData%GBRatio) - call RegPack(Buf, InData%DTTorSpr) - call RegPack(Buf, InData%DTTorDmp) - call RegPack(Buf, InData%Furling) - call RegPack(Buf, InData%TwrNodes) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%OutFile) - call RegPack(Buf, InData%TabDelim) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%Tstart) - call RegPack(Buf, InData%DecFact) - call RegPack(Buf, InData%NTwGages) - call RegPack(Buf, InData%TwrGagNd) - call RegPack(Buf, InData%NBlGages) - call RegPack(Buf, InData%BldGagNd) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%NTwInpSt) - call RegPack(Buf, InData%TwrFADmp) - call RegPack(Buf, InData%TwrSSDmp) - call RegPack(Buf, InData%FAStTunr) - call RegPack(Buf, InData%SSStTunr) - call RegPack(Buf, allocated(InData%HtFract)) - if (allocated(InData%HtFract)) then - call RegPackBounds(Buf, 1, lbound(InData%HtFract, kind=B8Ki), ubound(InData%HtFract, kind=B8Ki)) - call RegPack(Buf, InData%HtFract) - end if - call RegPack(Buf, allocated(InData%TMassDen)) - if (allocated(InData%TMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%TMassDen, kind=B8Ki), ubound(InData%TMassDen, kind=B8Ki)) - call RegPack(Buf, InData%TMassDen) - end if - call RegPack(Buf, allocated(InData%TwFAStif)) - if (allocated(InData%TwFAStif)) then - call RegPackBounds(Buf, 1, lbound(InData%TwFAStif, kind=B8Ki), ubound(InData%TwFAStif, kind=B8Ki)) - call RegPack(Buf, InData%TwFAStif) - end if - call RegPack(Buf, allocated(InData%TwSSStif)) - if (allocated(InData%TwSSStif)) then - call RegPackBounds(Buf, 1, lbound(InData%TwSSStif, kind=B8Ki), ubound(InData%TwSSStif, kind=B8Ki)) - call RegPack(Buf, InData%TwSSStif) - end if - call RegPack(Buf, allocated(InData%TwFAM1Sh)) - if (allocated(InData%TwFAM1Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh, kind=B8Ki), ubound(InData%TwFAM1Sh, kind=B8Ki)) - call RegPack(Buf, InData%TwFAM1Sh) - end if - call RegPack(Buf, allocated(InData%TwFAM2Sh)) - if (allocated(InData%TwFAM2Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh, kind=B8Ki), ubound(InData%TwFAM2Sh, kind=B8Ki)) - call RegPack(Buf, InData%TwFAM2Sh) - end if - call RegPack(Buf, allocated(InData%TwSSM1Sh)) - if (allocated(InData%TwSSM1Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh, kind=B8Ki), ubound(InData%TwSSM1Sh, kind=B8Ki)) - call RegPack(Buf, InData%TwSSM1Sh) - end if - call RegPack(Buf, allocated(InData%TwSSM2Sh)) - if (allocated(InData%TwSSM2Sh)) then - call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh, kind=B8Ki), ubound(InData%TwSSM2Sh, kind=B8Ki)) - call RegPack(Buf, InData%TwSSM2Sh) - end if - call RegPack(Buf, InData%RFrlDOF) - call RegPack(Buf, InData%TFrlDOF) - call RegPack(Buf, InData%RotFurl) - call RegPack(Buf, InData%TailFurl) - call RegPack(Buf, InData%Yaw2Shft) - call RegPack(Buf, InData%ShftSkew) - call RegPack(Buf, InData%RFrlCM_n) - call RegPack(Buf, InData%BoomCM_n) - call RegPack(Buf, InData%TFinCM_n) - call RegPack(Buf, InData%RFrlPnt_n) - call RegPack(Buf, InData%RFrlSkew) - call RegPack(Buf, InData%RFrlTilt) - call RegPack(Buf, InData%TFrlPnt_n) - call RegPack(Buf, InData%TFrlSkew) - call RegPack(Buf, InData%TFrlTilt) - call RegPack(Buf, InData%RFrlMass) - call RegPack(Buf, InData%BoomMass) - call RegPack(Buf, InData%TFinMass) - call RegPack(Buf, InData%RFrlIner) - call RegPack(Buf, InData%TFrlIner) - call RegPack(Buf, InData%RFrlMod) - call RegPack(Buf, InData%RFrlSpr) - call RegPack(Buf, InData%RFrlDmp) - call RegPack(Buf, InData%RFrlUSSP) - call RegPack(Buf, InData%RFrlDSSP) - call RegPack(Buf, InData%RFrlUSSpr) - call RegPack(Buf, InData%RFrlDSSpr) - call RegPack(Buf, InData%RFrlUSDP) - call RegPack(Buf, InData%RFrlDSDP) - call RegPack(Buf, InData%RFrlUSDmp) - call RegPack(Buf, InData%RFrlDSDmp) - call RegPack(Buf, InData%TFrlMod) - call RegPack(Buf, InData%TFrlSpr) - call RegPack(Buf, InData%TFrlDmp) - call RegPack(Buf, InData%TFrlUSSP) - call RegPack(Buf, InData%TFrlDSSP) - call RegPack(Buf, InData%TFrlUSSpr) - call RegPack(Buf, InData%TFrlDSSpr) - call RegPack(Buf, InData%TFrlUSDP) - call RegPack(Buf, InData%TFrlDSDP) - call RegPack(Buf, InData%TFrlUSDmp) - call RegPack(Buf, InData%TFrlDSDmp) - call RegPack(Buf, InData%method) - call RegPack(Buf, InData%BldNd_NumOuts) - call RegPack(Buf, allocated(InData%BldNd_OutList)) - if (allocated(InData%BldNd_OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList, kind=B8Ki), ubound(InData%BldNd_OutList, kind=B8Ki)) - call RegPack(Buf, InData%BldNd_OutList) - end if - call RegPack(Buf, InData%BldNd_BlOutNd_Str) - call RegPack(Buf, InData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%TeetMod) + call RegPack(RF, InData%TeetDmpP) + call RegPack(RF, InData%TeetDmp) + call RegPack(RF, InData%TeetCDmp) + call RegPack(RF, InData%TeetSStP) + call RegPack(RF, InData%TeetHStP) + call RegPack(RF, InData%TeetSSSp) + call RegPack(RF, InData%TeetHSSp) + call RegPack(RF, InData%GBoxEff) + call RegPack(RF, InData%GBRatio) + call RegPack(RF, InData%DTTorSpr) + call RegPack(RF, InData%DTTorDmp) + call RegPack(RF, InData%Furling) + call RegPack(RF, InData%TwrNodes) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%DecFact) + call RegPack(RF, InData%NTwGages) + call RegPack(RF, InData%TwrGagNd) + call RegPack(RF, InData%NBlGages) + call RegPack(RF, InData%BldGagNd) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%NTwInpSt) + call RegPack(RF, InData%TwrFADmp) + call RegPack(RF, InData%TwrSSDmp) + call RegPack(RF, InData%FAStTunr) + call RegPack(RF, InData%SSStTunr) + call RegPackAlloc(RF, InData%HtFract) + call RegPackAlloc(RF, InData%TMassDen) + call RegPackAlloc(RF, InData%TwFAStif) + call RegPackAlloc(RF, InData%TwSSStif) + call RegPackAlloc(RF, InData%TwFAM1Sh) + call RegPackAlloc(RF, InData%TwFAM2Sh) + call RegPackAlloc(RF, InData%TwSSM1Sh) + call RegPackAlloc(RF, InData%TwSSM2Sh) + call RegPack(RF, InData%RFrlDOF) + call RegPack(RF, InData%TFrlDOF) + call RegPack(RF, InData%RotFurl) + call RegPack(RF, InData%TailFurl) + call RegPack(RF, InData%Yaw2Shft) + call RegPack(RF, InData%ShftSkew) + call RegPack(RF, InData%RFrlCM_n) + call RegPack(RF, InData%BoomCM_n) + call RegPack(RF, InData%TFinCM_n) + call RegPack(RF, InData%RFrlPnt_n) + call RegPack(RF, InData%RFrlSkew) + call RegPack(RF, InData%RFrlTilt) + call RegPack(RF, InData%TFrlPnt_n) + call RegPack(RF, InData%TFrlSkew) + call RegPack(RF, InData%TFrlTilt) + call RegPack(RF, InData%RFrlMass) + call RegPack(RF, InData%BoomMass) + call RegPack(RF, InData%TFinMass) + call RegPack(RF, InData%RFrlIner) + call RegPack(RF, InData%TFrlIner) + call RegPack(RF, InData%RFrlMod) + call RegPack(RF, InData%RFrlSpr) + call RegPack(RF, InData%RFrlDmp) + call RegPack(RF, InData%RFrlUSSP) + call RegPack(RF, InData%RFrlDSSP) + call RegPack(RF, InData%RFrlUSSpr) + call RegPack(RF, InData%RFrlDSSpr) + call RegPack(RF, InData%RFrlUSDP) + call RegPack(RF, InData%RFrlDSDP) + call RegPack(RF, InData%RFrlUSDmp) + call RegPack(RF, InData%RFrlDSDmp) + call RegPack(RF, InData%TFrlMod) + call RegPack(RF, InData%TFrlSpr) + call RegPack(RF, InData%TFrlDmp) + call RegPack(RF, InData%TFrlUSSP) + call RegPack(RF, InData%TFrlDSSP) + call RegPack(RF, InData%TFrlUSSpr) + call RegPack(RF, InData%TFrlDSSpr) + call RegPack(RF, InData%TFrlUSDP) + call RegPack(RF, InData%TFrlDSDP) + call RegPack(RF, InData%TFrlUSDmp) + call RegPack(RF, InData%TFrlDSDmp) + call RegPack(RF, InData%method) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPackAlloc(RF, InData%BldNd_OutList) + call RegPack(RF, InData%BldNd_BlOutNd_Str) + call RegPack(RF, InData%BldNd_BladesOut) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInputFile' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FlapDOF1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FlapDOF2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EdgeDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DrTrDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwFADOF1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwFADOF2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwSSDOF1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwSSDOF2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmSgDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmSwDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmHvDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmPDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmYDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OoPDefl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IPDefl) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitch) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TeetDefl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Azimuth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TTDspFA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TTDspSS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmSurge) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmSway) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmHeave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRoll) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmPitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmYaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TipRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PreCone)) deallocate(OutData%PreCone) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PreCone(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PreCone) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HubCM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UndSling) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delta3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AzimB1Up) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OverHang) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShftGagL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShftTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCMxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCMyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCMzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMUxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMUyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMUzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Twr2Shft) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerBsHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmCMxt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmCMyt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmCMzt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TipMass(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TipMass) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HubMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmPIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmYIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNodes) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FlapDOF1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FlapDOF2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EdgeDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DrTrDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwFADOF1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwFADOF2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwSSDOF1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwSSDOF2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSgDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSwDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmHvDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OoPDefl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IPDefl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDefl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TTDspFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TTDspSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSurge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmSway); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmHeave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRoll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PreCone); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UndSling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delta3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimB1Up); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftGagL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMUxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMUyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMUzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBsHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TipMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%InpBlMesh)) deallocate(OutData%InpBlMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%InpBlMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackBladeMeshInputData(Buf, OutData%InpBlMesh(i1)) ! InpBlMesh + call ED_UnpackBladeMeshInputData(RF, OutData%InpBlMesh(i1)) ! InpBlMesh end do end if if (allocated(OutData%InpBl)) deallocate(OutData%InpBl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%InpBl(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackBladeInputData(Buf, OutData%InpBl(i1)) ! InpBl + call ED_UnpackBladeInputData(RF, OutData%InpBl(i1)) ! InpBl end do end if - call RegUnpack(Buf, OutData%TeetMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetDmpP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetCDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetSStP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetHStP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetSSSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetHSSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GBoxEff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GBRatio) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTTorSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTTorDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Furling) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DecFact) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTwGages) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrGagNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBlGages) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldGagNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NTwInpSt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrFADmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrSSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FAStTunr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SSStTunr) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%HtFract)) deallocate(OutData%HtFract) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HtFract(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HtFract) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TMassDen)) deallocate(OutData%TMassDen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TMassDen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TMassDen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwFAStif)) deallocate(OutData%TwFAStif) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwFAStif(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwFAStif) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwSSStif)) deallocate(OutData%TwSSStif) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwSSStif(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwSSStif) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwFAM1Sh)) deallocate(OutData%TwFAM1Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwFAM1Sh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwFAM1Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwFAM2Sh)) deallocate(OutData%TwFAM2Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwFAM2Sh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwFAM2Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwSSM1Sh)) deallocate(OutData%TwSSM1Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwSSM1Sh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwSSM1Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwSSM2Sh)) deallocate(OutData%TwSSM2Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwSSM2Sh(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwSSM2Sh) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RFrlDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotFurl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TailFurl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Yaw2Shft) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShftSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlCM_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BoomCM_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinCM_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BoomMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFinMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%method) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldNd_OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%TeetMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmpP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetCDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Furling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DecFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwGages); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlGages); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrFADmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrSSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FAStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SSStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HtFract); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwFAStif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwSSStif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwFAM1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwFAM2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwSSM1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwSSM2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotFurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TailFurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw2Shft); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlCM_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoomCM_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinCM_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoomMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%method); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldNd_OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BlOutNd_Str); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg) @@ -3436,528 +2615,190 @@ subroutine ED_DestroyCoordSys(CoordSysData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackCoordSys(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackCoordSys(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_CoordSys), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackCoordSys' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%a1) - call RegPack(Buf, InData%a2) - call RegPack(Buf, InData%a3) - call RegPack(Buf, InData%b1) - call RegPack(Buf, InData%b2) - call RegPack(Buf, InData%b3) - call RegPack(Buf, InData%c1) - call RegPack(Buf, InData%c2) - call RegPack(Buf, InData%c3) - call RegPack(Buf, InData%d1) - call RegPack(Buf, InData%d2) - call RegPack(Buf, InData%d3) - call RegPack(Buf, InData%e1) - call RegPack(Buf, InData%e2) - call RegPack(Buf, InData%e3) - call RegPack(Buf, InData%f1) - call RegPack(Buf, InData%f2) - call RegPack(Buf, InData%f3) - call RegPack(Buf, InData%g1) - call RegPack(Buf, InData%g2) - call RegPack(Buf, InData%g3) - call RegPack(Buf, allocated(InData%i1)) - if (allocated(InData%i1)) then - call RegPackBounds(Buf, 2, lbound(InData%i1, kind=B8Ki), ubound(InData%i1, kind=B8Ki)) - call RegPack(Buf, InData%i1) - end if - call RegPack(Buf, allocated(InData%i2)) - if (allocated(InData%i2)) then - call RegPackBounds(Buf, 2, lbound(InData%i2, kind=B8Ki), ubound(InData%i2, kind=B8Ki)) - call RegPack(Buf, InData%i2) - end if - call RegPack(Buf, allocated(InData%i3)) - if (allocated(InData%i3)) then - call RegPackBounds(Buf, 2, lbound(InData%i3, kind=B8Ki), ubound(InData%i3, kind=B8Ki)) - call RegPack(Buf, InData%i3) - end if - call RegPack(Buf, allocated(InData%j1)) - if (allocated(InData%j1)) then - call RegPackBounds(Buf, 2, lbound(InData%j1, kind=B8Ki), ubound(InData%j1, kind=B8Ki)) - call RegPack(Buf, InData%j1) - end if - call RegPack(Buf, allocated(InData%j2)) - if (allocated(InData%j2)) then - call RegPackBounds(Buf, 2, lbound(InData%j2, kind=B8Ki), ubound(InData%j2, kind=B8Ki)) - call RegPack(Buf, InData%j2) - end if - call RegPack(Buf, allocated(InData%j3)) - if (allocated(InData%j3)) then - call RegPackBounds(Buf, 2, lbound(InData%j3, kind=B8Ki), ubound(InData%j3, kind=B8Ki)) - call RegPack(Buf, InData%j3) - end if - call RegPack(Buf, allocated(InData%m1)) - if (allocated(InData%m1)) then - call RegPackBounds(Buf, 3, lbound(InData%m1, kind=B8Ki), ubound(InData%m1, kind=B8Ki)) - call RegPack(Buf, InData%m1) - end if - call RegPack(Buf, allocated(InData%m2)) - if (allocated(InData%m2)) then - call RegPackBounds(Buf, 3, lbound(InData%m2, kind=B8Ki), ubound(InData%m2, kind=B8Ki)) - call RegPack(Buf, InData%m2) - end if - call RegPack(Buf, allocated(InData%m3)) - if (allocated(InData%m3)) then - call RegPackBounds(Buf, 3, lbound(InData%m3, kind=B8Ki), ubound(InData%m3, kind=B8Ki)) - call RegPack(Buf, InData%m3) - end if - call RegPack(Buf, allocated(InData%n1)) - if (allocated(InData%n1)) then - call RegPackBounds(Buf, 3, lbound(InData%n1, kind=B8Ki), ubound(InData%n1, kind=B8Ki)) - call RegPack(Buf, InData%n1) - end if - call RegPack(Buf, allocated(InData%n2)) - if (allocated(InData%n2)) then - call RegPackBounds(Buf, 3, lbound(InData%n2, kind=B8Ki), ubound(InData%n2, kind=B8Ki)) - call RegPack(Buf, InData%n2) - end if - call RegPack(Buf, allocated(InData%n3)) - if (allocated(InData%n3)) then - call RegPackBounds(Buf, 3, lbound(InData%n3, kind=B8Ki), ubound(InData%n3, kind=B8Ki)) - call RegPack(Buf, InData%n3) - end if - call RegPack(Buf, InData%rf1) - call RegPack(Buf, InData%rf2) - call RegPack(Buf, InData%rf3) - call RegPack(Buf, InData%rfa) - call RegPack(Buf, allocated(InData%t1)) - if (allocated(InData%t1)) then - call RegPackBounds(Buf, 2, lbound(InData%t1, kind=B8Ki), ubound(InData%t1, kind=B8Ki)) - call RegPack(Buf, InData%t1) - end if - call RegPack(Buf, allocated(InData%t2)) - if (allocated(InData%t2)) then - call RegPackBounds(Buf, 2, lbound(InData%t2, kind=B8Ki), ubound(InData%t2, kind=B8Ki)) - call RegPack(Buf, InData%t2) - end if - call RegPack(Buf, allocated(InData%t3)) - if (allocated(InData%t3)) then - call RegPackBounds(Buf, 2, lbound(InData%t3, kind=B8Ki), ubound(InData%t3, kind=B8Ki)) - call RegPack(Buf, InData%t3) - end if - call RegPack(Buf, allocated(InData%te1)) - if (allocated(InData%te1)) then - call RegPackBounds(Buf, 3, lbound(InData%te1, kind=B8Ki), ubound(InData%te1, kind=B8Ki)) - call RegPack(Buf, InData%te1) - end if - call RegPack(Buf, allocated(InData%te2)) - if (allocated(InData%te2)) then - call RegPackBounds(Buf, 3, lbound(InData%te2, kind=B8Ki), ubound(InData%te2, kind=B8Ki)) - call RegPack(Buf, InData%te2) - end if - call RegPack(Buf, allocated(InData%te3)) - if (allocated(InData%te3)) then - call RegPackBounds(Buf, 3, lbound(InData%te3, kind=B8Ki), ubound(InData%te3, kind=B8Ki)) - call RegPack(Buf, InData%te3) - end if - call RegPack(Buf, InData%tf1) - call RegPack(Buf, InData%tf2) - call RegPack(Buf, InData%tf3) - call RegPack(Buf, InData%tfa) - call RegPack(Buf, InData%z1) - call RegPack(Buf, InData%z2) - call RegPack(Buf, InData%z3) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%a1) + call RegPack(RF, InData%a2) + call RegPack(RF, InData%a3) + call RegPack(RF, InData%b1) + call RegPack(RF, InData%b2) + call RegPack(RF, InData%b3) + call RegPack(RF, InData%c1) + call RegPack(RF, InData%c2) + call RegPack(RF, InData%c3) + call RegPack(RF, InData%d1) + call RegPack(RF, InData%d2) + call RegPack(RF, InData%d3) + call RegPack(RF, InData%e1) + call RegPack(RF, InData%e2) + call RegPack(RF, InData%e3) + call RegPack(RF, InData%f1) + call RegPack(RF, InData%f2) + call RegPack(RF, InData%f3) + call RegPack(RF, InData%g1) + call RegPack(RF, InData%g2) + call RegPack(RF, InData%g3) + call RegPackAlloc(RF, InData%i1) + call RegPackAlloc(RF, InData%i2) + call RegPackAlloc(RF, InData%i3) + call RegPackAlloc(RF, InData%j1) + call RegPackAlloc(RF, InData%j2) + call RegPackAlloc(RF, InData%j3) + call RegPackAlloc(RF, InData%m1) + call RegPackAlloc(RF, InData%m2) + call RegPackAlloc(RF, InData%m3) + call RegPackAlloc(RF, InData%n1) + call RegPackAlloc(RF, InData%n2) + call RegPackAlloc(RF, InData%n3) + call RegPack(RF, InData%rf1) + call RegPack(RF, InData%rf2) + call RegPack(RF, InData%rf3) + call RegPack(RF, InData%rfa) + call RegPackAlloc(RF, InData%t1) + call RegPackAlloc(RF, InData%t2) + call RegPackAlloc(RF, InData%t3) + call RegPackAlloc(RF, InData%te1) + call RegPackAlloc(RF, InData%te2) + call RegPackAlloc(RF, InData%te3) + call RegPack(RF, InData%tf1) + call RegPack(RF, InData%tf2) + call RegPack(RF, InData%tf3) + call RegPack(RF, InData%tfa) + call RegPack(RF, InData%z1) + call RegPack(RF, InData%z2) + call RegPack(RF, InData%z3) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackCoordSys(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackCoordSys(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_CoordSys), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%a1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%b3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%c3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%e1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%e2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%e3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%f1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%f2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%f3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%g1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%g2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%g3) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%i1)) deallocate(OutData%i1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%i1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%a1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%b3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%c3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%e1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%e2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%e3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%i1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%i2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%i3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%j1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%j2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%j3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%n3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rf1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rf2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rf3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%t3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%te1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%te2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%te3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tf1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tf2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tf3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tfa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z3); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(in) :: SrcActiveDOFsData + type(ED_ActiveDOFs), intent(inout) :: DstActiveDOFsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF + DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE + DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE + DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE + DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE + DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE + if (allocated(SrcActiveDOFsData%NPSBE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE, kind=B8Ki) + if (.not. allocated(DstActiveDOFsData%NPSBE)) then + allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%i1) - if (RegCheckErr(Buf, RoutineName)) return + DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE end if - if (allocated(OutData%i2)) deallocate(OutData%i2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%i2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcActiveDOFsData%NPSE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE, kind=B8Ki) + if (.not. allocated(DstActiveDOFsData%NPSE)) then + allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%i2) - if (RegCheckErr(Buf, RoutineName)) return + DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE end if - if (allocated(OutData%i3)) deallocate(OutData%i3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%i3(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE + DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE + if (allocated(SrcActiveDOFsData%PCE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PCE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PCE, kind=B8Ki) + if (.not. allocated(DstActiveDOFsData%PCE)) then + allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%i3) - if (RegCheckErr(Buf, RoutineName)) return + DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE end if - if (allocated(OutData%j1)) deallocate(OutData%j1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%j1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcActiveDOFsData%PDE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PDE, kind=B8Ki) + UB(1:1) = ubound(SrcActiveDOFsData%PDE, kind=B8Ki) + if (.not. allocated(DstActiveDOFsData%PDE)) then + allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%j1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%j2)) deallocate(OutData%j2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%j2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%j2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%j3)) deallocate(OutData%j3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%j3(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%j3) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m1)) deallocate(OutData%m1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m2)) deallocate(OutData%m2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m3)) deallocate(OutData%m3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m3) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%n1)) deallocate(OutData%n1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%n1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%n2)) deallocate(OutData%n2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%n2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%n3)) deallocate(OutData%n3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%n3) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%rf1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rf2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rf3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rfa) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%t1)) deallocate(OutData%t1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%t1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%t1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%t2)) deallocate(OutData%t2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%t2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%t2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%t3)) deallocate(OutData%t3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%t3(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%t3) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%te1)) deallocate(OutData%te1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%te1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%te2)) deallocate(OutData%te2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%te2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%te3)) deallocate(OutData%te3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%te3) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%tf1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tf2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tf3) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tfa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z3) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg) - type(ED_ActiveDOFs), intent(in) :: SrcActiveDOFsData - type(ED_ActiveDOFs), intent(inout) :: DstActiveDOFsData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' - ErrStat = ErrID_None - ErrMsg = '' - DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF - DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE - DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE - DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE - DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE - DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE - if (allocated(SrcActiveDOFsData%NPSBE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSBE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%NPSBE, kind=B8Ki) - if (.not. allocated(DstActiveDOFsData%NPSBE)) then - allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE - end if - if (allocated(SrcActiveDOFsData%NPSE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%NPSE, kind=B8Ki) - if (.not. allocated(DstActiveDOFsData%NPSE)) then - allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE - end if - DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE - DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE - if (allocated(SrcActiveDOFsData%PCE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PCE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PCE, kind=B8Ki) - if (.not. allocated(DstActiveDOFsData%PCE)) then - allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE - end if - if (allocated(SrcActiveDOFsData%PDE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PDE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PDE, kind=B8Ki) - if (.not. allocated(DstActiveDOFsData%PDE)) then - allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE + DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE end if if (allocated(SrcActiveDOFsData%PIE)) then LB(1:1) = lbound(SrcActiveDOFsData%PIE, kind=B8Ki) @@ -4147,331 +2988,68 @@ subroutine ED_DestroyActiveDOFs(ActiveDOFsData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackActiveDOFs(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackActiveDOFs(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_ActiveDOFs), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackActiveDOFs' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NActvDOF) - call RegPack(Buf, InData%NPCE) - call RegPack(Buf, InData%NPDE) - call RegPack(Buf, InData%NPIE) - call RegPack(Buf, InData%NPTE) - call RegPack(Buf, InData%NPTTE) - call RegPack(Buf, allocated(InData%NPSBE)) - if (allocated(InData%NPSBE)) then - call RegPackBounds(Buf, 1, lbound(InData%NPSBE, kind=B8Ki), ubound(InData%NPSBE, kind=B8Ki)) - call RegPack(Buf, InData%NPSBE) - end if - call RegPack(Buf, allocated(InData%NPSE)) - if (allocated(InData%NPSE)) then - call RegPackBounds(Buf, 1, lbound(InData%NPSE, kind=B8Ki), ubound(InData%NPSE, kind=B8Ki)) - call RegPack(Buf, InData%NPSE) - end if - call RegPack(Buf, InData%NPUE) - call RegPack(Buf, InData%NPYE) - call RegPack(Buf, allocated(InData%PCE)) - if (allocated(InData%PCE)) then - call RegPackBounds(Buf, 1, lbound(InData%PCE, kind=B8Ki), ubound(InData%PCE, kind=B8Ki)) - call RegPack(Buf, InData%PCE) - end if - call RegPack(Buf, allocated(InData%PDE)) - if (allocated(InData%PDE)) then - call RegPackBounds(Buf, 1, lbound(InData%PDE, kind=B8Ki), ubound(InData%PDE, kind=B8Ki)) - call RegPack(Buf, InData%PDE) - end if - call RegPack(Buf, allocated(InData%PIE)) - if (allocated(InData%PIE)) then - call RegPackBounds(Buf, 1, lbound(InData%PIE, kind=B8Ki), ubound(InData%PIE, kind=B8Ki)) - call RegPack(Buf, InData%PIE) - end if - call RegPack(Buf, allocated(InData%PTE)) - if (allocated(InData%PTE)) then - call RegPackBounds(Buf, 1, lbound(InData%PTE, kind=B8Ki), ubound(InData%PTE, kind=B8Ki)) - call RegPack(Buf, InData%PTE) - end if - call RegPack(Buf, allocated(InData%PTTE)) - if (allocated(InData%PTTE)) then - call RegPackBounds(Buf, 1, lbound(InData%PTTE, kind=B8Ki), ubound(InData%PTTE, kind=B8Ki)) - call RegPack(Buf, InData%PTTE) - end if - call RegPack(Buf, allocated(InData%PS)) - if (allocated(InData%PS)) then - call RegPackBounds(Buf, 1, lbound(InData%PS, kind=B8Ki), ubound(InData%PS, kind=B8Ki)) - call RegPack(Buf, InData%PS) - end if - call RegPack(Buf, allocated(InData%PSBE)) - if (allocated(InData%PSBE)) then - call RegPackBounds(Buf, 2, lbound(InData%PSBE, kind=B8Ki), ubound(InData%PSBE, kind=B8Ki)) - call RegPack(Buf, InData%PSBE) - end if - call RegPack(Buf, allocated(InData%PSE)) - if (allocated(InData%PSE)) then - call RegPackBounds(Buf, 2, lbound(InData%PSE, kind=B8Ki), ubound(InData%PSE, kind=B8Ki)) - call RegPack(Buf, InData%PSE) - end if - call RegPack(Buf, allocated(InData%PUE)) - if (allocated(InData%PUE)) then - call RegPackBounds(Buf, 1, lbound(InData%PUE, kind=B8Ki), ubound(InData%PUE, kind=B8Ki)) - call RegPack(Buf, InData%PUE) - end if - call RegPack(Buf, allocated(InData%PYE)) - if (allocated(InData%PYE)) then - call RegPackBounds(Buf, 1, lbound(InData%PYE, kind=B8Ki), ubound(InData%PYE, kind=B8Ki)) - call RegPack(Buf, InData%PYE) - end if - call RegPack(Buf, allocated(InData%SrtPS)) - if (allocated(InData%SrtPS)) then - call RegPackBounds(Buf, 1, lbound(InData%SrtPS, kind=B8Ki), ubound(InData%SrtPS, kind=B8Ki)) - call RegPack(Buf, InData%SrtPS) - end if - call RegPack(Buf, allocated(InData%SrtPSNAUG)) - if (allocated(InData%SrtPSNAUG)) then - call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG, kind=B8Ki), ubound(InData%SrtPSNAUG, kind=B8Ki)) - call RegPack(Buf, InData%SrtPSNAUG) - end if - call RegPack(Buf, allocated(InData%Diag)) - if (allocated(InData%Diag)) then - call RegPackBounds(Buf, 1, lbound(InData%Diag, kind=B8Ki), ubound(InData%Diag, kind=B8Ki)) - call RegPack(Buf, InData%Diag) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NActvDOF) + call RegPack(RF, InData%NPCE) + call RegPack(RF, InData%NPDE) + call RegPack(RF, InData%NPIE) + call RegPack(RF, InData%NPTE) + call RegPack(RF, InData%NPTTE) + call RegPackAlloc(RF, InData%NPSBE) + call RegPackAlloc(RF, InData%NPSE) + call RegPack(RF, InData%NPUE) + call RegPack(RF, InData%NPYE) + call RegPackAlloc(RF, InData%PCE) + call RegPackAlloc(RF, InData%PDE) + call RegPackAlloc(RF, InData%PIE) + call RegPackAlloc(RF, InData%PTE) + call RegPackAlloc(RF, InData%PTTE) + call RegPackAlloc(RF, InData%PS) + call RegPackAlloc(RF, InData%PSBE) + call RegPackAlloc(RF, InData%PSE) + call RegPackAlloc(RF, InData%PUE) + call RegPackAlloc(RF, InData%PYE) + call RegPackAlloc(RF, InData%SrtPS) + call RegPackAlloc(RF, InData%SrtPSNAUG) + call RegPackAlloc(RF, InData%Diag) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackActiveDOFs(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackActiveDOFs(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_ActiveDOFs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NActvDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPCE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPDE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPIE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPTE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPTTE) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NPSBE)) deallocate(OutData%NPSBE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NPSBE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NPSBE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NPSE)) deallocate(OutData%NPSE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NPSE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NPSE) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NPUE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPYE) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PCE)) deallocate(OutData%PCE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PCE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PCE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PDE)) deallocate(OutData%PDE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PDE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PDE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PIE)) deallocate(OutData%PIE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PIE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PIE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PTE)) deallocate(OutData%PTE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PTE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PTE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PTTE)) deallocate(OutData%PTTE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PTTE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PTTE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PS)) deallocate(OutData%PS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PSBE)) deallocate(OutData%PSBE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PSBE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PSBE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PSE)) deallocate(OutData%PSE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PSE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PSE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PUE)) deallocate(OutData%PUE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PUE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PUE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PYE)) deallocate(OutData%PYE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PYE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PYE) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SrtPS)) deallocate(OutData%SrtPS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SrtPS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SrtPS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SrtPSNAUG)) deallocate(OutData%SrtPSNAUG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SrtPSNAUG(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SrtPSNAUG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Diag)) deallocate(OutData%Diag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Diag(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Diag) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NActvDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPCE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPDE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPIE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPTTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NPSBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NPSE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPUE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPYE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PCE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PIE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PTTE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PSBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PSE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PUE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PYE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SrtPS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SrtPSNAUG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Diag); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg) @@ -5605,1591 +4183,344 @@ subroutine ED_DestroyRtHndSide(RtHndSideData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackRtHndSide(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackRtHndSide(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_RtHndSide), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackRtHndSide' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%rO) - call RegPack(Buf, allocated(InData%rQS)) - if (allocated(InData%rQS)) then - call RegPackBounds(Buf, 3, lbound(InData%rQS, kind=B8Ki), ubound(InData%rQS, kind=B8Ki)) - call RegPack(Buf, InData%rQS) - end if - call RegPack(Buf, allocated(InData%rS)) - if (allocated(InData%rS)) then - call RegPackBounds(Buf, 3, lbound(InData%rS, kind=B8Ki), ubound(InData%rS, kind=B8Ki)) - call RegPack(Buf, InData%rS) - end if - call RegPack(Buf, allocated(InData%rS0S)) - if (allocated(InData%rS0S)) then - call RegPackBounds(Buf, 3, lbound(InData%rS0S, kind=B8Ki), ubound(InData%rS0S, kind=B8Ki)) - call RegPack(Buf, InData%rS0S) - end if - call RegPack(Buf, allocated(InData%rT)) - if (allocated(InData%rT)) then - call RegPackBounds(Buf, 2, lbound(InData%rT, kind=B8Ki), ubound(InData%rT, kind=B8Ki)) - call RegPack(Buf, InData%rT) - end if - call RegPack(Buf, InData%rT0O) - call RegPack(Buf, allocated(InData%rT0T)) - if (allocated(InData%rT0T)) then - call RegPackBounds(Buf, 2, lbound(InData%rT0T, kind=B8Ki), ubound(InData%rT0T, kind=B8Ki)) - call RegPack(Buf, InData%rT0T) - end if - call RegPack(Buf, InData%rZ) - call RegPack(Buf, InData%rZO) - call RegPack(Buf, allocated(InData%rZT)) - if (allocated(InData%rZT)) then - call RegPackBounds(Buf, 2, lbound(InData%rZT, kind=B8Ki), ubound(InData%rZT, kind=B8Ki)) - call RegPack(Buf, InData%rZT) - end if - call RegPack(Buf, InData%rPQ) - call RegPack(Buf, InData%rP) - call RegPack(Buf, InData%rV) - call RegPack(Buf, InData%rJ) - call RegPack(Buf, InData%rZY) - call RegPack(Buf, InData%rOU) - call RegPack(Buf, InData%rOV) - call RegPack(Buf, InData%rVD) - call RegPack(Buf, InData%rOW) - call RegPack(Buf, InData%rPC) - call RegPack(Buf, allocated(InData%rPS0)) - if (allocated(InData%rPS0)) then - call RegPackBounds(Buf, 2, lbound(InData%rPS0, kind=B8Ki), ubound(InData%rPS0, kind=B8Ki)) - call RegPack(Buf, InData%rPS0) - end if - call RegPack(Buf, InData%rQ) - call RegPack(Buf, InData%rQC) - call RegPack(Buf, InData%rVIMU) - call RegPack(Buf, InData%rVP) - call RegPack(Buf, InData%rWI) - call RegPack(Buf, InData%rWJ) - call RegPack(Buf, InData%rZT0) - call RegPack(Buf, allocated(InData%AngPosEF)) - if (allocated(InData%AngPosEF)) then - call RegPackBounds(Buf, 2, lbound(InData%AngPosEF, kind=B8Ki), ubound(InData%AngPosEF, kind=B8Ki)) - call RegPack(Buf, InData%AngPosEF) - end if - call RegPack(Buf, allocated(InData%AngPosXF)) - if (allocated(InData%AngPosXF)) then - call RegPackBounds(Buf, 2, lbound(InData%AngPosXF, kind=B8Ki), ubound(InData%AngPosXF, kind=B8Ki)) - call RegPack(Buf, InData%AngPosXF) - end if - call RegPack(Buf, allocated(InData%AngPosHM)) - if (allocated(InData%AngPosHM)) then - call RegPackBounds(Buf, 3, lbound(InData%AngPosHM, kind=B8Ki), ubound(InData%AngPosHM, kind=B8Ki)) - call RegPack(Buf, InData%AngPosHM) - end if - call RegPack(Buf, InData%AngPosXB) - call RegPack(Buf, InData%AngPosEX) - call RegPack(Buf, allocated(InData%PAngVelEA)) - if (allocated(InData%PAngVelEA)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA, kind=B8Ki), ubound(InData%PAngVelEA, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEA) - end if - call RegPack(Buf, allocated(InData%PAngVelEF)) - if (allocated(InData%PAngVelEF)) then - call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF, kind=B8Ki), ubound(InData%PAngVelEF, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEF) - end if - call RegPack(Buf, allocated(InData%PAngVelEG)) - if (allocated(InData%PAngVelEG)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG, kind=B8Ki), ubound(InData%PAngVelEG, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEG) - end if - call RegPack(Buf, allocated(InData%PAngVelEH)) - if (allocated(InData%PAngVelEH)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH, kind=B8Ki), ubound(InData%PAngVelEH, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEH) - end if - call RegPack(Buf, allocated(InData%PAngVelEL)) - if (allocated(InData%PAngVelEL)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL, kind=B8Ki), ubound(InData%PAngVelEL, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEL) - end if - call RegPack(Buf, allocated(InData%PAngVelEM)) - if (allocated(InData%PAngVelEM)) then - call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM, kind=B8Ki), ubound(InData%PAngVelEM, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEM) - end if - call RegPack(Buf, allocated(InData%AngVelEM)) - if (allocated(InData%AngVelEM)) then - call RegPackBounds(Buf, 3, lbound(InData%AngVelEM, kind=B8Ki), ubound(InData%AngVelEM, kind=B8Ki)) - call RegPack(Buf, InData%AngVelEM) - end if - call RegPack(Buf, allocated(InData%PAngVelEN)) - if (allocated(InData%PAngVelEN)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN, kind=B8Ki), ubound(InData%PAngVelEN, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEN) - end if - call RegPack(Buf, InData%AngVelEA) - call RegPack(Buf, allocated(InData%PAngVelEB)) - if (allocated(InData%PAngVelEB)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB, kind=B8Ki), ubound(InData%PAngVelEB, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEB) - end if - call RegPack(Buf, allocated(InData%PAngVelER)) - if (allocated(InData%PAngVelER)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelER, kind=B8Ki), ubound(InData%PAngVelER, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelER) - end if - call RegPack(Buf, allocated(InData%PAngVelEX)) - if (allocated(InData%PAngVelEX)) then - call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX, kind=B8Ki), ubound(InData%PAngVelEX, kind=B8Ki)) - call RegPack(Buf, InData%PAngVelEX) - end if - call RegPack(Buf, InData%AngVelEG) - call RegPack(Buf, InData%AngVelEH) - call RegPack(Buf, InData%AngVelEL) - call RegPack(Buf, InData%AngVelEN) - call RegPack(Buf, InData%AngVelEB) - call RegPack(Buf, InData%AngVelER) - call RegPack(Buf, InData%AngVelEX) - call RegPack(Buf, InData%TeetAngVel) - call RegPack(Buf, InData%AngAccEBt) - call RegPack(Buf, InData%AngAccERt) - call RegPack(Buf, InData%AngAccEXt) - call RegPack(Buf, allocated(InData%AngAccEFt)) - if (allocated(InData%AngAccEFt)) then - call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt, kind=B8Ki), ubound(InData%AngAccEFt, kind=B8Ki)) - call RegPack(Buf, InData%AngAccEFt) - end if - call RegPack(Buf, allocated(InData%AngVelEF)) - if (allocated(InData%AngVelEF)) then - call RegPackBounds(Buf, 2, lbound(InData%AngVelEF, kind=B8Ki), ubound(InData%AngVelEF, kind=B8Ki)) - call RegPack(Buf, InData%AngVelEF) - end if - call RegPack(Buf, allocated(InData%AngVelHM)) - if (allocated(InData%AngVelHM)) then - call RegPackBounds(Buf, 3, lbound(InData%AngVelHM, kind=B8Ki), ubound(InData%AngVelHM, kind=B8Ki)) - call RegPack(Buf, InData%AngVelHM) - end if - call RegPack(Buf, InData%AngAccEAt) - call RegPack(Buf, InData%AngAccEGt) - call RegPack(Buf, InData%AngAccEHt) - call RegPack(Buf, allocated(InData%AngAccEKt)) - if (allocated(InData%AngAccEKt)) then - call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt, kind=B8Ki), ubound(InData%AngAccEKt, kind=B8Ki)) - call RegPack(Buf, InData%AngAccEKt) - end if - call RegPack(Buf, InData%AngAccENt) - call RegPack(Buf, InData%LinAccECt) - call RegPack(Buf, InData%LinAccEDt) - call RegPack(Buf, InData%LinAccEIt) - call RegPack(Buf, InData%LinAccEJt) - call RegPack(Buf, InData%LinAccEUt) - call RegPack(Buf, InData%LinAccEYt) - call RegPack(Buf, allocated(InData%LinVelES)) - if (allocated(InData%LinVelES)) then - call RegPackBounds(Buf, 3, lbound(InData%LinVelES, kind=B8Ki), ubound(InData%LinVelES, kind=B8Ki)) - call RegPack(Buf, InData%LinVelES) - end if - call RegPack(Buf, InData%LinVelEQ) - call RegPack(Buf, allocated(InData%LinVelET)) - if (allocated(InData%LinVelET)) then - call RegPackBounds(Buf, 2, lbound(InData%LinVelET, kind=B8Ki), ubound(InData%LinVelET, kind=B8Ki)) - call RegPack(Buf, InData%LinVelET) - end if - call RegPack(Buf, allocated(InData%LinVelESm2)) - if (allocated(InData%LinVelESm2)) then - call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2, kind=B8Ki), ubound(InData%LinVelESm2, kind=B8Ki)) - call RegPack(Buf, InData%LinVelESm2) - end if - call RegPack(Buf, allocated(InData%PLinVelEIMU)) - if (allocated(InData%PLinVelEIMU)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU, kind=B8Ki), ubound(InData%PLinVelEIMU, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEIMU) - end if - call RegPack(Buf, allocated(InData%PLinVelEO)) - if (allocated(InData%PLinVelEO)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO, kind=B8Ki), ubound(InData%PLinVelEO, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEO) - end if - call RegPack(Buf, allocated(InData%PLinVelES)) - if (allocated(InData%PLinVelES)) then - call RegPackBounds(Buf, 5, lbound(InData%PLinVelES, kind=B8Ki), ubound(InData%PLinVelES, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelES) - end if - call RegPack(Buf, allocated(InData%PLinVelET)) - if (allocated(InData%PLinVelET)) then - call RegPackBounds(Buf, 4, lbound(InData%PLinVelET, kind=B8Ki), ubound(InData%PLinVelET, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelET) - end if - call RegPack(Buf, allocated(InData%PLinVelEZ)) - if (allocated(InData%PLinVelEZ)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ, kind=B8Ki), ubound(InData%PLinVelEZ, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEZ) - end if - call RegPack(Buf, allocated(InData%PLinVelEC)) - if (allocated(InData%PLinVelEC)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC, kind=B8Ki), ubound(InData%PLinVelEC, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEC) - end if - call RegPack(Buf, allocated(InData%PLinVelED)) - if (allocated(InData%PLinVelED)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelED, kind=B8Ki), ubound(InData%PLinVelED, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelED) - end if - call RegPack(Buf, allocated(InData%PLinVelEI)) - if (allocated(InData%PLinVelEI)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI, kind=B8Ki), ubound(InData%PLinVelEI, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEI) - end if - call RegPack(Buf, allocated(InData%PLinVelEJ)) - if (allocated(InData%PLinVelEJ)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ, kind=B8Ki), ubound(InData%PLinVelEJ, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEJ) - end if - call RegPack(Buf, allocated(InData%PLinVelEP)) - if (allocated(InData%PLinVelEP)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP, kind=B8Ki), ubound(InData%PLinVelEP, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEP) - end if - call RegPack(Buf, allocated(InData%PLinVelEQ)) - if (allocated(InData%PLinVelEQ)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ, kind=B8Ki), ubound(InData%PLinVelEQ, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEQ) - end if - call RegPack(Buf, allocated(InData%PLinVelEU)) - if (allocated(InData%PLinVelEU)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU, kind=B8Ki), ubound(InData%PLinVelEU, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEU) - end if - call RegPack(Buf, allocated(InData%PLinVelEV)) - if (allocated(InData%PLinVelEV)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV, kind=B8Ki), ubound(InData%PLinVelEV, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEV) - end if - call RegPack(Buf, allocated(InData%PLinVelEW)) - if (allocated(InData%PLinVelEW)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW, kind=B8Ki), ubound(InData%PLinVelEW, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEW) - end if - call RegPack(Buf, allocated(InData%PLinVelEY)) - if (allocated(InData%PLinVelEY)) then - call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY, kind=B8Ki), ubound(InData%PLinVelEY, kind=B8Ki)) - call RegPack(Buf, InData%PLinVelEY) - end if - call RegPack(Buf, InData%LinAccEIMUt) - call RegPack(Buf, InData%LinAccEOt) - call RegPack(Buf, allocated(InData%LinAccESt)) - if (allocated(InData%LinAccESt)) then - call RegPackBounds(Buf, 3, lbound(InData%LinAccESt, kind=B8Ki), ubound(InData%LinAccESt, kind=B8Ki)) - call RegPack(Buf, InData%LinAccESt) - end if - call RegPack(Buf, allocated(InData%LinAccETt)) - if (allocated(InData%LinAccETt)) then - call RegPackBounds(Buf, 2, lbound(InData%LinAccETt, kind=B8Ki), ubound(InData%LinAccETt, kind=B8Ki)) - call RegPack(Buf, InData%LinAccETt) - end if - call RegPack(Buf, InData%LinAccEZt) - call RegPack(Buf, InData%LinVelEIMU) - call RegPack(Buf, InData%LinVelEZ) - call RegPack(Buf, InData%LinVelEO) - call RegPack(Buf, InData%LinVelEJ) - call RegPack(Buf, InData%FrcONcRtt) - call RegPack(Buf, InData%FrcPRott) - call RegPack(Buf, allocated(InData%FrcS0Bt)) - if (allocated(InData%FrcS0Bt)) then - call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt, kind=B8Ki), ubound(InData%FrcS0Bt, kind=B8Ki)) - call RegPack(Buf, InData%FrcS0Bt) - end if - call RegPack(Buf, InData%FrcT0Trbt) - call RegPack(Buf, allocated(InData%FSAero)) - if (allocated(InData%FSAero)) then - call RegPackBounds(Buf, 3, lbound(InData%FSAero, kind=B8Ki), ubound(InData%FSAero, kind=B8Ki)) - call RegPack(Buf, InData%FSAero) - end if - call RegPack(Buf, allocated(InData%FSTipDrag)) - if (allocated(InData%FSTipDrag)) then - call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag, kind=B8Ki), ubound(InData%FSTipDrag, kind=B8Ki)) - call RegPack(Buf, InData%FSTipDrag) - end if - call RegPack(Buf, allocated(InData%FTHydrot)) - if (allocated(InData%FTHydrot)) then - call RegPackBounds(Buf, 2, lbound(InData%FTHydrot, kind=B8Ki), ubound(InData%FTHydrot, kind=B8Ki)) - call RegPack(Buf, InData%FTHydrot) - end if - call RegPack(Buf, InData%FZHydrot) - call RegPack(Buf, allocated(InData%MFHydrot)) - if (allocated(InData%MFHydrot)) then - call RegPackBounds(Buf, 2, lbound(InData%MFHydrot, kind=B8Ki), ubound(InData%MFHydrot, kind=B8Ki)) - call RegPack(Buf, InData%MFHydrot) - end if - call RegPack(Buf, InData%MomBNcRtt) - call RegPack(Buf, allocated(InData%MomH0Bt)) - if (allocated(InData%MomH0Bt)) then - call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt, kind=B8Ki), ubound(InData%MomH0Bt, kind=B8Ki)) - call RegPack(Buf, InData%MomH0Bt) - end if - call RegPack(Buf, InData%MomLPRott) - call RegPack(Buf, InData%MomNGnRtt) - call RegPack(Buf, InData%MomNTailt) - call RegPack(Buf, InData%MomX0Trbt) - call RegPack(Buf, allocated(InData%MMAero)) - if (allocated(InData%MMAero)) then - call RegPackBounds(Buf, 3, lbound(InData%MMAero, kind=B8Ki), ubound(InData%MMAero, kind=B8Ki)) - call RegPack(Buf, InData%MMAero) - end if - call RegPack(Buf, InData%MXHydrot) - call RegPack(Buf, allocated(InData%PFrcONcRt)) - if (allocated(InData%PFrcONcRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt, kind=B8Ki), ubound(InData%PFrcONcRt, kind=B8Ki)) - call RegPack(Buf, InData%PFrcONcRt) - end if - call RegPack(Buf, allocated(InData%PFrcPRot)) - if (allocated(InData%PFrcPRot)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot, kind=B8Ki), ubound(InData%PFrcPRot, kind=B8Ki)) - call RegPack(Buf, InData%PFrcPRot) - end if - call RegPack(Buf, allocated(InData%PFrcS0B)) - if (allocated(InData%PFrcS0B)) then - call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B, kind=B8Ki), ubound(InData%PFrcS0B, kind=B8Ki)) - call RegPack(Buf, InData%PFrcS0B) - end if - call RegPack(Buf, allocated(InData%PFrcT0Trb)) - if (allocated(InData%PFrcT0Trb)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb, kind=B8Ki), ubound(InData%PFrcT0Trb, kind=B8Ki)) - call RegPack(Buf, InData%PFrcT0Trb) - end if - call RegPack(Buf, allocated(InData%PFTHydro)) - if (allocated(InData%PFTHydro)) then - call RegPackBounds(Buf, 3, lbound(InData%PFTHydro, kind=B8Ki), ubound(InData%PFTHydro, kind=B8Ki)) - call RegPack(Buf, InData%PFTHydro) - end if - call RegPack(Buf, InData%PFZHydro) - call RegPack(Buf, allocated(InData%PMFHydro)) - if (allocated(InData%PMFHydro)) then - call RegPackBounds(Buf, 3, lbound(InData%PMFHydro, kind=B8Ki), ubound(InData%PMFHydro, kind=B8Ki)) - call RegPack(Buf, InData%PMFHydro) - end if - call RegPack(Buf, allocated(InData%PMomBNcRt)) - if (allocated(InData%PMomBNcRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt, kind=B8Ki), ubound(InData%PMomBNcRt, kind=B8Ki)) - call RegPack(Buf, InData%PMomBNcRt) - end if - call RegPack(Buf, allocated(InData%PMomH0B)) - if (allocated(InData%PMomH0B)) then - call RegPackBounds(Buf, 3, lbound(InData%PMomH0B, kind=B8Ki), ubound(InData%PMomH0B, kind=B8Ki)) - call RegPack(Buf, InData%PMomH0B) - end if - call RegPack(Buf, allocated(InData%PMomLPRot)) - if (allocated(InData%PMomLPRot)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot, kind=B8Ki), ubound(InData%PMomLPRot, kind=B8Ki)) - call RegPack(Buf, InData%PMomLPRot) - end if - call RegPack(Buf, allocated(InData%PMomNGnRt)) - if (allocated(InData%PMomNGnRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt, kind=B8Ki), ubound(InData%PMomNGnRt, kind=B8Ki)) - call RegPack(Buf, InData%PMomNGnRt) - end if - call RegPack(Buf, allocated(InData%PMomNTail)) - if (allocated(InData%PMomNTail)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomNTail, kind=B8Ki), ubound(InData%PMomNTail, kind=B8Ki)) - call RegPack(Buf, InData%PMomNTail) - end if - call RegPack(Buf, allocated(InData%PMomX0Trb)) - if (allocated(InData%PMomX0Trb)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb, kind=B8Ki), ubound(InData%PMomX0Trb, kind=B8Ki)) - call RegPack(Buf, InData%PMomX0Trb) - end if - call RegPack(Buf, InData%PMXHydro) - call RegPack(Buf, InData%TeetAng) - call RegPack(Buf, InData%FrcVGnRtt) - call RegPack(Buf, InData%FrcWTailt) - call RegPack(Buf, InData%FrcZAllt) - call RegPack(Buf, InData%MomXAllt) - call RegPack(Buf, allocated(InData%PFrcVGnRt)) - if (allocated(InData%PFrcVGnRt)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt, kind=B8Ki), ubound(InData%PFrcVGnRt, kind=B8Ki)) - call RegPack(Buf, InData%PFrcVGnRt) - end if - call RegPack(Buf, allocated(InData%PFrcWTail)) - if (allocated(InData%PFrcWTail)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail, kind=B8Ki), ubound(InData%PFrcWTail, kind=B8Ki)) - call RegPack(Buf, InData%PFrcWTail) - end if - call RegPack(Buf, allocated(InData%PFrcZAll)) - if (allocated(InData%PFrcZAll)) then - call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll, kind=B8Ki), ubound(InData%PFrcZAll, kind=B8Ki)) - call RegPack(Buf, InData%PFrcZAll) - end if - call RegPack(Buf, allocated(InData%PMomXAll)) - if (allocated(InData%PMomXAll)) then - call RegPackBounds(Buf, 2, lbound(InData%PMomXAll, kind=B8Ki), ubound(InData%PMomXAll, kind=B8Ki)) - call RegPack(Buf, InData%PMomXAll) - end if - call RegPack(Buf, InData%TeetMom) - call RegPack(Buf, InData%TFrlMom) - call RegPack(Buf, InData%RFrlMom) - call RegPack(Buf, InData%GBoxEffFac) - call RegPack(Buf, allocated(InData%rSAerCen)) - if (allocated(InData%rSAerCen)) then - call RegPackBounds(Buf, 3, lbound(InData%rSAerCen, kind=B8Ki), ubound(InData%rSAerCen, kind=B8Ki)) - call RegPack(Buf, InData%rSAerCen) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%rO) + call RegPackAlloc(RF, InData%rQS) + call RegPackAlloc(RF, InData%rS) + call RegPackAlloc(RF, InData%rS0S) + call RegPackAlloc(RF, InData%rT) + call RegPack(RF, InData%rT0O) + call RegPackAlloc(RF, InData%rT0T) + call RegPack(RF, InData%rZ) + call RegPack(RF, InData%rZO) + call RegPackAlloc(RF, InData%rZT) + call RegPack(RF, InData%rPQ) + call RegPack(RF, InData%rP) + call RegPack(RF, InData%rV) + call RegPack(RF, InData%rJ) + call RegPack(RF, InData%rZY) + call RegPack(RF, InData%rOU) + call RegPack(RF, InData%rOV) + call RegPack(RF, InData%rVD) + call RegPack(RF, InData%rOW) + call RegPack(RF, InData%rPC) + call RegPackAlloc(RF, InData%rPS0) + call RegPack(RF, InData%rQ) + call RegPack(RF, InData%rQC) + call RegPack(RF, InData%rVIMU) + call RegPack(RF, InData%rVP) + call RegPack(RF, InData%rWI) + call RegPack(RF, InData%rWJ) + call RegPack(RF, InData%rZT0) + call RegPackAlloc(RF, InData%AngPosEF) + call RegPackAlloc(RF, InData%AngPosXF) + call RegPackAlloc(RF, InData%AngPosHM) + call RegPack(RF, InData%AngPosXB) + call RegPack(RF, InData%AngPosEX) + call RegPackAlloc(RF, InData%PAngVelEA) + call RegPackAlloc(RF, InData%PAngVelEF) + call RegPackAlloc(RF, InData%PAngVelEG) + call RegPackAlloc(RF, InData%PAngVelEH) + call RegPackAlloc(RF, InData%PAngVelEL) + call RegPackAlloc(RF, InData%PAngVelEM) + call RegPackAlloc(RF, InData%AngVelEM) + call RegPackAlloc(RF, InData%PAngVelEN) + call RegPack(RF, InData%AngVelEA) + call RegPackAlloc(RF, InData%PAngVelEB) + call RegPackAlloc(RF, InData%PAngVelER) + call RegPackAlloc(RF, InData%PAngVelEX) + call RegPack(RF, InData%AngVelEG) + call RegPack(RF, InData%AngVelEH) + call RegPack(RF, InData%AngVelEL) + call RegPack(RF, InData%AngVelEN) + call RegPack(RF, InData%AngVelEB) + call RegPack(RF, InData%AngVelER) + call RegPack(RF, InData%AngVelEX) + call RegPack(RF, InData%TeetAngVel) + call RegPack(RF, InData%AngAccEBt) + call RegPack(RF, InData%AngAccERt) + call RegPack(RF, InData%AngAccEXt) + call RegPackAlloc(RF, InData%AngAccEFt) + call RegPackAlloc(RF, InData%AngVelEF) + call RegPackAlloc(RF, InData%AngVelHM) + call RegPack(RF, InData%AngAccEAt) + call RegPack(RF, InData%AngAccEGt) + call RegPack(RF, InData%AngAccEHt) + call RegPackAlloc(RF, InData%AngAccEKt) + call RegPack(RF, InData%AngAccENt) + call RegPack(RF, InData%LinAccECt) + call RegPack(RF, InData%LinAccEDt) + call RegPack(RF, InData%LinAccEIt) + call RegPack(RF, InData%LinAccEJt) + call RegPack(RF, InData%LinAccEUt) + call RegPack(RF, InData%LinAccEYt) + call RegPackAlloc(RF, InData%LinVelES) + call RegPack(RF, InData%LinVelEQ) + call RegPackAlloc(RF, InData%LinVelET) + call RegPackAlloc(RF, InData%LinVelESm2) + call RegPackAlloc(RF, InData%PLinVelEIMU) + call RegPackAlloc(RF, InData%PLinVelEO) + call RegPackAlloc(RF, InData%PLinVelES) + call RegPackAlloc(RF, InData%PLinVelET) + call RegPackAlloc(RF, InData%PLinVelEZ) + call RegPackAlloc(RF, InData%PLinVelEC) + call RegPackAlloc(RF, InData%PLinVelED) + call RegPackAlloc(RF, InData%PLinVelEI) + call RegPackAlloc(RF, InData%PLinVelEJ) + call RegPackAlloc(RF, InData%PLinVelEP) + call RegPackAlloc(RF, InData%PLinVelEQ) + call RegPackAlloc(RF, InData%PLinVelEU) + call RegPackAlloc(RF, InData%PLinVelEV) + call RegPackAlloc(RF, InData%PLinVelEW) + call RegPackAlloc(RF, InData%PLinVelEY) + call RegPack(RF, InData%LinAccEIMUt) + call RegPack(RF, InData%LinAccEOt) + call RegPackAlloc(RF, InData%LinAccESt) + call RegPackAlloc(RF, InData%LinAccETt) + call RegPack(RF, InData%LinAccEZt) + call RegPack(RF, InData%LinVelEIMU) + call RegPack(RF, InData%LinVelEZ) + call RegPack(RF, InData%LinVelEO) + call RegPack(RF, InData%LinVelEJ) + call RegPack(RF, InData%FrcONcRtt) + call RegPack(RF, InData%FrcPRott) + call RegPackAlloc(RF, InData%FrcS0Bt) + call RegPack(RF, InData%FrcT0Trbt) + call RegPackAlloc(RF, InData%FSAero) + call RegPackAlloc(RF, InData%FSTipDrag) + call RegPackAlloc(RF, InData%FTHydrot) + call RegPack(RF, InData%FZHydrot) + call RegPackAlloc(RF, InData%MFHydrot) + call RegPack(RF, InData%MomBNcRtt) + call RegPackAlloc(RF, InData%MomH0Bt) + call RegPack(RF, InData%MomLPRott) + call RegPack(RF, InData%MomNGnRtt) + call RegPack(RF, InData%MomNTailt) + call RegPack(RF, InData%MomX0Trbt) + call RegPackAlloc(RF, InData%MMAero) + call RegPack(RF, InData%MXHydrot) + call RegPackAlloc(RF, InData%PFrcONcRt) + call RegPackAlloc(RF, InData%PFrcPRot) + call RegPackAlloc(RF, InData%PFrcS0B) + call RegPackAlloc(RF, InData%PFrcT0Trb) + call RegPackAlloc(RF, InData%PFTHydro) + call RegPack(RF, InData%PFZHydro) + call RegPackAlloc(RF, InData%PMFHydro) + call RegPackAlloc(RF, InData%PMomBNcRt) + call RegPackAlloc(RF, InData%PMomH0B) + call RegPackAlloc(RF, InData%PMomLPRot) + call RegPackAlloc(RF, InData%PMomNGnRt) + call RegPackAlloc(RF, InData%PMomNTail) + call RegPackAlloc(RF, InData%PMomX0Trb) + call RegPack(RF, InData%PMXHydro) + call RegPack(RF, InData%TeetAng) + call RegPack(RF, InData%FrcVGnRtt) + call RegPack(RF, InData%FrcWTailt) + call RegPack(RF, InData%FrcZAllt) + call RegPack(RF, InData%MomXAllt) + call RegPackAlloc(RF, InData%PFrcVGnRt) + call RegPackAlloc(RF, InData%PFrcWTail) + call RegPackAlloc(RF, InData%PFrcZAll) + call RegPackAlloc(RF, InData%PMomXAll) + call RegPack(RF, InData%TeetMom) + call RegPack(RF, InData%TFrlMom) + call RegPack(RF, InData%RFrlMom) + call RegPack(RF, InData%GBoxEffFac) + call RegPackAlloc(RF, InData%rSAerCen) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackRtHndSide(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackRtHndSide(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_RtHndSide), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%rO) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rQS)) deallocate(OutData%rQS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rQS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rS)) deallocate(OutData%rS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%rO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rQS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rS0S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rT0O); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rT0T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rZT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rPQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rOU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rOV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rPC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rPS0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rQC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZT0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngPosEF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngPosXF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngPosHM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngPosXB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngPosEX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngVelEM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelER); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PAngVelEX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelER); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngVelEX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetAngVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEBt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccERt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEXt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngAccEFt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngVelEF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngVelHM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEAt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEGt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccEHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngAccEKt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngAccENt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccECt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEDt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEIt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEJt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEUt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEYt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinVelES); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinVelET); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinVelESm2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEIMU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelES); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelET); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelED); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PLinVelEY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEIMUt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEOt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinAccESt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinAccETt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinAccEZt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEIMU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEO); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinVelEJ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcONcRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcPRott); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FrcS0Bt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcT0Trbt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FSTipDrag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FTHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FZHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MFHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomBNcRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MomH0Bt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomLPRott); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomNGnRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomNTailt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomX0Trbt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MMAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MXHydrot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcONcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcPRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcS0B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcT0Trb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFTHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PFZHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMFHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomBNcRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomH0B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomLPRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomNGnRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomNTail); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomX0Trb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PMXHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetAng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcVGnRtt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcWTailt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FrcZAllt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MomXAllt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcVGnRt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcWTail); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PFrcZAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PMomXAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxEffFac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rSAerCen); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(in) :: SrcContStateData + type(ED_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%QT)) then + LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) + if (.not. allocated(DstContStateData%QT)) then + allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%rS) - if (RegCheckErr(Buf, RoutineName)) return + DstContStateData%QT = SrcContStateData%QT end if - if (allocated(OutData%rS0S)) deallocate(OutData%rS0S) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcContStateData%QDT)) then + LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) + if (.not. allocated(DstContStateData%QDT)) then + allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%rS0S) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rT)) deallocate(OutData%rT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rT(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rT) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%rT0O) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rT0T)) deallocate(OutData%rT0T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rT0T(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rT0T) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%rZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rZO) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rZT)) deallocate(OutData%rZT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rZT(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rZT) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%rPQ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rJ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rZY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rOU) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rOV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rPC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rPS0)) deallocate(OutData%rPS0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rPS0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rPS0) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%rQ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rQC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVIMU) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWJ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rZT0) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AngPosEF)) deallocate(OutData%AngPosEF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngPosEF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngPosEF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngPosXF)) deallocate(OutData%AngPosXF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngPosXF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngPosXF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngPosHM)) deallocate(OutData%AngPosHM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngPosHM) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AngPosXB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngPosEX) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PAngVelEA)) deallocate(OutData%PAngVelEA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEF)) deallocate(OutData%PAngVelEF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEG)) deallocate(OutData%PAngVelEG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEH)) deallocate(OutData%PAngVelEH) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEH) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEL)) deallocate(OutData%PAngVelEL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEM)) deallocate(OutData%PAngVelEM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngVelEM)) deallocate(OutData%AngVelEM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngVelEM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEN)) deallocate(OutData%PAngVelEN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEN) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AngVelEA) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PAngVelEB)) deallocate(OutData%PAngVelEB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelER)) deallocate(OutData%PAngVelER) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelER) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PAngVelEX)) deallocate(OutData%PAngVelEX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PAngVelEX) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AngVelEG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngVelEH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngVelEL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngVelEN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngVelEB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngVelER) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngVelEX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetAngVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngAccEBt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngAccERt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngAccEXt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AngAccEFt)) deallocate(OutData%AngAccEFt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngAccEFt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngVelEF)) deallocate(OutData%AngVelEF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngVelEF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngVelEF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngVelHM)) deallocate(OutData%AngVelHM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelHM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngVelHM) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AngAccEAt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngAccEGt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngAccEHt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AngAccEKt)) deallocate(OutData%AngAccEKt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEKt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngAccEKt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AngAccENt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccECt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccEDt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccEIt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccEJt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccEUt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccEYt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LinVelES)) deallocate(OutData%LinVelES) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinVelES) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LinVelEQ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LinVelET)) deallocate(OutData%LinVelET) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinVelET(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinVelET) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinVelESm2)) deallocate(OutData%LinVelESm2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinVelESm2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinVelESm2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEIMU)) deallocate(OutData%PLinVelEIMU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEIMU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEO)) deallocate(OutData%PLinVelEO) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEO) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelES)) deallocate(OutData%PLinVelES) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelES) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelET)) deallocate(OutData%PLinVelET) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelET) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEZ)) deallocate(OutData%PLinVelEZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEC)) deallocate(OutData%PLinVelEC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelED)) deallocate(OutData%PLinVelED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelED) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEI)) deallocate(OutData%PLinVelEI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEJ)) deallocate(OutData%PLinVelEJ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEJ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEP)) deallocate(OutData%PLinVelEP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEQ)) deallocate(OutData%PLinVelEQ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEQ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEU)) deallocate(OutData%PLinVelEU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEV)) deallocate(OutData%PLinVelEV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEW)) deallocate(OutData%PLinVelEW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PLinVelEY)) deallocate(OutData%PLinVelEY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PLinVelEY) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LinAccEIMUt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinAccEOt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LinAccESt)) deallocate(OutData%LinAccESt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinAccESt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinAccETt)) deallocate(OutData%LinAccETt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinAccETt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinAccETt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LinAccEZt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinVelEIMU) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinVelEZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinVelEO) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinVelEJ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrcONcRtt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrcPRott) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FrcS0Bt)) deallocate(OutData%FrcS0Bt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FrcS0Bt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FrcT0Trbt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FSAero)) deallocate(OutData%FSAero) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FSAero) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FSTipDrag)) deallocate(OutData%FSTipDrag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FSTipDrag) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FTHydrot)) deallocate(OutData%FTHydrot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FTHydrot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FTHydrot) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FZHydrot) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%MFHydrot)) deallocate(OutData%MFHydrot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MFHydrot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MFHydrot) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MomBNcRtt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%MomH0Bt)) deallocate(OutData%MomH0Bt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MomH0Bt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MomLPRott) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MomNGnRtt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MomNTailt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MomX0Trbt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%MMAero)) deallocate(OutData%MMAero) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MMAero) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MXHydrot) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PFrcONcRt)) deallocate(OutData%PFrcONcRt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcONcRt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PFrcPRot)) deallocate(OutData%PFrcPRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcPRot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PFrcS0B)) deallocate(OutData%PFrcS0B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcS0B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PFrcT0Trb)) deallocate(OutData%PFrcT0Trb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcT0Trb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PFTHydro)) deallocate(OutData%PFTHydro) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFTHydro) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PFZHydro) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PMFHydro)) deallocate(OutData%PMFHydro) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMFHydro) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomBNcRt)) deallocate(OutData%PMomBNcRt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomBNcRt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomH0B)) deallocate(OutData%PMomH0B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomH0B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomLPRot)) deallocate(OutData%PMomLPRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomLPRot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomNGnRt)) deallocate(OutData%PMomNGnRt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomNGnRt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomNTail)) deallocate(OutData%PMomNTail) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomNTail(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomNTail) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomX0Trb)) deallocate(OutData%PMomX0Trb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomX0Trb) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PMXHydro) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetAng) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrcVGnRtt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrcWTailt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FrcZAllt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MomXAllt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PFrcVGnRt)) deallocate(OutData%PFrcVGnRt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcVGnRt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PFrcWTail)) deallocate(OutData%PFrcWTail) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcWTail) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PFrcZAll)) deallocate(OutData%PFrcZAll) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PFrcZAll) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PMomXAll)) deallocate(OutData%PMomXAll) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PMomXAll(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PMomXAll) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TeetMom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlMom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlMom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GBoxEffFac) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rSAerCen)) deallocate(OutData%rSAerCen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rSAerCen) - if (RegCheckErr(Buf, RoutineName)) return - end if -end subroutine - -subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) - type(ED_ContinuousStateType), intent(in) :: SrcContStateData - type(ED_ContinuousStateType), intent(inout) :: DstContStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'ED_CopyContState' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcContStateData%QT)) then - LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) - if (.not. allocated(DstContStateData%QT)) then - allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstContStateData%QT = SrcContStateData%QT - end if - if (allocated(SrcContStateData%QDT)) then - LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) - if (.not. allocated(DstContStateData%QDT)) then - allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstContStateData%QDT = SrcContStateData%QDT + DstContStateData%QDT = SrcContStateData%QDT end if end subroutine @@ -7208,60 +4539,26 @@ subroutine ED_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%QT)) - if (allocated(InData%QT)) then - call RegPackBounds(Buf, 1, lbound(InData%QT, kind=B8Ki), ubound(InData%QT, kind=B8Ki)) - call RegPack(Buf, InData%QT) - end if - call RegPack(Buf, allocated(InData%QDT)) - if (allocated(InData%QDT)) then - call RegPackBounds(Buf, 1, lbound(InData%QDT, kind=B8Ki), ubound(InData%QDT, kind=B8Ki)) - call RegPack(Buf, InData%QDT) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%QT) + call RegPackAlloc(RF, InData%QDT) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackContState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%QT)) deallocate(OutData%QT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%QDT)) deallocate(OutData%QDT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QDT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QDT) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%QT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QDT); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -7285,22 +4582,21 @@ subroutine ED_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine ED_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -7324,22 +4620,21 @@ subroutine ED_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine ED_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -7403,69 +4698,47 @@ subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackContState(Buf, InData%xdot(i1)) + call ED_PackContState(RF, InData%xdot(i1)) end do - call RegPack(Buf, allocated(InData%IC)) - if (allocated(InData%IC)) then - call RegPackBounds(Buf, 1, lbound(InData%IC, kind=B8Ki), ubound(InData%IC, kind=B8Ki)) - call RegPack(Buf, InData%IC) - end if - call RegPack(Buf, InData%HSSBrTrq) - call RegPack(Buf, InData%HSSBrTrqC) - call RegPack(Buf, InData%SgnPrvLSTQ) - call RegPack(Buf, InData%SgnLSTQ) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%IC) + call RegPack(RF, InData%HSSBrTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%SgnPrvLSTQ) + call RegPack(RF, InData%SgnLSTQ) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%xdot, kind=B8Ki) UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call ED_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do - if (allocated(OutData%IC)) deallocate(OutData%IC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IC) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HSSBrTrq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrTrqC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SgnPrvLSTQ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SgnLSTQ) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SgnPrvLSTQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SgnLSTQ); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -7595,176 +4868,56 @@ subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%AugMat_factor)) then deallocate(MiscData%AugMat_factor) end if - if (allocated(MiscData%SolnVec)) then - deallocate(MiscData%SolnVec) - end if - if (allocated(MiscData%AugMat_pivot)) then - deallocate(MiscData%AugMat_pivot) - end if - if (allocated(MiscData%OgnlGeAzRo)) then - deallocate(MiscData%OgnlGeAzRo) - end if - if (allocated(MiscData%QD2T)) then - deallocate(MiscData%QD2T) - end if -end subroutine - -subroutine ED_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(ED_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call ED_PackCoordSys(Buf, InData%CoordSys) - call ED_PackRtHndSide(Buf, InData%RtHS) - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - call RegPack(Buf, allocated(InData%AugMat)) - if (allocated(InData%AugMat)) then - call RegPackBounds(Buf, 2, lbound(InData%AugMat, kind=B8Ki), ubound(InData%AugMat, kind=B8Ki)) - call RegPack(Buf, InData%AugMat) - end if - call RegPack(Buf, allocated(InData%AugMat_factor)) - if (allocated(InData%AugMat_factor)) then - call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor, kind=B8Ki), ubound(InData%AugMat_factor, kind=B8Ki)) - call RegPack(Buf, InData%AugMat_factor) - end if - call RegPack(Buf, allocated(InData%SolnVec)) - if (allocated(InData%SolnVec)) then - call RegPackBounds(Buf, 1, lbound(InData%SolnVec, kind=B8Ki), ubound(InData%SolnVec, kind=B8Ki)) - call RegPack(Buf, InData%SolnVec) - end if - call RegPack(Buf, allocated(InData%AugMat_pivot)) - if (allocated(InData%AugMat_pivot)) then - call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot, kind=B8Ki), ubound(InData%AugMat_pivot, kind=B8Ki)) - call RegPack(Buf, InData%AugMat_pivot) - end if - call RegPack(Buf, allocated(InData%OgnlGeAzRo)) - if (allocated(InData%OgnlGeAzRo)) then - call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo, kind=B8Ki), ubound(InData%OgnlGeAzRo, kind=B8Ki)) - call RegPack(Buf, InData%OgnlGeAzRo) - end if - call RegPack(Buf, allocated(InData%QD2T)) - if (allocated(InData%QD2T)) then - call RegPackBounds(Buf, 1, lbound(InData%QD2T, kind=B8Ki), ubound(InData%QD2T, kind=B8Ki)) - call RegPack(Buf, InData%QD2T) - end if - call RegPack(Buf, InData%IgnoreMod) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine ED_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(ED_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call ED_UnpackCoordSys(Buf, OutData%CoordSys) ! CoordSys - call ED_UnpackRtHndSide(Buf, OutData%RtHS) ! RtHS - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AugMat)) deallocate(OutData%AugMat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AugMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AugMat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AugMat_factor)) deallocate(OutData%AugMat_factor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AugMat_factor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SolnVec)) deallocate(OutData%SolnVec) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SolnVec(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SolnVec) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AugMat_pivot)) deallocate(OutData%AugMat_pivot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AugMat_pivot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AugMat_pivot) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(MiscData%SolnVec)) then + deallocate(MiscData%SolnVec) end if - if (allocated(OutData%OgnlGeAzRo)) deallocate(OutData%OgnlGeAzRo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OgnlGeAzRo(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OgnlGeAzRo) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(MiscData%AugMat_pivot)) then + deallocate(MiscData%AugMat_pivot) end if - if (allocated(OutData%QD2T)) deallocate(OutData%QD2T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%QD2T(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%QD2T) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(MiscData%OgnlGeAzRo)) then + deallocate(MiscData%OgnlGeAzRo) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) end if - call RegUnpack(Buf, OutData%IgnoreMod) - if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call ED_PackCoordSys(RF, InData%CoordSys) + call ED_PackRtHndSide(RF, InData%RtHS) + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%AugMat) + call RegPackAlloc(RF, InData%AugMat_factor) + call RegPackAlloc(RF, InData%SolnVec) + call RegPackAlloc(RF, InData%AugMat_pivot) + call RegPackAlloc(RF, InData%OgnlGeAzRo) + call RegPackAlloc(RF, InData%QD2T) + call RegPack(RF, InData%IgnoreMod) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackMisc' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call ED_UnpackCoordSys(RF, OutData%CoordSys) ! CoordSys + call ED_UnpackRtHndSide(RF, OutData%RtHS) ! RtHS + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_factor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SolnVec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AugMat_pivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OgnlGeAzRo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%QD2T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IgnoreMod); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -8758,1731 +5911,610 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%CAeroTwst) end if if (allocated(ParamData%CBE)) then - deallocate(ParamData%CBE) - end if - if (allocated(ParamData%CBF)) then - deallocate(ParamData%CBF) - end if - if (allocated(ParamData%Chord)) then - deallocate(ParamData%Chord) - end if - if (allocated(ParamData%CThetaS)) then - deallocate(ParamData%CThetaS) - end if - if (allocated(ParamData%DRNodes)) then - deallocate(ParamData%DRNodes) - end if - if (allocated(ParamData%FStTunr)) then - deallocate(ParamData%FStTunr) - end if - if (allocated(ParamData%KBE)) then - deallocate(ParamData%KBE) - end if - if (allocated(ParamData%KBF)) then - deallocate(ParamData%KBF) - end if - if (allocated(ParamData%MassB)) then - deallocate(ParamData%MassB) - end if - if (allocated(ParamData%RNodes)) then - deallocate(ParamData%RNodes) - end if - if (allocated(ParamData%RNodesNorm)) then - deallocate(ParamData%RNodesNorm) - end if - if (allocated(ParamData%rSAerCenn1)) then - deallocate(ParamData%rSAerCenn1) - end if - if (allocated(ParamData%rSAerCenn2)) then - deallocate(ParamData%rSAerCenn2) - end if - if (allocated(ParamData%SAeroTwst)) then - deallocate(ParamData%SAeroTwst) - end if - if (allocated(ParamData%StiffBE)) then - deallocate(ParamData%StiffBE) - end if - if (allocated(ParamData%StiffBF)) then - deallocate(ParamData%StiffBF) - end if - if (allocated(ParamData%SThetaS)) then - deallocate(ParamData%SThetaS) - end if - if (allocated(ParamData%ThetaS)) then - deallocate(ParamData%ThetaS) - end if - if (allocated(ParamData%TwistedSF)) then - deallocate(ParamData%TwistedSF) - end if - if (allocated(ParamData%BldFl1Sh)) then - deallocate(ParamData%BldFl1Sh) - end if - if (allocated(ParamData%BldFl2Sh)) then - deallocate(ParamData%BldFl2Sh) - end if - if (allocated(ParamData%BldEdgSh)) then - deallocate(ParamData%BldEdgSh) - end if - if (allocated(ParamData%FreqBE)) then - deallocate(ParamData%FreqBE) - end if - if (allocated(ParamData%FreqBF)) then - deallocate(ParamData%FreqBF) - end if - if (allocated(ParamData%BElmntMass)) then - deallocate(ParamData%BElmntMass) - end if - if (allocated(ParamData%TElmntMass)) then - deallocate(ParamData%TElmntMass) - end if - if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%BldNd_OutParam) - end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if - if (allocated(ParamData%dx)) then - deallocate(ParamData%dx) - end if -end subroutine - -subroutine ED_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(ED_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'ED_PackParam' - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%DT24) - call RegPack(Buf, InData%BldNodes) - call RegPack(Buf, InData%TipNode) - call RegPack(Buf, InData%NDOF) - call RegPack(Buf, InData%TwoPiNB) - call RegPack(Buf, InData%NAug) - call RegPack(Buf, InData%NPH) - call RegPack(Buf, allocated(InData%PH)) - if (allocated(InData%PH)) then - call RegPackBounds(Buf, 1, lbound(InData%PH, kind=B8Ki), ubound(InData%PH, kind=B8Ki)) - call RegPack(Buf, InData%PH) - end if - call RegPack(Buf, InData%NPM) - call RegPack(Buf, allocated(InData%PM)) - if (allocated(InData%PM)) then - call RegPackBounds(Buf, 2, lbound(InData%PM, kind=B8Ki), ubound(InData%PM, kind=B8Ki)) - call RegPack(Buf, InData%PM) - end if - call RegPack(Buf, allocated(InData%DOF_Flag)) - if (allocated(InData%DOF_Flag)) then - call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag, kind=B8Ki), ubound(InData%DOF_Flag, kind=B8Ki)) - call RegPack(Buf, InData%DOF_Flag) - end if - call RegPack(Buf, allocated(InData%DOF_Desc)) - if (allocated(InData%DOF_Desc)) then - call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc, kind=B8Ki), ubound(InData%DOF_Desc, kind=B8Ki)) - call RegPack(Buf, InData%DOF_Desc) - end if - call ED_PackActiveDOFs(Buf, InData%DOFs) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%NBlGages) - call RegPack(Buf, InData%NTwGages) - call RegPack(Buf, allocated(InData%OutParam)) - if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) - end do - end if - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%AvgNrmTpRd) - call RegPack(Buf, InData%AzimB1Up) - call RegPack(Buf, InData%CosDel3) - call RegPack(Buf, allocated(InData%CosPreC)) - if (allocated(InData%CosPreC)) then - call RegPackBounds(Buf, 1, lbound(InData%CosPreC, kind=B8Ki), ubound(InData%CosPreC, kind=B8Ki)) - call RegPack(Buf, InData%CosPreC) - end if - call RegPack(Buf, InData%CRFrlSkew) - call RegPack(Buf, InData%CRFrlSkw2) - call RegPack(Buf, InData%CRFrlTilt) - call RegPack(Buf, InData%CRFrlTlt2) - call RegPack(Buf, InData%CShftSkew) - call RegPack(Buf, InData%CShftTilt) - call RegPack(Buf, InData%CSRFrlSkw) - call RegPack(Buf, InData%CSRFrlTlt) - call RegPack(Buf, InData%CSTFrlSkw) - call RegPack(Buf, InData%CSTFrlTlt) - call RegPack(Buf, InData%CTFrlSkew) - call RegPack(Buf, InData%CTFrlSkw2) - call RegPack(Buf, InData%CTFrlTilt) - call RegPack(Buf, InData%CTFrlTlt2) - call RegPack(Buf, InData%HubHt) - call RegPack(Buf, InData%HubCM) - call RegPack(Buf, InData%HubRad) - call RegPack(Buf, InData%NacCMxn) - call RegPack(Buf, InData%NacCMyn) - call RegPack(Buf, InData%NacCMzn) - call RegPack(Buf, InData%OverHang) - call RegPack(Buf, InData%ProjArea) - call RegPack(Buf, InData%PtfmRefzt) - call RegPack(Buf, InData%RefTwrHt) - call RegPack(Buf, InData%RFrlPnt_n) - call RegPack(Buf, InData%rVDxn) - call RegPack(Buf, InData%rVDyn) - call RegPack(Buf, InData%rVDzn) - call RegPack(Buf, InData%rVIMUxn) - call RegPack(Buf, InData%rVIMUyn) - call RegPack(Buf, InData%rVIMUzn) - call RegPack(Buf, InData%rVPxn) - call RegPack(Buf, InData%rVPyn) - call RegPack(Buf, InData%rVPzn) - call RegPack(Buf, InData%rWIxn) - call RegPack(Buf, InData%rWIyn) - call RegPack(Buf, InData%rWIzn) - call RegPack(Buf, InData%rWJxn) - call RegPack(Buf, InData%rWJyn) - call RegPack(Buf, InData%rWJzn) - call RegPack(Buf, InData%rZT0zt) - call RegPack(Buf, InData%rZYzt) - call RegPack(Buf, InData%SinDel3) - call RegPack(Buf, allocated(InData%SinPreC)) - if (allocated(InData%SinPreC)) then - call RegPackBounds(Buf, 1, lbound(InData%SinPreC, kind=B8Ki), ubound(InData%SinPreC, kind=B8Ki)) - call RegPack(Buf, InData%SinPreC) - end if - call RegPack(Buf, InData%SRFrlSkew) - call RegPack(Buf, InData%SRFrlSkw2) - call RegPack(Buf, InData%SRFrlTilt) - call RegPack(Buf, InData%SRFrlTlt2) - call RegPack(Buf, InData%SShftSkew) - call RegPack(Buf, InData%SShftTilt) - call RegPack(Buf, InData%STFrlSkew) - call RegPack(Buf, InData%STFrlSkw2) - call RegPack(Buf, InData%STFrlTilt) - call RegPack(Buf, InData%STFrlTlt2) - call RegPack(Buf, InData%TFrlPnt_n) - call RegPack(Buf, InData%TipRad) - call RegPack(Buf, InData%TowerHt) - call RegPack(Buf, InData%TowerBsHt) - call RegPack(Buf, InData%UndSling) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, allocated(InData%AxRedTFA)) - if (allocated(InData%AxRedTFA)) then - call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA, kind=B8Ki), ubound(InData%AxRedTFA, kind=B8Ki)) - call RegPack(Buf, InData%AxRedTFA) - end if - call RegPack(Buf, allocated(InData%AxRedTSS)) - if (allocated(InData%AxRedTSS)) then - call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS, kind=B8Ki), ubound(InData%AxRedTSS, kind=B8Ki)) - call RegPack(Buf, InData%AxRedTSS) - end if - call RegPack(Buf, InData%CTFA) - call RegPack(Buf, InData%CTSS) - call RegPack(Buf, allocated(InData%DHNodes)) - if (allocated(InData%DHNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%DHNodes, kind=B8Ki), ubound(InData%DHNodes, kind=B8Ki)) - call RegPack(Buf, InData%DHNodes) - end if - call RegPack(Buf, allocated(InData%HNodes)) - if (allocated(InData%HNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%HNodes, kind=B8Ki), ubound(InData%HNodes, kind=B8Ki)) - call RegPack(Buf, InData%HNodes) - end if - call RegPack(Buf, allocated(InData%HNodesNorm)) - if (allocated(InData%HNodesNorm)) then - call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm, kind=B8Ki), ubound(InData%HNodesNorm, kind=B8Ki)) - call RegPack(Buf, InData%HNodesNorm) - end if - call RegPack(Buf, InData%KTFA) - call RegPack(Buf, InData%KTSS) - call RegPack(Buf, allocated(InData%MassT)) - if (allocated(InData%MassT)) then - call RegPackBounds(Buf, 1, lbound(InData%MassT, kind=B8Ki), ubound(InData%MassT, kind=B8Ki)) - call RegPack(Buf, InData%MassT) - end if - call RegPack(Buf, allocated(InData%StiffTSS)) - if (allocated(InData%StiffTSS)) then - call RegPackBounds(Buf, 1, lbound(InData%StiffTSS, kind=B8Ki), ubound(InData%StiffTSS, kind=B8Ki)) - call RegPack(Buf, InData%StiffTSS) - end if - call RegPack(Buf, allocated(InData%TwrFASF)) - if (allocated(InData%TwrFASF)) then - call RegPackBounds(Buf, 3, lbound(InData%TwrFASF, kind=B8Ki), ubound(InData%TwrFASF, kind=B8Ki)) - call RegPack(Buf, InData%TwrFASF) - end if - call RegPack(Buf, InData%TwrFlexL) - call RegPack(Buf, allocated(InData%TwrSSSF)) - if (allocated(InData%TwrSSSF)) then - call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF, kind=B8Ki), ubound(InData%TwrSSSF, kind=B8Ki)) - call RegPack(Buf, InData%TwrSSSF) - end if - call RegPack(Buf, InData%TTopNode) - call RegPack(Buf, InData%TwrNodes) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, allocated(InData%StiffTFA)) - if (allocated(InData%StiffTFA)) then - call RegPackBounds(Buf, 1, lbound(InData%StiffTFA, kind=B8Ki), ubound(InData%StiffTFA, kind=B8Ki)) - call RegPack(Buf, InData%StiffTFA) - end if - call RegPack(Buf, InData%AtfaIner) - call RegPack(Buf, allocated(InData%BldCG)) - if (allocated(InData%BldCG)) then - call RegPackBounds(Buf, 1, lbound(InData%BldCG, kind=B8Ki), ubound(InData%BldCG, kind=B8Ki)) - call RegPack(Buf, InData%BldCG) - end if - call RegPack(Buf, allocated(InData%BldMass)) - if (allocated(InData%BldMass)) then - call RegPackBounds(Buf, 1, lbound(InData%BldMass, kind=B8Ki), ubound(InData%BldMass, kind=B8Ki)) - call RegPack(Buf, InData%BldMass) - end if - call RegPack(Buf, InData%BoomMass) - call RegPack(Buf, allocated(InData%FirstMom)) - if (allocated(InData%FirstMom)) then - call RegPackBounds(Buf, 1, lbound(InData%FirstMom, kind=B8Ki), ubound(InData%FirstMom, kind=B8Ki)) - call RegPack(Buf, InData%FirstMom) - end if - call RegPack(Buf, InData%GenIner) - call RegPack(Buf, InData%Hubg1Iner) - call RegPack(Buf, InData%Hubg2Iner) - call RegPack(Buf, InData%HubMass) - call RegPack(Buf, InData%Nacd2Iner) - call RegPack(Buf, InData%NacMass) - call RegPack(Buf, InData%PtfmMass) - call RegPack(Buf, InData%PtfmPIner) - call RegPack(Buf, InData%PtfmRIner) - call RegPack(Buf, InData%PtfmYIner) - call RegPack(Buf, InData%RFrlMass) - call RegPack(Buf, InData%RotIner) - call RegPack(Buf, InData%RotMass) - call RegPack(Buf, InData%RrfaIner) - call RegPack(Buf, allocated(InData%SecondMom)) - if (allocated(InData%SecondMom)) then - call RegPackBounds(Buf, 1, lbound(InData%SecondMom, kind=B8Ki), ubound(InData%SecondMom, kind=B8Ki)) - call RegPack(Buf, InData%SecondMom) - end if - call RegPack(Buf, InData%TFinMass) - call RegPack(Buf, InData%TFrlIner) - call RegPack(Buf, allocated(InData%TipMass)) - if (allocated(InData%TipMass)) then - call RegPackBounds(Buf, 1, lbound(InData%TipMass, kind=B8Ki), ubound(InData%TipMass, kind=B8Ki)) - call RegPack(Buf, InData%TipMass) - end if - call RegPack(Buf, InData%TurbMass) - call RegPack(Buf, InData%TwrMass) - call RegPack(Buf, InData%TwrTpMass) - call RegPack(Buf, InData%YawBrMass) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, allocated(InData%PitchAxis)) - if (allocated(InData%PitchAxis)) then - call RegPackBounds(Buf, 2, lbound(InData%PitchAxis, kind=B8Ki), ubound(InData%PitchAxis, kind=B8Ki)) - call RegPack(Buf, InData%PitchAxis) - end if - call RegPack(Buf, allocated(InData%AeroTwst)) - if (allocated(InData%AeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%AeroTwst, kind=B8Ki), ubound(InData%AeroTwst, kind=B8Ki)) - call RegPack(Buf, InData%AeroTwst) - end if - call RegPack(Buf, allocated(InData%AxRedBld)) - if (allocated(InData%AxRedBld)) then - call RegPackBounds(Buf, 4, lbound(InData%AxRedBld, kind=B8Ki), ubound(InData%AxRedBld, kind=B8Ki)) - call RegPack(Buf, InData%AxRedBld) - end if - call RegPack(Buf, allocated(InData%BldEDamp)) - if (allocated(InData%BldEDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%BldEDamp, kind=B8Ki), ubound(InData%BldEDamp, kind=B8Ki)) - call RegPack(Buf, InData%BldEDamp) - end if - call RegPack(Buf, allocated(InData%BldFDamp)) - if (allocated(InData%BldFDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%BldFDamp, kind=B8Ki), ubound(InData%BldFDamp, kind=B8Ki)) - call RegPack(Buf, InData%BldFDamp) - end if - call RegPack(Buf, InData%BldFlexL) - call RegPack(Buf, allocated(InData%CAeroTwst)) - if (allocated(InData%CAeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst, kind=B8Ki), ubound(InData%CAeroTwst, kind=B8Ki)) - call RegPack(Buf, InData%CAeroTwst) - end if - call RegPack(Buf, allocated(InData%CBE)) - if (allocated(InData%CBE)) then - call RegPackBounds(Buf, 3, lbound(InData%CBE, kind=B8Ki), ubound(InData%CBE, kind=B8Ki)) - call RegPack(Buf, InData%CBE) - end if - call RegPack(Buf, allocated(InData%CBF)) - if (allocated(InData%CBF)) then - call RegPackBounds(Buf, 3, lbound(InData%CBF, kind=B8Ki), ubound(InData%CBF, kind=B8Ki)) - call RegPack(Buf, InData%CBF) - end if - call RegPack(Buf, allocated(InData%Chord)) - if (allocated(InData%Chord)) then - call RegPackBounds(Buf, 1, lbound(InData%Chord, kind=B8Ki), ubound(InData%Chord, kind=B8Ki)) - call RegPack(Buf, InData%Chord) - end if - call RegPack(Buf, allocated(InData%CThetaS)) - if (allocated(InData%CThetaS)) then - call RegPackBounds(Buf, 2, lbound(InData%CThetaS, kind=B8Ki), ubound(InData%CThetaS, kind=B8Ki)) - call RegPack(Buf, InData%CThetaS) - end if - call RegPack(Buf, allocated(InData%DRNodes)) - if (allocated(InData%DRNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%DRNodes, kind=B8Ki), ubound(InData%DRNodes, kind=B8Ki)) - call RegPack(Buf, InData%DRNodes) - end if - call RegPack(Buf, allocated(InData%FStTunr)) - if (allocated(InData%FStTunr)) then - call RegPackBounds(Buf, 2, lbound(InData%FStTunr, kind=B8Ki), ubound(InData%FStTunr, kind=B8Ki)) - call RegPack(Buf, InData%FStTunr) - end if - call RegPack(Buf, allocated(InData%KBE)) - if (allocated(InData%KBE)) then - call RegPackBounds(Buf, 3, lbound(InData%KBE, kind=B8Ki), ubound(InData%KBE, kind=B8Ki)) - call RegPack(Buf, InData%KBE) - end if - call RegPack(Buf, allocated(InData%KBF)) - if (allocated(InData%KBF)) then - call RegPackBounds(Buf, 3, lbound(InData%KBF, kind=B8Ki), ubound(InData%KBF, kind=B8Ki)) - call RegPack(Buf, InData%KBF) - end if - call RegPack(Buf, allocated(InData%MassB)) - if (allocated(InData%MassB)) then - call RegPackBounds(Buf, 2, lbound(InData%MassB, kind=B8Ki), ubound(InData%MassB, kind=B8Ki)) - call RegPack(Buf, InData%MassB) - end if - call RegPack(Buf, allocated(InData%RNodes)) - if (allocated(InData%RNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%RNodes, kind=B8Ki), ubound(InData%RNodes, kind=B8Ki)) - call RegPack(Buf, InData%RNodes) - end if - call RegPack(Buf, allocated(InData%RNodesNorm)) - if (allocated(InData%RNodesNorm)) then - call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm, kind=B8Ki), ubound(InData%RNodesNorm, kind=B8Ki)) - call RegPack(Buf, InData%RNodesNorm) - end if - call RegPack(Buf, allocated(InData%rSAerCenn1)) - if (allocated(InData%rSAerCenn1)) then - call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1, kind=B8Ki), ubound(InData%rSAerCenn1, kind=B8Ki)) - call RegPack(Buf, InData%rSAerCenn1) - end if - call RegPack(Buf, allocated(InData%rSAerCenn2)) - if (allocated(InData%rSAerCenn2)) then - call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2, kind=B8Ki), ubound(InData%rSAerCenn2, kind=B8Ki)) - call RegPack(Buf, InData%rSAerCenn2) - end if - call RegPack(Buf, allocated(InData%SAeroTwst)) - if (allocated(InData%SAeroTwst)) then - call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst, kind=B8Ki), ubound(InData%SAeroTwst, kind=B8Ki)) - call RegPack(Buf, InData%SAeroTwst) - end if - call RegPack(Buf, allocated(InData%StiffBE)) - if (allocated(InData%StiffBE)) then - call RegPackBounds(Buf, 2, lbound(InData%StiffBE, kind=B8Ki), ubound(InData%StiffBE, kind=B8Ki)) - call RegPack(Buf, InData%StiffBE) - end if - call RegPack(Buf, allocated(InData%StiffBF)) - if (allocated(InData%StiffBF)) then - call RegPackBounds(Buf, 2, lbound(InData%StiffBF, kind=B8Ki), ubound(InData%StiffBF, kind=B8Ki)) - call RegPack(Buf, InData%StiffBF) - end if - call RegPack(Buf, allocated(InData%SThetaS)) - if (allocated(InData%SThetaS)) then - call RegPackBounds(Buf, 2, lbound(InData%SThetaS, kind=B8Ki), ubound(InData%SThetaS, kind=B8Ki)) - call RegPack(Buf, InData%SThetaS) - end if - call RegPack(Buf, allocated(InData%ThetaS)) - if (allocated(InData%ThetaS)) then - call RegPackBounds(Buf, 2, lbound(InData%ThetaS, kind=B8Ki), ubound(InData%ThetaS, kind=B8Ki)) - call RegPack(Buf, InData%ThetaS) - end if - call RegPack(Buf, allocated(InData%TwistedSF)) - if (allocated(InData%TwistedSF)) then - call RegPackBounds(Buf, 5, lbound(InData%TwistedSF, kind=B8Ki), ubound(InData%TwistedSF, kind=B8Ki)) - call RegPack(Buf, InData%TwistedSF) - end if - call RegPack(Buf, allocated(InData%BldFl1Sh)) - if (allocated(InData%BldFl1Sh)) then - call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh, kind=B8Ki), ubound(InData%BldFl1Sh, kind=B8Ki)) - call RegPack(Buf, InData%BldFl1Sh) - end if - call RegPack(Buf, allocated(InData%BldFl2Sh)) - if (allocated(InData%BldFl2Sh)) then - call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh, kind=B8Ki), ubound(InData%BldFl2Sh, kind=B8Ki)) - call RegPack(Buf, InData%BldFl2Sh) - end if - call RegPack(Buf, allocated(InData%BldEdgSh)) - if (allocated(InData%BldEdgSh)) then - call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh, kind=B8Ki), ubound(InData%BldEdgSh, kind=B8Ki)) - call RegPack(Buf, InData%BldEdgSh) - end if - call RegPack(Buf, allocated(InData%FreqBE)) - if (allocated(InData%FreqBE)) then - call RegPackBounds(Buf, 3, lbound(InData%FreqBE, kind=B8Ki), ubound(InData%FreqBE, kind=B8Ki)) - call RegPack(Buf, InData%FreqBE) - end if - call RegPack(Buf, allocated(InData%FreqBF)) - if (allocated(InData%FreqBF)) then - call RegPackBounds(Buf, 3, lbound(InData%FreqBF, kind=B8Ki), ubound(InData%FreqBF, kind=B8Ki)) - call RegPack(Buf, InData%FreqBF) - end if - call RegPack(Buf, InData%FreqTFA) - call RegPack(Buf, InData%FreqTSS) - call RegPack(Buf, InData%TeetCDmp) - call RegPack(Buf, InData%TeetDmp) - call RegPack(Buf, InData%TeetDmpP) - call RegPack(Buf, InData%TeetHSSp) - call RegPack(Buf, InData%TeetHStP) - call RegPack(Buf, InData%TeetSSSp) - call RegPack(Buf, InData%TeetSStP) - call RegPack(Buf, InData%TeetMod) - call RegPack(Buf, InData%TFrlDmp) - call RegPack(Buf, InData%TFrlDSDmp) - call RegPack(Buf, InData%TFrlDSDP) - call RegPack(Buf, InData%TFrlDSSP) - call RegPack(Buf, InData%TFrlDSSpr) - call RegPack(Buf, InData%TFrlSpr) - call RegPack(Buf, InData%TFrlUSDmp) - call RegPack(Buf, InData%TFrlUSDP) - call RegPack(Buf, InData%TFrlUSSP) - call RegPack(Buf, InData%TFrlUSSpr) - call RegPack(Buf, InData%TFrlMod) - call RegPack(Buf, InData%RFrlDmp) - call RegPack(Buf, InData%RFrlDSDmp) - call RegPack(Buf, InData%RFrlDSDP) - call RegPack(Buf, InData%RFrlDSSP) - call RegPack(Buf, InData%RFrlDSSpr) - call RegPack(Buf, InData%RFrlSpr) - call RegPack(Buf, InData%RFrlUSDmp) - call RegPack(Buf, InData%RFrlUSDP) - call RegPack(Buf, InData%RFrlUSSP) - call RegPack(Buf, InData%RFrlUSSpr) - call RegPack(Buf, InData%RFrlMod) - call RegPack(Buf, InData%ShftGagL) - call RegPack(Buf, InData%BldGagNd) - call RegPack(Buf, InData%TwrGagNd) - call RegPack(Buf, InData%TStart) - call RegPack(Buf, InData%DTTorDmp) - call RegPack(Buf, InData%DTTorSpr) - call RegPack(Buf, InData%GBRatio) - call RegPack(Buf, InData%GBoxEff) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%BElmntMass)) - if (allocated(InData%BElmntMass)) then - call RegPackBounds(Buf, 2, lbound(InData%BElmntMass, kind=B8Ki), ubound(InData%BElmntMass, kind=B8Ki)) - call RegPack(Buf, InData%BElmntMass) - end if - call RegPack(Buf, allocated(InData%TElmntMass)) - if (allocated(InData%TElmntMass)) then - call RegPackBounds(Buf, 1, lbound(InData%TElmntMass, kind=B8Ki), ubound(InData%TElmntMass, kind=B8Ki)) - call RegPack(Buf, InData%TElmntMass) - end if - call RegPack(Buf, InData%method) - call RegPack(Buf, InData%PtfmCMxt) - call RegPack(Buf, InData%PtfmCMyt) - call RegPack(Buf, InData%BD4Blades) - call RegPack(Buf, InData%UseAD14) - call RegPack(Buf, InData%BldNd_NumOuts) - call RegPack(Buf, InData%BldNd_TotNumOuts) - call RegPack(Buf, allocated(InData%BldNd_OutParam)) - if (allocated(InData%BldNd_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) - end do - end if - call RegPack(Buf, InData%BldNd_BladesOut) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, allocated(InData%dx)) - if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) - call RegPack(Buf, InData%dx) - end if - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%CompAeroMaps) - call RegPack(Buf, InData%NumExtendedInputs) - call RegPack(Buf, InData%NumBl_Lin) - call RegPack(Buf, InData%NActvVelDOF_Lin) - call RegPack(Buf, InData%NActvDOF_Lin) - call RegPack(Buf, InData%NActvDOF_Stride) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine ED_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(ED_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT24) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TipNode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwoPiNB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NAug) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPH) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PH)) deallocate(OutData%PH) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PH(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PH) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NPM) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PM)) deallocate(OutData%PM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DOF_Flag)) deallocate(OutData%DOF_Flag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DOF_Flag(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DOF_Flag) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DOF_Desc)) deallocate(OutData%DOF_Desc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DOF_Desc(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DOF_Desc) - if (RegCheckErr(Buf, RoutineName)) return - end if - call ED_UnpackActiveDOFs(Buf, OutData%DOFs) ! DOFs - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBlGages) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTwGages) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam - end do - end if - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgNrmTpRd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AzimB1Up) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CosDel3) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%CosPreC)) deallocate(OutData%CosPreC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CosPreC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CosPreC) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%CRFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CRFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CRFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CRFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CShftSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CShftTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CSRFrlSkw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CSRFrlTlt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CSTFrlSkw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CSTFrlTlt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubCM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCMxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCMyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacCMzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OverHang) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ProjArea) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefTwrHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVDxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVDyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVDzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVIMUxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVIMUyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVIMUzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVPxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVPyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rVPzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWIxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWIyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWIzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWJxn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWJyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rWJzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rZT0zt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rZYzt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SinDel3) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%SinPreC)) deallocate(OutData%SinPreC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SinPreC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SinPreC) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SRFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SRFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SRFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SRFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SShftSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SShftTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TipRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerBsHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UndSling) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AxRedTFA)) deallocate(OutData%AxRedTFA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxRedTFA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AxRedTSS)) deallocate(OutData%AxRedTSS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxRedTSS) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%CTFA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTSS) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%DHNodes)) deallocate(OutData%DHNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DHNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DHNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HNodes)) deallocate(OutData%HNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HNodesNorm)) deallocate(OutData%HNodesNorm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HNodesNorm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HNodesNorm) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%KTFA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KTSS) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%MassT)) deallocate(OutData%MassT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MassT(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MassT) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StiffTSS)) deallocate(OutData%StiffTSS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StiffTSS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StiffTSS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TwrFASF)) deallocate(OutData%TwrFASF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrFASF) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TwrFlexL) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TwrSSSF)) deallocate(OutData%TwrSSSF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrSSSF) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TTopNode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%StiffTFA)) deallocate(OutData%StiffTFA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StiffTFA(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StiffTFA) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AtfaIner) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldCG)) deallocate(OutData%BldCG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldCG(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldCG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BldMass)) deallocate(OutData%BldMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldMass(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldMass) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BoomMass) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FirstMom)) deallocate(OutData%FirstMom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FirstMom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FirstMom) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%GenIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Hubg1Iner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Hubg2Iner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Nacd2Iner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmPIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmYIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotIner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RrfaIner) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%SecondMom)) deallocate(OutData%SecondMom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SecondMom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SecondMom) - if (RegCheckErr(Buf, RoutineName)) return + deallocate(ParamData%CBE) end if - call RegUnpack(Buf, OutData%TFinMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlIner) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TipMass(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TipMass) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TurbMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrTpMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PitchAxis)) deallocate(OutData%PitchAxis) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PitchAxis(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PitchAxis) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%CBF)) then + deallocate(ParamData%CBF) end if - if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AeroTwst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AeroTwst) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%Chord)) then + deallocate(ParamData%Chord) end if - if (allocated(OutData%AxRedBld)) deallocate(OutData%AxRedBld) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxRedBld) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%CThetaS)) then + deallocate(ParamData%CThetaS) end if - if (allocated(OutData%BldEDamp)) deallocate(OutData%BldEDamp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldEDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldEDamp) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%DRNodes)) then + deallocate(ParamData%DRNodes) end if - if (allocated(OutData%BldFDamp)) deallocate(OutData%BldFDamp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldFDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldFDamp) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%FStTunr)) then + deallocate(ParamData%FStTunr) end if - call RegUnpack(Buf, OutData%BldFlexL) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%CAeroTwst)) deallocate(OutData%CAeroTwst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CAeroTwst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CAeroTwst) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%KBE)) then + deallocate(ParamData%KBE) end if - if (allocated(OutData%CBE)) deallocate(OutData%CBE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CBE) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%KBF)) then + deallocate(ParamData%KBF) end if - if (allocated(OutData%CBF)) deallocate(OutData%CBF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CBF) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%MassB)) then + deallocate(ParamData%MassB) end if - if (allocated(OutData%Chord)) deallocate(OutData%Chord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Chord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Chord) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%RNodes)) then + deallocate(ParamData%RNodes) end if - if (allocated(OutData%CThetaS)) deallocate(OutData%CThetaS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CThetaS) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%RNodesNorm)) then + deallocate(ParamData%RNodesNorm) end if - if (allocated(OutData%DRNodes)) deallocate(OutData%DRNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DRNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DRNodes) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%rSAerCenn1)) then + deallocate(ParamData%rSAerCenn1) end if - if (allocated(OutData%FStTunr)) deallocate(OutData%FStTunr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FStTunr(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FStTunr) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%rSAerCenn2)) then + deallocate(ParamData%rSAerCenn2) end if - if (allocated(OutData%KBE)) deallocate(OutData%KBE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%KBE) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%SAeroTwst)) then + deallocate(ParamData%SAeroTwst) end if - if (allocated(OutData%KBF)) deallocate(OutData%KBF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%KBF) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%StiffBE)) then + deallocate(ParamData%StiffBE) end if - if (allocated(OutData%MassB)) deallocate(OutData%MassB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MassB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MassB) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%StiffBF)) then + deallocate(ParamData%StiffBF) end if - if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RNodes) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%SThetaS)) then + deallocate(ParamData%SThetaS) end if - if (allocated(OutData%RNodesNorm)) deallocate(OutData%RNodesNorm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RNodesNorm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RNodesNorm) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%ThetaS)) then + deallocate(ParamData%ThetaS) end if - if (allocated(OutData%rSAerCenn1)) deallocate(OutData%rSAerCenn1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rSAerCenn1) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%TwistedSF)) then + deallocate(ParamData%TwistedSF) end if - if (allocated(OutData%rSAerCenn2)) deallocate(OutData%rSAerCenn2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rSAerCenn2) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%BldFl1Sh)) then + deallocate(ParamData%BldFl1Sh) end if - if (allocated(OutData%SAeroTwst)) deallocate(OutData%SAeroTwst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SAeroTwst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SAeroTwst) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%BldFl2Sh)) then + deallocate(ParamData%BldFl2Sh) end if - if (allocated(OutData%StiffBE)) deallocate(OutData%StiffBE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StiffBE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StiffBE) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%BldEdgSh)) then + deallocate(ParamData%BldEdgSh) end if - if (allocated(OutData%StiffBF)) deallocate(OutData%StiffBF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StiffBF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StiffBF) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%FreqBE)) then + deallocate(ParamData%FreqBE) end if - if (allocated(OutData%SThetaS)) deallocate(OutData%SThetaS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SThetaS) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%FreqBF)) then + deallocate(ParamData%FreqBF) end if - if (allocated(OutData%ThetaS)) deallocate(OutData%ThetaS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ThetaS) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%BElmntMass)) then + deallocate(ParamData%BElmntMass) end if - if (allocated(OutData%TwistedSF)) deallocate(OutData%TwistedSF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwistedSF) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%TElmntMass)) then + deallocate(ParamData%TElmntMass) end if - if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldFl1Sh) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) end if - if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldFl2Sh) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) end if - if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BldEdgSh) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%du)) then + deallocate(ParamData%du) end if - if (allocated(OutData%FreqBE)) deallocate(OutData%FreqBE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FreqBE) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) end if - if (allocated(OutData%FreqBF)) deallocate(OutData%FreqBF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FreqBF) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FreqTFA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FreqTSS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetCDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetDmpP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetHSSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetHStP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetSSSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetSStP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TeetMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TFrlMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RFrlMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShftGagL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldGagNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrGagNd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTTorDmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DTTorSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GBRatio) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GBoxEff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BElmntMass)) deallocate(OutData%BElmntMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BElmntMass(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BElmntMass) - if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ED_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackParam' + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%DT24) + call RegPack(RF, InData%BldNodes) + call RegPack(RF, InData%TipNode) + call RegPack(RF, InData%NDOF) + call RegPack(RF, InData%TwoPiNB) + call RegPack(RF, InData%NAug) + call RegPack(RF, InData%NPH) + call RegPackAlloc(RF, InData%PH) + call RegPack(RF, InData%NPM) + call RegPackAlloc(RF, InData%PM) + call RegPackAlloc(RF, InData%DOF_Flag) + call RegPackAlloc(RF, InData%DOF_Desc) + call ED_PackActiveDOFs(RF, InData%DOFs) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%NBlGages) + call RegPack(RF, InData%NTwGages) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do end if - if (allocated(OutData%TElmntMass)) deallocate(OutData%TElmntMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TElmntMass(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TElmntMass) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%method) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmCMxt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmCMyt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BD4Blades) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseAD14) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BldNd_TotNumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%AvgNrmTpRd) + call RegPack(RF, InData%AzimB1Up) + call RegPack(RF, InData%CosDel3) + call RegPackAlloc(RF, InData%CosPreC) + call RegPack(RF, InData%CRFrlSkew) + call RegPack(RF, InData%CRFrlSkw2) + call RegPack(RF, InData%CRFrlTilt) + call RegPack(RF, InData%CRFrlTlt2) + call RegPack(RF, InData%CShftSkew) + call RegPack(RF, InData%CShftTilt) + call RegPack(RF, InData%CSRFrlSkw) + call RegPack(RF, InData%CSRFrlTlt) + call RegPack(RF, InData%CSTFrlSkw) + call RegPack(RF, InData%CSTFrlTlt) + call RegPack(RF, InData%CTFrlSkew) + call RegPack(RF, InData%CTFrlSkw2) + call RegPack(RF, InData%CTFrlTilt) + call RegPack(RF, InData%CTFrlTlt2) + call RegPack(RF, InData%HubHt) + call RegPack(RF, InData%HubCM) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%NacCMxn) + call RegPack(RF, InData%NacCMyn) + call RegPack(RF, InData%NacCMzn) + call RegPack(RF, InData%OverHang) + call RegPack(RF, InData%ProjArea) + call RegPack(RF, InData%PtfmRefzt) + call RegPack(RF, InData%RefTwrHt) + call RegPack(RF, InData%RFrlPnt_n) + call RegPack(RF, InData%rVDxn) + call RegPack(RF, InData%rVDyn) + call RegPack(RF, InData%rVDzn) + call RegPack(RF, InData%rVIMUxn) + call RegPack(RF, InData%rVIMUyn) + call RegPack(RF, InData%rVIMUzn) + call RegPack(RF, InData%rVPxn) + call RegPack(RF, InData%rVPyn) + call RegPack(RF, InData%rVPzn) + call RegPack(RF, InData%rWIxn) + call RegPack(RF, InData%rWIyn) + call RegPack(RF, InData%rWIzn) + call RegPack(RF, InData%rWJxn) + call RegPack(RF, InData%rWJyn) + call RegPack(RF, InData%rWJzn) + call RegPack(RF, InData%rZT0zt) + call RegPack(RF, InData%rZYzt) + call RegPack(RF, InData%SinDel3) + call RegPackAlloc(RF, InData%SinPreC) + call RegPack(RF, InData%SRFrlSkew) + call RegPack(RF, InData%SRFrlSkw2) + call RegPack(RF, InData%SRFrlTilt) + call RegPack(RF, InData%SRFrlTlt2) + call RegPack(RF, InData%SShftSkew) + call RegPack(RF, InData%SShftTilt) + call RegPack(RF, InData%STFrlSkew) + call RegPack(RF, InData%STFrlSkw2) + call RegPack(RF, InData%STFrlTilt) + call RegPack(RF, InData%STFrlTlt2) + call RegPack(RF, InData%TFrlPnt_n) + call RegPack(RF, InData%TipRad) + call RegPack(RF, InData%TowerHt) + call RegPack(RF, InData%TowerBsHt) + call RegPack(RF, InData%UndSling) + call RegPack(RF, InData%NumBl) + call RegPackAlloc(RF, InData%AxRedTFA) + call RegPackAlloc(RF, InData%AxRedTSS) + call RegPack(RF, InData%CTFA) + call RegPack(RF, InData%CTSS) + call RegPackAlloc(RF, InData%DHNodes) + call RegPackAlloc(RF, InData%HNodes) + call RegPackAlloc(RF, InData%HNodesNorm) + call RegPack(RF, InData%KTFA) + call RegPack(RF, InData%KTSS) + call RegPackAlloc(RF, InData%MassT) + call RegPackAlloc(RF, InData%StiffTSS) + call RegPackAlloc(RF, InData%TwrFASF) + call RegPack(RF, InData%TwrFlexL) + call RegPackAlloc(RF, InData%TwrSSSF) + call RegPack(RF, InData%TTopNode) + call RegPack(RF, InData%TwrNodes) + call RegPack(RF, InData%MHK) + call RegPackAlloc(RF, InData%StiffTFA) + call RegPack(RF, InData%AtfaIner) + call RegPackAlloc(RF, InData%BldCG) + call RegPackAlloc(RF, InData%BldMass) + call RegPack(RF, InData%BoomMass) + call RegPackAlloc(RF, InData%FirstMom) + call RegPack(RF, InData%GenIner) + call RegPack(RF, InData%Hubg1Iner) + call RegPack(RF, InData%Hubg2Iner) + call RegPack(RF, InData%HubMass) + call RegPack(RF, InData%Nacd2Iner) + call RegPack(RF, InData%NacMass) + call RegPack(RF, InData%PtfmMass) + call RegPack(RF, InData%PtfmPIner) + call RegPack(RF, InData%PtfmRIner) + call RegPack(RF, InData%PtfmYIner) + call RegPack(RF, InData%RFrlMass) + call RegPack(RF, InData%RotIner) + call RegPack(RF, InData%RotMass) + call RegPack(RF, InData%RrfaIner) + call RegPackAlloc(RF, InData%SecondMom) + call RegPack(RF, InData%TFinMass) + call RegPack(RF, InData%TFrlIner) + call RegPackAlloc(RF, InData%TipMass) + call RegPack(RF, InData%TurbMass) + call RegPack(RF, InData%TwrMass) + call RegPack(RF, InData%TwrTpMass) + call RegPack(RF, InData%YawBrMass) + call RegPack(RF, InData%Gravity) + call RegPackAlloc(RF, InData%PitchAxis) + call RegPackAlloc(RF, InData%AeroTwst) + call RegPackAlloc(RF, InData%AxRedBld) + call RegPackAlloc(RF, InData%BldEDamp) + call RegPackAlloc(RF, InData%BldFDamp) + call RegPack(RF, InData%BldFlexL) + call RegPackAlloc(RF, InData%CAeroTwst) + call RegPackAlloc(RF, InData%CBE) + call RegPackAlloc(RF, InData%CBF) + call RegPackAlloc(RF, InData%Chord) + call RegPackAlloc(RF, InData%CThetaS) + call RegPackAlloc(RF, InData%DRNodes) + call RegPackAlloc(RF, InData%FStTunr) + call RegPackAlloc(RF, InData%KBE) + call RegPackAlloc(RF, InData%KBF) + call RegPackAlloc(RF, InData%MassB) + call RegPackAlloc(RF, InData%RNodes) + call RegPackAlloc(RF, InData%RNodesNorm) + call RegPackAlloc(RF, InData%rSAerCenn1) + call RegPackAlloc(RF, InData%rSAerCenn2) + call RegPackAlloc(RF, InData%SAeroTwst) + call RegPackAlloc(RF, InData%StiffBE) + call RegPackAlloc(RF, InData%StiffBF) + call RegPackAlloc(RF, InData%SThetaS) + call RegPackAlloc(RF, InData%ThetaS) + call RegPackAlloc(RF, InData%TwistedSF) + call RegPackAlloc(RF, InData%BldFl1Sh) + call RegPackAlloc(RF, InData%BldFl2Sh) + call RegPackAlloc(RF, InData%BldEdgSh) + call RegPackAlloc(RF, InData%FreqBE) + call RegPackAlloc(RF, InData%FreqBF) + call RegPack(RF, InData%FreqTFA) + call RegPack(RF, InData%FreqTSS) + call RegPack(RF, InData%TeetCDmp) + call RegPack(RF, InData%TeetDmp) + call RegPack(RF, InData%TeetDmpP) + call RegPack(RF, InData%TeetHSSp) + call RegPack(RF, InData%TeetHStP) + call RegPack(RF, InData%TeetSSSp) + call RegPack(RF, InData%TeetSStP) + call RegPack(RF, InData%TeetMod) + call RegPack(RF, InData%TFrlDmp) + call RegPack(RF, InData%TFrlDSDmp) + call RegPack(RF, InData%TFrlDSDP) + call RegPack(RF, InData%TFrlDSSP) + call RegPack(RF, InData%TFrlDSSpr) + call RegPack(RF, InData%TFrlSpr) + call RegPack(RF, InData%TFrlUSDmp) + call RegPack(RF, InData%TFrlUSDP) + call RegPack(RF, InData%TFrlUSSP) + call RegPack(RF, InData%TFrlUSSpr) + call RegPack(RF, InData%TFrlMod) + call RegPack(RF, InData%RFrlDmp) + call RegPack(RF, InData%RFrlDSDmp) + call RegPack(RF, InData%RFrlDSDP) + call RegPack(RF, InData%RFrlDSSP) + call RegPack(RF, InData%RFrlDSSpr) + call RegPack(RF, InData%RFrlSpr) + call RegPack(RF, InData%RFrlUSDmp) + call RegPack(RF, InData%RFrlUSDP) + call RegPack(RF, InData%RFrlUSSP) + call RegPack(RF, InData%RFrlUSSpr) + call RegPack(RF, InData%RFrlMod) + call RegPack(RF, InData%ShftGagL) + call RegPack(RF, InData%BldGagNd) + call RegPack(RF, InData%TwrGagNd) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%DTTorDmp) + call RegPack(RF, InData%DTTorSpr) + call RegPack(RF, InData%GBRatio) + call RegPack(RF, InData%GBoxEff) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%RootName) + call RegPackAlloc(RF, InData%BElmntMass) + call RegPackAlloc(RF, InData%TElmntMass) + call RegPack(RF, InData%method) + call RegPack(RF, InData%PtfmCMxt) + call RegPack(RF, InData%PtfmCMyt) + call RegPack(RF, InData%BD4Blades) + call RegPack(RF, InData%UseAD14) + call RegPack(RF, InData%BldNd_NumOuts) + call RegPack(RF, InData%BldNd_TotNumOuts) + call RegPack(RF, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%BldNd_OutParam, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) + LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) + UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) end do end if - call RegUnpack(Buf, OutData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%BldNd_BladesOut) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%NumExtendedInputs) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%NActvVelDOF_Lin) + call RegPack(RF, InData%NActvDOF_Lin) + call RegPack(RF, InData%NActvDOF_Stride) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ED_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackParam' + integer(B8Ki) :: i1, i2, i3, i4, i5 + integer(B8Ki) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT24); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwoPiNB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NAug); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOF_Flag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOF_Desc); if (RegCheckErr(RF, RoutineName)) return + call ED_UnpackActiveDOFs(RF, OutData%DOFs) ! DOFs + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBlGages); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTwGages); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgNrmTpRd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimB1Up); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CosDel3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CosPreC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CRFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CShftSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSRFrlSkw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSRFrlTlt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSTFrlSkw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CSTFrlTlt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubCM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacCMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverHang); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ProjArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefTwrHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVDxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVDzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMUxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMUyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVIMUzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVPxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVPyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rVPzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWIxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWIyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWIzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJxn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rWJzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZT0zt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rZYzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SinDel3); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SinPreC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SRFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SShftSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SShftTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlSkew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlSkw2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlTilt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STFrlTlt2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlPnt_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TipRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerBsHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UndSling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxRedTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxRedTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DHNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HNodesNorm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrFASF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrFlexL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwrSSSF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TTopNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AtfaIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldCG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoomMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FirstMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hubg1Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hubg2Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nacd2Iner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmPIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmYIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RrfaIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SecondMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlIner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TipMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrTpMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitchAxis); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxRedBld); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldEDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldFlexL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CAeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Chord); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CThetaS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DRNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FStTunr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MassB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RNodesNorm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rSAerCenn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rSAerCenn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SAeroTwst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StiffBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SThetaS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ThetaS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TwistedSF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl1Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldFl2Sh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BldEdgSh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreqBE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreqBF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreqTFA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FreqTSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetCDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetDmpP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetHStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSSSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetSStP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TeetMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlDSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSDP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlUSSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RFrlMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShftGagL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrGagNd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorDmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTTorSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GBoxEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BElmntMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TElmntMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%method); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmCMyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BD4Blades); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseAD14); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_TotNumOuts); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumExtendedInputs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl_Lin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NActvVelDOF_Lin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NActvDOF_Lin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NActvDOF_Stride) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NActvVelDOF_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NActvDOF_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NActvDOF_Stride); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -10597,109 +6629,69 @@ subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInput' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%BladePtLoads)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladePtLoads)) if (allocated(InData%BladePtLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%BladePtLoads, kind=B8Ki), ubound(InData%BladePtLoads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladePtLoads, kind=B8Ki), ubound(InData%BladePtLoads, kind=B8Ki)) LB(1:1) = lbound(InData%BladePtLoads, kind=B8Ki) UB(1:1) = ubound(InData%BladePtLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladePtLoads(i1)) + call MeshPack(RF, InData%BladePtLoads(i1)) end do end if - call MeshPack(Buf, InData%PlatformPtMesh) - call MeshPack(Buf, InData%TowerPtLoads) - call MeshPack(Buf, InData%HubPtLoad) - call MeshPack(Buf, InData%NacelleLoads) - call MeshPack(Buf, InData%TFinCMLoads) - call RegPack(Buf, allocated(InData%TwrAddedMass)) - if (allocated(InData%TwrAddedMass)) then - call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass, kind=B8Ki), ubound(InData%TwrAddedMass, kind=B8Ki)) - call RegPack(Buf, InData%TwrAddedMass) - end if - call RegPack(Buf, InData%PtfmAddedMass) - call RegPack(Buf, allocated(InData%BlPitchCom)) - if (allocated(InData%BlPitchCom)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom, kind=B8Ki), ubound(InData%BlPitchCom, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchCom) - end if - call RegPack(Buf, InData%YawMom) - call RegPack(Buf, InData%GenTrq) - call RegPack(Buf, InData%HSSBrTrqC) - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TowerPtLoads) + call MeshPack(RF, InData%HubPtLoad) + call MeshPack(RF, InData%NacelleLoads) + call MeshPack(RF, InData%TFinCMLoads) + call RegPackAlloc(RF, InData%TwrAddedMass) + call RegPack(RF, InData%PtfmAddedMass) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInput' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladePtLoads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladePtLoads(i1)) ! BladePtLoads + call MeshUnpack(RF, OutData%BladePtLoads(i1)) ! BladePtLoads end do end if - call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh - call MeshUnpack(Buf, OutData%TowerPtLoads) ! TowerPtLoads - call MeshUnpack(Buf, OutData%HubPtLoad) ! HubPtLoad - call MeshUnpack(Buf, OutData%NacelleLoads) ! NacelleLoads - call MeshUnpack(Buf, OutData%TFinCMLoads) ! TFinCMLoads - if (allocated(OutData%TwrAddedMass)) deallocate(OutData%TwrAddedMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TwrAddedMass) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PtfmAddedMass) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchCom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%YawMom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrTrqC) - if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TowerPtLoads) ! TowerPtLoads + call MeshUnpack(RF, OutData%HubPtLoad) ! HubPtLoad + call MeshUnpack(RF, OutData%NacelleLoads) ! NacelleLoads + call MeshUnpack(RF, OutData%TFinCMLoads) ! TFinCMLoads + call RegUnpackAlloc(RF, OutData%TwrAddedMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmAddedMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -10881,207 +6873,143 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ED_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ED_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%BladeLn2Mesh)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeLn2Mesh(i1)) + call MeshPack(RF, InData%BladeLn2Mesh(i1)) end do end if - call MeshPack(Buf, InData%PlatformPtMesh) - call MeshPack(Buf, InData%TowerLn2Mesh) - call MeshPack(Buf, InData%HubPtMotion14) - call MeshPack(Buf, InData%HubPtMotion) - call MeshPack(Buf, InData%BladeRootMotion14) - call RegPack(Buf, allocated(InData%BladeRootMotion)) + call MeshPack(RF, InData%PlatformPtMesh) + call MeshPack(RF, InData%TowerLn2Mesh) + call MeshPack(RF, InData%HubPtMotion14) + call MeshPack(RF, InData%HubPtMotion) + call MeshPack(RF, InData%BladeRootMotion14) + call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BladeRootMotion(i1)) + call MeshPack(RF, InData%BladeRootMotion(i1)) end do end if - call MeshPack(Buf, InData%RotorFurlMotion14) - call MeshPack(Buf, InData%NacelleMotion) - call MeshPack(Buf, InData%TowerBaseMotion14) - call MeshPack(Buf, InData%TFinCMMotion) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, allocated(InData%BlPitch)) - if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) - call RegPack(Buf, InData%BlPitch) - end if - call RegPack(Buf, InData%Yaw) - call RegPack(Buf, InData%YawRate) - call RegPack(Buf, InData%LSS_Spd) - call RegPack(Buf, InData%HSS_Spd) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%TwrAccel) - call RegPack(Buf, InData%YawAngle) - call RegPack(Buf, InData%RootMyc) - call RegPack(Buf, InData%YawBrTAxp) - call RegPack(Buf, InData%YawBrTAyp) - call RegPack(Buf, InData%LSSTipPxa) - call RegPack(Buf, InData%RootMxc) - call RegPack(Buf, InData%LSSTipMxa) - call RegPack(Buf, InData%LSSTipMya) - call RegPack(Buf, InData%LSSTipMza) - call RegPack(Buf, InData%LSSTipMys) - call RegPack(Buf, InData%LSSTipMzs) - call RegPack(Buf, InData%YawBrMyn) - call RegPack(Buf, InData%YawBrMzn) - call RegPack(Buf, InData%NcIMURAxs) - call RegPack(Buf, InData%NcIMURAys) - call RegPack(Buf, InData%NcIMURAzs) - call RegPack(Buf, InData%RotPwr) - call RegPack(Buf, InData%LSShftFxa) - call RegPack(Buf, InData%LSShftFys) - call RegPack(Buf, InData%LSShftFzs) - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%RotorFurlMotion14) + call MeshPack(RF, InData%NacelleMotion) + call MeshPack(RF, InData%TowerBaseMotion14) + call MeshPack(RF, InData%TFinCMMotion) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ED_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ED_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + call MeshUnpack(RF, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh end do end if - call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh - call MeshUnpack(Buf, OutData%TowerLn2Mesh) ! TowerLn2Mesh - call MeshUnpack(Buf, OutData%HubPtMotion14) ! HubPtMotion14 - call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion - call MeshUnpack(Buf, OutData%BladeRootMotion14) ! BladeRootMotion14 + call MeshUnpack(RF, OutData%PlatformPtMesh) ! PlatformPtMesh + call MeshUnpack(RF, OutData%TowerLn2Mesh) ! TowerLn2Mesh + call MeshUnpack(RF, OutData%HubPtMotion14) ! HubPtMotion14 + call MeshUnpack(RF, OutData%HubPtMotion) ! HubPtMotion + call MeshUnpack(RF, OutData%BladeRootMotion14) ! BladeRootMotion14 if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + call MeshUnpack(RF, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if - call MeshUnpack(Buf, OutData%RotorFurlMotion14) ! RotorFurlMotion14 - call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion - call MeshUnpack(Buf, OutData%TowerBaseMotion14) ! TowerBaseMotion14 - call MeshUnpack(Buf, OutData%TFinCMMotion) ! TFinCMMotion - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitch) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Yaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawRate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrAccel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawAngle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMyc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrTAxp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrTAyp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipPxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMxc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMya) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMza) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMzs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAxs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAzs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotPwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFzs) - if (RegCheckErr(Buf, RoutineName)) return + call MeshUnpack(RF, OutData%RotorFurlMotion14) ! RotorFurlMotion14 + call MeshUnpack(RF, OutData%NacelleMotion) ! NacelleMotion + call MeshUnpack(RF, OutData%TowerBaseMotion14) ! TowerBaseMotion14 + call MeshUnpack(RF, OutData%TFinCMMotion) ! TFinCMMotion + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/externalinflow/src/ExternalInflow_Types.f90 b/modules/externalinflow/src/ExternalInflow_Types.f90 index 64783b1eb5..b2abf20b7e 100644 --- a/modules/externalinflow/src/ExternalInflow_Types.f90 +++ b/modules/externalinflow/src/ExternalInflow_Types.f90 @@ -282,43 +282,29 @@ subroutine ExtInfw_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtInfw_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtInfw_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackInitInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%NumActForcePtsBlade) - call RegPack(Buf, InData%NumActForcePtsTower) - call RegPack(Buf, associated(InData%StructBldRNodes)) - if (associated(InData%StructBldRNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes, kind=B8Ki), ubound(InData%StructBldRNodes, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%StructBldRNodes), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%StructBldRNodes) - end if - end if - call RegPack(Buf, associated(InData%StructTwrHNodes)) - if (associated(InData%StructTwrHNodes)) then - call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes, kind=B8Ki), ubound(InData%StructTwrHNodes, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%StructTwrHNodes), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%StructTwrHNodes) - end if - end if - call RegPack(Buf, InData%BladeLength) - call RegPack(Buf, InData%TowerHeight) - call RegPack(Buf, InData%TowerBaseHeight) - call RegPack(Buf, InData%NodeClusterType) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%NumActForcePtsBlade) + call RegPack(RF, InData%NumActForcePtsTower) + call RegPackPtr(RF, InData%StructBldRNodes) + call RegPackPtr(RF, InData%StructTwrHNodes) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerHeight) + call RegPack(RF, InData%TowerBaseHeight) + call RegPack(RF, InData%NodeClusterType) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtInfw_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtInfw_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) @@ -326,76 +312,20 @@ subroutine ExtInfw_UnPackInitInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumActForcePtsBlade) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumActForcePtsBlade); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - call RegUnpack(Buf, OutData%NumActForcePtsTower) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumActForcePtsTower); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower - if (associated(OutData%StructBldRNodes)) deallocate(OutData%StructBldRNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%StructBldRNodes, UB(1:1)-LB(1:1)) - OutData%StructBldRNodes(LB(1):) => OutData%StructBldRNodes - else - allocate(OutData%StructBldRNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructBldRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%StructBldRNodes) - OutData%C_obj%StructBldRNodes_Len = size(OutData%StructBldRNodes) - if (OutData%C_obj%StructBldRNodes_Len > 0) OutData%C_obj%StructBldRNodes = c_loc(OutData%StructBldRNodes(LB(1))) - call RegUnpack(Buf, OutData%StructBldRNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%StructBldRNodes => null() - end if - if (associated(OutData%StructTwrHNodes)) deallocate(OutData%StructTwrHNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%StructTwrHNodes, UB(1:1)-LB(1:1)) - OutData%StructTwrHNodes(LB(1):) => OutData%StructTwrHNodes - else - allocate(OutData%StructTwrHNodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructTwrHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%StructTwrHNodes) - OutData%C_obj%StructTwrHNodes_Len = size(OutData%StructTwrHNodes) - if (OutData%C_obj%StructTwrHNodes_Len > 0) OutData%C_obj%StructTwrHNodes = c_loc(OutData%StructTwrHNodes(LB(1))) - call RegUnpack(Buf, OutData%StructTwrHNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%StructTwrHNodes => null() - end if - call RegUnpack(Buf, OutData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPtr(RF, OutData%StructBldRNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%StructTwrHNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%BladeLength = OutData%BladeLength - call RegUnpack(Buf, OutData%TowerHeight) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%TowerHeight); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%TowerHeight = OutData%TowerHeight - call RegUnpack(Buf, OutData%TowerBaseHeight) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%TowerBaseHeight); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - call RegUnpack(Buf, OutData%NodeClusterType) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NodeClusterType); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NodeClusterType = OutData%NodeClusterType end subroutine @@ -549,39 +479,31 @@ subroutine ExtInfw_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%FlowField) end subroutine -subroutine ExtInfw_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtInfw_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackInitOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, associated(InData%FlowField)) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, associated(InData%FlowField)) if (associated(InData%FlowField)) then - call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtInfw_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtInfw_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) @@ -589,52 +511,24 @@ subroutine ExtInfw_UnPackInitOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%FlowField) else allocate(OutData%FlowField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if else OutData%FlowField => null() @@ -821,66 +715,66 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtInfw_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtInfw_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, allocated(InData%ActForceMotionsPoints)) + call RegPack(RF, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then - call RegPackBounds(Buf, 1, lbound(InData%ActForceMotionsPoints, kind=B8Ki), ubound(InData%ActForceMotionsPoints, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints, kind=B8Ki), ubound(InData%ActForceMotionsPoints, kind=B8Ki)) LB(1:1) = lbound(InData%ActForceMotionsPoints, kind=B8Ki) UB(1:1) = ubound(InData%ActForceMotionsPoints, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%ActForceMotionsPoints(i1)) + call MeshPack(RF, InData%ActForceMotionsPoints(i1)) end do end if - call RegPack(Buf, allocated(InData%ActForceLoadsPoints)) + call RegPack(RF, allocated(InData%ActForceLoadsPoints)) if (allocated(InData%ActForceLoadsPoints)) then - call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints, kind=B8Ki), ubound(InData%ActForceLoadsPoints, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ActForceLoadsPoints, kind=B8Ki), ubound(InData%ActForceLoadsPoints, kind=B8Ki)) LB(1:1) = lbound(InData%ActForceLoadsPoints, kind=B8Ki) UB(1:1) = ubound(InData%ActForceLoadsPoints, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%ActForceLoadsPoints(i1)) + call MeshPack(RF, InData%ActForceLoadsPoints(i1)) end do end if - call RegPack(Buf, allocated(InData%Line2_to_Point_Loads)) + call RegPack(RF, allocated(InData%Line2_to_Point_Loads)) if (allocated(InData%Line2_to_Point_Loads)) then - call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads, kind=B8Ki), ubound(InData%Line2_to_Point_Loads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Loads, kind=B8Ki), ubound(InData%Line2_to_Point_Loads, kind=B8Ki)) LB(1:1) = lbound(InData%Line2_to_Point_Loads, kind=B8Ki) UB(1:1) = ubound(InData%Line2_to_Point_Loads, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Loads(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Loads(i1)) end do end if - call RegPack(Buf, allocated(InData%Line2_to_Point_Motions)) + call RegPack(RF, allocated(InData%Line2_to_Point_Motions)) if (allocated(InData%Line2_to_Point_Motions)) then - call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions, kind=B8Ki), ubound(InData%Line2_to_Point_Motions, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Motions, kind=B8Ki), ubound(InData%Line2_to_Point_Motions, kind=B8Ki)) LB(1:1) = lbound(InData%Line2_to_Point_Motions, kind=B8Ki) UB(1:1) = ubound(InData%Line2_to_Point_Motions, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Motions(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Motions(i1)) end do end if - call RegPack(Buf, associated(InData%FlowField)) + call RegPack(RF, associated(InData%FlowField)) if (associated(InData%FlowField)) then - call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtInfw_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtInfw_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackMisc' integer(B8Ki) :: i1 @@ -889,83 +783,73 @@ subroutine ExtInfw_UnPackMisc(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ActForceMotionsPoints(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%ActForceMotionsPoints(i1)) ! ActForceMotionsPoints + call MeshUnpack(RF, OutData%ActForceMotionsPoints(i1)) ! ActForceMotionsPoints end do end if if (allocated(OutData%ActForceLoadsPoints)) deallocate(OutData%ActForceLoadsPoints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ActForceLoadsPoints(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%ActForceLoadsPoints(i1)) ! ActForceLoadsPoints + call MeshUnpack(RF, OutData%ActForceLoadsPoints(i1)) ! ActForceLoadsPoints end do end if if (allocated(OutData%Line2_to_Point_Loads)) deallocate(OutData%Line2_to_Point_Loads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Line2_to_Point_Loads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Loads(i1)) ! Line2_to_Point_Loads + call NWTC_Library_UnpackMeshMapType(RF, OutData%Line2_to_Point_Loads(i1)) ! Line2_to_Point_Loads end do end if if (allocated(OutData%Line2_to_Point_Motions)) deallocate(OutData%Line2_to_Point_Motions) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Line2_to_Point_Motions(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Motions(i1)) ! Line2_to_Point_Motions + call NWTC_Library_UnpackMeshMapType(RF, OutData%Line2_to_Point_Motions(i1)) ! Line2_to_Point_Motions end do end if if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%FlowField) else allocate(OutData%FlowField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if else OutData%FlowField => null() @@ -1092,48 +976,34 @@ subroutine ExtInfw_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtInfw_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtInfw_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackParam' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, InData%NMappings) - call RegPack(Buf, InData%NnodesVel) - call RegPack(Buf, InData%NnodesForce) - call RegPack(Buf, InData%NnodesForceBlade) - call RegPack(Buf, InData%NnodesForceTower) - call RegPack(Buf, associated(InData%forceBldRnodes)) - if (associated(InData%forceBldRnodes)) then - call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes, kind=B8Ki), ubound(InData%forceBldRnodes, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%forceBldRnodes), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%forceBldRnodes) - end if - end if - call RegPack(Buf, associated(InData%forceTwrHnodes)) - if (associated(InData%forceTwrHnodes)) then - call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes, kind=B8Ki), ubound(InData%forceTwrHnodes, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%forceTwrHnodes), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%forceTwrHnodes) - end if - end if - call RegPack(Buf, InData%BladeLength) - call RegPack(Buf, InData%TowerHeight) - call RegPack(Buf, InData%TowerBaseHeight) - call RegPack(Buf, InData%NodeClusterType) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NMappings) + call RegPack(RF, InData%NnodesVel) + call RegPack(RF, InData%NnodesForce) + call RegPack(RF, InData%NnodesForceBlade) + call RegPack(RF, InData%NnodesForceTower) + call RegPackPtr(RF, InData%forceBldRnodes) + call RegPackPtr(RF, InData%forceTwrHnodes) + call RegPack(RF, InData%BladeLength) + call RegPack(RF, InData%TowerHeight) + call RegPack(RF, InData%TowerBaseHeight) + call RegPack(RF, InData%NodeClusterType) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtInfw_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtInfw_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackParam' integer(B8Ki) :: LB(1), UB(1) @@ -1141,91 +1011,30 @@ subroutine ExtInfw_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%AirDens = OutData%AirDens - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumBl = OutData%NumBl - call RegUnpack(Buf, OutData%NMappings) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NMappings); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NMappings = OutData%NMappings - call RegUnpack(Buf, OutData%NnodesVel) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NnodesVel); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NnodesVel = OutData%NnodesVel - call RegUnpack(Buf, OutData%NnodesForce) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NnodesForce); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NnodesForce = OutData%NnodesForce - call RegUnpack(Buf, OutData%NnodesForceBlade) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NnodesForceBlade); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - call RegUnpack(Buf, OutData%NnodesForceTower) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NnodesForceTower); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower - if (associated(OutData%forceBldRnodes)) deallocate(OutData%forceBldRnodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%forceBldRnodes, UB(1:1)-LB(1:1)) - OutData%forceBldRnodes(LB(1):) => OutData%forceBldRnodes - else - allocate(OutData%forceBldRnodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceBldRnodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%forceBldRnodes) - OutData%C_obj%forceBldRnodes_Len = size(OutData%forceBldRnodes) - if (OutData%C_obj%forceBldRnodes_Len > 0) OutData%C_obj%forceBldRnodes = c_loc(OutData%forceBldRnodes(LB(1))) - call RegUnpack(Buf, OutData%forceBldRnodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%forceBldRnodes => null() - end if - if (associated(OutData%forceTwrHnodes)) deallocate(OutData%forceTwrHnodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%forceTwrHnodes, UB(1:1)-LB(1:1)) - OutData%forceTwrHnodes(LB(1):) => OutData%forceTwrHnodes - else - allocate(OutData%forceTwrHnodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceTwrHnodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%forceTwrHnodes) - OutData%C_obj%forceTwrHnodes_Len = size(OutData%forceTwrHnodes) - if (OutData%C_obj%forceTwrHnodes_Len > 0) OutData%C_obj%forceTwrHnodes = c_loc(OutData%forceTwrHnodes(LB(1))) - call RegUnpack(Buf, OutData%forceTwrHnodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%forceTwrHnodes => null() - end if - call RegUnpack(Buf, OutData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPtr(RF, OutData%forceBldRnodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%forceTwrHnodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLength); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%BladeLength = OutData%BladeLength - call RegUnpack(Buf, OutData%TowerHeight) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%TowerHeight); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%TowerHeight = OutData%TowerHeight - call RegUnpack(Buf, OutData%TowerBaseHeight) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%TowerBaseHeight); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - call RegUnpack(Buf, OutData%NodeClusterType) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NodeClusterType); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NodeClusterType = OutData%NodeClusterType end subroutine @@ -1706,157 +1515,38 @@ subroutine ExtInfw_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtInfw_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtInfw_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%pxVel)) - if (associated(InData%pxVel)) then - call RegPackBounds(Buf, 1, lbound(InData%pxVel, kind=B8Ki), ubound(InData%pxVel, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pxVel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pxVel) - end if - end if - call RegPack(Buf, associated(InData%pyVel)) - if (associated(InData%pyVel)) then - call RegPackBounds(Buf, 1, lbound(InData%pyVel, kind=B8Ki), ubound(InData%pyVel, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pyVel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pyVel) - end if - end if - call RegPack(Buf, associated(InData%pzVel)) - if (associated(InData%pzVel)) then - call RegPackBounds(Buf, 1, lbound(InData%pzVel, kind=B8Ki), ubound(InData%pzVel, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pzVel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pzVel) - end if - end if - call RegPack(Buf, associated(InData%pxForce)) - if (associated(InData%pxForce)) then - call RegPackBounds(Buf, 1, lbound(InData%pxForce, kind=B8Ki), ubound(InData%pxForce, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pxForce), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pxForce) - end if - end if - call RegPack(Buf, associated(InData%pyForce)) - if (associated(InData%pyForce)) then - call RegPackBounds(Buf, 1, lbound(InData%pyForce, kind=B8Ki), ubound(InData%pyForce, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pyForce), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pyForce) - end if - end if - call RegPack(Buf, associated(InData%pzForce)) - if (associated(InData%pzForce)) then - call RegPackBounds(Buf, 1, lbound(InData%pzForce, kind=B8Ki), ubound(InData%pzForce, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pzForce), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pzForce) - end if - end if - call RegPack(Buf, associated(InData%xdotForce)) - if (associated(InData%xdotForce)) then - call RegPackBounds(Buf, 1, lbound(InData%xdotForce, kind=B8Ki), ubound(InData%xdotForce, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%xdotForce), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%xdotForce) - end if - end if - call RegPack(Buf, associated(InData%ydotForce)) - if (associated(InData%ydotForce)) then - call RegPackBounds(Buf, 1, lbound(InData%ydotForce, kind=B8Ki), ubound(InData%ydotForce, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%ydotForce), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%ydotForce) - end if - end if - call RegPack(Buf, associated(InData%zdotForce)) - if (associated(InData%zdotForce)) then - call RegPackBounds(Buf, 1, lbound(InData%zdotForce, kind=B8Ki), ubound(InData%zdotForce, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%zdotForce), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%zdotForce) - end if - end if - call RegPack(Buf, associated(InData%pOrientation)) - if (associated(InData%pOrientation)) then - call RegPackBounds(Buf, 1, lbound(InData%pOrientation, kind=B8Ki), ubound(InData%pOrientation, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%pOrientation), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%pOrientation) - end if - end if - call RegPack(Buf, associated(InData%fx)) - if (associated(InData%fx)) then - call RegPackBounds(Buf, 1, lbound(InData%fx, kind=B8Ki), ubound(InData%fx, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fx), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fx) - end if - end if - call RegPack(Buf, associated(InData%fy)) - if (associated(InData%fy)) then - call RegPackBounds(Buf, 1, lbound(InData%fy, kind=B8Ki), ubound(InData%fy, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fy), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fy) - end if - end if - call RegPack(Buf, associated(InData%fz)) - if (associated(InData%fz)) then - call RegPackBounds(Buf, 1, lbound(InData%fz, kind=B8Ki), ubound(InData%fz, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fz), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fz) - end if - end if - call RegPack(Buf, associated(InData%momentx)) - if (associated(InData%momentx)) then - call RegPackBounds(Buf, 1, lbound(InData%momentx, kind=B8Ki), ubound(InData%momentx, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%momentx), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%momentx) - end if - end if - call RegPack(Buf, associated(InData%momenty)) - if (associated(InData%momenty)) then - call RegPackBounds(Buf, 1, lbound(InData%momenty, kind=B8Ki), ubound(InData%momenty, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%momenty), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%momenty) - end if - end if - call RegPack(Buf, associated(InData%momentz)) - if (associated(InData%momentz)) then - call RegPackBounds(Buf, 1, lbound(InData%momentz, kind=B8Ki), ubound(InData%momentz, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%momentz), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%momentz) - end if - end if - call RegPack(Buf, associated(InData%forceNodesChord)) - if (associated(InData%forceNodesChord)) then - call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord, kind=B8Ki), ubound(InData%forceNodesChord, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%forceNodesChord), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%forceNodesChord) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%pxVel) + call RegPackPtr(RF, InData%pyVel) + call RegPackPtr(RF, InData%pzVel) + call RegPackPtr(RF, InData%pxForce) + call RegPackPtr(RF, InData%pyForce) + call RegPackPtr(RF, InData%pzForce) + call RegPackPtr(RF, InData%xdotForce) + call RegPackPtr(RF, InData%ydotForce) + call RegPackPtr(RF, InData%zdotForce) + call RegPackPtr(RF, InData%pOrientation) + call RegPackPtr(RF, InData%fx) + call RegPackPtr(RF, InData%fy) + call RegPackPtr(RF, InData%fz) + call RegPackPtr(RF, InData%momentx) + call RegPackPtr(RF, InData%momenty) + call RegPackPtr(RF, InData%momentz) + call RegPackPtr(RF, InData%forceNodesChord) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtInfw_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtInfw_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInput' integer(B8Ki) :: LB(1), UB(1) @@ -1864,449 +1554,24 @@ subroutine ExtInfw_UnPackInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%pxVel)) deallocate(OutData%pxVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pxVel, UB(1:1)-LB(1:1)) - OutData%pxVel(LB(1):) => OutData%pxVel - else - allocate(OutData%pxVel(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pxVel) - OutData%C_obj%pxVel_Len = size(OutData%pxVel) - if (OutData%C_obj%pxVel_Len > 0) OutData%C_obj%pxVel = c_loc(OutData%pxVel(LB(1))) - call RegUnpack(Buf, OutData%pxVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pxVel => null() - end if - if (associated(OutData%pyVel)) deallocate(OutData%pyVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pyVel, UB(1:1)-LB(1:1)) - OutData%pyVel(LB(1):) => OutData%pyVel - else - allocate(OutData%pyVel(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pyVel) - OutData%C_obj%pyVel_Len = size(OutData%pyVel) - if (OutData%C_obj%pyVel_Len > 0) OutData%C_obj%pyVel = c_loc(OutData%pyVel(LB(1))) - call RegUnpack(Buf, OutData%pyVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pyVel => null() - end if - if (associated(OutData%pzVel)) deallocate(OutData%pzVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pzVel, UB(1:1)-LB(1:1)) - OutData%pzVel(LB(1):) => OutData%pzVel - else - allocate(OutData%pzVel(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pzVel) - OutData%C_obj%pzVel_Len = size(OutData%pzVel) - if (OutData%C_obj%pzVel_Len > 0) OutData%C_obj%pzVel = c_loc(OutData%pzVel(LB(1))) - call RegUnpack(Buf, OutData%pzVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pzVel => null() - end if - if (associated(OutData%pxForce)) deallocate(OutData%pxForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pxForce, UB(1:1)-LB(1:1)) - OutData%pxForce(LB(1):) => OutData%pxForce - else - allocate(OutData%pxForce(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pxForce) - OutData%C_obj%pxForce_Len = size(OutData%pxForce) - if (OutData%C_obj%pxForce_Len > 0) OutData%C_obj%pxForce = c_loc(OutData%pxForce(LB(1))) - call RegUnpack(Buf, OutData%pxForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pxForce => null() - end if - if (associated(OutData%pyForce)) deallocate(OutData%pyForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pyForce, UB(1:1)-LB(1:1)) - OutData%pyForce(LB(1):) => OutData%pyForce - else - allocate(OutData%pyForce(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pyForce) - OutData%C_obj%pyForce_Len = size(OutData%pyForce) - if (OutData%C_obj%pyForce_Len > 0) OutData%C_obj%pyForce = c_loc(OutData%pyForce(LB(1))) - call RegUnpack(Buf, OutData%pyForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pyForce => null() - end if - if (associated(OutData%pzForce)) deallocate(OutData%pzForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pzForce, UB(1:1)-LB(1:1)) - OutData%pzForce(LB(1):) => OutData%pzForce - else - allocate(OutData%pzForce(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pzForce) - OutData%C_obj%pzForce_Len = size(OutData%pzForce) - if (OutData%C_obj%pzForce_Len > 0) OutData%C_obj%pzForce = c_loc(OutData%pzForce(LB(1))) - call RegUnpack(Buf, OutData%pzForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pzForce => null() - end if - if (associated(OutData%xdotForce)) deallocate(OutData%xdotForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%xdotForce, UB(1:1)-LB(1:1)) - OutData%xdotForce(LB(1):) => OutData%xdotForce - else - allocate(OutData%xdotForce(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%xdotForce) - OutData%C_obj%xdotForce_Len = size(OutData%xdotForce) - if (OutData%C_obj%xdotForce_Len > 0) OutData%C_obj%xdotForce = c_loc(OutData%xdotForce(LB(1))) - call RegUnpack(Buf, OutData%xdotForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%xdotForce => null() - end if - if (associated(OutData%ydotForce)) deallocate(OutData%ydotForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%ydotForce, UB(1:1)-LB(1:1)) - OutData%ydotForce(LB(1):) => OutData%ydotForce - else - allocate(OutData%ydotForce(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ydotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%ydotForce) - OutData%C_obj%ydotForce_Len = size(OutData%ydotForce) - if (OutData%C_obj%ydotForce_Len > 0) OutData%C_obj%ydotForce = c_loc(OutData%ydotForce(LB(1))) - call RegUnpack(Buf, OutData%ydotForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%ydotForce => null() - end if - if (associated(OutData%zdotForce)) deallocate(OutData%zdotForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%zdotForce, UB(1:1)-LB(1:1)) - OutData%zdotForce(LB(1):) => OutData%zdotForce - else - allocate(OutData%zdotForce(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zdotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%zdotForce) - OutData%C_obj%zdotForce_Len = size(OutData%zdotForce) - if (OutData%C_obj%zdotForce_Len > 0) OutData%C_obj%zdotForce = c_loc(OutData%zdotForce(LB(1))) - call RegUnpack(Buf, OutData%zdotForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%zdotForce => null() - end if - if (associated(OutData%pOrientation)) deallocate(OutData%pOrientation) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%pOrientation, UB(1:1)-LB(1:1)) - OutData%pOrientation(LB(1):) => OutData%pOrientation - else - allocate(OutData%pOrientation(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pOrientation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%pOrientation) - OutData%C_obj%pOrientation_Len = size(OutData%pOrientation) - if (OutData%C_obj%pOrientation_Len > 0) OutData%C_obj%pOrientation = c_loc(OutData%pOrientation(LB(1))) - call RegUnpack(Buf, OutData%pOrientation) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%pOrientation => null() - end if - if (associated(OutData%fx)) deallocate(OutData%fx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fx, UB(1:1)-LB(1:1)) - OutData%fx(LB(1):) => OutData%fx - else - allocate(OutData%fx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fx) - OutData%C_obj%fx_Len = size(OutData%fx) - if (OutData%C_obj%fx_Len > 0) OutData%C_obj%fx = c_loc(OutData%fx(LB(1))) - call RegUnpack(Buf, OutData%fx) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fx => null() - end if - if (associated(OutData%fy)) deallocate(OutData%fy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fy, UB(1:1)-LB(1:1)) - OutData%fy(LB(1):) => OutData%fy - else - allocate(OutData%fy(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fy) - OutData%C_obj%fy_Len = size(OutData%fy) - if (OutData%C_obj%fy_Len > 0) OutData%C_obj%fy = c_loc(OutData%fy(LB(1))) - call RegUnpack(Buf, OutData%fy) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fy => null() - end if - if (associated(OutData%fz)) deallocate(OutData%fz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fz, UB(1:1)-LB(1:1)) - OutData%fz(LB(1):) => OutData%fz - else - allocate(OutData%fz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fz) - OutData%C_obj%fz_Len = size(OutData%fz) - if (OutData%C_obj%fz_Len > 0) OutData%C_obj%fz = c_loc(OutData%fz(LB(1))) - call RegUnpack(Buf, OutData%fz) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fz => null() - end if - if (associated(OutData%momentx)) deallocate(OutData%momentx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%momentx, UB(1:1)-LB(1:1)) - OutData%momentx(LB(1):) => OutData%momentx - else - allocate(OutData%momentx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%momentx) - OutData%C_obj%momentx_Len = size(OutData%momentx) - if (OutData%C_obj%momentx_Len > 0) OutData%C_obj%momentx = c_loc(OutData%momentx(LB(1))) - call RegUnpack(Buf, OutData%momentx) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%momentx => null() - end if - if (associated(OutData%momenty)) deallocate(OutData%momenty) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%momenty, UB(1:1)-LB(1:1)) - OutData%momenty(LB(1):) => OutData%momenty - else - allocate(OutData%momenty(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momenty.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%momenty) - OutData%C_obj%momenty_Len = size(OutData%momenty) - if (OutData%C_obj%momenty_Len > 0) OutData%C_obj%momenty = c_loc(OutData%momenty(LB(1))) - call RegUnpack(Buf, OutData%momenty) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%momenty => null() - end if - if (associated(OutData%momentz)) deallocate(OutData%momentz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%momentz, UB(1:1)-LB(1:1)) - OutData%momentz(LB(1):) => OutData%momentz - else - allocate(OutData%momentz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%momentz) - OutData%C_obj%momentz_Len = size(OutData%momentz) - if (OutData%C_obj%momentz_Len > 0) OutData%C_obj%momentz = c_loc(OutData%momentz(LB(1))) - call RegUnpack(Buf, OutData%momentz) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%momentz => null() - end if - if (associated(OutData%forceNodesChord)) deallocate(OutData%forceNodesChord) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%forceNodesChord, UB(1:1)-LB(1:1)) - OutData%forceNodesChord(LB(1):) => OutData%forceNodesChord - else - allocate(OutData%forceNodesChord(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceNodesChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%forceNodesChord) - OutData%C_obj%forceNodesChord_Len = size(OutData%forceNodesChord) - if (OutData%C_obj%forceNodesChord_Len > 0) OutData%C_obj%forceNodesChord = c_loc(OutData%forceNodesChord(LB(1))) - call RegUnpack(Buf, OutData%forceNodesChord) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%forceNodesChord => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%pxVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%pyVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%pzVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%pxForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%pyForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%pzForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%xdotForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%ydotForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%zdotForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%pOrientation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%fx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%fy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%fz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%momentx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%momenty); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%momentz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%forceNodesChord); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE ExtInfw_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) @@ -2800,50 +2065,25 @@ subroutine ExtInfw_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtInfw_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtInfw_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%u)) - if (associated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%u), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%u) - end if - end if - call RegPack(Buf, associated(InData%v)) - if (associated(InData%v)) then - call RegPackBounds(Buf, 1, lbound(InData%v, kind=B8Ki), ubound(InData%v, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%v), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%v) - end if - end if - call RegPack(Buf, associated(InData%w)) - if (associated(InData%w)) then - call RegPackBounds(Buf, 1, lbound(InData%w, kind=B8Ki), ubound(InData%w, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%w), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%w) - end if - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%u) + call RegPackPtr(RF, InData%v) + call RegPackPtr(RF, InData%w) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtInfw_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtInfw_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtInfw_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) @@ -2851,99 +2091,11 @@ subroutine ExtInfw_UnPackOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%u)) deallocate(OutData%u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%u, UB(1:1)-LB(1:1)) - OutData%u(LB(1):) => OutData%u - else - allocate(OutData%u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%u) - OutData%C_obj%u_Len = size(OutData%u) - if (OutData%C_obj%u_Len > 0) OutData%C_obj%u = c_loc(OutData%u(LB(1))) - call RegUnpack(Buf, OutData%u) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%u => null() - end if - if (associated(OutData%v)) deallocate(OutData%v) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%v, UB(1:1)-LB(1:1)) - OutData%v(LB(1):) => OutData%v - else - allocate(OutData%v(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%v.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%v) - OutData%C_obj%v_Len = size(OutData%v) - if (OutData%C_obj%v_Len > 0) OutData%C_obj%v = c_loc(OutData%v(LB(1))) - call RegUnpack(Buf, OutData%v) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%v => null() - end if - if (associated(OutData%w)) deallocate(OutData%w) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%w, UB(1:1)-LB(1:1)) - OutData%w(LB(1):) => OutData%w - else - allocate(OutData%w(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%w.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%w) - OutData%C_obj%w_Len = size(OutData%w) - if (OutData%C_obj%w_Len > 0) OutData%C_obj%w = c_loc(OutData%w(LB(1))) - call RegUnpack(Buf, OutData%w) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%w => null() - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE ExtInfw_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 9ca5ac7425..17debf3902 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -180,31 +180,27 @@ subroutine ExtPtfm_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine ExtPtfm_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%PtfmRefzt) - call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%PtfmRefzt) + call RegPack(RF, InData%RootName) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -301,134 +297,54 @@ subroutine ExtPtfm_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%IntMethod) - call RegPack(Buf, InData%FileFormat) - call RegPack(Buf, InData%RedFile) - call RegPack(Buf, InData%RedFileCst) - call RegPack(Buf, InData%EquilStart) - call RegPack(Buf, allocated(InData%ActiveCBDOF)) - if (allocated(InData%ActiveCBDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF, kind=B8Ki), ubound(InData%ActiveCBDOF, kind=B8Ki)) - call RegPack(Buf, InData%ActiveCBDOF) - end if - call RegPack(Buf, allocated(InData%InitPosList)) - if (allocated(InData%InitPosList)) then - call RegPackBounds(Buf, 1, lbound(InData%InitPosList, kind=B8Ki), ubound(InData%InitPosList, kind=B8Ki)) - call RegPack(Buf, InData%InitPosList) - end if - call RegPack(Buf, allocated(InData%InitVelList)) - if (allocated(InData%InitVelList)) then - call RegPackBounds(Buf, 1, lbound(InData%InitVelList, kind=B8Ki), ubound(InData%InitVelList, kind=B8Ki)) - call RegPack(Buf, InData%InitVelList) - end if - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%OutFile) - call RegPack(Buf, InData%TabDelim) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%Tstart) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%FileFormat) + call RegPack(RF, InData%RedFile) + call RegPack(RF, InData%RedFileCst) + call RegPack(RF, InData%EquilStart) + call RegPackAlloc(RF, InData%ActiveCBDOF) + call RegPackAlloc(RF, InData%InitPosList) + call RegPackAlloc(RF, InData%InitVelList) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FileFormat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RedFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RedFileCst) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EquilStart) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ActiveCBDOF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ActiveCBDOF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitPosList)) deallocate(OutData%InitPosList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitPosList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitPosList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitVelList)) deallocate(OutData%InitVelList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitVelList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitVelList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RedFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RedFileCst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ActiveCBDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitPosList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitVelList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -611,214 +527,44 @@ subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -873,60 +619,26 @@ subroutine ExtPtfm_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%qm)) - if (allocated(InData%qm)) then - call RegPackBounds(Buf, 1, lbound(InData%qm, kind=B8Ki), ubound(InData%qm, kind=B8Ki)) - call RegPack(Buf, InData%qm) - end if - call RegPack(Buf, allocated(InData%qmdot)) - if (allocated(InData%qmdot)) then - call RegPackBounds(Buf, 1, lbound(InData%qmdot, kind=B8Ki), ubound(InData%qmdot, kind=B8Ki)) - call RegPack(Buf, InData%qmdot) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%qm) + call RegPackAlloc(RF, InData%qmdot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%qm)) deallocate(OutData%qm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%qm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%qm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%qmdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%qmdot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%qm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qmdot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -950,22 +662,21 @@ subroutine ExtPtfm_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine ExtPtfm_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -989,22 +700,21 @@ subroutine ExtPtfm_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine ExtPtfm_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1061,52 +771,49 @@ subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%xdot)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(Buf, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(Buf, InData%xdot(i1)) + call ExtPtfm_PackContState(RF, InData%xdot(i1)) end do end if - call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%xdot)) deallocate(OutData%xdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xdot(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call ExtPtfm_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do end if - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1179,88 +886,34 @@ subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%xFlat)) - if (allocated(InData%xFlat)) then - call RegPackBounds(Buf, 1, lbound(InData%xFlat, kind=B8Ki), ubound(InData%xFlat, kind=B8Ki)) - call RegPack(Buf, InData%xFlat) - end if - call RegPack(Buf, InData%uFlat) - call RegPack(Buf, allocated(InData%F_at_t)) - if (allocated(InData%F_at_t)) then - call RegPackBounds(Buf, 1, lbound(InData%F_at_t, kind=B8Ki), ubound(InData%F_at_t, kind=B8Ki)) - call RegPack(Buf, InData%F_at_t) - end if - call RegPack(Buf, InData%Indx) - call RegPack(Buf, InData%EquilStart) - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xFlat) + call RegPack(RF, InData%uFlat) + call RegPackAlloc(RF, InData%F_at_t) + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%EquilStart) + call RegPackAlloc(RF, InData%AllOuts) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%xFlat)) deallocate(OutData%xFlat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xFlat(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xFlat) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%uFlat) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_at_t)) deallocate(OutData%F_at_t) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_at_t(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_at_t) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Indx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EquilStart) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%uFlat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_at_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EquilStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1668,507 +1321,107 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Mass)) - if (allocated(InData%Mass)) then - call RegPackBounds(Buf, 2, lbound(InData%Mass, kind=B8Ki), ubound(InData%Mass, kind=B8Ki)) - call RegPack(Buf, InData%Mass) - end if - call RegPack(Buf, allocated(InData%Damp)) - if (allocated(InData%Damp)) then - call RegPackBounds(Buf, 2, lbound(InData%Damp, kind=B8Ki), ubound(InData%Damp, kind=B8Ki)) - call RegPack(Buf, InData%Damp) - end if - call RegPack(Buf, allocated(InData%Stff)) - if (allocated(InData%Stff)) then - call RegPackBounds(Buf, 2, lbound(InData%Stff, kind=B8Ki), ubound(InData%Stff, kind=B8Ki)) - call RegPack(Buf, InData%Stff) - end if - call RegPack(Buf, allocated(InData%Forces)) - if (allocated(InData%Forces)) then - call RegPackBounds(Buf, 2, lbound(InData%Forces, kind=B8Ki), ubound(InData%Forces, kind=B8Ki)) - call RegPack(Buf, InData%Forces) - end if - call RegPack(Buf, allocated(InData%times)) - if (allocated(InData%times)) then - call RegPackBounds(Buf, 1, lbound(InData%times, kind=B8Ki), ubound(InData%times, kind=B8Ki)) - call RegPack(Buf, InData%times) - end if - call RegPack(Buf, allocated(InData%AMat)) - if (allocated(InData%AMat)) then - call RegPackBounds(Buf, 2, lbound(InData%AMat, kind=B8Ki), ubound(InData%AMat, kind=B8Ki)) - call RegPack(Buf, InData%AMat) - end if - call RegPack(Buf, allocated(InData%BMat)) - if (allocated(InData%BMat)) then - call RegPackBounds(Buf, 2, lbound(InData%BMat, kind=B8Ki), ubound(InData%BMat, kind=B8Ki)) - call RegPack(Buf, InData%BMat) - end if - call RegPack(Buf, allocated(InData%CMat)) - if (allocated(InData%CMat)) then - call RegPackBounds(Buf, 2, lbound(InData%CMat, kind=B8Ki), ubound(InData%CMat, kind=B8Ki)) - call RegPack(Buf, InData%CMat) - end if - call RegPack(Buf, allocated(InData%DMat)) - if (allocated(InData%DMat)) then - call RegPackBounds(Buf, 2, lbound(InData%DMat, kind=B8Ki), ubound(InData%DMat, kind=B8Ki)) - call RegPack(Buf, InData%DMat) - end if - call RegPack(Buf, allocated(InData%FX)) - if (allocated(InData%FX)) then - call RegPackBounds(Buf, 1, lbound(InData%FX, kind=B8Ki), ubound(InData%FX, kind=B8Ki)) - call RegPack(Buf, InData%FX) - end if - call RegPack(Buf, allocated(InData%FY)) - if (allocated(InData%FY)) then - call RegPackBounds(Buf, 1, lbound(InData%FY, kind=B8Ki), ubound(InData%FY, kind=B8Ki)) - call RegPack(Buf, InData%FY) - end if - call RegPack(Buf, allocated(InData%M11)) - if (allocated(InData%M11)) then - call RegPackBounds(Buf, 2, lbound(InData%M11, kind=B8Ki), ubound(InData%M11, kind=B8Ki)) - call RegPack(Buf, InData%M11) - end if - call RegPack(Buf, allocated(InData%M12)) - if (allocated(InData%M12)) then - call RegPackBounds(Buf, 2, lbound(InData%M12, kind=B8Ki), ubound(InData%M12, kind=B8Ki)) - call RegPack(Buf, InData%M12) - end if - call RegPack(Buf, allocated(InData%M22)) - if (allocated(InData%M22)) then - call RegPackBounds(Buf, 2, lbound(InData%M22, kind=B8Ki), ubound(InData%M22, kind=B8Ki)) - call RegPack(Buf, InData%M22) - end if - call RegPack(Buf, allocated(InData%M21)) - if (allocated(InData%M21)) then - call RegPackBounds(Buf, 2, lbound(InData%M21, kind=B8Ki), ubound(InData%M21, kind=B8Ki)) - call RegPack(Buf, InData%M21) - end if - call RegPack(Buf, allocated(InData%K11)) - if (allocated(InData%K11)) then - call RegPackBounds(Buf, 2, lbound(InData%K11, kind=B8Ki), ubound(InData%K11, kind=B8Ki)) - call RegPack(Buf, InData%K11) - end if - call RegPack(Buf, allocated(InData%K22)) - if (allocated(InData%K22)) then - call RegPackBounds(Buf, 2, lbound(InData%K22, kind=B8Ki), ubound(InData%K22, kind=B8Ki)) - call RegPack(Buf, InData%K22) - end if - call RegPack(Buf, allocated(InData%C11)) - if (allocated(InData%C11)) then - call RegPackBounds(Buf, 2, lbound(InData%C11, kind=B8Ki), ubound(InData%C11, kind=B8Ki)) - call RegPack(Buf, InData%C11) - end if - call RegPack(Buf, allocated(InData%C12)) - if (allocated(InData%C12)) then - call RegPackBounds(Buf, 2, lbound(InData%C12, kind=B8Ki), ubound(InData%C12, kind=B8Ki)) - call RegPack(Buf, InData%C12) - end if - call RegPack(Buf, allocated(InData%C22)) - if (allocated(InData%C22)) then - call RegPackBounds(Buf, 2, lbound(InData%C22, kind=B8Ki), ubound(InData%C22, kind=B8Ki)) - call RegPack(Buf, InData%C22) - end if - call RegPack(Buf, allocated(InData%C21)) - if (allocated(InData%C21)) then - call RegPackBounds(Buf, 2, lbound(InData%C21, kind=B8Ki), ubound(InData%C21, kind=B8Ki)) - call RegPack(Buf, InData%C21) - end if - call RegPack(Buf, InData%EP_DeltaT) - call RegPack(Buf, InData%nTimeSteps) - call RegPack(Buf, InData%nCB) - call RegPack(Buf, InData%nCBFull) - call RegPack(Buf, InData%nTot) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%IntMethod) - call RegPack(Buf, allocated(InData%ActiveCBDOF)) - if (allocated(InData%ActiveCBDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF, kind=B8Ki), ubound(InData%ActiveCBDOF, kind=B8Ki)) - call RegPack(Buf, InData%ActiveCBDOF) - end if - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Mass) + call RegPackAlloc(RF, InData%Damp) + call RegPackAlloc(RF, InData%Stff) + call RegPackAlloc(RF, InData%Forces) + call RegPackAlloc(RF, InData%times) + call RegPackAlloc(RF, InData%AMat) + call RegPackAlloc(RF, InData%BMat) + call RegPackAlloc(RF, InData%CMat) + call RegPackAlloc(RF, InData%DMat) + call RegPackAlloc(RF, InData%FX) + call RegPackAlloc(RF, InData%FY) + call RegPackAlloc(RF, InData%M11) + call RegPackAlloc(RF, InData%M12) + call RegPackAlloc(RF, InData%M22) + call RegPackAlloc(RF, InData%M21) + call RegPackAlloc(RF, InData%K11) + call RegPackAlloc(RF, InData%K22) + call RegPackAlloc(RF, InData%C11) + call RegPackAlloc(RF, InData%C12) + call RegPackAlloc(RF, InData%C22) + call RegPackAlloc(RF, InData%C21) + call RegPack(RF, InData%EP_DeltaT) + call RegPack(RF, InData%nTimeSteps) + call RegPack(RF, InData%nCB) + call RegPack(RF, InData%nCBFull) + call RegPack(RF, InData%nTot) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%IntMethod) + call RegPackAlloc(RF, InData%ActiveCBDOF) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, allocated(InData%OutParamLinIndx)) - if (allocated(InData%OutParamLinIndx)) then - call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx, kind=B8Ki), ubound(InData%OutParamLinIndx, kind=B8Ki)) - call RegPack(Buf, InData%OutParamLinIndx) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%OutParamLinIndx) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Mass)) deallocate(OutData%Mass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mass(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mass) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Damp)) deallocate(OutData%Damp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Damp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Damp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Stff)) deallocate(OutData%Stff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Stff(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Stff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Forces)) deallocate(OutData%Forces) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Forces(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Forces) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%times)) deallocate(OutData%times) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%times(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%times) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AMat)) deallocate(OutData%AMat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AMat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BMat)) deallocate(OutData%BMat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BMat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CMat)) deallocate(OutData%CMat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CMat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DMat)) deallocate(OutData%DMat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DMat) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FX)) deallocate(OutData%FX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FY)) deallocate(OutData%FY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M11)) deallocate(OutData%M11) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M11(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M11) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M12)) deallocate(OutData%M12) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M12(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M12) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M22)) deallocate(OutData%M22) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M22(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M22) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M21)) deallocate(OutData%M21) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M21(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M21) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%K11)) deallocate(OutData%K11) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%K11(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%K11) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%K22)) deallocate(OutData%K22) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%K22(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%K22) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C11)) deallocate(OutData%C11) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C11(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C11) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C12)) deallocate(OutData%C12) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C12(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C12) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C22)) deallocate(OutData%C22) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C22(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C22) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C21)) deallocate(OutData%C21) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C21(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C21) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%EP_DeltaT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nTimeSteps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nCB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nCBFull) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nTot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ActiveCBDOF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ActiveCBDOF) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Mass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Damp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Forces); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%times); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C22); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C21); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EP_DeltaT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTimeSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCBFull); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ActiveCBDOF); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutParamLinIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%OutParamLinIndx); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -2200,21 +1453,21 @@ subroutine ExtPtfm_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine ExtPtfm_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PtfmMesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh end subroutine subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2262,43 +1515,26 @@ subroutine ExtPtfm_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine ExtPtfm_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PtfmMesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ExtPtfm_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine ExtPtfm_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtPtfm_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 70dbe328be..a96fa832aa 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -530,403 +530,84 @@ subroutine FEAM_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, allocated(InData%LineCI)) - if (allocated(InData%LineCI)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCI, kind=B8Ki), ubound(InData%LineCI, kind=B8Ki)) - call RegPack(Buf, InData%LineCI) - end if - call RegPack(Buf, allocated(InData%LineCD)) - if (allocated(InData%LineCD)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCD, kind=B8Ki), ubound(InData%LineCD, kind=B8Ki)) - call RegPack(Buf, InData%LineCD) - end if - call RegPack(Buf, allocated(InData%LEAStiff)) - if (allocated(InData%LEAStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%LEAStiff, kind=B8Ki), ubound(InData%LEAStiff, kind=B8Ki)) - call RegPack(Buf, InData%LEAStiff) - end if - call RegPack(Buf, allocated(InData%LMassDen)) - if (allocated(InData%LMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LMassDen, kind=B8Ki), ubound(InData%LMassDen, kind=B8Ki)) - call RegPack(Buf, InData%LMassDen) - end if - call RegPack(Buf, allocated(InData%LDMassDen)) - if (allocated(InData%LDMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LDMassDen, kind=B8Ki), ubound(InData%LDMassDen, kind=B8Ki)) - call RegPack(Buf, InData%LDMassDen) - end if - call RegPack(Buf, allocated(InData%BottmStiff)) - if (allocated(InData%BottmStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%BottmStiff, kind=B8Ki), ubound(InData%BottmStiff, kind=B8Ki)) - call RegPack(Buf, InData%BottmStiff) - end if - call RegPack(Buf, allocated(InData%LRadAnch)) - if (allocated(InData%LRadAnch)) then - call RegPackBounds(Buf, 1, lbound(InData%LRadAnch, kind=B8Ki), ubound(InData%LRadAnch, kind=B8Ki)) - call RegPack(Buf, InData%LRadAnch) - end if - call RegPack(Buf, allocated(InData%LAngAnch)) - if (allocated(InData%LAngAnch)) then - call RegPackBounds(Buf, 1, lbound(InData%LAngAnch, kind=B8Ki), ubound(InData%LAngAnch, kind=B8Ki)) - call RegPack(Buf, InData%LAngAnch) - end if - call RegPack(Buf, allocated(InData%LDpthAnch)) - if (allocated(InData%LDpthAnch)) then - call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch, kind=B8Ki), ubound(InData%LDpthAnch, kind=B8Ki)) - call RegPack(Buf, InData%LDpthAnch) - end if - call RegPack(Buf, allocated(InData%LRadFair)) - if (allocated(InData%LRadFair)) then - call RegPackBounds(Buf, 1, lbound(InData%LRadFair, kind=B8Ki), ubound(InData%LRadFair, kind=B8Ki)) - call RegPack(Buf, InData%LRadFair) - end if - call RegPack(Buf, allocated(InData%LAngFair)) - if (allocated(InData%LAngFair)) then - call RegPackBounds(Buf, 1, lbound(InData%LAngFair, kind=B8Ki), ubound(InData%LAngFair, kind=B8Ki)) - call RegPack(Buf, InData%LAngFair) - end if - call RegPack(Buf, allocated(InData%LDrftFair)) - if (allocated(InData%LDrftFair)) then - call RegPackBounds(Buf, 1, lbound(InData%LDrftFair, kind=B8Ki), ubound(InData%LDrftFair, kind=B8Ki)) - call RegPack(Buf, InData%LDrftFair) - end if - call RegPack(Buf, allocated(InData%LUnstrLen)) - if (allocated(InData%LUnstrLen)) then - call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen, kind=B8Ki), ubound(InData%LUnstrLen, kind=B8Ki)) - call RegPack(Buf, InData%LUnstrLen) - end if - call RegPack(Buf, allocated(InData%Tension)) - if (allocated(InData%Tension)) then - call RegPackBounds(Buf, 1, lbound(InData%Tension, kind=B8Ki), ubound(InData%Tension, kind=B8Ki)) - call RegPack(Buf, InData%Tension) - end if - call RegPack(Buf, allocated(InData%GSL)) - if (allocated(InData%GSL)) then - call RegPackBounds(Buf, 3, lbound(InData%GSL, kind=B8Ki), ubound(InData%GSL, kind=B8Ki)) - call RegPack(Buf, InData%GSL) - end if - call RegPack(Buf, allocated(InData%GSR)) - if (allocated(InData%GSR)) then - call RegPackBounds(Buf, 2, lbound(InData%GSR, kind=B8Ki), ubound(InData%GSR, kind=B8Ki)) - call RegPack(Buf, InData%GSR) - end if - call RegPack(Buf, allocated(InData%GE)) - if (allocated(InData%GE)) then - call RegPackBounds(Buf, 3, lbound(InData%GE, kind=B8Ki), ubound(InData%GE, kind=B8Ki)) - call RegPack(Buf, InData%GE) - end if - call RegPack(Buf, InData%NumLines) - call RegPack(Buf, InData%NumElems) - call RegPack(Buf, InData%Eps) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, InData%MaxIter) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%OutFile) - call RegPack(Buf, InData%TabDelim) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%Tstart) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%LineCI) + call RegPackAlloc(RF, InData%LineCD) + call RegPackAlloc(RF, InData%LEAStiff) + call RegPackAlloc(RF, InData%LMassDen) + call RegPackAlloc(RF, InData%LDMassDen) + call RegPackAlloc(RF, InData%BottmStiff) + call RegPackAlloc(RF, InData%LRadAnch) + call RegPackAlloc(RF, InData%LAngAnch) + call RegPackAlloc(RF, InData%LDpthAnch) + call RegPackAlloc(RF, InData%LRadFair) + call RegPackAlloc(RF, InData%LAngFair) + call RegPackAlloc(RF, InData%LDrftFair) + call RegPackAlloc(RF, InData%LUnstrLen) + call RegPackAlloc(RF, InData%Tension) + call RegPackAlloc(RF, InData%GSL) + call RegPackAlloc(RF, InData%GSR) + call RegPackAlloc(RF, InData%GE) + call RegPack(RF, InData%NumLines) + call RegPack(RF, InData%NumElems) + call RegPack(RF, InData%Eps) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%MaxIter) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineCI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineCI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineCD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineCD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LEAStiff(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LEAStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LMassDen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LMassDen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LDMassDen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LDMassDen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BottmStiff(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BottmStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LRadAnch)) deallocate(OutData%LRadAnch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LRadAnch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LRadAnch) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LAngAnch)) deallocate(OutData%LAngAnch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LAngAnch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LAngAnch) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LDpthAnch)) deallocate(OutData%LDpthAnch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LDpthAnch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LDpthAnch) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LRadFair)) deallocate(OutData%LRadFair) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LRadFair(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LRadFair) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LAngFair)) deallocate(OutData%LAngFair) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LAngFair(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LAngFair) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LDrftFair)) deallocate(OutData%LDrftFair) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LDrftFair(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LDrftFair) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LUnstrLen)) deallocate(OutData%LUnstrLen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LUnstrLen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LUnstrLen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Tension)) deallocate(OutData%Tension) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Tension(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Tension) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GSL)) deallocate(OutData%GSL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GSL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GSR)) deallocate(OutData%GSR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GSR(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GSR) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GE)) deallocate(OutData%GE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GE) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumLines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumElems) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Eps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MaxIter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LEAStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BottmStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LRadAnch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAngAnch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDpthAnch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LRadFair); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAngFair); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDrftFair); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LUnstrLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Tension); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GSL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumElems); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -1002,97 +683,40 @@ subroutine FEAM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%PtfmInit) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, allocated(InData%WaveAcc0)) - if (allocated(InData%WaveAcc0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0, kind=B8Ki), ubound(InData%WaveAcc0, kind=B8Ki)) - call RegPack(Buf, InData%WaveAcc0) - end if - call RegPack(Buf, allocated(InData%WaveTime)) - if (allocated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime, kind=B8Ki), ubound(InData%WaveTime, kind=B8Ki)) - call RegPack(Buf, InData%WaveTime) - end if - call RegPack(Buf, allocated(InData%WaveVel0)) - if (allocated(InData%WaveVel0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveVel0, kind=B8Ki), ubound(InData%WaveVel0, kind=B8Ki)) - call RegPack(Buf, InData%WaveVel0) - end if - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%PtfmInit) + call RegPack(RF, InData%NStepWave) + call RegPackAlloc(RF, InData%WaveAcc0) + call RegPackAlloc(RF, InData%WaveTime) + call RegPackAlloc(RF, InData%WaveVel0) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveAcc0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveVel0) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1245,176 +869,40 @@ subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%LAnchxi)) - if (allocated(InData%LAnchxi)) then - call RegPackBounds(Buf, 1, lbound(InData%LAnchxi, kind=B8Ki), ubound(InData%LAnchxi, kind=B8Ki)) - call RegPack(Buf, InData%LAnchxi) - end if - call RegPack(Buf, allocated(InData%LAnchyi)) - if (allocated(InData%LAnchyi)) then - call RegPackBounds(Buf, 1, lbound(InData%LAnchyi, kind=B8Ki), ubound(InData%LAnchyi, kind=B8Ki)) - call RegPack(Buf, InData%LAnchyi) - end if - call RegPack(Buf, allocated(InData%LAnchzi)) - if (allocated(InData%LAnchzi)) then - call RegPackBounds(Buf, 1, lbound(InData%LAnchzi, kind=B8Ki), ubound(InData%LAnchzi, kind=B8Ki)) - call RegPack(Buf, InData%LAnchzi) - end if - call RegPack(Buf, allocated(InData%LFairxt)) - if (allocated(InData%LFairxt)) then - call RegPackBounds(Buf, 1, lbound(InData%LFairxt, kind=B8Ki), ubound(InData%LFairxt, kind=B8Ki)) - call RegPack(Buf, InData%LFairxt) - end if - call RegPack(Buf, allocated(InData%LFairyt)) - if (allocated(InData%LFairyt)) then - call RegPackBounds(Buf, 1, lbound(InData%LFairyt, kind=B8Ki), ubound(InData%LFairyt, kind=B8Ki)) - call RegPack(Buf, InData%LFairyt) - end if - call RegPack(Buf, allocated(InData%LFairzt)) - if (allocated(InData%LFairzt)) then - call RegPackBounds(Buf, 1, lbound(InData%LFairzt, kind=B8Ki), ubound(InData%LFairzt, kind=B8Ki)) - call RegPack(Buf, InData%LFairzt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LAnchxi) + call RegPackAlloc(RF, InData%LAnchyi) + call RegPackAlloc(RF, InData%LAnchzi) + call RegPackAlloc(RF, InData%LFairxt) + call RegPackAlloc(RF, InData%LFairyt) + call RegPackAlloc(RF, InData%LFairzt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%LAnchxi)) deallocate(OutData%LAnchxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LAnchxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LAnchxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LAnchyi)) deallocate(OutData%LAnchyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LAnchyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LAnchyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LAnchzi)) deallocate(OutData%LAnchzi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LAnchzi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LAnchzi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LFairxt)) deallocate(OutData%LFairxt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LFairxt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LFairxt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LFairyt)) deallocate(OutData%LFairyt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LFairyt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LFairyt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LFairzt)) deallocate(OutData%LFairzt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LFairzt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LFairzt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LAnchxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAnchyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LAnchzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LFairxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LFairyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LFairzt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1469,60 +957,26 @@ subroutine FEAM_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%GLU)) - if (allocated(InData%GLU)) then - call RegPackBounds(Buf, 2, lbound(InData%GLU, kind=B8Ki), ubound(InData%GLU, kind=B8Ki)) - call RegPack(Buf, InData%GLU) - end if - call RegPack(Buf, allocated(InData%GLDU)) - if (allocated(InData%GLDU)) then - call RegPackBounds(Buf, 2, lbound(InData%GLDU, kind=B8Ki), ubound(InData%GLDU, kind=B8Ki)) - call RegPack(Buf, InData%GLDU) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%GLU) + call RegPackAlloc(RF, InData%GLDU) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackContState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%GLU)) deallocate(OutData%GLU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GLDU)) deallocate(OutData%GLDU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLDU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLDU) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%GLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLDU); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -1546,22 +1000,21 @@ subroutine FEAM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FEAM_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1586,25 +1039,23 @@ subroutine FEAM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FEAM_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%TSN) - call RegPack(Buf, InData%TZER) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TSN) + call RegPack(RF, InData%TZER) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%TSN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TZER) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TSN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TZER); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1724,151 +1175,44 @@ subroutine FEAM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%GLU0)) - if (allocated(InData%GLU0)) then - call RegPackBounds(Buf, 2, lbound(InData%GLU0, kind=B8Ki), ubound(InData%GLU0, kind=B8Ki)) - call RegPack(Buf, InData%GLU0) - end if - call RegPack(Buf, allocated(InData%GLDDU)) - if (allocated(InData%GLDDU)) then - call RegPackBounds(Buf, 2, lbound(InData%GLDDU, kind=B8Ki), ubound(InData%GLDDU, kind=B8Ki)) - call RegPack(Buf, InData%GLDDU) - end if - call RegPack(Buf, InData%BottomTouch) - call RegPack(Buf, allocated(InData%GFORC0)) - if (allocated(InData%GFORC0)) then - call RegPackBounds(Buf, 3, lbound(InData%GFORC0, kind=B8Ki), ubound(InData%GFORC0, kind=B8Ki)) - call RegPack(Buf, InData%GFORC0) - end if - call RegPack(Buf, allocated(InData%GMASS0)) - if (allocated(InData%GMASS0)) then - call RegPackBounds(Buf, 4, lbound(InData%GMASS0, kind=B8Ki), ubound(InData%GMASS0, kind=B8Ki)) - call RegPack(Buf, InData%GMASS0) - end if - call RegPack(Buf, allocated(InData%FAST_FPA)) - if (allocated(InData%FAST_FPA)) then - call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA, kind=B8Ki), ubound(InData%FAST_FPA, kind=B8Ki)) - call RegPack(Buf, InData%FAST_FPA) - end if - call RegPack(Buf, allocated(InData%FAST_RP)) - if (allocated(InData%FAST_RP)) then - call RegPackBounds(Buf, 2, lbound(InData%FAST_RP, kind=B8Ki), ubound(InData%FAST_RP, kind=B8Ki)) - call RegPack(Buf, InData%FAST_RP) - end if - call RegPack(Buf, InData%INCR) - call RegPack(Buf, InData%RSDF) - call RegPack(Buf, InData%FORC0) - call RegPack(Buf, InData%EMAS0) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%GLU0) + call RegPackAlloc(RF, InData%GLDDU) + call RegPack(RF, InData%BottomTouch) + call RegPackAlloc(RF, InData%GFORC0) + call RegPackAlloc(RF, InData%GMASS0) + call RegPackAlloc(RF, InData%FAST_FPA) + call RegPackAlloc(RF, InData%FAST_RP) + call RegPack(RF, InData%INCR) + call RegPack(RF, InData%RSDF) + call RegPack(RF, InData%FORC0) + call RegPack(RF, InData%EMAS0) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%GLU0)) deallocate(OutData%GLU0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLU0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLU0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GLDDU)) deallocate(OutData%GLDDU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLDDU(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLDDU) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BottomTouch) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%GFORC0)) deallocate(OutData%GFORC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GFORC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GMASS0)) deallocate(OutData%GMASS0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GMASS0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FAST_FPA)) deallocate(OutData%FAST_FPA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FAST_FPA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FAST_RP)) deallocate(OutData%FAST_RP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FAST_RP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FAST_RP) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%INCR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RSDF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FORC0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EMAS0) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%GLU0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLDDU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BottomTouch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GFORC0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GMASS0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAST_FPA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAST_RP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%INCR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RSDF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FORC0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EMAS0); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -2057,254 +1401,70 @@ subroutine FEAM_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%GLF)) - if (allocated(InData%GLF)) then - call RegPackBounds(Buf, 2, lbound(InData%GLF, kind=B8Ki), ubound(InData%GLF, kind=B8Ki)) - call RegPack(Buf, InData%GLF) - end if - call RegPack(Buf, allocated(InData%GLK)) - if (allocated(InData%GLK)) then - call RegPackBounds(Buf, 3, lbound(InData%GLK, kind=B8Ki), ubound(InData%GLK, kind=B8Ki)) - call RegPack(Buf, InData%GLK) - end if - call RegPack(Buf, InData%EMASS) - call RegPack(Buf, InData%ESTIF) - call RegPack(Buf, allocated(InData%FAST_FP)) - if (allocated(InData%FAST_FP)) then - call RegPackBounds(Buf, 2, lbound(InData%FAST_FP, kind=B8Ki), ubound(InData%FAST_FP, kind=B8Ki)) - call RegPack(Buf, InData%FAST_FP) - end if - call RegPack(Buf, InData%FORCE) - call RegPack(Buf, InData%FP) - call RegPack(Buf, InData%U) - call RegPack(Buf, InData%U0) - call RegPack(Buf, InData%DU) - call RegPack(Buf, InData%DDU) - call RegPack(Buf, InData%R) - call RegPack(Buf, InData%RP) - call RegPack(Buf, InData%RHSR) - call RegPack(Buf, InData%SLIN) - call RegPack(Buf, InData%STIFR) - call RegPack(Buf, allocated(InData%FAIR_ANG)) - if (allocated(InData%FAIR_ANG)) then - call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG, kind=B8Ki), ubound(InData%FAIR_ANG, kind=B8Ki)) - call RegPack(Buf, InData%FAIR_ANG) - end if - call RegPack(Buf, allocated(InData%FAIR_T)) - if (allocated(InData%FAIR_T)) then - call RegPackBounds(Buf, 1, lbound(InData%FAIR_T, kind=B8Ki), ubound(InData%FAIR_T, kind=B8Ki)) - call RegPack(Buf, InData%FAIR_T) - end if - call RegPack(Buf, allocated(InData%ANCH_ANG)) - if (allocated(InData%ANCH_ANG)) then - call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG, kind=B8Ki), ubound(InData%ANCH_ANG, kind=B8Ki)) - call RegPack(Buf, InData%ANCH_ANG) - end if - call RegPack(Buf, allocated(InData%ANCH_T)) - if (allocated(InData%ANCH_T)) then - call RegPackBounds(Buf, 1, lbound(InData%ANCH_T, kind=B8Ki), ubound(InData%ANCH_T, kind=B8Ki)) - call RegPack(Buf, InData%ANCH_T) - end if - call RegPack(Buf, allocated(InData%Line_Coordinate)) - if (allocated(InData%Line_Coordinate)) then - call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate, kind=B8Ki), ubound(InData%Line_Coordinate, kind=B8Ki)) - call RegPack(Buf, InData%Line_Coordinate) - end if - call RegPack(Buf, allocated(InData%Line_Tangent)) - if (allocated(InData%Line_Tangent)) then - call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent, kind=B8Ki), ubound(InData%Line_Tangent, kind=B8Ki)) - call RegPack(Buf, InData%Line_Tangent) - end if - call RegPack(Buf, allocated(InData%F_Lines)) - if (allocated(InData%F_Lines)) then - call RegPackBounds(Buf, 2, lbound(InData%F_Lines, kind=B8Ki), ubound(InData%F_Lines, kind=B8Ki)) - call RegPack(Buf, InData%F_Lines) - end if - call RegPack(Buf, InData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%GLF) + call RegPackAlloc(RF, InData%GLK) + call RegPack(RF, InData%EMASS) + call RegPack(RF, InData%ESTIF) + call RegPackAlloc(RF, InData%FAST_FP) + call RegPack(RF, InData%FORCE) + call RegPack(RF, InData%FP) + call RegPack(RF, InData%U) + call RegPack(RF, InData%U0) + call RegPack(RF, InData%DU) + call RegPack(RF, InData%DDU) + call RegPack(RF, InData%R) + call RegPack(RF, InData%RP) + call RegPack(RF, InData%RHSR) + call RegPack(RF, InData%SLIN) + call RegPack(RF, InData%STIFR) + call RegPackAlloc(RF, InData%FAIR_ANG) + call RegPackAlloc(RF, InData%FAIR_T) + call RegPackAlloc(RF, InData%ANCH_ANG) + call RegPackAlloc(RF, InData%ANCH_T) + call RegPackAlloc(RF, InData%Line_Coordinate) + call RegPackAlloc(RF, InData%Line_Tangent) + call RegPackAlloc(RF, InData%F_Lines) + call RegPack(RF, InData%LastIndWave) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%GLF)) deallocate(OutData%GLF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GLK)) deallocate(OutData%GLK) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLK) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%EMASS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ESTIF) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FAST_FP)) deallocate(OutData%FAST_FP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FAST_FP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FAST_FP) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FORCE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%U) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%U0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DU) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DDU) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%R) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RHSR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SLIN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STIFR) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FAIR_ANG)) deallocate(OutData%FAIR_ANG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FAIR_ANG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FAIR_T)) deallocate(OutData%FAIR_T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FAIR_T(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FAIR_T) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ANCH_ANG)) deallocate(OutData%ANCH_ANG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ANCH_ANG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ANCH_T)) deallocate(OutData%ANCH_T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ANCH_T(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ANCH_T) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Line_Coordinate)) deallocate(OutData%Line_Coordinate) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Line_Coordinate) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Line_Tangent)) deallocate(OutData%Line_Tangent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Line_Tangent) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_Lines)) deallocate(OutData%F_Lines) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_Lines(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_Lines) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%GLF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EMASS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ESTIF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAST_FP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FORCE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DDU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RHSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SLIN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STIFR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAIR_ANG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAIR_T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ANCH_ANG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ANCH_T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Line_Coordinate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Line_Tangent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Lines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2649,474 +1809,149 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine FEAM_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%GRAV) - call RegPack(Buf, InData%Eps) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, InData%MaxIter) - call RegPack(Buf, InData%NHBD) - call RegPack(Buf, InData%NDIM) - call RegPack(Buf, allocated(InData%NEQ)) - if (allocated(InData%NEQ)) then - call RegPackBounds(Buf, 1, lbound(InData%NEQ, kind=B8Ki), ubound(InData%NEQ, kind=B8Ki)) - call RegPack(Buf, InData%NEQ) - end if - call RegPack(Buf, InData%NBAND) - call RegPack(Buf, InData%NumLines) - call RegPack(Buf, InData%NumElems) - call RegPack(Buf, InData%NumNodes) - call RegPack(Buf, allocated(InData%GSL)) - if (allocated(InData%GSL)) then - call RegPackBounds(Buf, 3, lbound(InData%GSL, kind=B8Ki), ubound(InData%GSL, kind=B8Ki)) - call RegPack(Buf, InData%GSL) - end if - call RegPack(Buf, allocated(InData%GP)) - if (allocated(InData%GP)) then - call RegPackBounds(Buf, 2, lbound(InData%GP, kind=B8Ki), ubound(InData%GP, kind=B8Ki)) - call RegPack(Buf, InData%GP) - end if - call RegPack(Buf, allocated(InData%Elength)) - if (allocated(InData%Elength)) then - call RegPackBounds(Buf, 1, lbound(InData%Elength, kind=B8Ki), ubound(InData%Elength, kind=B8Ki)) - call RegPack(Buf, InData%Elength) - end if - call RegPack(Buf, allocated(InData%BottmElev)) - if (allocated(InData%BottmElev)) then - call RegPackBounds(Buf, 1, lbound(InData%BottmElev, kind=B8Ki), ubound(InData%BottmElev, kind=B8Ki)) - call RegPack(Buf, InData%BottmElev) - end if - call RegPack(Buf, allocated(InData%BottmStiff)) - if (allocated(InData%BottmStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%BottmStiff, kind=B8Ki), ubound(InData%BottmStiff, kind=B8Ki)) - call RegPack(Buf, InData%BottmStiff) - end if - call RegPack(Buf, allocated(InData%LMassDen)) - if (allocated(InData%LMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LMassDen, kind=B8Ki), ubound(InData%LMassDen, kind=B8Ki)) - call RegPack(Buf, InData%LMassDen) - end if - call RegPack(Buf, allocated(InData%LDMassDen)) - if (allocated(InData%LDMassDen)) then - call RegPackBounds(Buf, 1, lbound(InData%LDMassDen, kind=B8Ki), ubound(InData%LDMassDen, kind=B8Ki)) - call RegPack(Buf, InData%LDMassDen) - end if - call RegPack(Buf, allocated(InData%LEAStiff)) - if (allocated(InData%LEAStiff)) then - call RegPackBounds(Buf, 1, lbound(InData%LEAStiff, kind=B8Ki), ubound(InData%LEAStiff, kind=B8Ki)) - call RegPack(Buf, InData%LEAStiff) - end if - call RegPack(Buf, allocated(InData%LineCI)) - if (allocated(InData%LineCI)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCI, kind=B8Ki), ubound(InData%LineCI, kind=B8Ki)) - call RegPack(Buf, InData%LineCI) - end if - call RegPack(Buf, allocated(InData%LineCD)) - if (allocated(InData%LineCD)) then - call RegPackBounds(Buf, 1, lbound(InData%LineCD, kind=B8Ki), ubound(InData%LineCD, kind=B8Ki)) - call RegPack(Buf, InData%LineCD) - end if - call RegPack(Buf, allocated(InData%Bvp)) - if (allocated(InData%Bvp)) then - call RegPackBounds(Buf, 2, lbound(InData%Bvp, kind=B8Ki), ubound(InData%Bvp, kind=B8Ki)) - call RegPack(Buf, InData%Bvp) - end if - call RegPack(Buf, allocated(InData%WaveAcc0)) - if (allocated(InData%WaveAcc0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0, kind=B8Ki), ubound(InData%WaveAcc0, kind=B8Ki)) - call RegPack(Buf, InData%WaveAcc0) - end if - call RegPack(Buf, allocated(InData%WaveTime)) - if (allocated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime, kind=B8Ki), ubound(InData%WaveTime, kind=B8Ki)) - call RegPack(Buf, InData%WaveTime) - end if - call RegPack(Buf, allocated(InData%WaveVel0)) - if (allocated(InData%WaveVel0)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveVel0, kind=B8Ki), ubound(InData%WaveVel0, kind=B8Ki)) - call RegPack(Buf, InData%WaveVel0) - end if - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%SHAP) - call RegPack(Buf, InData%SHAPS) - call RegPack(Buf, InData%GAUSSW) - call RegPack(Buf, InData%NGAUSS) - call RegPack(Buf, InData%SHAPT) - call RegPack(Buf, InData%SHAPTS) - call RegPack(Buf, InData%NTRAP) - call RegPack(Buf, InData%SBEND) - call RegPack(Buf, InData%STEN) - call RegPack(Buf, InData%RMASS) - call RegPack(Buf, InData%RADDM) - call RegPack(Buf, InData%PMPN) - call RegPack(Buf, InData%AM) - call RegPack(Buf, InData%PM) - call RegPack(Buf, InData%IDOF) - call RegPack(Buf, InData%JDOF) - call RegPack(Buf, InData%PPA) - call RegPack(Buf, InData%PtfmRefzt) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%GRAV) + call RegPack(RF, InData%Eps) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%MaxIter) + call RegPack(RF, InData%NHBD) + call RegPack(RF, InData%NDIM) + call RegPackAlloc(RF, InData%NEQ) + call RegPack(RF, InData%NBAND) + call RegPack(RF, InData%NumLines) + call RegPack(RF, InData%NumElems) + call RegPack(RF, InData%NumNodes) + call RegPackAlloc(RF, InData%GSL) + call RegPackAlloc(RF, InData%GP) + call RegPackAlloc(RF, InData%Elength) + call RegPackAlloc(RF, InData%BottmElev) + call RegPackAlloc(RF, InData%BottmStiff) + call RegPackAlloc(RF, InData%LMassDen) + call RegPackAlloc(RF, InData%LDMassDen) + call RegPackAlloc(RF, InData%LEAStiff) + call RegPackAlloc(RF, InData%LineCI) + call RegPackAlloc(RF, InData%LineCD) + call RegPackAlloc(RF, InData%Bvp) + call RegPackAlloc(RF, InData%WaveAcc0) + call RegPackAlloc(RF, InData%WaveTime) + call RegPackAlloc(RF, InData%WaveVel0) + call RegPack(RF, InData%NStepWave) + call RegPack(RF, InData%SHAP) + call RegPack(RF, InData%SHAPS) + call RegPack(RF, InData%GAUSSW) + call RegPack(RF, InData%NGAUSS) + call RegPack(RF, InData%SHAPT) + call RegPack(RF, InData%SHAPTS) + call RegPack(RF, InData%NTRAP) + call RegPack(RF, InData%SBEND) + call RegPack(RF, InData%STEN) + call RegPack(RF, InData%RMASS) + call RegPack(RF, InData%RADDM) + call RegPack(RF, InData%PMPN) + call RegPack(RF, InData%AM) + call RegPack(RF, InData%PM) + call RegPack(RF, InData%IDOF) + call RegPack(RF, InData%JDOF) + call RegPack(RF, InData%PPA) + call RegPack(RF, InData%PtfmRefzt) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%Delim) - call RegPack(Buf, allocated(InData%GLUZR)) - if (allocated(InData%GLUZR)) then - call RegPackBounds(Buf, 3, lbound(InData%GLUZR, kind=B8Ki), ubound(InData%GLUZR, kind=B8Ki)) - call RegPack(Buf, InData%GLUZR) - end if - call RegPack(Buf, allocated(InData%GTZER)) - if (allocated(InData%GTZER)) then - call RegPackBounds(Buf, 2, lbound(InData%GTZER, kind=B8Ki), ubound(InData%GTZER, kind=B8Ki)) - call RegPack(Buf, InData%GTZER) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%Delim) + call RegPackAlloc(RF, InData%GLUZR) + call RegPackAlloc(RF, InData%GTZER) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GRAV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Eps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MaxIter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NHBD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NDIM) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NEQ)) deallocate(OutData%NEQ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NEQ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NEQ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NBAND) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumLines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumElems) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumNodes) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%GSL)) deallocate(OutData%GSL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GSL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GP)) deallocate(OutData%GP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Elength)) deallocate(OutData%Elength) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Elength(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Elength) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BottmElev)) deallocate(OutData%BottmElev) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BottmElev(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BottmElev) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BottmStiff(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BottmStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LMassDen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LMassDen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LDMassDen(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LDMassDen) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LEAStiff(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LEAStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineCI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineCI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineCD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineCD) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Bvp)) deallocate(OutData%Bvp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Bvp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Bvp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveAcc0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveVel0) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SHAP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SHAPS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GAUSSW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NGAUSS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SHAPT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SHAPTS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTRAP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SBEND) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%STEN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RMASS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RADDM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PMPN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PPA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GRAV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Eps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MaxIter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NHBD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NDIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NEQ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBAND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumElems); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GSL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Elength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BottmElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BottmStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LDMassDen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LEAStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineCD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bvp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAPS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GAUSSW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGAUSS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAPT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SHAPTS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTRAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SBEND); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%STEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RMASS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RADDM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PMPN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PPA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%GLUZR)) deallocate(OutData%GLUZR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GLUZR) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GTZER)) deallocate(OutData%GTZER) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GTZER(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GTZER) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GLUZR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GTZER); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FEAM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -3153,23 +1988,23 @@ subroutine FEAM_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FEAM_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%HydroForceLineMesh) - call MeshPack(Buf, InData%PtFairleadDisplacement) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%HydroForceLineMesh) + call MeshPack(RF, InData%PtFairleadDisplacement) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%HydroForceLineMesh) ! HydroForceLineMesh - call MeshUnpack(Buf, OutData%PtFairleadDisplacement) ! PtFairleadDisplacement + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%HydroForceLineMesh) ! HydroForceLineMesh + call MeshUnpack(RF, OutData%PtFairleadDisplacement) ! PtFairleadDisplacement end subroutine subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3222,45 +2057,28 @@ subroutine FEAM_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FEAM_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAM_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call MeshPack(Buf, InData%PtFairleadLoad) - call MeshPack(Buf, InData%LineMeshPosition) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + call MeshPack(RF, InData%PtFairleadLoad) + call MeshPack(RF, InData%LineMeshPosition) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FEAM_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FEAM_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAM_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - call MeshUnpack(Buf, OutData%PtFairleadLoad) ! PtFairleadLoad - call MeshUnpack(Buf, OutData%LineMeshPosition) ! LineMeshPosition + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtFairleadLoad) ! PtFairleadLoad + call MeshUnpack(RF, OutData%LineMeshPosition) ! LineMeshPosition end subroutine subroutine FEAM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 88f18e81de..4b47ee2a95 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -174,100 +174,42 @@ subroutine Conv_Rdtn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine Conv_Rdtn_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%RdtnDT) - call RegPack(Buf, InData%RdtnDTChr) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%HighFreq) - call RegPack(Buf, InData%WAMITFile) - call RegPack(Buf, allocated(InData%HdroAddMs)) - if (allocated(InData%HdroAddMs)) then - call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs, kind=B8Ki), ubound(InData%HdroAddMs, kind=B8Ki)) - call RegPack(Buf, InData%HdroAddMs) - end if - call RegPack(Buf, allocated(InData%HdroFreq)) - if (allocated(InData%HdroFreq)) then - call RegPackBounds(Buf, 1, lbound(InData%HdroFreq, kind=B8Ki), ubound(InData%HdroFreq, kind=B8Ki)) - call RegPack(Buf, InData%HdroFreq) - end if - call RegPack(Buf, allocated(InData%HdroDmpng)) - if (allocated(InData%HdroDmpng)) then - call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng, kind=B8Ki), ubound(InData%HdroDmpng, kind=B8Ki)) - call RegPack(Buf, InData%HdroDmpng) - end if - call RegPack(Buf, InData%NInpFreq) - call RegPack(Buf, InData%RdtnTMax) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RdtnDT) + call RegPack(RF, InData%RdtnDTChr) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%HighFreq) + call RegPack(RF, InData%WAMITFile) + call RegPackAlloc(RF, InData%HdroAddMs) + call RegPackAlloc(RF, InData%HdroFreq) + call RegPackAlloc(RF, InData%HdroDmpng) + call RegPack(RF, InData%NInpFreq) + call RegPack(RF, InData%RdtnTMax) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%RdtnDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RdtnDTChr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HighFreq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAMITFile) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%HdroAddMs)) deallocate(OutData%HdroAddMs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HdroAddMs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HdroFreq)) deallocate(OutData%HdroFreq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HdroFreq(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HdroFreq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HdroDmpng)) deallocate(OutData%HdroDmpng) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HdroDmpng) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NInpFreq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RdtnTMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RdtnDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnDTChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HighFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroAddMs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroDmpng); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NInpFreq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnTMax); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -291,22 +233,21 @@ subroutine Conv_Rdtn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Conv_Rdtn_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyInitOut) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyInitOut) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyInitOut) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyInitOut); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -330,22 +271,21 @@ subroutine Conv_Rdtn_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Conv_Rdtn_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -386,44 +326,26 @@ subroutine Conv_Rdtn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine Conv_Rdtn_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%XDHistory)) - if (allocated(InData%XDHistory)) then - call RegPackBounds(Buf, 2, lbound(InData%XDHistory, kind=B8Ki), ubound(InData%XDHistory, kind=B8Ki)) - call RegPack(Buf, InData%XDHistory) - end if - call RegPack(Buf, InData%LastTime) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%XDHistory) + call RegPack(RF, InData%LastTime) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%XDHistory)) deallocate(OutData%XDHistory) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%XDHistory(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%XDHistory) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LastTime) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%XDHistory); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTime); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -447,22 +369,21 @@ subroutine Conv_Rdtn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Conv_Rdtn_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -486,22 +407,21 @@ subroutine Conv_Rdtn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Conv_Rdtn_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IndRdtn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IndRdtn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IndRdtn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IndRdtn); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -525,22 +445,21 @@ subroutine Conv_Rdtn_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Conv_Rdtn_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%LastIndRdtn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastIndRdtn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%LastIndRdtn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastIndRdtn); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -585,56 +504,34 @@ subroutine Conv_Rdtn_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine Conv_Rdtn_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%RdtnDT) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, allocated(InData%RdtnKrnl)) - if (allocated(InData%RdtnKrnl)) then - call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl, kind=B8Ki), ubound(InData%RdtnKrnl, kind=B8Ki)) - call RegPack(Buf, InData%RdtnKrnl) - end if - call RegPack(Buf, InData%NStepRdtn) - call RegPack(Buf, InData%NStepRdtn1) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine Conv_Rdtn_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RdtnDT) + call RegPack(RF, InData%NBody) + call RegPackAlloc(RF, InData%RdtnKrnl) + call RegPack(RF, InData%NStepRdtn) + call RegPack(RF, InData%NStepRdtn1) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RdtnDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%RdtnKrnl)) deallocate(OutData%RdtnKrnl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RdtnKrnl) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NStepRdtn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepRdtn1) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RdtnKrnl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepRdtn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepRdtn1); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -674,41 +571,24 @@ subroutine Conv_Rdtn_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine Conv_Rdtn_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Velocity)) - if (allocated(InData%Velocity)) then - call RegPackBounds(Buf, 1, lbound(InData%Velocity, kind=B8Ki), ubound(InData%Velocity, kind=B8Ki)) - call RegPack(Buf, InData%Velocity) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Velocity) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Velocity)) deallocate(OutData%Velocity) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Velocity(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Velocity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Velocity) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Velocity); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -748,41 +628,24 @@ subroutine Conv_Rdtn_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Conv_Rdtn_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%F_Rdtn)) - if (allocated(InData%F_Rdtn)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn, kind=B8Ki), ubound(InData%F_Rdtn, kind=B8Ki)) - call RegPack(Buf, InData%F_Rdtn) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%F_Rdtn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Conv_Rdtn_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Conv_Rdtn_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Conv_Rdtn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_Rdtn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%F_Rdtn); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Conv_Rdtn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 54102ff6d8..d0c6fac27f 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -487,361 +487,90 @@ subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine HydroDyn_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%EchoFlag) - call RegPack(Buf, allocated(InData%AddF0)) - if (allocated(InData%AddF0)) then - call RegPackBounds(Buf, 2, lbound(InData%AddF0, kind=B8Ki), ubound(InData%AddF0, kind=B8Ki)) - call RegPack(Buf, InData%AddF0) - end if - call RegPack(Buf, allocated(InData%AddCLin)) - if (allocated(InData%AddCLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddCLin, kind=B8Ki), ubound(InData%AddCLin, kind=B8Ki)) - call RegPack(Buf, InData%AddCLin) - end if - call RegPack(Buf, allocated(InData%AddBLin)) - if (allocated(InData%AddBLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBLin, kind=B8Ki), ubound(InData%AddBLin, kind=B8Ki)) - call RegPack(Buf, InData%AddBLin) - end if - call RegPack(Buf, allocated(InData%AddBQuad)) - if (allocated(InData%AddBQuad)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBQuad, kind=B8Ki), ubound(InData%AddBQuad, kind=B8Ki)) - call RegPack(Buf, InData%AddBQuad) - end if - call RegPack(Buf, allocated(InData%PotFile)) - if (allocated(InData%PotFile)) then - call RegPackBounds(Buf, 1, lbound(InData%PotFile, kind=B8Ki), ubound(InData%PotFile, kind=B8Ki)) - call RegPack(Buf, InData%PotFile) - end if - call RegPack(Buf, InData%nWAMITObj) - call RegPack(Buf, InData%vecMultiplier) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%NBodyMod) - call RegPack(Buf, allocated(InData%PtfmVol0)) - if (allocated(InData%PtfmVol0)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0, kind=B8Ki), ubound(InData%PtfmVol0, kind=B8Ki)) - call RegPack(Buf, InData%PtfmVol0) - end if - call RegPack(Buf, InData%HasWAMIT) - call RegPack(Buf, allocated(InData%WAMITULEN)) - if (allocated(InData%WAMITULEN)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN, kind=B8Ki), ubound(InData%WAMITULEN, kind=B8Ki)) - call RegPack(Buf, InData%WAMITULEN) - end if - call RegPack(Buf, allocated(InData%PtfmRefxt)) - if (allocated(InData%PtfmRefxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt, kind=B8Ki), ubound(InData%PtfmRefxt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefxt) - end if - call RegPack(Buf, allocated(InData%PtfmRefyt)) - if (allocated(InData%PtfmRefyt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt, kind=B8Ki), ubound(InData%PtfmRefyt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefyt) - end if - call RegPack(Buf, allocated(InData%PtfmRefzt)) - if (allocated(InData%PtfmRefzt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt, kind=B8Ki), ubound(InData%PtfmRefzt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefzt) - end if - call RegPack(Buf, allocated(InData%PtfmRefztRot)) - if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefztRot) - end if - call RegPack(Buf, allocated(InData%PtfmCOBxt)) - if (allocated(InData%PtfmCOBxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt, kind=B8Ki), ubound(InData%PtfmCOBxt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmCOBxt) - end if - call RegPack(Buf, allocated(InData%PtfmCOByt)) - if (allocated(InData%PtfmCOByt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt, kind=B8Ki), ubound(InData%PtfmCOByt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmCOByt) - end if - call WAMIT_PackInitInput(Buf, InData%WAMIT) - call WAMIT2_PackInitInput(Buf, InData%WAMIT2) - call Morison_PackInitInput(Buf, InData%Morison) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%PotMod) - call RegPack(Buf, InData%NUserOutputs) - call RegPack(Buf, allocated(InData%UserOutputs)) - if (allocated(InData%UserOutputs)) then - call RegPackBounds(Buf, 1, lbound(InData%UserOutputs, kind=B8Ki), ubound(InData%UserOutputs, kind=B8Ki)) - call RegPack(Buf, InData%UserOutputs) - end if - call RegPack(Buf, InData%OutSwtch) - call RegPack(Buf, InData%OutAll) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%HDSum) - call RegPack(Buf, InData%UnSum) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPackAlloc(RF, InData%AddF0) + call RegPackAlloc(RF, InData%AddCLin) + call RegPackAlloc(RF, InData%AddBLin) + call RegPackAlloc(RF, InData%AddBQuad) + call RegPackAlloc(RF, InData%PotFile) + call RegPack(RF, InData%nWAMITObj) + call RegPack(RF, InData%vecMultiplier) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%PtfmVol0) + call RegPack(RF, InData%HasWAMIT) + call RegPackAlloc(RF, InData%WAMITULEN) + call RegPackAlloc(RF, InData%PtfmRefxt) + call RegPackAlloc(RF, InData%PtfmRefyt) + call RegPackAlloc(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPackAlloc(RF, InData%PtfmCOBxt) + call RegPackAlloc(RF, InData%PtfmCOByt) + call WAMIT_PackInitInput(RF, InData%WAMIT) + call WAMIT2_PackInitInput(RF, InData%WAMIT2) + call Morison_PackInitInput(RF, InData%Morison) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%PotMod) + call RegPack(RF, InData%NUserOutputs) + call RegPackAlloc(RF, InData%UserOutputs) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutAll) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%HDSum) + call RegPack(RF, InData%UnSum) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%EchoFlag) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddF0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddF0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddCLin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddBLin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddBQuad) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PotFile)) deallocate(OutData%PotFile) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PotFile(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PotFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PotFile) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nWAMITObj) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%vecMultiplier) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmVol0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmVol0) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HasWAMIT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WAMITULEN)) deallocate(OutData%WAMITULEN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WAMITULEN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMITULEN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WAMITULEN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefxt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefyt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefztRot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmCOBxt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmCOBxt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmCOByt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmCOByt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call WAMIT_UnpackInitInput(Buf, OutData%WAMIT) ! WAMIT - call WAMIT2_UnpackInitInput(Buf, OutData%WAMIT2) ! WAMIT2 - call Morison_UnpackInitInput(Buf, OutData%Morison) ! Morison - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PotMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NUserOutputs) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%UserOutputs)) deallocate(OutData%UserOutputs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UserOutputs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UserOutputs) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutAll) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HDSum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddF0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddCLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBQuad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PotFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmVol0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasWAMIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WAMITULEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOBxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOByt); if (RegCheckErr(RF, RoutineName)) return + call WAMIT_UnpackInitInput(RF, OutData%WAMIT) ! WAMIT + call WAMIT2_UnpackInitInput(RF, OutData%WAMIT2) ! WAMIT2 + call Morison_UnpackInitInput(RF, OutData%Morison) ! Morison + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PotMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NUserOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UserOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HDSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -884,33 +613,33 @@ subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) nullify(InitInputData%WaveField) end subroutine -subroutine HydroDyn_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - call RegPack(Buf, InData%OutRootName) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%TMax) - call RegPack(Buf, InData%VisMeshes) - call RegPack(Buf, InData%InvalidWithSSExctn) - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, InData%OutRootName) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, InData%InvalidWithSSExctn) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' integer(B8Ki) :: LB(0), UB(0) @@ -918,40 +647,30 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - call RegUnpack(Buf, OutData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InvalidWithSSExctn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvalidWithSSExctn); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -1098,159 +817,40 @@ subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine HydroDyn_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call Morison_PackInitOutput(Buf, InData%Morison) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call Morison_PackInitOutput(RF, InData%Morison) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%IsLoad_u) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call Morison_UnpackInitOutput(Buf, OutData%Morison) ! Morison - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call Morison_UnpackInitOutput(RF, OutData%Morison) ! Morison + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_CopyHD_ModuleMapType(SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1292,25 +892,25 @@ subroutine HydroDyn_DestroyHD_ModuleMapType(HD_ModuleMapTypeData, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine HydroDyn_PackHD_ModuleMapType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackHD_ModuleMapType(RF, Indata) + type(RegFile), intent(inout) :: RF type(HD_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackMeshMapType(Buf, InData%uW_P_2_PRP_P) - call NWTC_Library_PackMeshMapType(Buf, InData%W_P_2_PRP_P) - call NWTC_Library_PackMeshMapType(Buf, InData%M_P_2_PRP_P) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackMeshMapType(RF, InData%uW_P_2_PRP_P) + call NWTC_Library_PackMeshMapType(RF, InData%W_P_2_PRP_P) + call NWTC_Library_PackMeshMapType(RF, InData%M_P_2_PRP_P) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackHD_ModuleMapType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackHD_ModuleMapType(RF, OutData) + type(RegFile), intent(inout) :: RF type(HD_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackMeshMapType(Buf, OutData%uW_P_2_PRP_P) ! uW_P_2_PRP_P - call NWTC_Library_UnpackMeshMapType(Buf, OutData%W_P_2_PRP_P) ! W_P_2_PRP_P - call NWTC_Library_UnpackMeshMapType(Buf, OutData%M_P_2_PRP_P) ! M_P_2_PRP_P + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%uW_P_2_PRP_P) ! uW_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%W_P_2_PRP_P) ! W_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%M_P_2_PRP_P) ! M_P_2_PRP_P end subroutine subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1371,51 +971,49 @@ subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine HydroDyn_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WAMIT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackContState(Buf, InData%WAMIT(i1)) + call WAMIT_PackContState(RF, InData%WAMIT(i1)) end do end if - call Morison_PackContState(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return + call Morison_PackContState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackContState(Buf, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackContState(RF, OutData%WAMIT(i1)) ! WAMIT end do end if - call Morison_UnpackContState(Buf, OutData%Morison) ! Morison + call Morison_UnpackContState(RF, OutData%Morison) ! Morison end subroutine subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -1476,51 +1074,49 @@ subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine HydroDyn_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WAMIT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackDiscState(Buf, InData%WAMIT(i1)) + call WAMIT_PackDiscState(RF, InData%WAMIT(i1)) end do end if - call Morison_PackDiscState(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return + call Morison_PackDiscState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackDiscState(Buf, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackDiscState(RF, OutData%WAMIT(i1)) ! WAMIT end do end if - call Morison_UnpackDiscState(Buf, OutData%Morison) ! Morison + call Morison_UnpackDiscState(RF, OutData%Morison) ! Morison end subroutine subroutine HydroDyn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1557,23 +1153,23 @@ subroutine HydroDyn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine HydroDyn_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call WAMIT_PackConstrState(Buf, InData%WAMIT) - call Morison_PackConstrState(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call WAMIT_PackConstrState(RF, InData%WAMIT) + call Morison_PackConstrState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call WAMIT_UnpackConstrState(Buf, OutData%WAMIT) ! WAMIT - call Morison_UnpackConstrState(Buf, OutData%Morison) ! Morison + if (RF%ErrStat /= ErrID_None) return + call WAMIT_UnpackConstrState(RF, OutData%WAMIT) ! WAMIT + call Morison_UnpackConstrState(RF, OutData%Morison) ! Morison end subroutine subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1634,51 +1230,49 @@ subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine HydroDyn_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WAMIT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackOtherState(Buf, InData%WAMIT(i1)) + call WAMIT_PackOtherState(RF, InData%WAMIT(i1)) end do end if - call Morison_PackOtherState(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return + call Morison_PackOtherState(RF, InData%Morison) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackOtherState(Buf, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackOtherState(RF, OutData%WAMIT(i1)) ! WAMIT end do end if - call Morison_UnpackOtherState(Buf, OutData%Morison) ! Morison + call Morison_UnpackOtherState(RF, OutData%Morison) ! Morison end subroutine subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1832,148 +1426,105 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine HydroDyn_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%AllHdroOrigin) - call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) - call RegPack(Buf, InData%Decimate) - call RegPack(Buf, InData%LastOutTime) - call RegPack(Buf, allocated(InData%F_PtfmAdd)) - if (allocated(InData%F_PtfmAdd)) then - call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd, kind=B8Ki), ubound(InData%F_PtfmAdd, kind=B8Ki)) - call RegPack(Buf, InData%F_PtfmAdd) - end if - call RegPack(Buf, InData%F_Hydro) - call RegPack(Buf, allocated(InData%F_Waves)) - if (allocated(InData%F_Waves)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Waves, kind=B8Ki), ubound(InData%F_Waves, kind=B8Ki)) - call RegPack(Buf, InData%F_Waves) - end if - call RegPack(Buf, allocated(InData%WAMIT)) + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%AllHdroOrigin) + call HydroDyn_PackHD_ModuleMapType(RF, InData%HD_MeshMap) + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPackAlloc(RF, InData%F_PtfmAdd) + call RegPack(RF, InData%F_Hydro) + call RegPackAlloc(RF, InData%F_Waves) + call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackMisc(Buf, InData%WAMIT(i1)) + call WAMIT_PackMisc(RF, InData%WAMIT(i1)) end do end if - call RegPack(Buf, allocated(InData%WAMIT2)) + call RegPack(RF, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT2_PackMisc(Buf, InData%WAMIT2(i1)) + call WAMIT2_PackMisc(RF, InData%WAMIT2(i1)) end do end if - call Morison_PackMisc(Buf, InData%Morison) - call RegPack(Buf, allocated(InData%u_WAMIT)) + call Morison_PackMisc(RF, InData%Morison) + call RegPack(RF, allocated(InData%u_WAMIT)) if (allocated(InData%u_WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_WAMIT, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%u_WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%u_WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackInput(Buf, InData%u_WAMIT(i1)) + call WAMIT_PackInput(RF, InData%u_WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%AllHdroOrigin) ! AllHdroOrigin - call HydroDyn_UnpackHD_ModuleMapType(Buf, OutData%HD_MeshMap) ! HD_MeshMap - call RegUnpack(Buf, OutData%Decimate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_PtfmAdd)) deallocate(OutData%F_PtfmAdd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_PtfmAdd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAdd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_PtfmAdd) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%F_Hydro) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_Waves)) deallocate(OutData%F_Waves) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_Waves(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_Waves) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%AllHdroOrigin) ! AllHdroOrigin + call HydroDyn_UnpackHD_ModuleMapType(RF, OutData%HD_MeshMap) ! HD_MeshMap + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_PtfmAdd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F_Hydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackMisc(Buf, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackMisc(RF, OutData%WAMIT(i1)) ! WAMIT end do end if if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT2_UnpackMisc(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + call WAMIT2_UnpackMisc(RF, OutData%WAMIT2(i1)) ! WAMIT2 end do end if - call Morison_UnpackMisc(Buf, OutData%Morison) ! Morison + call Morison_UnpackMisc(RF, OutData%Morison) ! Morison if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackInput(Buf, OutData%u_WAMIT(i1)) ! u_WAMIT + call WAMIT_UnpackInput(RF, OutData%u_WAMIT(i1)) ! u_WAMIT end do end if end subroutine @@ -2213,109 +1764,81 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveField) end subroutine -subroutine HydroDyn_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%nWAMITObj) - call RegPack(Buf, InData%vecMultiplier) - call RegPack(Buf, allocated(InData%WAMIT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nWAMITObj) + call RegPack(RF, InData%vecMultiplier) + call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackParam(Buf, InData%WAMIT(i1)) + call WAMIT_PackParam(RF, InData%WAMIT(i1)) end do end if - call RegPack(Buf, allocated(InData%WAMIT2)) + call RegPack(RF, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT2_PackParam(Buf, InData%WAMIT2(i1)) + call WAMIT2_PackParam(RF, InData%WAMIT2(i1)) end do end if - call RegPack(Buf, InData%WAMIT2used) - call Morison_PackParam(Buf, InData%Morison) - call RegPack(Buf, InData%PotMod) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%NBodyMod) - call RegPack(Buf, InData%totalStates) - call RegPack(Buf, InData%totalExctnStates) - call RegPack(Buf, InData%totalRdtnStates) - call RegPack(Buf, allocated(InData%AddF0)) - if (allocated(InData%AddF0)) then - call RegPackBounds(Buf, 2, lbound(InData%AddF0, kind=B8Ki), ubound(InData%AddF0, kind=B8Ki)) - call RegPack(Buf, InData%AddF0) - end if - call RegPack(Buf, allocated(InData%AddCLin)) - if (allocated(InData%AddCLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddCLin, kind=B8Ki), ubound(InData%AddCLin, kind=B8Ki)) - call RegPack(Buf, InData%AddCLin) - end if - call RegPack(Buf, allocated(InData%AddBLin)) - if (allocated(InData%AddBLin)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBLin, kind=B8Ki), ubound(InData%AddBLin, kind=B8Ki)) - call RegPack(Buf, InData%AddBLin) - end if - call RegPack(Buf, allocated(InData%AddBQuad)) - if (allocated(InData%AddBQuad)) then - call RegPackBounds(Buf, 3, lbound(InData%AddBQuad, kind=B8Ki), ubound(InData%AddBQuad, kind=B8Ki)) - call RegPack(Buf, InData%AddBQuad) - end if - call RegPack(Buf, InData%DT) - call RegPack(Buf, allocated(InData%OutParam)) + call RegPack(RF, InData%WAMIT2used) + call Morison_PackParam(RF, InData%Morison) + call RegPack(RF, InData%PotMod) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPack(RF, InData%totalStates) + call RegPack(RF, InData%totalExctnStates) + call RegPack(RF, InData%totalRdtnStates) + call RegPackAlloc(RF, InData%AddF0) + call RegPackAlloc(RF, InData%AddCLin) + call RegPackAlloc(RF, InData%AddBLin) + call RegPackAlloc(RF, InData%AddBQuad) + call RegPack(RF, InData%DT) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%NumTotalOuts) - call RegPack(Buf, InData%OutSwtch) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutSFmt) - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%UnOutFile) - call RegPack(Buf, InData%OutDec) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, allocated(InData%dx)) - if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) - call RegPack(Buf, InData%dx) - end if - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%VisMeshes) - call RegPack(Buf, associated(InData%WaveField)) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumTotalOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UnOutFile) + call RegPack(RF, InData%OutDec) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' integer(B8Ki) :: i1, i2, i3 @@ -2324,207 +1847,88 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%nWAMITObj) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%vecMultiplier) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nWAMITObj); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vecMultiplier); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackParam(Buf, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackParam(RF, OutData%WAMIT(i1)) ! WAMIT end do end if if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT2_UnpackParam(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + call WAMIT2_UnpackParam(RF, OutData%WAMIT2(i1)) ! WAMIT2 end do end if - call RegUnpack(Buf, OutData%WAMIT2used) - if (RegCheckErr(Buf, RoutineName)) return - call Morison_UnpackParam(Buf, OutData%Morison) ! Morison - call RegUnpack(Buf, OutData%PotMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%totalStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%totalExctnStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%totalRdtnStates) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddF0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddF0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddCLin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddBLin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AddBQuad) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%WAMIT2used); if (RegCheckErr(RF, RoutineName)) return + call Morison_UnpackParam(RF, OutData%Morison) ! Morison + call RegUnpack(RF, OutData%PotMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalExctnStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%totalRdtnStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddF0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddCLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AddBQuad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTotalOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutDec) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTotalOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -2570,25 +1974,25 @@ subroutine HydroDyn_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine HydroDyn_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call Morison_PackInput(Buf, InData%Morison) - call MeshPack(Buf, InData%WAMITMesh) - call MeshPack(Buf, InData%PRPMesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call Morison_PackInput(RF, InData%Morison) + call MeshPack(RF, InData%WAMITMesh) + call MeshPack(RF, InData%PRPMesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call Morison_UnpackInput(Buf, OutData%Morison) ! Morison - call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh - call MeshUnpack(Buf, OutData%PRPMesh) ! PRPMesh + if (RF%ErrStat /= ErrID_None) return + call Morison_UnpackInput(RF, OutData%Morison) ! Morison + call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh + call MeshUnpack(RF, OutData%PRPMesh) ! PRPMesh end subroutine subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2694,96 +2098,75 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine HydroDyn_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WAMIT)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT_PackOutput(Buf, InData%WAMIT(i1)) + call WAMIT_PackOutput(RF, InData%WAMIT(i1)) end do end if - call RegPack(Buf, allocated(InData%WAMIT2)) + call RegPack(RF, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then - call RegPackBounds(Buf, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%WAMIT2, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) do i1 = LB(1), UB(1) - call WAMIT2_PackOutput(Buf, InData%WAMIT2(i1)) + call WAMIT2_PackOutput(RF, InData%WAMIT2(i1)) end do end if - call Morison_PackOutput(Buf, InData%Morison) - call MeshPack(Buf, InData%WAMITMesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + call Morison_PackOutput(RF, InData%Morison) + call MeshPack(RF, InData%WAMITMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine HydroDyn_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT_UnpackOutput(Buf, OutData%WAMIT(i1)) ! WAMIT + call WAMIT_UnpackOutput(RF, OutData%WAMIT(i1)) ! WAMIT end do end if if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call WAMIT2_UnpackOutput(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + call WAMIT2_UnpackOutput(RF, OutData%WAMIT2(i1)) ! WAMIT2 end do end if - call Morison_UnpackOutput(Buf, OutData%Morison) ! Morison - call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + call Morison_UnpackOutput(RF, OutData%Morison) ! Morison + call MeshUnpack(RF, OutData%WAMITMesh) ! WAMITMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 024346ed79..d63aaef883 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -460,40 +460,33 @@ subroutine Morison_DestroyJointType(JointTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackJointType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackJointType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_JointType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackJointType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%JointID) - call RegPack(Buf, InData%Position) - call RegPack(Buf, InData%JointAxID) - call RegPack(Buf, InData%JointAxIDIndx) - call RegPack(Buf, InData%JointOvrlp) - call RegPack(Buf, InData%NConnections) - call RegPack(Buf, InData%ConnectionList) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%JointID) + call RegPack(RF, InData%Position) + call RegPack(RF, InData%JointAxID) + call RegPack(RF, InData%JointAxIDIndx) + call RegPack(RF, InData%JointOvrlp) + call RegPack(RF, InData%NConnections) + call RegPack(RF, InData%ConnectionList) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackJointType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackJointType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_JointType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackJointType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%JointID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Position) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JointAxID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JointAxIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JointOvrlp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NConnections) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ConnectionList) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointAxID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointAxIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointOvrlp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConnections); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConnectionList); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMemberPropType(SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg) @@ -519,28 +512,25 @@ subroutine Morison_DestroyMemberPropType(MemberPropTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackMemberPropType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMemberPropType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MemberPropType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberPropType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%PropSetID) - call RegPack(Buf, InData%PropD) - call RegPack(Buf, InData%PropThck) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PropSetID) + call RegPack(RF, InData%PropD) + call RegPack(RF, InData%PropThck) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMemberPropType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMemberPropType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MemberPropType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberPropType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%PropSetID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropThck) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PropSetID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropThck); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg) @@ -584,53 +574,32 @@ subroutine Morison_DestroyFilledGroupType(FilledGroupTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackFilledGroupType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackFilledGroupType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_FilledGroupType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackFilledGroupType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FillNumM) - call RegPack(Buf, allocated(InData%FillMList)) - if (allocated(InData%FillMList)) then - call RegPackBounds(Buf, 1, lbound(InData%FillMList, kind=B8Ki), ubound(InData%FillMList, kind=B8Ki)) - call RegPack(Buf, InData%FillMList) - end if - call RegPack(Buf, InData%FillFSLoc) - call RegPack(Buf, InData%FillDensChr) - call RegPack(Buf, InData%FillDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FillNumM) + call RegPackAlloc(RF, InData%FillMList) + call RegPack(RF, InData%FillFSLoc) + call RegPack(RF, InData%FillDensChr) + call RegPack(RF, InData%FillDens) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackFilledGroupType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackFilledGroupType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_FilledGroupType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FillNumM) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FillMList)) deallocate(OutData%FillMList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FillMList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FillMList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FillFSLoc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FillDensChr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FillDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FillNumM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FillMList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillFSLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDensChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDens); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyCoefDpths(SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg) @@ -669,67 +638,51 @@ subroutine Morison_DestroyCoefDpths(CoefDpthsData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackCoefDpths(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackCoefDpths(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_CoefDpths), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackCoefDpths' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dpth) - call RegPack(Buf, InData%DpthCd) - call RegPack(Buf, InData%DpthCdMG) - call RegPack(Buf, InData%DpthCa) - call RegPack(Buf, InData%DpthCaMG) - call RegPack(Buf, InData%DpthCp) - call RegPack(Buf, InData%DpthCpMG) - call RegPack(Buf, InData%DpthAxCd) - call RegPack(Buf, InData%DpthAxCdMG) - call RegPack(Buf, InData%DpthAxCa) - call RegPack(Buf, InData%DpthAxCaMG) - call RegPack(Buf, InData%DpthAxCp) - call RegPack(Buf, InData%DpthAxCpMG) - call RegPack(Buf, InData%DpthCb) - call RegPack(Buf, InData%DpthCbMg) - call RegPack(Buf, InData%DpthMCF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dpth) + call RegPack(RF, InData%DpthCd) + call RegPack(RF, InData%DpthCdMG) + call RegPack(RF, InData%DpthCa) + call RegPack(RF, InData%DpthCaMG) + call RegPack(RF, InData%DpthCp) + call RegPack(RF, InData%DpthCpMG) + call RegPack(RF, InData%DpthAxCd) + call RegPack(RF, InData%DpthAxCdMG) + call RegPack(RF, InData%DpthAxCa) + call RegPack(RF, InData%DpthAxCaMG) + call RegPack(RF, InData%DpthAxCp) + call RegPack(RF, InData%DpthAxCpMG) + call RegPack(RF, InData%DpthCb) + call RegPack(RF, InData%DpthCbMg) + call RegPack(RF, InData%DpthMCF) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackCoefDpths(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackCoefDpths(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_CoefDpths), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackCoefDpths' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCdMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCaMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCpMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthAxCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthAxCdMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthAxCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthAxCaMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthAxCp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthAxCpMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthCbMg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DpthMCF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthAxCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthCbMg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DpthMCF); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyAxialCoefType(SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg) @@ -759,40 +712,33 @@ subroutine Morison_DestroyAxialCoefType(AxialCoefTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackAxialCoefType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackAxialCoefType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_AxialCoefType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackAxialCoefType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%AxCoefID) - call RegPack(Buf, InData%AxCd) - call RegPack(Buf, InData%AxCa) - call RegPack(Buf, InData%AxCp) - call RegPack(Buf, InData%AxVnCOff) - call RegPack(Buf, InData%AxFDLoFSc) - call RegPack(Buf, InData%AxFDMod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%AxCoefID) + call RegPack(RF, InData%AxCd) + call RegPack(RF, InData%AxCa) + call RegPack(RF, InData%AxCp) + call RegPack(RF, InData%AxVnCOff) + call RegPack(RF, InData%AxFDLoFSc) + call RegPack(RF, InData%AxFDMod) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackAxialCoefType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackAxialCoefType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_AxialCoefType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackAxialCoefType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%AxCoefID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AxCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AxCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AxCp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AxVnCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AxFDLoFSc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AxFDMod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%AxCoefID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxVnCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxFDLoFSc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AxFDMod); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -851,98 +797,62 @@ subroutine Morison_DestroyMemberInputType(MemberInputTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackMemberInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMemberInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MemberInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MemberID) - call RegPack(Buf, allocated(InData%NodeIndx)) - if (allocated(InData%NodeIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeIndx, kind=B8Ki), ubound(InData%NodeIndx, kind=B8Ki)) - call RegPack(Buf, InData%NodeIndx) - end if - call RegPack(Buf, InData%MJointID1) - call RegPack(Buf, InData%MJointID2) - call RegPack(Buf, InData%MJointID1Indx) - call RegPack(Buf, InData%MJointID2Indx) - call RegPack(Buf, InData%MPropSetID1) - call RegPack(Buf, InData%MPropSetID2) - call RegPack(Buf, InData%MPropSetID1Indx) - call RegPack(Buf, InData%MPropSetID2Indx) - call RegPack(Buf, InData%MDivSize) - call RegPack(Buf, InData%MCoefMod) - call RegPack(Buf, InData%MHstLMod) - call RegPack(Buf, InData%MmbrCoefIDIndx) - call RegPack(Buf, InData%MmbrFilledIDIndx) - call RegPack(Buf, InData%PropPot) - call RegPack(Buf, InData%PropMCF) - call RegPack(Buf, InData%NElements) - call RegPack(Buf, InData%RefLength) - call RegPack(Buf, InData%dl) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPackAlloc(RF, InData%NodeIndx) + call RegPack(RF, InData%MJointID1) + call RegPack(RF, InData%MJointID2) + call RegPack(RF, InData%MJointID1Indx) + call RegPack(RF, InData%MJointID2Indx) + call RegPack(RF, InData%MPropSetID1) + call RegPack(RF, InData%MPropSetID2) + call RegPack(RF, InData%MPropSetID1Indx) + call RegPack(RF, InData%MPropSetID2Indx) + call RegPack(RF, InData%MDivSize) + call RegPack(RF, InData%MCoefMod) + call RegPack(RF, InData%MHstLMod) + call RegPack(RF, InData%MmbrCoefIDIndx) + call RegPack(RF, InData%MmbrFilledIDIndx) + call RegPack(RF, InData%PropPot) + call RegPack(RF, InData%PropMCF) + call RegPack(RF, InData%NElements) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%dl) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMemberInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMemberInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MemberInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodeIndx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodeIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MJointID1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MJointID2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MJointID1Indx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MJointID2Indx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MPropSetID1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MPropSetID2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MPropSetID1Indx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MPropSetID2Indx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MDivSize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCoefMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHstLMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MmbrCoefIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MmbrFilledIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropPot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropMCF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NElements) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dl) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID1Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MJointID2Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID1Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MPropSetID2Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDivSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCoefMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHstLMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrCoefIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrFilledIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropPot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NElements); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyNodeType(SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg) @@ -980,64 +890,49 @@ subroutine Morison_DestroyNodeType(NodeTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackNodeType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackNodeType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_NodeType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackNodeType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%JointIndx) - call RegPack(Buf, InData%Position) - call RegPack(Buf, InData%JointOvrlp) - call RegPack(Buf, InData%JointAxIDIndx) - call RegPack(Buf, InData%NConnections) - call RegPack(Buf, InData%ConnectionList) - call RegPack(Buf, InData%JAxCd) - call RegPack(Buf, InData%JAxCa) - call RegPack(Buf, InData%JAxCp) - call RegPack(Buf, InData%JAxVnCOff) - call RegPack(Buf, InData%JAxFDLoFSc) - call RegPack(Buf, InData%JAxFDMod) - call RegPack(Buf, InData%FillDensity) - call RegPack(Buf, InData%tMG) - call RegPack(Buf, InData%MGdensity) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%JointIndx) + call RegPack(RF, InData%Position) + call RegPack(RF, InData%JointOvrlp) + call RegPack(RF, InData%JointAxIDIndx) + call RegPack(RF, InData%NConnections) + call RegPack(RF, InData%ConnectionList) + call RegPack(RF, InData%JAxCd) + call RegPack(RF, InData%JAxCa) + call RegPack(RF, InData%JAxCp) + call RegPack(RF, InData%JAxVnCOff) + call RegPack(RF, InData%JAxFDLoFSc) + call RegPack(RF, InData%JAxFDMod) + call RegPack(RF, InData%FillDensity) + call RegPack(RF, InData%tMG) + call RegPack(RF, InData%MGdensity) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackNodeType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackNodeType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_NodeType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackNodeType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%JointIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Position) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JointOvrlp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JointAxIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NConnections) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ConnectionList) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JAxCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JAxCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JAxCp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JAxVnCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JAxFDLoFSc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JAxFDMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FillDensity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MGdensity) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%JointIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Position); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointOvrlp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointAxIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConnections); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConnectionList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxVnCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxFDLoFSc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JAxFDMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDensity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGdensity); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1692,872 +1587,162 @@ subroutine Morison_DestroyMemberType(MemberTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackMemberType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMemberType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MemberType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%NodeIndx)) - if (allocated(InData%NodeIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeIndx, kind=B8Ki), ubound(InData%NodeIndx, kind=B8Ki)) - call RegPack(Buf, InData%NodeIndx) - end if - call RegPack(Buf, InData%MemberID) - call RegPack(Buf, InData%NElements) - call RegPack(Buf, InData%RefLength) - call RegPack(Buf, InData%cosPhi_ref) - call RegPack(Buf, InData%dl) - call RegPack(Buf, InData%k) - call RegPack(Buf, InData%kkt) - call RegPack(Buf, InData%Ak) - call RegPack(Buf, allocated(InData%R)) - if (allocated(InData%R)) then - call RegPackBounds(Buf, 1, lbound(InData%R, kind=B8Ki), ubound(InData%R, kind=B8Ki)) - call RegPack(Buf, InData%R) - end if - call RegPack(Buf, allocated(InData%RMG)) - if (allocated(InData%RMG)) then - call RegPackBounds(Buf, 1, lbound(InData%RMG, kind=B8Ki), ubound(InData%RMG, kind=B8Ki)) - call RegPack(Buf, InData%RMG) - end if - call RegPack(Buf, allocated(InData%RMGB)) - if (allocated(InData%RMGB)) then - call RegPackBounds(Buf, 1, lbound(InData%RMGB, kind=B8Ki), ubound(InData%RMGB, kind=B8Ki)) - call RegPack(Buf, InData%RMGB) - end if - call RegPack(Buf, allocated(InData%Rin)) - if (allocated(InData%Rin)) then - call RegPackBounds(Buf, 1, lbound(InData%Rin, kind=B8Ki), ubound(InData%Rin, kind=B8Ki)) - call RegPack(Buf, InData%Rin) - end if - call RegPack(Buf, allocated(InData%tMG)) - if (allocated(InData%tMG)) then - call RegPackBounds(Buf, 1, lbound(InData%tMG, kind=B8Ki), ubound(InData%tMG, kind=B8Ki)) - call RegPack(Buf, InData%tMG) - end if - call RegPack(Buf, allocated(InData%MGdensity)) - if (allocated(InData%MGdensity)) then - call RegPackBounds(Buf, 1, lbound(InData%MGdensity, kind=B8Ki), ubound(InData%MGdensity, kind=B8Ki)) - call RegPack(Buf, InData%MGdensity) - end if - call RegPack(Buf, allocated(InData%dRdl_mg)) - if (allocated(InData%dRdl_mg)) then - call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg, kind=B8Ki), ubound(InData%dRdl_mg, kind=B8Ki)) - call RegPack(Buf, InData%dRdl_mg) - end if - call RegPack(Buf, allocated(InData%dRdl_mg_b)) - if (allocated(InData%dRdl_mg_b)) then - call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b, kind=B8Ki), ubound(InData%dRdl_mg_b, kind=B8Ki)) - call RegPack(Buf, InData%dRdl_mg_b) - end if - call RegPack(Buf, allocated(InData%dRdl_in)) - if (allocated(InData%dRdl_in)) then - call RegPackBounds(Buf, 1, lbound(InData%dRdl_in, kind=B8Ki), ubound(InData%dRdl_in, kind=B8Ki)) - call RegPack(Buf, InData%dRdl_in) - end if - call RegPack(Buf, InData%Vinner) - call RegPack(Buf, InData%Vouter) - call RegPack(Buf, InData%Vballast) - call RegPack(Buf, InData%Vsubmerged) - call RegPack(Buf, InData%l_fill) - call RegPack(Buf, InData%h_fill) - call RegPack(Buf, InData%z_overfill) - call RegPack(Buf, InData%h_floor) - call RegPack(Buf, InData%i_floor) - call RegPack(Buf, InData%doEndBuoyancy) - call RegPack(Buf, InData%memfloodstatus) - call RegPack(Buf, allocated(InData%floodstatus)) - if (allocated(InData%floodstatus)) then - call RegPackBounds(Buf, 1, lbound(InData%floodstatus, kind=B8Ki), ubound(InData%floodstatus, kind=B8Ki)) - call RegPack(Buf, InData%floodstatus) - end if - call RegPack(Buf, allocated(InData%alpha)) - if (allocated(InData%alpha)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha, kind=B8Ki), ubound(InData%alpha, kind=B8Ki)) - call RegPack(Buf, InData%alpha) - end if - call RegPack(Buf, allocated(InData%alpha_fb)) - if (allocated(InData%alpha_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha_fb, kind=B8Ki), ubound(InData%alpha_fb, kind=B8Ki)) - call RegPack(Buf, InData%alpha_fb) - end if - call RegPack(Buf, allocated(InData%alpha_fb_star)) - if (allocated(InData%alpha_fb_star)) then - call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star, kind=B8Ki), ubound(InData%alpha_fb_star, kind=B8Ki)) - call RegPack(Buf, InData%alpha_fb_star) - end if - call RegPack(Buf, allocated(InData%Cd)) - if (allocated(InData%Cd)) then - call RegPackBounds(Buf, 1, lbound(InData%Cd, kind=B8Ki), ubound(InData%Cd, kind=B8Ki)) - call RegPack(Buf, InData%Cd) - end if - call RegPack(Buf, allocated(InData%Ca)) - if (allocated(InData%Ca)) then - call RegPackBounds(Buf, 1, lbound(InData%Ca, kind=B8Ki), ubound(InData%Ca, kind=B8Ki)) - call RegPack(Buf, InData%Ca) - end if - call RegPack(Buf, allocated(InData%Cp)) - if (allocated(InData%Cp)) then - call RegPackBounds(Buf, 1, lbound(InData%Cp, kind=B8Ki), ubound(InData%Cp, kind=B8Ki)) - call RegPack(Buf, InData%Cp) - end if - call RegPack(Buf, allocated(InData%AxCd)) - if (allocated(InData%AxCd)) then - call RegPackBounds(Buf, 1, lbound(InData%AxCd, kind=B8Ki), ubound(InData%AxCd, kind=B8Ki)) - call RegPack(Buf, InData%AxCd) - end if - call RegPack(Buf, allocated(InData%AxCa)) - if (allocated(InData%AxCa)) then - call RegPackBounds(Buf, 1, lbound(InData%AxCa, kind=B8Ki), ubound(InData%AxCa, kind=B8Ki)) - call RegPack(Buf, InData%AxCa) - end if - call RegPack(Buf, allocated(InData%AxCp)) - if (allocated(InData%AxCp)) then - call RegPackBounds(Buf, 1, lbound(InData%AxCp, kind=B8Ki), ubound(InData%AxCp, kind=B8Ki)) - call RegPack(Buf, InData%AxCp) - end if - call RegPack(Buf, allocated(InData%Cb)) - if (allocated(InData%Cb)) then - call RegPackBounds(Buf, 1, lbound(InData%Cb, kind=B8Ki), ubound(InData%Cb, kind=B8Ki)) - call RegPack(Buf, InData%Cb) - end if - call RegPack(Buf, allocated(InData%m_fb_l)) - if (allocated(InData%m_fb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%m_fb_l, kind=B8Ki), ubound(InData%m_fb_l, kind=B8Ki)) - call RegPack(Buf, InData%m_fb_l) - end if - call RegPack(Buf, allocated(InData%m_fb_u)) - if (allocated(InData%m_fb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%m_fb_u, kind=B8Ki), ubound(InData%m_fb_u, kind=B8Ki)) - call RegPack(Buf, InData%m_fb_u) - end if - call RegPack(Buf, allocated(InData%h_cfb_l)) - if (allocated(InData%h_cfb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l, kind=B8Ki), ubound(InData%h_cfb_l, kind=B8Ki)) - call RegPack(Buf, InData%h_cfb_l) - end if - call RegPack(Buf, allocated(InData%h_cfb_u)) - if (allocated(InData%h_cfb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u, kind=B8Ki), ubound(InData%h_cfb_u, kind=B8Ki)) - call RegPack(Buf, InData%h_cfb_u) - end if - call RegPack(Buf, allocated(InData%I_lfb_l)) - if (allocated(InData%I_lfb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l, kind=B8Ki), ubound(InData%I_lfb_l, kind=B8Ki)) - call RegPack(Buf, InData%I_lfb_l) - end if - call RegPack(Buf, allocated(InData%I_lfb_u)) - if (allocated(InData%I_lfb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u, kind=B8Ki), ubound(InData%I_lfb_u, kind=B8Ki)) - call RegPack(Buf, InData%I_lfb_u) - end if - call RegPack(Buf, allocated(InData%I_rfb_l)) - if (allocated(InData%I_rfb_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l, kind=B8Ki), ubound(InData%I_rfb_l, kind=B8Ki)) - call RegPack(Buf, InData%I_rfb_l) - end if - call RegPack(Buf, allocated(InData%I_rfb_u)) - if (allocated(InData%I_rfb_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u, kind=B8Ki), ubound(InData%I_rfb_u, kind=B8Ki)) - call RegPack(Buf, InData%I_rfb_u) - end if - call RegPack(Buf, allocated(InData%m_mg_l)) - if (allocated(InData%m_mg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%m_mg_l, kind=B8Ki), ubound(InData%m_mg_l, kind=B8Ki)) - call RegPack(Buf, InData%m_mg_l) - end if - call RegPack(Buf, allocated(InData%m_mg_u)) - if (allocated(InData%m_mg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%m_mg_u, kind=B8Ki), ubound(InData%m_mg_u, kind=B8Ki)) - call RegPack(Buf, InData%m_mg_u) - end if - call RegPack(Buf, allocated(InData%h_cmg_l)) - if (allocated(InData%h_cmg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l, kind=B8Ki), ubound(InData%h_cmg_l, kind=B8Ki)) - call RegPack(Buf, InData%h_cmg_l) - end if - call RegPack(Buf, allocated(InData%h_cmg_u)) - if (allocated(InData%h_cmg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u, kind=B8Ki), ubound(InData%h_cmg_u, kind=B8Ki)) - call RegPack(Buf, InData%h_cmg_u) - end if - call RegPack(Buf, allocated(InData%I_lmg_l)) - if (allocated(InData%I_lmg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l, kind=B8Ki), ubound(InData%I_lmg_l, kind=B8Ki)) - call RegPack(Buf, InData%I_lmg_l) - end if - call RegPack(Buf, allocated(InData%I_lmg_u)) - if (allocated(InData%I_lmg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u, kind=B8Ki), ubound(InData%I_lmg_u, kind=B8Ki)) - call RegPack(Buf, InData%I_lmg_u) - end if - call RegPack(Buf, allocated(InData%I_rmg_l)) - if (allocated(InData%I_rmg_l)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l, kind=B8Ki), ubound(InData%I_rmg_l, kind=B8Ki)) - call RegPack(Buf, InData%I_rmg_l) - end if - call RegPack(Buf, allocated(InData%I_rmg_u)) - if (allocated(InData%I_rmg_u)) then - call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u, kind=B8Ki), ubound(InData%I_rmg_u, kind=B8Ki)) - call RegPack(Buf, InData%I_rmg_u) - end if - call RegPack(Buf, allocated(InData%Cfl_fb)) - if (allocated(InData%Cfl_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb, kind=B8Ki), ubound(InData%Cfl_fb, kind=B8Ki)) - call RegPack(Buf, InData%Cfl_fb) - end if - call RegPack(Buf, allocated(InData%Cfr_fb)) - if (allocated(InData%Cfr_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb, kind=B8Ki), ubound(InData%Cfr_fb, kind=B8Ki)) - call RegPack(Buf, InData%Cfr_fb) - end if - call RegPack(Buf, allocated(InData%CM0_fb)) - if (allocated(InData%CM0_fb)) then - call RegPackBounds(Buf, 1, lbound(InData%CM0_fb, kind=B8Ki), ubound(InData%CM0_fb, kind=B8Ki)) - call RegPack(Buf, InData%CM0_fb) - end if - call RegPack(Buf, InData%MGvolume) - call RegPack(Buf, InData%MDivSize) - call RegPack(Buf, InData%MCoefMod) - call RegPack(Buf, InData%MmbrCoefIDIndx) - call RegPack(Buf, InData%MmbrFilledIDIndx) - call RegPack(Buf, InData%MHstLMod) - call RegPack(Buf, InData%FillFSLoc) - call RegPack(Buf, InData%FillDens) - call RegPack(Buf, InData%PropPot) - call RegPack(Buf, InData%PropMCF) - call RegPack(Buf, InData%Flipped) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%NodeIndx) + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%NElements) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%cosPhi_ref) + call RegPack(RF, InData%dl) + call RegPack(RF, InData%k) + call RegPack(RF, InData%kkt) + call RegPack(RF, InData%Ak) + call RegPackAlloc(RF, InData%R) + call RegPackAlloc(RF, InData%RMG) + call RegPackAlloc(RF, InData%RMGB) + call RegPackAlloc(RF, InData%Rin) + call RegPackAlloc(RF, InData%tMG) + call RegPackAlloc(RF, InData%MGdensity) + call RegPackAlloc(RF, InData%dRdl_mg) + call RegPackAlloc(RF, InData%dRdl_mg_b) + call RegPackAlloc(RF, InData%dRdl_in) + call RegPack(RF, InData%Vinner) + call RegPack(RF, InData%Vouter) + call RegPack(RF, InData%Vballast) + call RegPack(RF, InData%Vsubmerged) + call RegPack(RF, InData%l_fill) + call RegPack(RF, InData%h_fill) + call RegPack(RF, InData%z_overfill) + call RegPack(RF, InData%h_floor) + call RegPack(RF, InData%i_floor) + call RegPack(RF, InData%doEndBuoyancy) + call RegPack(RF, InData%memfloodstatus) + call RegPackAlloc(RF, InData%floodstatus) + call RegPackAlloc(RF, InData%alpha) + call RegPackAlloc(RF, InData%alpha_fb) + call RegPackAlloc(RF, InData%alpha_fb_star) + call RegPackAlloc(RF, InData%Cd) + call RegPackAlloc(RF, InData%Ca) + call RegPackAlloc(RF, InData%Cp) + call RegPackAlloc(RF, InData%AxCd) + call RegPackAlloc(RF, InData%AxCa) + call RegPackAlloc(RF, InData%AxCp) + call RegPackAlloc(RF, InData%Cb) + call RegPackAlloc(RF, InData%m_fb_l) + call RegPackAlloc(RF, InData%m_fb_u) + call RegPackAlloc(RF, InData%h_cfb_l) + call RegPackAlloc(RF, InData%h_cfb_u) + call RegPackAlloc(RF, InData%I_lfb_l) + call RegPackAlloc(RF, InData%I_lfb_u) + call RegPackAlloc(RF, InData%I_rfb_l) + call RegPackAlloc(RF, InData%I_rfb_u) + call RegPackAlloc(RF, InData%m_mg_l) + call RegPackAlloc(RF, InData%m_mg_u) + call RegPackAlloc(RF, InData%h_cmg_l) + call RegPackAlloc(RF, InData%h_cmg_u) + call RegPackAlloc(RF, InData%I_lmg_l) + call RegPackAlloc(RF, InData%I_lmg_u) + call RegPackAlloc(RF, InData%I_rmg_l) + call RegPackAlloc(RF, InData%I_rmg_u) + call RegPackAlloc(RF, InData%Cfl_fb) + call RegPackAlloc(RF, InData%Cfr_fb) + call RegPackAlloc(RF, InData%CM0_fb) + call RegPack(RF, InData%MGvolume) + call RegPack(RF, InData%MDivSize) + call RegPack(RF, InData%MCoefMod) + call RegPack(RF, InData%MmbrCoefIDIndx) + call RegPack(RF, InData%MmbrFilledIDIndx) + call RegPack(RF, InData%MHstLMod) + call RegPack(RF, InData%FillFSLoc) + call RegPack(RF, InData%FillDens) + call RegPack(RF, InData%PropPot) + call RegPack(RF, InData%PropMCF) + call RegPack(RF, InData%Flipped) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMemberType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMemberType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MemberType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodeIndx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodeIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NElements) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%cosPhi_ref) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kkt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ak) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%R)) deallocate(OutData%R) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%R(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%R) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RMG)) deallocate(OutData%RMG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RMG(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RMG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RMGB)) deallocate(OutData%RMGB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RMGB(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMGB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RMGB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Rin)) deallocate(OutData%Rin) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Rin(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Rin) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%tMG)) deallocate(OutData%tMG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%tMG(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%tMG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MGdensity)) deallocate(OutData%MGdensity) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MGdensity(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGdensity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MGdensity) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dRdl_mg)) deallocate(OutData%dRdl_mg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dRdl_mg(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dRdl_mg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dRdl_mg_b)) deallocate(OutData%dRdl_mg_b) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dRdl_mg_b(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg_b.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dRdl_mg_b) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dRdl_in)) deallocate(OutData%dRdl_in) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dRdl_in(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_in.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dRdl_in) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Vinner) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Vouter) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Vballast) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Vsubmerged) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%l_fill) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%h_fill) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%z_overfill) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%h_floor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%i_floor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%doEndBuoyancy) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%memfloodstatus) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%floodstatus)) deallocate(OutData%floodstatus) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%floodstatus(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%floodstatus.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%floodstatus) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha)) deallocate(OutData%alpha) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha_fb)) deallocate(OutData%alpha_fb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_fb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_fb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha_fb_star)) deallocate(OutData%alpha_fb_star) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_fb_star(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb_star.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_fb_star) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cd)) deallocate(OutData%Cd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ca)) deallocate(OutData%Ca) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ca(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ca.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ca) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cp)) deallocate(OutData%Cp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AxCd)) deallocate(OutData%AxCd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxCd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxCd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AxCa)) deallocate(OutData%AxCa) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxCa(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxCa) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AxCp)) deallocate(OutData%AxCp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AxCp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AxCp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cb)) deallocate(OutData%Cb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m_fb_l)) deallocate(OutData%m_fb_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m_fb_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m_fb_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m_fb_u)) deallocate(OutData%m_fb_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m_fb_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m_fb_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%h_cfb_l)) deallocate(OutData%h_cfb_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%h_cfb_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%h_cfb_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%h_cfb_u)) deallocate(OutData%h_cfb_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%h_cfb_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%h_cfb_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_lfb_l)) deallocate(OutData%I_lfb_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_lfb_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_lfb_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_lfb_u)) deallocate(OutData%I_lfb_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_lfb_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_lfb_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_rfb_l)) deallocate(OutData%I_rfb_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_rfb_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_rfb_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_rfb_u)) deallocate(OutData%I_rfb_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_rfb_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_rfb_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m_mg_l)) deallocate(OutData%m_mg_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m_mg_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m_mg_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%m_mg_u)) deallocate(OutData%m_mg_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m_mg_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%m_mg_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%h_cmg_l)) deallocate(OutData%h_cmg_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%h_cmg_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%h_cmg_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%h_cmg_u)) deallocate(OutData%h_cmg_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%h_cmg_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%h_cmg_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_lmg_l)) deallocate(OutData%I_lmg_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_lmg_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_lmg_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_lmg_u)) deallocate(OutData%I_lmg_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_lmg_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_lmg_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_rmg_l)) deallocate(OutData%I_rmg_l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_rmg_l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_rmg_l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%I_rmg_u)) deallocate(OutData%I_rmg_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_rmg_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_rmg_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cfl_fb)) deallocate(OutData%Cfl_fb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cfl_fb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfl_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cfl_fb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cfr_fb)) deallocate(OutData%Cfr_fb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cfr_fb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfr_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cfr_fb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CM0_fb)) deallocate(OutData%CM0_fb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CM0_fb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM0_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CM0_fb) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MGvolume) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MDivSize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCoefMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MmbrCoefIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MmbrFilledIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHstLMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FillFSLoc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FillDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropPot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropMCF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Flipped) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%NodeIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NElements); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cosPhi_ref); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kkt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ak); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%R); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RMGB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Rin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MGdensity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dRdl_mg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dRdl_mg_b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dRdl_in); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vinner); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vouter); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vballast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vsubmerged); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%l_fill); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h_fill); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%z_overfill); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h_floor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%i_floor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%doEndBuoyancy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%memfloodstatus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%floodstatus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_fb_star); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ca); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_fb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_fb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cfb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cfb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lfb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lfb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rfb_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rfb_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_mg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%m_mg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cmg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%h_cmg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lmg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_lmg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rmg_l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_rmg_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cfl_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cfr_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CM0_fb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGvolume); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDivSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCoefMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrCoefIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MmbrFilledIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHstLMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillFSLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FillDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropPot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flipped); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg) @@ -2747,231 +1932,44 @@ subroutine Morison_DestroyMemberLoads(MemberLoadsData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackMemberLoads(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMemberLoads(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MemberLoads), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberLoads' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%F_D)) - if (allocated(InData%F_D)) then - call RegPackBounds(Buf, 2, lbound(InData%F_D, kind=B8Ki), ubound(InData%F_D, kind=B8Ki)) - call RegPack(Buf, InData%F_D) - end if - call RegPack(Buf, allocated(InData%F_I)) - if (allocated(InData%F_I)) then - call RegPackBounds(Buf, 2, lbound(InData%F_I, kind=B8Ki), ubound(InData%F_I, kind=B8Ki)) - call RegPack(Buf, InData%F_I) - end if - call RegPack(Buf, allocated(InData%F_A)) - if (allocated(InData%F_A)) then - call RegPackBounds(Buf, 2, lbound(InData%F_A, kind=B8Ki), ubound(InData%F_A, kind=B8Ki)) - call RegPack(Buf, InData%F_A) - end if - call RegPack(Buf, allocated(InData%F_B)) - if (allocated(InData%F_B)) then - call RegPackBounds(Buf, 2, lbound(InData%F_B, kind=B8Ki), ubound(InData%F_B, kind=B8Ki)) - call RegPack(Buf, InData%F_B) - end if - call RegPack(Buf, allocated(InData%F_BF)) - if (allocated(InData%F_BF)) then - call RegPackBounds(Buf, 2, lbound(InData%F_BF, kind=B8Ki), ubound(InData%F_BF, kind=B8Ki)) - call RegPack(Buf, InData%F_BF) - end if - call RegPack(Buf, allocated(InData%F_If)) - if (allocated(InData%F_If)) then - call RegPackBounds(Buf, 2, lbound(InData%F_If, kind=B8Ki), ubound(InData%F_If, kind=B8Ki)) - call RegPack(Buf, InData%F_If) - end if - call RegPack(Buf, allocated(InData%F_WMG)) - if (allocated(InData%F_WMG)) then - call RegPackBounds(Buf, 2, lbound(InData%F_WMG, kind=B8Ki), ubound(InData%F_WMG, kind=B8Ki)) - call RegPack(Buf, InData%F_WMG) - end if - call RegPack(Buf, allocated(InData%F_IMG)) - if (allocated(InData%F_IMG)) then - call RegPackBounds(Buf, 2, lbound(InData%F_IMG, kind=B8Ki), ubound(InData%F_IMG, kind=B8Ki)) - call RegPack(Buf, InData%F_IMG) - end if - call RegPack(Buf, allocated(InData%FV)) - if (allocated(InData%FV)) then - call RegPackBounds(Buf, 2, lbound(InData%FV, kind=B8Ki), ubound(InData%FV, kind=B8Ki)) - call RegPack(Buf, InData%FV) - end if - call RegPack(Buf, allocated(InData%FA)) - if (allocated(InData%FA)) then - call RegPackBounds(Buf, 2, lbound(InData%FA, kind=B8Ki), ubound(InData%FA, kind=B8Ki)) - call RegPack(Buf, InData%FA) - end if - call RegPack(Buf, allocated(InData%F_DP)) - if (allocated(InData%F_DP)) then - call RegPackBounds(Buf, 2, lbound(InData%F_DP, kind=B8Ki), ubound(InData%F_DP, kind=B8Ki)) - call RegPack(Buf, InData%F_DP) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%F_D) + call RegPackAlloc(RF, InData%F_I) + call RegPackAlloc(RF, InData%F_A) + call RegPackAlloc(RF, InData%F_B) + call RegPackAlloc(RF, InData%F_BF) + call RegPackAlloc(RF, InData%F_If) + call RegPackAlloc(RF, InData%F_WMG) + call RegPackAlloc(RF, InData%F_IMG) + call RegPackAlloc(RF, InData%FV) + call RegPackAlloc(RF, InData%FA) + call RegPackAlloc(RF, InData%F_DP) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMemberLoads(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMemberLoads(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MemberLoads), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%F_D)) deallocate(OutData%F_D) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_D(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_D) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_I)) deallocate(OutData%F_I) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_I(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_I) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_A)) deallocate(OutData%F_A) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_A(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_A) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_B)) deallocate(OutData%F_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_BF)) deallocate(OutData%F_BF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_BF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_BF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_If)) deallocate(OutData%F_If) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_If(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_If.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_If) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_WMG)) deallocate(OutData%F_WMG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_WMG(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_WMG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_IMG)) deallocate(OutData%F_IMG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_IMG(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_IMG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FV)) deallocate(OutData%FV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FV(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FA)) deallocate(OutData%FA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FA(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_DP)) deallocate(OutData%F_DP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_DP(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_DP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_DP) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%F_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_I); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_BF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_If); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_WMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_IMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_DP); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyCoefMembers(SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg) @@ -3024,109 +2022,79 @@ subroutine Morison_DestroyCoefMembers(CoefMembersData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackCoefMembers(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackCoefMembers(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_CoefMembers), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackCoefMembers' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MemberID) - call RegPack(Buf, InData%MemberCd1) - call RegPack(Buf, InData%MemberCd2) - call RegPack(Buf, InData%MemberCdMG1) - call RegPack(Buf, InData%MemberCdMG2) - call RegPack(Buf, InData%MemberCa1) - call RegPack(Buf, InData%MemberCa2) - call RegPack(Buf, InData%MemberCaMG1) - call RegPack(Buf, InData%MemberCaMG2) - call RegPack(Buf, InData%MemberCp1) - call RegPack(Buf, InData%MemberCp2) - call RegPack(Buf, InData%MemberCpMG1) - call RegPack(Buf, InData%MemberCpMG2) - call RegPack(Buf, InData%MemberAxCd1) - call RegPack(Buf, InData%MemberAxCd2) - call RegPack(Buf, InData%MemberAxCdMG1) - call RegPack(Buf, InData%MemberAxCdMG2) - call RegPack(Buf, InData%MemberAxCa1) - call RegPack(Buf, InData%MemberAxCa2) - call RegPack(Buf, InData%MemberAxCaMG1) - call RegPack(Buf, InData%MemberAxCaMG2) - call RegPack(Buf, InData%MemberAxCp1) - call RegPack(Buf, InData%MemberAxCp2) - call RegPack(Buf, InData%MemberAxCpMG1) - call RegPack(Buf, InData%MemberAxCpMG2) - call RegPack(Buf, InData%MemberCb1) - call RegPack(Buf, InData%MemberCb2) - call RegPack(Buf, InData%MemberCbMG1) - call RegPack(Buf, InData%MemberCbMG2) - call RegPack(Buf, InData%MemberMCF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%MemberCd1) + call RegPack(RF, InData%MemberCd2) + call RegPack(RF, InData%MemberCdMG1) + call RegPack(RF, InData%MemberCdMG2) + call RegPack(RF, InData%MemberCa1) + call RegPack(RF, InData%MemberCa2) + call RegPack(RF, InData%MemberCaMG1) + call RegPack(RF, InData%MemberCaMG2) + call RegPack(RF, InData%MemberCp1) + call RegPack(RF, InData%MemberCp2) + call RegPack(RF, InData%MemberCpMG1) + call RegPack(RF, InData%MemberCpMG2) + call RegPack(RF, InData%MemberAxCd1) + call RegPack(RF, InData%MemberAxCd2) + call RegPack(RF, InData%MemberAxCdMG1) + call RegPack(RF, InData%MemberAxCdMG2) + call RegPack(RF, InData%MemberAxCa1) + call RegPack(RF, InData%MemberAxCa2) + call RegPack(RF, InData%MemberAxCaMG1) + call RegPack(RF, InData%MemberAxCaMG2) + call RegPack(RF, InData%MemberAxCp1) + call RegPack(RF, InData%MemberAxCp2) + call RegPack(RF, InData%MemberAxCpMG1) + call RegPack(RF, InData%MemberAxCpMG2) + call RegPack(RF, InData%MemberCb1) + call RegPack(RF, InData%MemberCb2) + call RegPack(RF, InData%MemberCbMG1) + call RegPack(RF, InData%MemberCbMG2) + call RegPack(RF, InData%MemberMCF) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackCoefMembers(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackCoefMembers(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_CoefMembers), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackCoefMembers' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCd1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCd2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCdMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCdMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCa1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCa2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCaMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCaMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCp1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCp2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCpMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCpMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCd1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCd2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCdMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCdMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCa1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCa2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCaMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCaMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCp1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCp2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCpMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberAxCpMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCb1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCb2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCbMG1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberCbMG2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MemberMCF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCd1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCd2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCdMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCdMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCa1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCa2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCaMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCaMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCp2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCpMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCpMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCd1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCd2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCdMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCdMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCa1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCa2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCaMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCaMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCp1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCp2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCpMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberAxCpMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCb1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCb2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCbMG1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberCbMG2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberMCF); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMGDepthsType(SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3152,28 +2120,25 @@ subroutine Morison_DestroyMGDepthsType(MGDepthsTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackMGDepthsType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMGDepthsType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MGDepthsType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMGDepthsType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MGDpth) - call RegPack(Buf, InData%MGThck) - call RegPack(Buf, InData%MGDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MGDpth) + call RegPack(RF, InData%MGThck) + call RegPack(RF, InData%MGDens) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMGDepthsType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMGDepthsType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MGDepthsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMGDepthsType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MGDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MGThck) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MGDens) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MGDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGThck); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGDens); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3291,145 +2256,40 @@ subroutine Morison_DestroyMOutput(MOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackMOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MOutput), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MemberID) - call RegPack(Buf, InData%NOutLoc) - call RegPack(Buf, allocated(InData%NodeLocs)) - if (allocated(InData%NodeLocs)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeLocs, kind=B8Ki), ubound(InData%NodeLocs, kind=B8Ki)) - call RegPack(Buf, InData%NodeLocs) - end if - call RegPack(Buf, InData%MemberIDIndx) - call RegPack(Buf, allocated(InData%MeshIndx1)) - if (allocated(InData%MeshIndx1)) then - call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1, kind=B8Ki), ubound(InData%MeshIndx1, kind=B8Ki)) - call RegPack(Buf, InData%MeshIndx1) - end if - call RegPack(Buf, allocated(InData%MeshIndx2)) - if (allocated(InData%MeshIndx2)) then - call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2, kind=B8Ki), ubound(InData%MeshIndx2, kind=B8Ki)) - call RegPack(Buf, InData%MeshIndx2) - end if - call RegPack(Buf, allocated(InData%MemberIndx1)) - if (allocated(InData%MemberIndx1)) then - call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1, kind=B8Ki), ubound(InData%MemberIndx1, kind=B8Ki)) - call RegPack(Buf, InData%MemberIndx1) - end if - call RegPack(Buf, allocated(InData%MemberIndx2)) - if (allocated(InData%MemberIndx2)) then - call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2, kind=B8Ki), ubound(InData%MemberIndx2, kind=B8Ki)) - call RegPack(Buf, InData%MemberIndx2) - end if - call RegPack(Buf, allocated(InData%s)) - if (allocated(InData%s)) then - call RegPackBounds(Buf, 1, lbound(InData%s, kind=B8Ki), ubound(InData%s, kind=B8Ki)) - call RegPack(Buf, InData%s) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%NOutLoc) + call RegPackAlloc(RF, InData%NodeLocs) + call RegPack(RF, InData%MemberIDIndx) + call RegPackAlloc(RF, InData%MeshIndx1) + call RegPackAlloc(RF, InData%MeshIndx2) + call RegPackAlloc(RF, InData%MemberIndx1) + call RegPackAlloc(RF, InData%MemberIndx2) + call RegPackAlloc(RF, InData%s) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MOutput), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NOutLoc) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NodeLocs)) deallocate(OutData%NodeLocs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodeLocs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodeLocs) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MemberIDIndx) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%MeshIndx1)) deallocate(OutData%MeshIndx1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MeshIndx1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MeshIndx1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MeshIndx2)) deallocate(OutData%MeshIndx2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MeshIndx2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MeshIndx2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MemberIndx1)) deallocate(OutData%MemberIndx1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MemberIndx1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MemberIndx1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MemberIndx2)) deallocate(OutData%MemberIndx2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MemberIndx2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MemberIndx2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%s)) deallocate(OutData%s) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%s(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%s) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeLocs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MemberIDIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeshIndx1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeshIndx2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MemberIndx1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MemberIndx2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%s); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyJOutput(SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3454,25 +2314,23 @@ subroutine Morison_DestroyJOutput(JOutputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackJOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackJOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_JOutput), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackJOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%JointID) - call RegPack(Buf, InData%JointIDIndx) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%JointID) + call RegPack(RF, InData%JointIDIndx) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackJOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackJOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_JOutput), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackJOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%JointID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%JointIDIndx) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%JointIDIndx); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -3829,164 +2687,160 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) nullify(InitInputData%WaveField) end subroutine -subroutine Morison_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInitInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WaveDisp) - call RegPack(Buf, InData%AMMod) - call RegPack(Buf, InData%NJoints) - call RegPack(Buf, InData%NNodes) - call RegPack(Buf, allocated(InData%InpJoints)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WaveDisp) + call RegPack(RF, InData%AMMod) + call RegPack(RF, InData%NJoints) + call RegPack(RF, InData%NNodes) + call RegPack(RF, allocated(InData%InpJoints)) if (allocated(InData%InpJoints)) then - call RegPackBounds(Buf, 1, lbound(InData%InpJoints, kind=B8Ki), ubound(InData%InpJoints, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%InpJoints, kind=B8Ki), ubound(InData%InpJoints, kind=B8Ki)) LB(1:1) = lbound(InData%InpJoints, kind=B8Ki) UB(1:1) = ubound(InData%InpJoints, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackJointType(Buf, InData%InpJoints(i1)) + call Morison_PackJointType(RF, InData%InpJoints(i1)) end do end if - call RegPack(Buf, allocated(InData%Nodes)) + call RegPack(RF, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then - call RegPackBounds(Buf, 1, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) LB(1:1) = lbound(InData%Nodes, kind=B8Ki) UB(1:1) = ubound(InData%Nodes, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackNodeType(Buf, InData%Nodes(i1)) + call Morison_PackNodeType(RF, InData%Nodes(i1)) end do end if - call RegPack(Buf, InData%NAxCoefs) - call RegPack(Buf, allocated(InData%AxialCoefs)) + call RegPack(RF, InData%NAxCoefs) + call RegPack(RF, allocated(InData%AxialCoefs)) if (allocated(InData%AxialCoefs)) then - call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs, kind=B8Ki), ubound(InData%AxialCoefs, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%AxialCoefs, kind=B8Ki), ubound(InData%AxialCoefs, kind=B8Ki)) LB(1:1) = lbound(InData%AxialCoefs, kind=B8Ki) UB(1:1) = ubound(InData%AxialCoefs, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackAxialCoefType(Buf, InData%AxialCoefs(i1)) + call Morison_PackAxialCoefType(RF, InData%AxialCoefs(i1)) end do end if - call RegPack(Buf, InData%NPropSets) - call RegPack(Buf, allocated(InData%MPropSets)) + call RegPack(RF, InData%NPropSets) + call RegPack(RF, allocated(InData%MPropSets)) if (allocated(InData%MPropSets)) then - call RegPackBounds(Buf, 1, lbound(InData%MPropSets, kind=B8Ki), ubound(InData%MPropSets, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MPropSets, kind=B8Ki), ubound(InData%MPropSets, kind=B8Ki)) LB(1:1) = lbound(InData%MPropSets, kind=B8Ki) UB(1:1) = ubound(InData%MPropSets, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMemberPropType(Buf, InData%MPropSets(i1)) + call Morison_PackMemberPropType(RF, InData%MPropSets(i1)) end do end if - call RegPack(Buf, InData%SimplCd) - call RegPack(Buf, InData%SimplCdMG) - call RegPack(Buf, InData%SimplCa) - call RegPack(Buf, InData%SimplCaMG) - call RegPack(Buf, InData%SimplCp) - call RegPack(Buf, InData%SimplCpMG) - call RegPack(Buf, InData%SimplAxCd) - call RegPack(Buf, InData%SimplAxCdMG) - call RegPack(Buf, InData%SimplAxCa) - call RegPack(Buf, InData%SimplAxCaMG) - call RegPack(Buf, InData%SimplAxCp) - call RegPack(Buf, InData%SimplAxCpMG) - call RegPack(Buf, InData%SimplCb) - call RegPack(Buf, InData%SimplCbMg) - call RegPack(Buf, InData%SimplMCF) - call RegPack(Buf, InData%NCoefDpth) - call RegPack(Buf, allocated(InData%CoefDpths)) + call RegPack(RF, InData%SimplCd) + call RegPack(RF, InData%SimplCdMG) + call RegPack(RF, InData%SimplCa) + call RegPack(RF, InData%SimplCaMG) + call RegPack(RF, InData%SimplCp) + call RegPack(RF, InData%SimplCpMG) + call RegPack(RF, InData%SimplAxCd) + call RegPack(RF, InData%SimplAxCdMG) + call RegPack(RF, InData%SimplAxCa) + call RegPack(RF, InData%SimplAxCaMG) + call RegPack(RF, InData%SimplAxCp) + call RegPack(RF, InData%SimplAxCpMG) + call RegPack(RF, InData%SimplCb) + call RegPack(RF, InData%SimplCbMg) + call RegPack(RF, InData%SimplMCF) + call RegPack(RF, InData%NCoefDpth) + call RegPack(RF, allocated(InData%CoefDpths)) if (allocated(InData%CoefDpths)) then - call RegPackBounds(Buf, 1, lbound(InData%CoefDpths, kind=B8Ki), ubound(InData%CoefDpths, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%CoefDpths, kind=B8Ki), ubound(InData%CoefDpths, kind=B8Ki)) LB(1:1) = lbound(InData%CoefDpths, kind=B8Ki) UB(1:1) = ubound(InData%CoefDpths, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackCoefDpths(Buf, InData%CoefDpths(i1)) + call Morison_PackCoefDpths(RF, InData%CoefDpths(i1)) end do end if - call RegPack(Buf, InData%NCoefMembers) - call RegPack(Buf, allocated(InData%CoefMembers)) + call RegPack(RF, InData%NCoefMembers) + call RegPack(RF, allocated(InData%CoefMembers)) if (allocated(InData%CoefMembers)) then - call RegPackBounds(Buf, 1, lbound(InData%CoefMembers, kind=B8Ki), ubound(InData%CoefMembers, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%CoefMembers, kind=B8Ki), ubound(InData%CoefMembers, kind=B8Ki)) LB(1:1) = lbound(InData%CoefMembers, kind=B8Ki) UB(1:1) = ubound(InData%CoefMembers, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackCoefMembers(Buf, InData%CoefMembers(i1)) + call Morison_PackCoefMembers(RF, InData%CoefMembers(i1)) end do end if - call RegPack(Buf, InData%NMembers) - call RegPack(Buf, allocated(InData%InpMembers)) + call RegPack(RF, InData%NMembers) + call RegPack(RF, allocated(InData%InpMembers)) if (allocated(InData%InpMembers)) then - call RegPackBounds(Buf, 1, lbound(InData%InpMembers, kind=B8Ki), ubound(InData%InpMembers, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%InpMembers, kind=B8Ki), ubound(InData%InpMembers, kind=B8Ki)) LB(1:1) = lbound(InData%InpMembers, kind=B8Ki) UB(1:1) = ubound(InData%InpMembers, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMemberInputType(Buf, InData%InpMembers(i1)) + call Morison_PackMemberInputType(RF, InData%InpMembers(i1)) end do end if - call RegPack(Buf, InData%NFillGroups) - call RegPack(Buf, allocated(InData%FilledGroups)) + call RegPack(RF, InData%NFillGroups) + call RegPack(RF, allocated(InData%FilledGroups)) if (allocated(InData%FilledGroups)) then - call RegPackBounds(Buf, 1, lbound(InData%FilledGroups, kind=B8Ki), ubound(InData%FilledGroups, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%FilledGroups, kind=B8Ki), ubound(InData%FilledGroups, kind=B8Ki)) LB(1:1) = lbound(InData%FilledGroups, kind=B8Ki) UB(1:1) = ubound(InData%FilledGroups, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackFilledGroupType(Buf, InData%FilledGroups(i1)) + call Morison_PackFilledGroupType(RF, InData%FilledGroups(i1)) end do end if - call RegPack(Buf, InData%NMGDepths) - call RegPack(Buf, allocated(InData%MGDepths)) + call RegPack(RF, InData%NMGDepths) + call RegPack(RF, allocated(InData%MGDepths)) if (allocated(InData%MGDepths)) then - call RegPackBounds(Buf, 1, lbound(InData%MGDepths, kind=B8Ki), ubound(InData%MGDepths, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MGDepths, kind=B8Ki), ubound(InData%MGDepths, kind=B8Ki)) LB(1:1) = lbound(InData%MGDepths, kind=B8Ki) UB(1:1) = ubound(InData%MGDepths, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMGDepthsType(Buf, InData%MGDepths(i1)) + call Morison_PackMGDepthsType(RF, InData%MGDepths(i1)) end do end if - call RegPack(Buf, InData%MGTop) - call RegPack(Buf, InData%MGBottom) - call RegPack(Buf, InData%NMOutputs) - call RegPack(Buf, allocated(InData%MOutLst)) + call RegPack(RF, InData%MGTop) + call RegPack(RF, InData%MGBottom) + call RegPack(RF, InData%NMOutputs) + call RegPack(RF, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMOutput(Buf, InData%MOutLst(i1)) + call Morison_PackMOutput(RF, InData%MOutLst(i1)) end do end if - call RegPack(Buf, InData%NJOutputs) - call RegPack(Buf, allocated(InData%JOutLst)) + call RegPack(RF, InData%NJOutputs) + call RegPack(RF, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackJOutput(Buf, InData%JOutLst(i1)) + call Morison_PackJOutput(RF, InData%JOutLst(i1)) end do end if - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%UnSum) - call RegPack(Buf, associated(InData%WaveField)) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%UnSum) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call RegPack(Buf, InData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%VisMeshes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' integer(B8Ki) :: i1 @@ -3995,274 +2849,203 @@ subroutine Morison_UnPackInitInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AMMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NJoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NNodes) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AMMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NJoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NNodes); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%InpJoints)) deallocate(OutData%InpJoints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%InpJoints(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackJointType(Buf, OutData%InpJoints(i1)) ! InpJoints + call Morison_UnpackJointType(RF, OutData%InpJoints(i1)) ! InpJoints end do end if if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Nodes(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackNodeType(Buf, OutData%Nodes(i1)) ! Nodes + call Morison_UnpackNodeType(RF, OutData%Nodes(i1)) ! Nodes end do end if - call RegUnpack(Buf, OutData%NAxCoefs) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NAxCoefs); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%AxialCoefs)) deallocate(OutData%AxialCoefs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%AxialCoefs(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackAxialCoefType(Buf, OutData%AxialCoefs(i1)) ! AxialCoefs + call Morison_UnpackAxialCoefType(RF, OutData%AxialCoefs(i1)) ! AxialCoefs end do end if - call RegUnpack(Buf, OutData%NPropSets) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NPropSets); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%MPropSets)) deallocate(OutData%MPropSets) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MPropSets(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMemberPropType(Buf, OutData%MPropSets(i1)) ! MPropSets + call Morison_UnpackMemberPropType(RF, OutData%MPropSets(i1)) ! MPropSets end do end if - call RegUnpack(Buf, OutData%SimplCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCdMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCaMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCpMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplAxCd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplAxCdMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplAxCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplAxCaMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplAxCp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplAxCpMG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplCbMg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimplMCF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NCoefDpth) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%SimplCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCdMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCaMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplAxCpMG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplCbMg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimplMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NCoefDpth); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%CoefDpths)) deallocate(OutData%CoefDpths) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%CoefDpths(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackCoefDpths(Buf, OutData%CoefDpths(i1)) ! CoefDpths + call Morison_UnpackCoefDpths(RF, OutData%CoefDpths(i1)) ! CoefDpths end do end if - call RegUnpack(Buf, OutData%NCoefMembers) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NCoefMembers); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%CoefMembers)) deallocate(OutData%CoefMembers) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%CoefMembers(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackCoefMembers(Buf, OutData%CoefMembers(i1)) ! CoefMembers + call Morison_UnpackCoefMembers(RF, OutData%CoefMembers(i1)) ! CoefMembers end do end if - call RegUnpack(Buf, OutData%NMembers) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NMembers); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%InpMembers)) deallocate(OutData%InpMembers) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%InpMembers(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMemberInputType(Buf, OutData%InpMembers(i1)) ! InpMembers + call Morison_UnpackMemberInputType(RF, OutData%InpMembers(i1)) ! InpMembers end do end if - call RegUnpack(Buf, OutData%NFillGroups) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NFillGroups); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%FilledGroups)) deallocate(OutData%FilledGroups) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%FilledGroups(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackFilledGroupType(Buf, OutData%FilledGroups(i1)) ! FilledGroups + call Morison_UnpackFilledGroupType(RF, OutData%FilledGroups(i1)) ! FilledGroups end do end if - call RegUnpack(Buf, OutData%NMGDepths) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NMGDepths); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%MGDepths)) deallocate(OutData%MGDepths) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MGDepths(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMGDepthsType(Buf, OutData%MGDepths(i1)) ! MGDepths + call Morison_UnpackMGDepthsType(RF, OutData%MGDepths(i1)) ! MGDepths end do end if - call RegUnpack(Buf, OutData%MGTop) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MGBottom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NMOutputs) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%MGTop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MGBottom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMOutputs); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst + call Morison_UnpackMOutput(RF, OutData%MOutLst(i1)) ! MOutLst end do end if - call RegUnpack(Buf, OutData%NJOutputs) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NJOutputs); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst + call Morison_UnpackJOutput(RF, OutData%JOutLst(i1)) ! JOutLst end do end if - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnSum); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() end if - call RegUnpack(Buf, OutData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -4332,79 +3115,28 @@ subroutine Morison_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%MorisonVisRad)) - if (allocated(InData%MorisonVisRad)) then - call RegPackBounds(Buf, 1, lbound(InData%MorisonVisRad, kind=B8Ki), ubound(InData%MorisonVisRad, kind=B8Ki)) - call RegPack(Buf, InData%MorisonVisRad) - end if - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%MorisonVisRad) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%MorisonVisRad)) deallocate(OutData%MorisonVisRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MorisonVisRad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonVisRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MorisonVisRad) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%MorisonVisRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -4428,22 +3160,21 @@ subroutine Morison_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -4483,41 +3214,24 @@ subroutine Morison_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%V_rel_n_FiltStat)) - if (allocated(InData%V_rel_n_FiltStat)) then - call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_FiltStat, kind=B8Ki), ubound(InData%V_rel_n_FiltStat, kind=B8Ki)) - call RegPack(Buf, InData%V_rel_n_FiltStat) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%V_rel_n_FiltStat) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%V_rel_n_FiltStat)) deallocate(OutData%V_rel_n_FiltStat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_rel_n_FiltStat(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_FiltStat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_rel_n_FiltStat) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%V_rel_n_FiltStat); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -4541,22 +3255,21 @@ subroutine Morison_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -4580,22 +3293,21 @@ subroutine Morison_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Morison_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -4946,414 +3658,89 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine Morison_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%DispNodePosHdn)) - if (allocated(InData%DispNodePosHdn)) then - call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHdn, kind=B8Ki), ubound(InData%DispNodePosHdn, kind=B8Ki)) - call RegPack(Buf, InData%DispNodePosHdn) - end if - call RegPack(Buf, allocated(InData%DispNodePosHst)) - if (allocated(InData%DispNodePosHst)) then - call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHst, kind=B8Ki), ubound(InData%DispNodePosHst, kind=B8Ki)) - call RegPack(Buf, InData%DispNodePosHst) - end if - call RegPack(Buf, allocated(InData%FV)) - if (allocated(InData%FV)) then - call RegPackBounds(Buf, 2, lbound(InData%FV, kind=B8Ki), ubound(InData%FV, kind=B8Ki)) - call RegPack(Buf, InData%FV) - end if - call RegPack(Buf, allocated(InData%FA)) - if (allocated(InData%FA)) then - call RegPackBounds(Buf, 2, lbound(InData%FA, kind=B8Ki), ubound(InData%FA, kind=B8Ki)) - call RegPack(Buf, InData%FA) - end if - call RegPack(Buf, allocated(InData%FAMCF)) - if (allocated(InData%FAMCF)) then - call RegPackBounds(Buf, 2, lbound(InData%FAMCF, kind=B8Ki), ubound(InData%FAMCF, kind=B8Ki)) - call RegPack(Buf, InData%FAMCF) - end if - call RegPack(Buf, allocated(InData%FDynP)) - if (allocated(InData%FDynP)) then - call RegPackBounds(Buf, 1, lbound(InData%FDynP, kind=B8Ki), ubound(InData%FDynP, kind=B8Ki)) - call RegPack(Buf, InData%FDynP) - end if - call RegPack(Buf, allocated(InData%WaveElev)) - if (allocated(InData%WaveElev)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev, kind=B8Ki), ubound(InData%WaveElev, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev) - end if - call RegPack(Buf, allocated(InData%WaveElev1)) - if (allocated(InData%WaveElev1)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev1, kind=B8Ki), ubound(InData%WaveElev1, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev1) - end if - call RegPack(Buf, allocated(InData%WaveElev2)) - if (allocated(InData%WaveElev2)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev2, kind=B8Ki), ubound(InData%WaveElev2, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev2) - end if - call RegPack(Buf, allocated(InData%vrel)) - if (allocated(InData%vrel)) then - call RegPackBounds(Buf, 2, lbound(InData%vrel, kind=B8Ki), ubound(InData%vrel, kind=B8Ki)) - call RegPack(Buf, InData%vrel) - end if - call RegPack(Buf, allocated(InData%nodeInWater)) - if (allocated(InData%nodeInWater)) then - call RegPackBounds(Buf, 1, lbound(InData%nodeInWater, kind=B8Ki), ubound(InData%nodeInWater, kind=B8Ki)) - call RegPack(Buf, InData%nodeInWater) - end if - call RegPack(Buf, allocated(InData%memberLoads)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%DispNodePosHdn) + call RegPackAlloc(RF, InData%DispNodePosHst) + call RegPackAlloc(RF, InData%FV) + call RegPackAlloc(RF, InData%FA) + call RegPackAlloc(RF, InData%FAMCF) + call RegPackAlloc(RF, InData%FDynP) + call RegPackAlloc(RF, InData%WaveElev) + call RegPackAlloc(RF, InData%WaveElev1) + call RegPackAlloc(RF, InData%WaveElev2) + call RegPackAlloc(RF, InData%vrel) + call RegPackAlloc(RF, InData%nodeInWater) + call RegPack(RF, allocated(InData%memberLoads)) if (allocated(InData%memberLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%memberLoads, kind=B8Ki), ubound(InData%memberLoads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%memberLoads, kind=B8Ki), ubound(InData%memberLoads, kind=B8Ki)) LB(1:1) = lbound(InData%memberLoads, kind=B8Ki) UB(1:1) = ubound(InData%memberLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMemberLoads(Buf, InData%memberLoads(i1)) + call Morison_PackMemberLoads(RF, InData%memberLoads(i1)) end do end if - call RegPack(Buf, allocated(InData%F_B_End)) - if (allocated(InData%F_B_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_B_End, kind=B8Ki), ubound(InData%F_B_End, kind=B8Ki)) - call RegPack(Buf, InData%F_B_End) - end if - call RegPack(Buf, allocated(InData%F_D_End)) - if (allocated(InData%F_D_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_D_End, kind=B8Ki), ubound(InData%F_D_End, kind=B8Ki)) - call RegPack(Buf, InData%F_D_End) - end if - call RegPack(Buf, allocated(InData%F_I_End)) - if (allocated(InData%F_I_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_I_End, kind=B8Ki), ubound(InData%F_I_End, kind=B8Ki)) - call RegPack(Buf, InData%F_I_End) - end if - call RegPack(Buf, allocated(InData%F_IMG_End)) - if (allocated(InData%F_IMG_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End, kind=B8Ki), ubound(InData%F_IMG_End, kind=B8Ki)) - call RegPack(Buf, InData%F_IMG_End) - end if - call RegPack(Buf, allocated(InData%F_A_End)) - if (allocated(InData%F_A_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_A_End, kind=B8Ki), ubound(InData%F_A_End, kind=B8Ki)) - call RegPack(Buf, InData%F_A_End) - end if - call RegPack(Buf, allocated(InData%F_BF_End)) - if (allocated(InData%F_BF_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_BF_End, kind=B8Ki), ubound(InData%F_BF_End, kind=B8Ki)) - call RegPack(Buf, InData%F_BF_End) - end if - call RegPack(Buf, allocated(InData%V_rel_n)) - if (allocated(InData%V_rel_n)) then - call RegPackBounds(Buf, 1, lbound(InData%V_rel_n, kind=B8Ki), ubound(InData%V_rel_n, kind=B8Ki)) - call RegPack(Buf, InData%V_rel_n) - end if - call RegPack(Buf, allocated(InData%V_rel_n_HiPass)) - if (allocated(InData%V_rel_n_HiPass)) then - call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass, kind=B8Ki), ubound(InData%V_rel_n_HiPass, kind=B8Ki)) - call RegPack(Buf, InData%V_rel_n_HiPass) - end if - call NWTC_Library_PackMeshMapType(Buf, InData%VisMeshMap) - call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%F_B_End) + call RegPackAlloc(RF, InData%F_D_End) + call RegPackAlloc(RF, InData%F_I_End) + call RegPackAlloc(RF, InData%F_IMG_End) + call RegPackAlloc(RF, InData%F_A_End) + call RegPackAlloc(RF, InData%F_BF_End) + call RegPackAlloc(RF, InData%V_rel_n) + call RegPackAlloc(RF, InData%V_rel_n_HiPass) + call NWTC_Library_PackMeshMapType(RF, InData%VisMeshMap) + call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%DispNodePosHdn)) deallocate(OutData%DispNodePosHdn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHdn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DispNodePosHdn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DispNodePosHst)) deallocate(OutData%DispNodePosHst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DispNodePosHst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FV)) deallocate(OutData%FV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FV(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FA)) deallocate(OutData%FA) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FA(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FA) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FAMCF)) deallocate(OutData%FAMCF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FAMCF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FAMCF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FDynP)) deallocate(OutData%FDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FDynP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vrel)) deallocate(OutData%vrel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vrel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%nodeInWater)) deallocate(OutData%nodeInWater) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%nodeInWater(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%nodeInWater) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%DispNodePosHdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DispNodePosHst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FAMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FDynP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vrel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nodeInWater); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%memberLoads)) deallocate(OutData%memberLoads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%memberLoads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMemberLoads(Buf, OutData%memberLoads(i1)) ! memberLoads + call Morison_UnpackMemberLoads(RF, OutData%memberLoads(i1)) ! memberLoads end do end if - if (allocated(OutData%F_B_End)) deallocate(OutData%F_B_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_B_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_B_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_D_End)) deallocate(OutData%F_D_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_D_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_D_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_I_End)) deallocate(OutData%F_I_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_I_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_I_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_IMG_End)) deallocate(OutData%F_IMG_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_IMG_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_A_End)) deallocate(OutData%F_A_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_A_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_A_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_BF_End)) deallocate(OutData%F_BF_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_BF_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_BF_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%V_rel_n)) deallocate(OutData%V_rel_n) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_rel_n(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_rel_n) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%V_rel_n_HiPass)) deallocate(OutData%V_rel_n_HiPass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_rel_n_HiPass(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_HiPass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_rel_n_HiPass) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%VisMeshMap) ! VisMeshMap - call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call RegUnpackAlloc(RF, OutData%F_B_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_D_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_I_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_IMG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_A_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_BF_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_rel_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_rel_n_HiPass); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapType(RF, OutData%VisMeshMap) ! VisMeshMap + call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -5647,123 +4034,83 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveField) end subroutine -subroutine Morison_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%WaveDisp) - call RegPack(Buf, InData%AMMod) - call RegPack(Buf, InData%NMembers) - call RegPack(Buf, allocated(InData%Members)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%WaveDisp) + call RegPack(RF, InData%AMMod) + call RegPack(RF, InData%NMembers) + call RegPack(RF, allocated(InData%Members)) if (allocated(InData%Members)) then - call RegPackBounds(Buf, 1, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) LB(1:1) = lbound(InData%Members, kind=B8Ki) UB(1:1) = ubound(InData%Members, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMemberType(Buf, InData%Members(i1)) + call Morison_PackMemberType(RF, InData%Members(i1)) end do end if - call RegPack(Buf, InData%NNodes) - call RegPack(Buf, InData%NJoints) - call RegPack(Buf, allocated(InData%I_MG_End)) - if (allocated(InData%I_MG_End)) then - call RegPackBounds(Buf, 3, lbound(InData%I_MG_End, kind=B8Ki), ubound(InData%I_MG_End, kind=B8Ki)) - call RegPack(Buf, InData%I_MG_End) - end if - call RegPack(Buf, allocated(InData%An_End)) - if (allocated(InData%An_End)) then - call RegPackBounds(Buf, 2, lbound(InData%An_End, kind=B8Ki), ubound(InData%An_End, kind=B8Ki)) - call RegPack(Buf, InData%An_End) - end if - call RegPack(Buf, allocated(InData%DragConst_End)) - if (allocated(InData%DragConst_End)) then - call RegPackBounds(Buf, 1, lbound(InData%DragConst_End, kind=B8Ki), ubound(InData%DragConst_End, kind=B8Ki)) - call RegPack(Buf, InData%DragConst_End) - end if - call RegPack(Buf, allocated(InData%VRelNFiltConst)) - if (allocated(InData%VRelNFiltConst)) then - call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst, kind=B8Ki), ubound(InData%VRelNFiltConst, kind=B8Ki)) - call RegPack(Buf, InData%VRelNFiltConst) - end if - call RegPack(Buf, allocated(InData%DragMod_End)) - if (allocated(InData%DragMod_End)) then - call RegPackBounds(Buf, 1, lbound(InData%DragMod_End, kind=B8Ki), ubound(InData%DragMod_End, kind=B8Ki)) - call RegPack(Buf, InData%DragMod_End) - end if - call RegPack(Buf, allocated(InData%DragLoFSc_End)) - if (allocated(InData%DragLoFSc_End)) then - call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End, kind=B8Ki), ubound(InData%DragLoFSc_End, kind=B8Ki)) - call RegPack(Buf, InData%DragLoFSc_End) - end if - call RegPack(Buf, allocated(InData%F_WMG_End)) - if (allocated(InData%F_WMG_End)) then - call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End, kind=B8Ki), ubound(InData%F_WMG_End, kind=B8Ki)) - call RegPack(Buf, InData%F_WMG_End) - end if - call RegPack(Buf, allocated(InData%DP_Const_End)) - if (allocated(InData%DP_Const_End)) then - call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End, kind=B8Ki), ubound(InData%DP_Const_End, kind=B8Ki)) - call RegPack(Buf, InData%DP_Const_End) - end if - call RegPack(Buf, allocated(InData%Mass_MG_End)) - if (allocated(InData%Mass_MG_End)) then - call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End, kind=B8Ki), ubound(InData%Mass_MG_End, kind=B8Ki)) - call RegPack(Buf, InData%Mass_MG_End) - end if - call RegPack(Buf, allocated(InData%AM_End)) - if (allocated(InData%AM_End)) then - call RegPackBounds(Buf, 3, lbound(InData%AM_End, kind=B8Ki), ubound(InData%AM_End, kind=B8Ki)) - call RegPack(Buf, InData%AM_End) - end if - call RegPack(Buf, InData%NMOutputs) - call RegPack(Buf, allocated(InData%MOutLst)) + call RegPack(RF, InData%NNodes) + call RegPack(RF, InData%NJoints) + call RegPackAlloc(RF, InData%I_MG_End) + call RegPackAlloc(RF, InData%An_End) + call RegPackAlloc(RF, InData%DragConst_End) + call RegPackAlloc(RF, InData%VRelNFiltConst) + call RegPackAlloc(RF, InData%DragMod_End) + call RegPackAlloc(RF, InData%DragLoFSc_End) + call RegPackAlloc(RF, InData%F_WMG_End) + call RegPackAlloc(RF, InData%DP_Const_End) + call RegPackAlloc(RF, InData%Mass_MG_End) + call RegPackAlloc(RF, InData%AM_End) + call RegPack(RF, InData%NMOutputs) + call RegPack(RF, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackMOutput(Buf, InData%MOutLst(i1)) + call Morison_PackMOutput(RF, InData%MOutLst(i1)) end do end if - call RegPack(Buf, InData%NJOutputs) - call RegPack(Buf, allocated(InData%JOutLst)) + call RegPack(RF, InData%NJOutputs) + call RegPack(RF, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) do i1 = LB(1), UB(1) - call Morison_PackJOutput(Buf, InData%JOutLst(i1)) + call Morison_PackJOutput(RF, InData%JOutLst(i1)) end do end if - call RegPack(Buf, allocated(InData%OutParam)) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, associated(InData%WaveField)) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call RegPack(Buf, InData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%VisMeshes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackParam' integer(B8Ki) :: i1, i2, i3 @@ -5772,249 +4119,98 @@ subroutine Morison_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AMMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NMembers) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AMMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMembers); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%Members)) deallocate(OutData%Members) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Members(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMemberType(Buf, OutData%Members(i1)) ! Members + call Morison_UnpackMemberType(RF, OutData%Members(i1)) ! Members end do end if - call RegUnpack(Buf, OutData%NNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NJoints) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%I_MG_End)) deallocate(OutData%I_MG_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_MG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%I_MG_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%An_End)) deallocate(OutData%An_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%An_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%An_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%An_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DragConst_End)) deallocate(OutData%DragConst_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DragConst_End(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragConst_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DragConst_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VRelNFiltConst)) deallocate(OutData%VRelNFiltConst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VRelNFiltConst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRelNFiltConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VRelNFiltConst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DragMod_End)) deallocate(OutData%DragMod_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DragMod_End(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragMod_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DragMod_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DragLoFSc_End)) deallocate(OutData%DragLoFSc_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DragLoFSc_End(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragLoFSc_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DragLoFSc_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_WMG_End)) deallocate(OutData%F_WMG_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_WMG_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DP_Const_End)) deallocate(OutData%DP_Const_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP_Const_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DP_Const_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Mass_MG_End)) deallocate(OutData%Mass_MG_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Mass_MG_End(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass_MG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Mass_MG_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AM_End)) deallocate(OutData%AM_End) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AM_End) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NMOutputs) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NJoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%I_MG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%An_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DragConst_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VRelNFiltConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DragMod_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DragLoFSc_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_WMG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DP_Const_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Mass_MG_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AM_End); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMOutputs); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst + call Morison_UnpackMOutput(RF, OutData%MOutLst(i1)) ! MOutLst end do end if - call RegUnpack(Buf, OutData%NJOutputs) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NJOutputs); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst + call Morison_UnpackJOutput(RF, OutData%JOutLst(i1)) ! JOutLst end do end if if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() end if - call RegUnpack(Buf, OutData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -6046,21 +4242,21 @@ subroutine Morison_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine Morison_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%Mesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%Mesh) ! Mesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh end subroutine subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -6113,45 +4309,28 @@ subroutine Morison_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Morison_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Morison_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%Mesh) - call MeshPack(Buf, InData%VisMesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + call MeshPack(RF, InData%VisMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Morison_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Morison_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Morison_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%Mesh) ! Mesh - call MeshUnpack(Buf, OutData%VisMesh) ! VisMesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh + call MeshUnpack(RF, OutData%VisMesh) ! VisMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Morison_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index ba09d27160..08bfc7e05f 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -149,32 +149,28 @@ subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) nullify(InitInputData%WaveField) end subroutine -subroutine SS_Exc_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackInitInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, allocated(InData%PtfmRefztRot)) - if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefztRot) - end if - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%ExctnDisp) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) @@ -182,43 +178,25 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefztRot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -277,60 +255,26 @@ subroutine SS_Exc_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Exc_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -370,41 +314,24 @@ subroutine SS_Exc_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Exc_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%x)) - if (allocated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - call RegPack(Buf, InData%x) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%x) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Exc_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -428,22 +355,21 @@ subroutine SS_Exc_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SS_Exc_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Exc_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -467,22 +393,21 @@ subroutine SS_Exc_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SS_Exc_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -527,35 +452,34 @@ subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end do end subroutine -subroutine SS_Exc_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call SS_Exc_PackContState(Buf, InData%xdot(i1)) + call SS_Exc_PackContState(RF, InData%xdot(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%xdot, kind=B8Ki) UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call SS_Exc_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call SS_Exc_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do end subroutine @@ -589,24 +513,23 @@ subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SS_Exc_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%LastIndWave) - call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastIndWave) + call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -701,49 +624,33 @@ subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveField) end subroutine -subroutine SS_Exc_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackParam' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, allocated(InData%spDOF)) - if (allocated(InData%spDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%spDOF, kind=B8Ki), ubound(InData%spDOF, kind=B8Ki)) - call RegPack(Buf, InData%spDOF) - end if - call RegPack(Buf, allocated(InData%A)) - if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) - call RegPack(Buf, InData%A) - end if - call RegPack(Buf, allocated(InData%B)) - if (allocated(InData%B)) then - call RegPackBounds(Buf, 1, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) - call RegPack(Buf, InData%B) - end if - call RegPack(Buf, allocated(InData%C)) - if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) - call RegPack(Buf, InData%C) - end if - call RegPack(Buf, InData%numStates) - call RegPack(Buf, InData%Tc) - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%ExctnDisp) + call RegPackAlloc(RF, InData%spDOF) + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%C) + call RegPack(RF, InData%numStates) + call RegPack(RF, InData%Tc) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' integer(B8Ki) :: LB(2), UB(2) @@ -751,89 +658,30 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%spDOF)) deallocate(OutData%spDOF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%spDOF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%spDOF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%A)) deallocate(OutData%A) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%A) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%B)) deallocate(OutData%B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%B(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C)) deallocate(OutData%C) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numStates) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%spDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tc); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -877,41 +725,24 @@ subroutine SS_Exc_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Exc_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%PtfmPos)) - if (allocated(InData%PtfmPos)) then - call RegPackBounds(Buf, 2, lbound(InData%PtfmPos, kind=B8Ki), ubound(InData%PtfmPos, kind=B8Ki)) - call RegPack(Buf, InData%PtfmPos) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%PtfmPos) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%PtfmPos)) deallocate(OutData%PtfmPos) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmPos) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%PtfmPos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -966,60 +797,26 @@ subroutine SS_Exc_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Exc_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Exc_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPack(Buf, InData%y) - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Exc_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Exc_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Exc_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Exc_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 1c07721d8a..1c91b852e4 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -151,66 +151,30 @@ subroutine SS_Rad_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Rad_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, allocated(InData%enabledDOFs)) - if (allocated(InData%enabledDOFs)) then - call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs, kind=B8Ki), ubound(InData%enabledDOFs, kind=B8Ki)) - call RegPack(Buf, InData%enabledDOFs) - end if - call RegPack(Buf, InData%NBody) - call RegPack(Buf, allocated(InData%PtfmRefztRot)) - if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefztRot) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPackAlloc(RF, InData%enabledDOFs) + call RegPack(RF, InData%NBody) + call RegPackAlloc(RF, InData%PtfmRefztRot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%enabledDOFs)) deallocate(OutData%enabledDOFs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%enabledDOFs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%enabledDOFs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%enabledDOFs) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefztRot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%enabledDOFs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -265,60 +229,26 @@ subroutine SS_Rad_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Rad_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -358,41 +288,24 @@ subroutine SS_Rad_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Rad_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%x)) - if (allocated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - call RegPack(Buf, InData%x) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%x) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -416,22 +329,21 @@ subroutine SS_Rad_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SS_Rad_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -455,22 +367,21 @@ subroutine SS_Rad_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SS_Rad_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -515,35 +426,34 @@ subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end do end subroutine -subroutine SS_Rad_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call SS_Rad_PackContState(Buf, InData%xdot(i1)) + call SS_Rad_PackContState(RF, InData%xdot(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%xdot, kind=B8Ki) UB(1:1) = ubound(OutData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call SS_Rad_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call SS_Rad_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do end subroutine @@ -568,22 +478,21 @@ subroutine SS_Rad_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SS_Rad_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -671,107 +580,36 @@ subroutine SS_Rad_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Rad_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, allocated(InData%A)) - if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) - call RegPack(Buf, InData%A) - end if - call RegPack(Buf, allocated(InData%B)) - if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) - call RegPack(Buf, InData%B) - end if - call RegPack(Buf, allocated(InData%C)) - if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) - call RegPack(Buf, InData%C) - end if - call RegPack(Buf, InData%numStates) - call RegPack(Buf, allocated(InData%spdof)) - if (allocated(InData%spdof)) then - call RegPackBounds(Buf, 1, lbound(InData%spdof, kind=B8Ki), ubound(InData%spdof, kind=B8Ki)) - call RegPack(Buf, InData%spdof) - end if - call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%C) + call RegPack(RF, InData%numStates) + call RegPackAlloc(RF, InData%spdof) + call RegPack(RF, InData%NBody) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%A)) deallocate(OutData%A) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%A) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%B)) deallocate(OutData%B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C)) deallocate(OutData%C) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numStates) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%spdof)) deallocate(OutData%spdof) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%spdof(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spdof.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%spdof) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numStates); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%spdof); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -811,41 +649,24 @@ subroutine SS_Rad_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Rad_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%dq)) - if (allocated(InData%dq)) then - call RegPackBounds(Buf, 1, lbound(InData%dq, kind=B8Ki), ubound(InData%dq, kind=B8Ki)) - call RegPack(Buf, InData%dq) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%dq) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%dq)) deallocate(OutData%dq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dq(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dq) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%dq); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -900,60 +721,26 @@ subroutine SS_Rad_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SS_Rad_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SS_Rad_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPack(Buf, InData%y) - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SS_Rad_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SS_Rad_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SS_Rad_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SS_Rad_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 3a25ad9a6b..c2b6e5baeb 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -187,58 +187,42 @@ subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) nullify(InitInputData%WaveField) end subroutine -subroutine WAMIT2_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT2_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackInitInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%HasWAMIT) - call RegPack(Buf, InData%WAMITFile) - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%NBodyMod) - call RegPack(Buf, allocated(InData%PtfmRefxt)) - if (allocated(InData%PtfmRefxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt, kind=B8Ki), ubound(InData%PtfmRefxt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefxt) - end if - call RegPack(Buf, allocated(InData%PtfmRefyt)) - if (allocated(InData%PtfmRefyt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt, kind=B8Ki), ubound(InData%PtfmRefyt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefyt) - end if - call RegPack(Buf, allocated(InData%PtfmRefzt)) - if (allocated(InData%PtfmRefzt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt, kind=B8Ki), ubound(InData%PtfmRefzt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefzt) - end if - call RegPack(Buf, allocated(InData%PtfmRefztRot)) - if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefztRot) - end if - call RegPack(Buf, InData%WAMITULEN) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HasWAMIT) + call RegPack(RF, InData%WAMITFile) + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%PtfmRefxt) + call RegPackAlloc(RF, InData%PtfmRefyt) + call RegPackAlloc(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPack(RF, InData%WAMITULEN) + call RegPack(RF, InData%Gravity) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - call RegPack(Buf, InData%MnDrift) - call RegPack(Buf, InData%NewmanApp) - call RegPack(Buf, InData%DiffQTF) - call RegPack(Buf, InData%SumQTF) - call RegPack(Buf, InData%MnDriftF) - call RegPack(Buf, InData%NewmanAppF) - call RegPack(Buf, InData%DiffQTFF) - call RegPack(Buf, InData%SumQTFF) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%MnDrift) + call RegPack(RF, InData%NewmanApp) + call RegPack(RF, InData%DiffQTF) + call RegPack(RF, InData%SumQTF) + call RegPack(RF, InData%MnDriftF) + call RegPack(RF, InData%NewmanAppF) + call RegPack(RF, InData%DiffQTFF) + call RegPack(RF, InData%SumQTFF) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT2_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) @@ -246,111 +230,43 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%HasWAMIT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAMITFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefxt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefyt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefztRot) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WAMITULEN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HasWAMIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITULEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() end if - call RegUnpack(Buf, OutData%MnDrift) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NewmanApp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DiffQTF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumQTF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MnDriftF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NewmanAppF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumQTFF) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%MnDrift); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanApp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MnDriftF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanAppF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTFF); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -405,60 +321,26 @@ subroutine WAMIT2_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine WAMIT2_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT2_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%LastIndWave)) - if (allocated(InData%LastIndWave)) then - call RegPackBounds(Buf, 1, lbound(InData%LastIndWave, kind=B8Ki), ubound(InData%LastIndWave, kind=B8Ki)) - call RegPack(Buf, InData%LastIndWave) - end if - call RegPack(Buf, allocated(InData%F_Waves2)) - if (allocated(InData%F_Waves2)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Waves2, kind=B8Ki), ubound(InData%F_Waves2, kind=B8Ki)) - call RegPack(Buf, InData%F_Waves2) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LastIndWave) + call RegPackAlloc(RF, InData%F_Waves2) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT2_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT2_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%LastIndWave)) deallocate(OutData%LastIndWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LastIndWave(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LastIndWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_Waves2)) deallocate(OutData%F_Waves2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_Waves2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_Waves2) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves2); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -508,71 +390,44 @@ subroutine WAMIT2_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine WAMIT2_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT2_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%NBodyMod) - call RegPack(Buf, allocated(InData%WaveExctn2)) - if (allocated(InData%WaveExctn2)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2, kind=B8Ki), ubound(InData%WaveExctn2, kind=B8Ki)) - call RegPack(Buf, InData%WaveExctn2) - end if - call RegPack(Buf, InData%MnDriftDims) - call RegPack(Buf, InData%NewmanAppDims) - call RegPack(Buf, InData%DiffQTFDims) - call RegPack(Buf, InData%SumQTFDims) - call RegPack(Buf, InData%MnDriftF) - call RegPack(Buf, InData%NewmanAppF) - call RegPack(Buf, InData%DiffQTFF) - call RegPack(Buf, InData%SumQTFF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%WaveExctn2) + call RegPack(RF, InData%MnDriftDims) + call RegPack(RF, InData%NewmanAppDims) + call RegPack(RF, InData%DiffQTFDims) + call RegPack(RF, InData%SumQTFDims) + call RegPack(RF, InData%MnDriftF) + call RegPack(RF, InData%NewmanAppF) + call RegPack(RF, InData%DiffQTFF) + call RegPack(RF, InData%SumQTFF) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT2_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT2_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveExctn2)) deallocate(OutData%WaveExctn2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveExctn2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveExctn2) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%MnDriftDims) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NewmanAppDims) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DiffQTFDims) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumQTFDims) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MnDriftF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NewmanAppF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumQTFF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveExctn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MnDriftDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanAppDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTFDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTFDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MnDriftF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NewmanAppF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiffQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumQTFF); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WAMIT2_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -604,21 +459,21 @@ subroutine WAMIT2_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT2_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT2_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%Mesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT2_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT2_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT2_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackOutput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%Mesh) ! Mesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh end subroutine subroutine WAMIT2_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index d801d3ad76..0c82e5c2d8 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -289,71 +289,43 @@ subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) nullify(InitInputData%WaveField) end subroutine -subroutine WAMIT_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackInitInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%NBodyMod) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, allocated(InData%PtfmVol0)) - if (allocated(InData%PtfmVol0)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0, kind=B8Ki), ubound(InData%PtfmVol0, kind=B8Ki)) - call RegPack(Buf, InData%PtfmVol0) - end if - call RegPack(Buf, InData%HasWAMIT) - call RegPack(Buf, InData%WAMITULEN) - call RegPack(Buf, allocated(InData%PtfmRefxt)) - if (allocated(InData%PtfmRefxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt, kind=B8Ki), ubound(InData%PtfmRefxt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefxt) - end if - call RegPack(Buf, allocated(InData%PtfmRefyt)) - if (allocated(InData%PtfmRefyt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt, kind=B8Ki), ubound(InData%PtfmRefyt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefyt) - end if - call RegPack(Buf, allocated(InData%PtfmRefzt)) - if (allocated(InData%PtfmRefzt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt, kind=B8Ki), ubound(InData%PtfmRefzt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefzt) - end if - call RegPack(Buf, allocated(InData%PtfmRefztRot)) - if (allocated(InData%PtfmRefztRot)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot, kind=B8Ki), ubound(InData%PtfmRefztRot, kind=B8Ki)) - call RegPack(Buf, InData%PtfmRefztRot) - end if - call RegPack(Buf, allocated(InData%PtfmCOBxt)) - if (allocated(InData%PtfmCOBxt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt, kind=B8Ki), ubound(InData%PtfmCOBxt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmCOBxt) - end if - call RegPack(Buf, allocated(InData%PtfmCOByt)) - if (allocated(InData%PtfmCOByt)) then - call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt, kind=B8Ki), ubound(InData%PtfmCOByt, kind=B8Ki)) - call RegPack(Buf, InData%PtfmCOByt) - end if - call RegPack(Buf, InData%RdtnMod) - call RegPack(Buf, InData%ExctnMod) - call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, InData%ExctnCutOff) - call RegPack(Buf, InData%RdtnTMax) - call RegPack(Buf, InData%WAMITFile) - call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPack(RF, InData%Gravity) + call RegPackAlloc(RF, InData%PtfmVol0) + call RegPack(RF, InData%HasWAMIT) + call RegPack(RF, InData%WAMITULEN) + call RegPackAlloc(RF, InData%PtfmRefxt) + call RegPackAlloc(RF, InData%PtfmRefyt) + call RegPackAlloc(RF, InData%PtfmRefzt) + call RegPackAlloc(RF, InData%PtfmRefztRot) + call RegPackAlloc(RF, InData%PtfmCOBxt) + call RegPackAlloc(RF, InData%PtfmCOByt) + call RegPack(RF, InData%RdtnMod) + call RegPack(RF, InData%ExctnMod) + call RegPack(RF, InData%ExctnDisp) + call RegPack(RF, InData%ExctnCutOff) + call RegPack(RF, InData%RdtnTMax) + call RegPack(RF, InData%WAMITFile) + call Conv_Rdtn_PackInitInput(RF, InData%Conv_Rdtn) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) @@ -361,144 +333,40 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmVol0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmVol0) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HasWAMIT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAMITULEN) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefxt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefyt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmRefztRot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmCOBxt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmCOBxt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmCOByt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmCOByt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RdtnMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnCutOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RdtnTMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAMITFile) - if (RegCheckErr(Buf, RoutineName)) return - call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmVol0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasWAMIT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITULEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefyt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefzt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmRefztRot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOBxt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmCOByt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnTMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAMITFile); if (RegCheckErr(RF, RoutineName)) return + call Conv_Rdtn_UnpackInitInput(RF, OutData%Conv_Rdtn) ! Conv_Rdtn if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -544,25 +412,25 @@ subroutine WAMIT_DestroyContState(ContStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call SS_Rad_PackContState(Buf, InData%SS_Rdtn) - call SS_Exc_PackContState(Buf, InData%SS_Exctn) - call Conv_Rdtn_PackContState(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call SS_Rad_PackContState(RF, InData%SS_Rdtn) + call SS_Exc_PackContState(RF, InData%SS_Exctn) + call Conv_Rdtn_PackContState(RF, InData%Conv_Rdtn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call SS_Rad_UnpackContState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - call SS_Exc_UnpackContState(Buf, OutData%SS_Exctn) ! SS_Exctn - call Conv_Rdtn_UnpackContState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + if (RF%ErrStat /= ErrID_None) return + call SS_Rad_UnpackContState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackContState(RF, OutData%SS_Exctn) ! SS_Exctn + call Conv_Rdtn_UnpackContState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn end subroutine subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -620,47 +488,30 @@ subroutine WAMIT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine WAMIT_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call Conv_Rdtn_PackDiscState(Buf, InData%Conv_Rdtn) - call SS_Rad_PackDiscState(Buf, InData%SS_Rdtn) - call SS_Exc_PackDiscState(Buf, InData%SS_Exctn) - call RegPack(Buf, allocated(InData%BdyPosFilt)) - if (allocated(InData%BdyPosFilt)) then - call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt, kind=B8Ki), ubound(InData%BdyPosFilt, kind=B8Ki)) - call RegPack(Buf, InData%BdyPosFilt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call Conv_Rdtn_PackDiscState(RF, InData%Conv_Rdtn) + call SS_Rad_PackDiscState(RF, InData%SS_Rdtn) + call SS_Exc_PackDiscState(RF, InData%SS_Exctn) + call RegPackAlloc(RF, InData%BdyPosFilt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call Conv_Rdtn_UnpackDiscState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - call SS_Rad_UnpackDiscState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - call SS_Exc_UnpackDiscState(Buf, OutData%SS_Exctn) ! SS_Exctn - if (allocated(OutData%BdyPosFilt)) deallocate(OutData%BdyPosFilt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BdyPosFilt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BdyPosFilt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call Conv_Rdtn_UnpackDiscState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackDiscState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackDiscState(RF, OutData%SS_Exctn) ! SS_Exctn + call RegUnpackAlloc(RF, OutData%BdyPosFilt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WAMIT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -702,25 +553,25 @@ subroutine WAMIT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call Conv_Rdtn_PackConstrState(Buf, InData%Conv_Rdtn) - call SS_Rad_PackConstrState(Buf, InData%SS_Rdtn) - call SS_Exc_PackConstrState(Buf, InData%SS_Exctn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call Conv_Rdtn_PackConstrState(RF, InData%Conv_Rdtn) + call SS_Rad_PackConstrState(RF, InData%SS_Rdtn) + call SS_Exc_PackConstrState(RF, InData%SS_Exctn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call Conv_Rdtn_UnpackConstrState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - call SS_Rad_UnpackConstrState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - call SS_Exc_UnpackConstrState(Buf, OutData%SS_Exctn) ! SS_Exctn + if (RF%ErrStat /= ErrID_None) return + call Conv_Rdtn_UnpackConstrState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackConstrState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackConstrState(RF, OutData%SS_Exctn) ! SS_Exctn end subroutine subroutine WAMIT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -762,25 +613,25 @@ subroutine WAMIT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call SS_Rad_PackOtherState(Buf, InData%SS_Rdtn) - call SS_Exc_PackOtherState(Buf, InData%SS_Exctn) - call Conv_Rdtn_PackOtherState(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call SS_Rad_PackOtherState(RF, InData%SS_Rdtn) + call SS_Exc_PackOtherState(RF, InData%SS_Exctn) + call Conv_Rdtn_PackOtherState(RF, InData%Conv_Rdtn) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call SS_Rad_UnpackOtherState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - call SS_Exc_UnpackOtherState(Buf, OutData%SS_Exctn) ! SS_Exctn - call Conv_Rdtn_UnpackOtherState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + if (RF%ErrStat /= ErrID_None) return + call SS_Rad_UnpackOtherState(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackOtherState(RF, OutData%SS_Exctn) ! SS_Exctn + call Conv_Rdtn_UnpackOtherState(RF, OutData%Conv_Rdtn) ! Conv_Rdtn end subroutine subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -919,121 +770,52 @@ subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%LastIndWave) - call RegPack(Buf, allocated(InData%F_HS)) - if (allocated(InData%F_HS)) then - call RegPackBounds(Buf, 1, lbound(InData%F_HS, kind=B8Ki), ubound(InData%F_HS, kind=B8Ki)) - call RegPack(Buf, InData%F_HS) - end if - call RegPack(Buf, allocated(InData%F_Waves1)) - if (allocated(InData%F_Waves1)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Waves1, kind=B8Ki), ubound(InData%F_Waves1, kind=B8Ki)) - call RegPack(Buf, InData%F_Waves1) - end if - call RegPack(Buf, allocated(InData%F_Rdtn)) - if (allocated(InData%F_Rdtn)) then - call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn, kind=B8Ki), ubound(InData%F_Rdtn, kind=B8Ki)) - call RegPack(Buf, InData%F_Rdtn) - end if - call RegPack(Buf, allocated(InData%F_PtfmAM)) - if (allocated(InData%F_PtfmAM)) then - call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM, kind=B8Ki), ubound(InData%F_PtfmAM, kind=B8Ki)) - call RegPack(Buf, InData%F_PtfmAM) - end if - call SS_Rad_PackMisc(Buf, InData%SS_Rdtn) - call SS_Rad_PackInput(Buf, InData%SS_Rdtn_u) - call SS_Rad_PackOutput(Buf, InData%SS_Rdtn_y) - call SS_Exc_PackMisc(Buf, InData%SS_Exctn) - call SS_Exc_PackInput(Buf, InData%SS_Exctn_u) - call SS_Exc_PackOutput(Buf, InData%SS_Exctn_y) - call Conv_Rdtn_PackMisc(Buf, InData%Conv_Rdtn) - call Conv_Rdtn_PackInput(Buf, InData%Conv_Rdtn_u) - call Conv_Rdtn_PackOutput(Buf, InData%Conv_Rdtn_y) - call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastIndWave) + call RegPackAlloc(RF, InData%F_HS) + call RegPackAlloc(RF, InData%F_Waves1) + call RegPackAlloc(RF, InData%F_Rdtn) + call RegPackAlloc(RF, InData%F_PtfmAM) + call SS_Rad_PackMisc(RF, InData%SS_Rdtn) + call SS_Rad_PackInput(RF, InData%SS_Rdtn_u) + call SS_Rad_PackOutput(RF, InData%SS_Rdtn_y) + call SS_Exc_PackMisc(RF, InData%SS_Exctn) + call SS_Exc_PackInput(RF, InData%SS_Exctn_u) + call SS_Exc_PackOutput(RF, InData%SS_Exctn_y) + call Conv_Rdtn_PackMisc(RF, InData%Conv_Rdtn) + call Conv_Rdtn_PackInput(RF, InData%Conv_Rdtn_u) + call Conv_Rdtn_PackOutput(RF, InData%Conv_Rdtn_y) + call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_HS)) deallocate(OutData%F_HS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_HS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_HS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_Waves1)) deallocate(OutData%F_Waves1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_Waves1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_Waves1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_Rdtn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_PtfmAM)) deallocate(OutData%F_PtfmAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_PtfmAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_PtfmAM) - if (RegCheckErr(Buf, RoutineName)) return - end if - call SS_Rad_UnpackMisc(Buf, OutData%SS_Rdtn) ! SS_Rdtn - call SS_Rad_UnpackInput(Buf, OutData%SS_Rdtn_u) ! SS_Rdtn_u - call SS_Rad_UnpackOutput(Buf, OutData%SS_Rdtn_y) ! SS_Rdtn_y - call SS_Exc_UnpackMisc(Buf, OutData%SS_Exctn) ! SS_Exctn - call SS_Exc_UnpackInput(Buf, OutData%SS_Exctn_u) ! SS_Exctn_u - call SS_Exc_UnpackOutput(Buf, OutData%SS_Exctn_y) ! SS_Exctn_y - call Conv_Rdtn_UnpackMisc(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - call Conv_Rdtn_UnpackInput(Buf, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u - call Conv_Rdtn_UnpackOutput(Buf, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y - call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_HS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Waves1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_Rdtn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_PtfmAM); if (RegCheckErr(RF, RoutineName)) return + call SS_Rad_UnpackMisc(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Rad_UnpackInput(RF, OutData%SS_Rdtn_u) ! SS_Rdtn_u + call SS_Rad_UnpackOutput(RF, OutData%SS_Rdtn_y) ! SS_Rdtn_y + call SS_Exc_UnpackMisc(RF, OutData%SS_Exctn) ! SS_Exctn + call SS_Exc_UnpackInput(RF, OutData%SS_Exctn_u) ! SS_Exctn_u + call SS_Exc_UnpackOutput(RF, OutData%SS_Exctn_y) ! SS_Exctn_y + call Conv_Rdtn_UnpackMisc(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call Conv_Rdtn_UnpackInput(RF, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u + call Conv_Rdtn_UnpackOutput(RF, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y + call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1161,60 +943,40 @@ subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveField) end subroutine -subroutine WAMIT_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackParam' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NBody) - call RegPack(Buf, InData%NBodyMod) - call RegPack(Buf, allocated(InData%F_HS_Moment_Offset)) - if (allocated(InData%F_HS_Moment_Offset)) then - call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset, kind=B8Ki), ubound(InData%F_HS_Moment_Offset, kind=B8Ki)) - call RegPack(Buf, InData%F_HS_Moment_Offset) - end if - call RegPack(Buf, allocated(InData%HdroAdMsI)) - if (allocated(InData%HdroAdMsI)) then - call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI, kind=B8Ki), ubound(InData%HdroAdMsI, kind=B8Ki)) - call RegPack(Buf, InData%HdroAdMsI) - end if - call RegPack(Buf, allocated(InData%HdroSttc)) - if (allocated(InData%HdroSttc)) then - call RegPackBounds(Buf, 2, lbound(InData%HdroSttc, kind=B8Ki), ubound(InData%HdroSttc, kind=B8Ki)) - call RegPack(Buf, InData%HdroSttc) - end if - call RegPack(Buf, InData%RdtnMod) - call RegPack(Buf, InData%ExctnMod) - call RegPack(Buf, InData%ExctnDisp) - call RegPack(Buf, InData%ExctnCutOff) - call RegPack(Buf, InData%ExctnFiltConst) - call RegPack(Buf, allocated(InData%WaveExctn)) - if (allocated(InData%WaveExctn)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveExctn, kind=B8Ki), ubound(InData%WaveExctn, kind=B8Ki)) - call RegPack(Buf, InData%WaveExctn) - end if - call RegPack(Buf, allocated(InData%WaveExctnGrid)) - if (allocated(InData%WaveExctnGrid)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid, kind=B8Ki), ubound(InData%WaveExctnGrid, kind=B8Ki)) - call RegPack(Buf, InData%WaveExctnGrid) - end if - call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) - call SS_Rad_PackParam(Buf, InData%SS_Rdtn) - call SS_Exc_PackParam(Buf, InData%SS_Exctn) - call RegPack(Buf, InData%DT) - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NBody) + call RegPack(RF, InData%NBodyMod) + call RegPackAlloc(RF, InData%F_HS_Moment_Offset) + call RegPackAlloc(RF, InData%HdroAdMsI) + call RegPackAlloc(RF, InData%HdroSttc) + call RegPack(RF, InData%RdtnMod) + call RegPack(RF, InData%ExctnMod) + call RegPack(RF, InData%ExctnDisp) + call RegPack(RF, InData%ExctnCutOff) + call RegPack(RF, InData%ExctnFiltConst) + call RegPackAlloc(RF, InData%WaveExctn) + call RegPackAlloc(RF, InData%WaveExctnGrid) + call Conv_Rdtn_PackParam(RF, InData%Conv_Rdtn) + call SS_Rad_PackParam(RF, InData%SS_Rdtn) + call SS_Exc_PackParam(RF, InData%SS_Exctn) + call RegPack(RF, InData%DT) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' integer(B8Ki) :: LB(4), UB(4) @@ -1222,112 +984,37 @@ subroutine WAMIT_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NBody) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_HS_Moment_Offset)) deallocate(OutData%F_HS_Moment_Offset) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS_Moment_Offset.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_HS_Moment_Offset) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HdroAdMsI)) deallocate(OutData%HdroAdMsI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAdMsI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HdroAdMsI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%HdroSttc)) deallocate(OutData%HdroSttc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HdroSttc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroSttc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HdroSttc) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RdtnMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnCutOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExctnFiltConst) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveExctn)) deallocate(OutData%WaveExctn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveExctn(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveExctn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveExctnGrid)) deallocate(OutData%WaveExctnGrid) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctnGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveExctnGrid) - if (RegCheckErr(Buf, RoutineName)) return - end if - call Conv_Rdtn_UnpackParam(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - call SS_Rad_UnpackParam(Buf, OutData%SS_Rdtn) ! SS_Rdtn - call SS_Exc_UnpackParam(Buf, OutData%SS_Exctn) ! SS_Exctn - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NBody); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NBodyMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_HS_Moment_Offset); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroAdMsI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%HdroSttc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RdtnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnCutOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExctnFiltConst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveExctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveExctnGrid); if (RegCheckErr(RF, RoutineName)) return + call Conv_Rdtn_UnpackParam(RF, OutData%Conv_Rdtn) ! Conv_Rdtn + call SS_Rad_UnpackParam(RF, OutData%SS_Rdtn) ! SS_Rdtn + call SS_Exc_UnpackParam(RF, OutData%SS_Exctn) ! SS_Exctn + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -1363,21 +1050,21 @@ subroutine WAMIT_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%Mesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%Mesh) ! Mesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh end subroutine subroutine WAMIT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1409,21 +1096,21 @@ subroutine WAMIT_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WAMIT_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WAMIT_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%Mesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Mesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WAMIT_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WAMIT_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WAMIT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackOutput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%Mesh) ! Mesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Mesh) ! Mesh end subroutine subroutine WAMIT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 299b42c9a0..c62479cd44 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -350,250 +350,142 @@ subroutine IceD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine IceD_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IceModel) - call RegPack(Buf, InData%IceSubModel) - call RegPack(Buf, InData%h) - call RegPack(Buf, InData%v) - call RegPack(Buf, InData%InitLoc) - call RegPack(Buf, InData%t0) - call RegPack(Buf, InData%rhow) - call RegPack(Buf, InData%rhoi) - call RegPack(Buf, InData%Seed1) - call RegPack(Buf, InData%Seed2) - call RegPack(Buf, InData%NumLegs) - call RegPack(Buf, allocated(InData%LegPosX)) - if (allocated(InData%LegPosX)) then - call RegPackBounds(Buf, 1, lbound(InData%LegPosX, kind=B8Ki), ubound(InData%LegPosX, kind=B8Ki)) - call RegPack(Buf, InData%LegPosX) - end if - call RegPack(Buf, allocated(InData%LegPosY)) - if (allocated(InData%LegPosY)) then - call RegPackBounds(Buf, 1, lbound(InData%LegPosY, kind=B8Ki), ubound(InData%LegPosY, kind=B8Ki)) - call RegPack(Buf, InData%LegPosY) - end if - call RegPack(Buf, allocated(InData%StrWd)) - if (allocated(InData%StrWd)) then - call RegPackBounds(Buf, 1, lbound(InData%StrWd, kind=B8Ki), ubound(InData%StrWd, kind=B8Ki)) - call RegPack(Buf, InData%StrWd) - end if - call RegPack(Buf, InData%Ikm) - call RegPack(Buf, InData%Ag) - call RegPack(Buf, InData%Qg) - call RegPack(Buf, InData%Rg) - call RegPack(Buf, InData%Tice) - call RegPack(Buf, InData%nu) - call RegPack(Buf, InData%phi) - call RegPack(Buf, InData%SigNm) - call RegPack(Buf, InData%Eice) - call RegPack(Buf, InData%IceStr2) - call RegPack(Buf, InData%Delmax2) - call RegPack(Buf, InData%Pitch) - call RegPack(Buf, InData%miuh) - call RegPack(Buf, InData%varh) - call RegPack(Buf, InData%miuv) - call RegPack(Buf, InData%varv) - call RegPack(Buf, InData%miut) - call RegPack(Buf, InData%miubr) - call RegPack(Buf, InData%varbr) - call RegPack(Buf, InData%miuDelm) - call RegPack(Buf, InData%varDelm) - call RegPack(Buf, InData%miuP) - call RegPack(Buf, InData%varP) - call RegPack(Buf, InData%Zn1) - call RegPack(Buf, InData%Zn2) - call RegPack(Buf, InData%ZonePitch) - call RegPack(Buf, InData%PrflMean) - call RegPack(Buf, InData%PrflSig) - call RegPack(Buf, InData%IceStr) - call RegPack(Buf, InData%Delmax) - call RegPack(Buf, InData%alpha) - call RegPack(Buf, InData%Dwl) - call RegPack(Buf, InData%Dtp) - call RegPack(Buf, InData%hr) - call RegPack(Buf, InData%mu) - call RegPack(Buf, InData%sigf) - call RegPack(Buf, InData%StrLim) - call RegPack(Buf, InData%StrRtLim) - call RegPack(Buf, InData%UorD) - call RegPack(Buf, InData%Ll) - call RegPack(Buf, InData%Lw) - call RegPack(Buf, InData%Cpa) - call RegPack(Buf, InData%dpa) - call RegPack(Buf, InData%Fdr) - call RegPack(Buf, InData%Kic) - call RegPack(Buf, InData%FspN) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IceModel) + call RegPack(RF, InData%IceSubModel) + call RegPack(RF, InData%h) + call RegPack(RF, InData%v) + call RegPack(RF, InData%InitLoc) + call RegPack(RF, InData%t0) + call RegPack(RF, InData%rhow) + call RegPack(RF, InData%rhoi) + call RegPack(RF, InData%Seed1) + call RegPack(RF, InData%Seed2) + call RegPack(RF, InData%NumLegs) + call RegPackAlloc(RF, InData%LegPosX) + call RegPackAlloc(RF, InData%LegPosY) + call RegPackAlloc(RF, InData%StrWd) + call RegPack(RF, InData%Ikm) + call RegPack(RF, InData%Ag) + call RegPack(RF, InData%Qg) + call RegPack(RF, InData%Rg) + call RegPack(RF, InData%Tice) + call RegPack(RF, InData%nu) + call RegPack(RF, InData%phi) + call RegPack(RF, InData%SigNm) + call RegPack(RF, InData%Eice) + call RegPack(RF, InData%IceStr2) + call RegPack(RF, InData%Delmax2) + call RegPack(RF, InData%Pitch) + call RegPack(RF, InData%miuh) + call RegPack(RF, InData%varh) + call RegPack(RF, InData%miuv) + call RegPack(RF, InData%varv) + call RegPack(RF, InData%miut) + call RegPack(RF, InData%miubr) + call RegPack(RF, InData%varbr) + call RegPack(RF, InData%miuDelm) + call RegPack(RF, InData%varDelm) + call RegPack(RF, InData%miuP) + call RegPack(RF, InData%varP) + call RegPack(RF, InData%Zn1) + call RegPack(RF, InData%Zn2) + call RegPack(RF, InData%ZonePitch) + call RegPack(RF, InData%PrflMean) + call RegPack(RF, InData%PrflSig) + call RegPack(RF, InData%IceStr) + call RegPack(RF, InData%Delmax) + call RegPack(RF, InData%alpha) + call RegPack(RF, InData%Dwl) + call RegPack(RF, InData%Dtp) + call RegPack(RF, InData%hr) + call RegPack(RF, InData%mu) + call RegPack(RF, InData%sigf) + call RegPack(RF, InData%StrLim) + call RegPack(RF, InData%StrRtLim) + call RegPack(RF, InData%UorD) + call RegPack(RF, InData%Ll) + call RegPack(RF, InData%Lw) + call RegPack(RF, InData%Cpa) + call RegPack(RF, InData%dpa) + call RegPack(RF, InData%Fdr) + call RegPack(RF, InData%Kic) + call RegPack(RF, InData%FspN) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IceModel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IceSubModel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%h) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%v) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InitLoc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%t0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhoi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Seed1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Seed2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumLegs) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LegPosX)) deallocate(OutData%LegPosX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LegPosX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LegPosX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LegPosY)) deallocate(OutData%LegPosY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LegPosY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LegPosY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StrWd)) deallocate(OutData%StrWd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StrWd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StrWd) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Ikm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Qg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Rg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tice) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nu) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%phi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SigNm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Eice) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IceStr2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delmax2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%miuh) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%varh) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%miuv) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%varv) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%miut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%miubr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%varbr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%miuDelm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%varDelm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%miuP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%varP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Zn1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Zn2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ZonePitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrflMean) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrflSig) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IceStr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Dwl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Dtp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%hr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%mu) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%sigf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StrLim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StrRtLim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UorD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ll) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Lw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cpa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dpa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fdr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kic) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FspN) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IceModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceSubModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Seed1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Seed2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LegPosX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LegPosY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StrWd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ikm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Qg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%phi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SigNm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Eice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceStr2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varh); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miubr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuDelm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varDelm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%miuP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%varP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zn1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zn2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZonePitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrflMean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrflSig); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dwl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dtp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%hr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sigf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrLim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrRtLim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UorD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FspN); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -623,40 +515,33 @@ subroutine IceD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, InData%gravity) - call RegPack(Buf, InData%LegNum) - call RegPack(Buf, InData%TMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%LegNum) + call RegPack(RF, InData%TMax) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LegNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LegNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -720,65 +605,30 @@ subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine IceD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call RegPack(Buf, InData%numLegs) - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call RegPack(RF, InData%numLegs) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numLegs) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numLegs); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine IceD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -803,25 +653,23 @@ subroutine IceD_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%q) - call RegPack(Buf, InData%dqdt) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%q) + call RegPack(RF, InData%dqdt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%q) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dqdt) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dqdt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -845,22 +693,21 @@ subroutine IceD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -884,22 +731,21 @@ subroutine IceD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1006,124 +852,65 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine IceD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IceTthNo2) - call RegPack(Buf, allocated(InData%Nc)) - if (allocated(InData%Nc)) then - call RegPackBounds(Buf, 1, lbound(InData%Nc, kind=B8Ki), ubound(InData%Nc, kind=B8Ki)) - call RegPack(Buf, InData%Nc) - end if - call RegPack(Buf, allocated(InData%Psum)) - if (allocated(InData%Psum)) then - call RegPackBounds(Buf, 1, lbound(InData%Psum, kind=B8Ki), ubound(InData%Psum, kind=B8Ki)) - call RegPack(Buf, InData%Psum) - end if - call RegPack(Buf, allocated(InData%IceTthNo)) - if (allocated(InData%IceTthNo)) then - call RegPackBounds(Buf, 1, lbound(InData%IceTthNo, kind=B8Ki), ubound(InData%IceTthNo, kind=B8Ki)) - call RegPack(Buf, InData%IceTthNo) - end if - call RegPack(Buf, InData%Beta) - call RegPack(Buf, InData%Tinit) - call RegPack(Buf, InData%Splitf) - call RegPack(Buf, InData%dxc) - call RegPack(Buf, allocated(InData%xdot)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IceTthNo2) + call RegPackAlloc(RF, InData%Nc) + call RegPackAlloc(RF, InData%Psum) + call RegPackAlloc(RF, InData%IceTthNo) + call RegPack(RF, InData%Beta) + call RegPack(RF, InData%Tinit) + call RegPack(RF, InData%Splitf) + call RegPack(RF, InData%dxc) + call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(Buf, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call IceD_PackContState(Buf, InData%xdot(i1)) + call IceD_PackContState(RF, InData%xdot(i1)) end do end if - call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IceTthNo2) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Nc)) deallocate(OutData%Nc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nc(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Psum)) deallocate(OutData%Psum) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Psum(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Psum) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IceTthNo)) deallocate(OutData%IceTthNo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IceTthNo(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IceTthNo) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Beta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tinit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Splitf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dxc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IceTthNo2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Psum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IceTthNo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Beta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tinit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Splitf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dxc); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%xdot)) deallocate(OutData%xdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xdot(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call IceD_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do end if - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1147,22 +934,21 @@ subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1385,356 +1171,138 @@ subroutine IceD_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine IceD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%h) - call RegPack(Buf, InData%v) - call RegPack(Buf, InData%t0) - call RegPack(Buf, InData%StrWd) - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%InitLoc) - call RegPack(Buf, InData%tolerance) - call RegPack(Buf, InData%Tmax) - call RegPack(Buf, InData%verif) - call RegPack(Buf, InData%ModNo) - call RegPack(Buf, InData%SubModNo) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%method) - call RegPack(Buf, InData%TmStep) - call RegPack(Buf, allocated(InData%OutName)) - if (allocated(InData%OutName)) then - call RegPackBounds(Buf, 1, lbound(InData%OutName, kind=B8Ki), ubound(InData%OutName, kind=B8Ki)) - call RegPack(Buf, InData%OutName) - end if - call RegPack(Buf, allocated(InData%OutUnit)) - if (allocated(InData%OutUnit)) then - call RegPackBounds(Buf, 1, lbound(InData%OutUnit, kind=B8Ki), ubound(InData%OutUnit, kind=B8Ki)) - call RegPack(Buf, InData%OutUnit) - end if - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%tm1a) - call RegPack(Buf, InData%tm1b) - call RegPack(Buf, InData%tm1c) - call RegPack(Buf, InData%Fmax1a) - call RegPack(Buf, InData%Fmax1b) - call RegPack(Buf, InData%Fmax1c) - call RegPack(Buf, InData%Ikm) - call RegPack(Buf, InData%Cstr) - call RegPack(Buf, InData%EiPa) - call RegPack(Buf, InData%Delmax2) - call RegPack(Buf, InData%Pitch) - call RegPack(Buf, InData%Kice2) - call RegPack(Buf, allocated(InData%rdmFm)) - if (allocated(InData%rdmFm)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmFm, kind=B8Ki), ubound(InData%rdmFm, kind=B8Ki)) - call RegPack(Buf, InData%rdmFm) - end if - call RegPack(Buf, allocated(InData%rdmt0)) - if (allocated(InData%rdmt0)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmt0, kind=B8Ki), ubound(InData%rdmt0, kind=B8Ki)) - call RegPack(Buf, InData%rdmt0) - end if - call RegPack(Buf, allocated(InData%rdmtm)) - if (allocated(InData%rdmtm)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmtm, kind=B8Ki), ubound(InData%rdmtm, kind=B8Ki)) - call RegPack(Buf, InData%rdmtm) - end if - call RegPack(Buf, allocated(InData%rdmDm)) - if (allocated(InData%rdmDm)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmDm, kind=B8Ki), ubound(InData%rdmDm, kind=B8Ki)) - call RegPack(Buf, InData%rdmDm) - end if - call RegPack(Buf, allocated(InData%rdmP)) - if (allocated(InData%rdmP)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmP, kind=B8Ki), ubound(InData%rdmP, kind=B8Ki)) - call RegPack(Buf, InData%rdmP) - end if - call RegPack(Buf, allocated(InData%rdmKi)) - if (allocated(InData%rdmKi)) then - call RegPackBounds(Buf, 1, lbound(InData%rdmKi, kind=B8Ki), ubound(InData%rdmKi, kind=B8Ki)) - call RegPack(Buf, InData%rdmKi) - end if - call RegPack(Buf, InData%ZonePitch) - call RegPack(Buf, InData%Kice) - call RegPack(Buf, InData%Delmax) - call RegPack(Buf, allocated(InData%Y0)) - if (allocated(InData%Y0)) then - call RegPackBounds(Buf, 1, lbound(InData%Y0, kind=B8Ki), ubound(InData%Y0, kind=B8Ki)) - call RegPack(Buf, InData%Y0) - end if - call RegPack(Buf, allocated(InData%ContPrfl)) - if (allocated(InData%ContPrfl)) then - call RegPackBounds(Buf, 1, lbound(InData%ContPrfl, kind=B8Ki), ubound(InData%ContPrfl, kind=B8Ki)) - call RegPack(Buf, InData%ContPrfl) - end if - call RegPack(Buf, InData%Zn) - call RegPack(Buf, InData%rhoi) - call RegPack(Buf, InData%rhow) - call RegPack(Buf, InData%alphaR) - call RegPack(Buf, InData%Dwl) - call RegPack(Buf, InData%Zr) - call RegPack(Buf, InData%RHbr) - call RegPack(Buf, InData%RVbr) - call RegPack(Buf, InData%Lbr) - call RegPack(Buf, InData%LovR) - call RegPack(Buf, InData%mu) - call RegPack(Buf, InData%Wri) - call RegPack(Buf, InData%WL) - call RegPack(Buf, InData%Cpa) - call RegPack(Buf, InData%dpa) - call RegPack(Buf, InData%FdrN) - call RegPack(Buf, InData%Mice) - call RegPack(Buf, InData%Fsp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%h) + call RegPack(RF, InData%v) + call RegPack(RF, InData%t0) + call RegPack(RF, InData%StrWd) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%InitLoc) + call RegPack(RF, InData%tolerance) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%verif) + call RegPack(RF, InData%ModNo) + call RegPack(RF, InData%SubModNo) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%method) + call RegPack(RF, InData%TmStep) + call RegPackAlloc(RF, InData%OutName) + call RegPackAlloc(RF, InData%OutUnit) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%tm1a) + call RegPack(RF, InData%tm1b) + call RegPack(RF, InData%tm1c) + call RegPack(RF, InData%Fmax1a) + call RegPack(RF, InData%Fmax1b) + call RegPack(RF, InData%Fmax1c) + call RegPack(RF, InData%Ikm) + call RegPack(RF, InData%Cstr) + call RegPack(RF, InData%EiPa) + call RegPack(RF, InData%Delmax2) + call RegPack(RF, InData%Pitch) + call RegPack(RF, InData%Kice2) + call RegPackAlloc(RF, InData%rdmFm) + call RegPackAlloc(RF, InData%rdmt0) + call RegPackAlloc(RF, InData%rdmtm) + call RegPackAlloc(RF, InData%rdmDm) + call RegPackAlloc(RF, InData%rdmP) + call RegPackAlloc(RF, InData%rdmKi) + call RegPack(RF, InData%ZonePitch) + call RegPack(RF, InData%Kice) + call RegPack(RF, InData%Delmax) + call RegPackAlloc(RF, InData%Y0) + call RegPackAlloc(RF, InData%ContPrfl) + call RegPack(RF, InData%Zn) + call RegPack(RF, InData%rhoi) + call RegPack(RF, InData%rhow) + call RegPack(RF, InData%alphaR) + call RegPack(RF, InData%Dwl) + call RegPack(RF, InData%Zr) + call RegPack(RF, InData%RHbr) + call RegPack(RF, InData%RVbr) + call RegPack(RF, InData%Lbr) + call RegPack(RF, InData%LovR) + call RegPack(RF, InData%mu) + call RegPack(RF, InData%Wri) + call RegPack(RF, InData%WL) + call RegPack(RF, InData%Cpa) + call RegPack(RF, InData%dpa) + call RegPack(RF, InData%FdrN) + call RegPack(RF, InData%Mice) + call RegPack(RF, InData%Fsp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackParam' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%h) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%v) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%t0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StrWd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InitLoc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tolerance) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%verif) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ModNo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SubModNo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%method) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TmStep) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutName)) deallocate(OutData%OutName) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutName(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutName) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OutUnit)) deallocate(OutData%OutUnit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutUnit(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutUnit) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tm1a) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tm1b) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tm1c) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fmax1a) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fmax1b) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fmax1c) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ikm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cstr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EiPa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delmax2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kice2) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%rdmFm)) deallocate(OutData%rdmFm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdmFm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdmFm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdmt0)) deallocate(OutData%rdmt0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdmt0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdmt0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdmtm)) deallocate(OutData%rdmtm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdmtm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdmtm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdmDm)) deallocate(OutData%rdmDm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdmDm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdmDm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdmP)) deallocate(OutData%rdmP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdmP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdmP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdmKi)) deallocate(OutData%rdmKi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdmKi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdmKi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%ZonePitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kice) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delmax) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Y0)) deallocate(OutData%Y0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ContPrfl)) deallocate(OutData%ContPrfl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ContPrfl(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ContPrfl) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Zn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhoi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%alphaR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Dwl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Zr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RHbr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RVbr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Lbr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LovR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%mu) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Wri) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cpa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dpa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FdrN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mice) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Fsp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%h); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrWd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tolerance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%verif); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModNo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubModNo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%method); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TmStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutUnit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tm1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tm1b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tm1c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmax1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmax1b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fmax1c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ikm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cstr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EiPa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kice2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmFm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmt0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmtm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmDm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdmKi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZonePitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ContPrfl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Dwl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Zr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RHbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RVbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LovR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Wri); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dpa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FdrN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mice); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fsp); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1766,21 +1334,21 @@ subroutine IceD_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine IceD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PointMesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PointMesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PointMesh) ! PointMesh end subroutine subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1828,43 +1396,26 @@ subroutine IceD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine IceD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PointMesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PointMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PointMesh) ! PointMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 5d53911bed..41cffbc0de 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -135,34 +135,29 @@ subroutine IceFloe_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceFloe_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%simLength) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%gravity) - call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%simLength) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%RootName) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%simLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%simLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -225,62 +220,28 @@ subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine IceFloe_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -304,22 +265,21 @@ subroutine IceFloe_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceFloe_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContStateVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContStateVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContStateVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContStateVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -343,22 +303,21 @@ subroutine IceFloe_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceFloe_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscStateVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscStateVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscStateVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscStateVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -382,22 +341,21 @@ subroutine IceFloe_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceFloe_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrStateVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrStateVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrStateVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrStateVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -421,22 +379,21 @@ subroutine IceFloe_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceFloe_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -460,22 +417,21 @@ subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine IceFloe_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -575,143 +531,60 @@ subroutine IceFloe_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine IceFloe_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%loadSeries)) - if (allocated(InData%loadSeries)) then - call RegPackBounds(Buf, 2, lbound(InData%loadSeries, kind=B8Ki), ubound(InData%loadSeries, kind=B8Ki)) - call RegPack(Buf, InData%loadSeries) - end if - call RegPack(Buf, InData%iceVel) - call RegPack(Buf, InData%iceDirection) - call RegPack(Buf, InData%minStrength) - call RegPack(Buf, InData%minStrengthNegVel) - call RegPack(Buf, InData%defaultArea) - call RegPack(Buf, InData%crushArea) - call RegPack(Buf, InData%coeffStressRate) - call RegPack(Buf, InData%C(4)) - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%rampTime) - call RegPack(Buf, allocated(InData%legX)) - if (allocated(InData%legX)) then - call RegPackBounds(Buf, 1, lbound(InData%legX, kind=B8Ki), ubound(InData%legX, kind=B8Ki)) - call RegPack(Buf, InData%legX) - end if - call RegPack(Buf, allocated(InData%legY)) - if (allocated(InData%legY)) then - call RegPackBounds(Buf, 1, lbound(InData%legY, kind=B8Ki), ubound(InData%legY, kind=B8Ki)) - call RegPack(Buf, InData%legY) - end if - call RegPack(Buf, allocated(InData%ks)) - if (allocated(InData%ks)) then - call RegPackBounds(Buf, 1, lbound(InData%ks, kind=B8Ki), ubound(InData%ks, kind=B8Ki)) - call RegPack(Buf, InData%ks) - end if - call RegPack(Buf, InData%numLegs) - call RegPack(Buf, InData%iceType) - call RegPack(Buf, InData%logUnitNum) - call RegPack(Buf, InData%singleLoad) - call RegPack(Buf, InData%initFlag) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%loadSeries) + call RegPack(RF, InData%iceVel) + call RegPack(RF, InData%iceDirection) + call RegPack(RF, InData%minStrength) + call RegPack(RF, InData%minStrengthNegVel) + call RegPack(RF, InData%defaultArea) + call RegPack(RF, InData%crushArea) + call RegPack(RF, InData%coeffStressRate) + call RegPack(RF, InData%C(4)) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%rampTime) + call RegPackAlloc(RF, InData%legX) + call RegPackAlloc(RF, InData%legY) + call RegPackAlloc(RF, InData%ks) + call RegPack(RF, InData%numLegs) + call RegPack(RF, InData%iceType) + call RegPack(RF, InData%logUnitNum) + call RegPack(RF, InData%singleLoad) + call RegPack(RF, InData%initFlag) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%loadSeries)) deallocate(OutData%loadSeries) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%loadSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%loadSeries) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%iceVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iceDirection) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%minStrength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%minStrengthNegVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defaultArea) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%crushArea) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%coeffStressRate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C(4)) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rampTime) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%legX)) deallocate(OutData%legX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%legX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%legX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%legY)) deallocate(OutData%legY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%legY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%legY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ks)) deallocate(OutData%ks) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ks(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ks) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%numLegs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%iceType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%logUnitNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%singleLoad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%initFlag) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%loadSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iceVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iceDirection); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%minStrength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%minStrengthNegVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defaultArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%crushArea); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%coeffStressRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C(4)); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rampTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%legX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%legY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ks); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iceType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%logUnitNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%singleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initFlag); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -743,21 +616,21 @@ subroutine IceFloe_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine IceFloe_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%iceMesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%iceMesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%iceMesh) ! iceMesh end subroutine subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -805,43 +678,26 @@ subroutine IceFloe_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine IceFloe_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%iceMesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%iceMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IceFloe_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IceFloe_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%iceMesh) ! iceMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IceFloe_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 415a47a057..022bbb2cb9 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -446,354 +446,62 @@ subroutine IfW_FlowField_DestroyUniformFieldType(UniformFieldTypeData, ErrStat, end if end subroutine -subroutine IfW_FlowField_PackUniformFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackUniformFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(UniformFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformFieldType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%RefHeight) - call RegPack(Buf, InData%RefLength) - call RegPack(Buf, InData%DataSize) - call RegPack(Buf, allocated(InData%Time)) - if (allocated(InData%Time)) then - call RegPackBounds(Buf, 1, lbound(InData%Time, kind=B8Ki), ubound(InData%Time, kind=B8Ki)) - call RegPack(Buf, InData%Time) - end if - call RegPack(Buf, allocated(InData%VelH)) - if (allocated(InData%VelH)) then - call RegPackBounds(Buf, 1, lbound(InData%VelH, kind=B8Ki), ubound(InData%VelH, kind=B8Ki)) - call RegPack(Buf, InData%VelH) - end if - call RegPack(Buf, allocated(InData%VelHDot)) - if (allocated(InData%VelHDot)) then - call RegPackBounds(Buf, 1, lbound(InData%VelHDot, kind=B8Ki), ubound(InData%VelHDot, kind=B8Ki)) - call RegPack(Buf, InData%VelHDot) - end if - call RegPack(Buf, allocated(InData%VelV)) - if (allocated(InData%VelV)) then - call RegPackBounds(Buf, 1, lbound(InData%VelV, kind=B8Ki), ubound(InData%VelV, kind=B8Ki)) - call RegPack(Buf, InData%VelV) - end if - call RegPack(Buf, allocated(InData%VelVDot)) - if (allocated(InData%VelVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%VelVDot, kind=B8Ki), ubound(InData%VelVDot, kind=B8Ki)) - call RegPack(Buf, InData%VelVDot) - end if - call RegPack(Buf, allocated(InData%VelGust)) - if (allocated(InData%VelGust)) then - call RegPackBounds(Buf, 1, lbound(InData%VelGust, kind=B8Ki), ubound(InData%VelGust, kind=B8Ki)) - call RegPack(Buf, InData%VelGust) - end if - call RegPack(Buf, allocated(InData%VelGustDot)) - if (allocated(InData%VelGustDot)) then - call RegPackBounds(Buf, 1, lbound(InData%VelGustDot, kind=B8Ki), ubound(InData%VelGustDot, kind=B8Ki)) - call RegPack(Buf, InData%VelGustDot) - end if - call RegPack(Buf, allocated(InData%AngleH)) - if (allocated(InData%AngleH)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleH, kind=B8Ki), ubound(InData%AngleH, kind=B8Ki)) - call RegPack(Buf, InData%AngleH) - end if - call RegPack(Buf, allocated(InData%AngleHDot)) - if (allocated(InData%AngleHDot)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleHDot, kind=B8Ki), ubound(InData%AngleHDot, kind=B8Ki)) - call RegPack(Buf, InData%AngleHDot) - end if - call RegPack(Buf, allocated(InData%AngleV)) - if (allocated(InData%AngleV)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleV, kind=B8Ki), ubound(InData%AngleV, kind=B8Ki)) - call RegPack(Buf, InData%AngleV) - end if - call RegPack(Buf, allocated(InData%AngleVDot)) - if (allocated(InData%AngleVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%AngleVDot, kind=B8Ki), ubound(InData%AngleVDot, kind=B8Ki)) - call RegPack(Buf, InData%AngleVDot) - end if - call RegPack(Buf, allocated(InData%ShrH)) - if (allocated(InData%ShrH)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrH, kind=B8Ki), ubound(InData%ShrH, kind=B8Ki)) - call RegPack(Buf, InData%ShrH) - end if - call RegPack(Buf, allocated(InData%ShrHDot)) - if (allocated(InData%ShrHDot)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrHDot, kind=B8Ki), ubound(InData%ShrHDot, kind=B8Ki)) - call RegPack(Buf, InData%ShrHDot) - end if - call RegPack(Buf, allocated(InData%ShrV)) - if (allocated(InData%ShrV)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrV, kind=B8Ki), ubound(InData%ShrV, kind=B8Ki)) - call RegPack(Buf, InData%ShrV) - end if - call RegPack(Buf, allocated(InData%ShrVDot)) - if (allocated(InData%ShrVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%ShrVDot, kind=B8Ki), ubound(InData%ShrVDot, kind=B8Ki)) - call RegPack(Buf, InData%ShrVDot) - end if - call RegPack(Buf, allocated(InData%LinShrV)) - if (allocated(InData%LinShrV)) then - call RegPackBounds(Buf, 1, lbound(InData%LinShrV, kind=B8Ki), ubound(InData%LinShrV, kind=B8Ki)) - call RegPack(Buf, InData%LinShrV) - end if - call RegPack(Buf, allocated(InData%LinShrVDot)) - if (allocated(InData%LinShrVDot)) then - call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot, kind=B8Ki), ubound(InData%LinShrVDot, kind=B8Ki)) - call RegPack(Buf, InData%LinShrVDot) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RefHeight) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%DataSize) + call RegPackAlloc(RF, InData%Time) + call RegPackAlloc(RF, InData%VelH) + call RegPackAlloc(RF, InData%VelHDot) + call RegPackAlloc(RF, InData%VelV) + call RegPackAlloc(RF, InData%VelVDot) + call RegPackAlloc(RF, InData%VelGust) + call RegPackAlloc(RF, InData%VelGustDot) + call RegPackAlloc(RF, InData%AngleH) + call RegPackAlloc(RF, InData%AngleHDot) + call RegPackAlloc(RF, InData%AngleV) + call RegPackAlloc(RF, InData%AngleVDot) + call RegPackAlloc(RF, InData%ShrH) + call RegPackAlloc(RF, InData%ShrHDot) + call RegPackAlloc(RF, InData%ShrV) + call RegPackAlloc(RF, InData%ShrVDot) + call RegPackAlloc(RF, InData%LinShrV) + call RegPackAlloc(RF, InData%LinShrVDot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackUniformFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(UniformFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DataSize) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Time)) deallocate(OutData%Time) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Time(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Time.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Time) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelH)) deallocate(OutData%VelH) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelH(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelH) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelHDot)) deallocate(OutData%VelHDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelHDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelHDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelV)) deallocate(OutData%VelV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelVDot)) deallocate(OutData%VelVDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelVDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelVDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelGust)) deallocate(OutData%VelGust) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelGust(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGust.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelGust) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelGustDot)) deallocate(OutData%VelGustDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelGustDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGustDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelGustDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngleH)) deallocate(OutData%AngleH) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngleH(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngleH) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngleHDot)) deallocate(OutData%AngleHDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngleHDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngleHDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngleV)) deallocate(OutData%AngleV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngleV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngleV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AngleVDot)) deallocate(OutData%AngleVDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AngleVDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AngleVDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ShrH)) deallocate(OutData%ShrH) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ShrH(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ShrH) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ShrHDot)) deallocate(OutData%ShrHDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ShrHDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ShrHDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ShrV)) deallocate(OutData%ShrV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ShrV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ShrV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ShrVDot)) deallocate(OutData%ShrVDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ShrVDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ShrVDot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinShrV)) deallocate(OutData%LinShrV) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinShrV(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinShrV) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinShrVDot)) deallocate(OutData%LinShrVDot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinShrVDot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinShrVDot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DataSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelGust); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelGustDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AngleVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ShrVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinShrVDot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IfW_FlowField_CopyUniformField_Interp(SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg) @@ -836,79 +544,59 @@ subroutine IfW_FlowField_DestroyUniformField_Interp(UniformField_InterpData, Err ErrMsg = '' end subroutine -subroutine IfW_FlowField_PackUniformField_Interp(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackUniformField_Interp(RF, Indata) + type(RegFile), intent(inout) :: RF type(UniformField_Interp), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%VelH) - call RegPack(Buf, InData%VelHDot) - call RegPack(Buf, InData%VelV) - call RegPack(Buf, InData%VelVDot) - call RegPack(Buf, InData%VelGust) - call RegPack(Buf, InData%VelGustDot) - call RegPack(Buf, InData%AngleH) - call RegPack(Buf, InData%AngleHDot) - call RegPack(Buf, InData%AngleV) - call RegPack(Buf, InData%AngleVDot) - call RegPack(Buf, InData%ShrH) - call RegPack(Buf, InData%ShrHDot) - call RegPack(Buf, InData%ShrV) - call RegPack(Buf, InData%ShrVDot) - call RegPack(Buf, InData%LinShrV) - call RegPack(Buf, InData%LinShrVDot) - call RegPack(Buf, InData%CosAngleH) - call RegPack(Buf, InData%SinAngleH) - call RegPack(Buf, InData%CosAngleV) - call RegPack(Buf, InData%SinAngleV) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%VelH) + call RegPack(RF, InData%VelHDot) + call RegPack(RF, InData%VelV) + call RegPack(RF, InData%VelVDot) + call RegPack(RF, InData%VelGust) + call RegPack(RF, InData%VelGustDot) + call RegPack(RF, InData%AngleH) + call RegPack(RF, InData%AngleHDot) + call RegPack(RF, InData%AngleV) + call RegPack(RF, InData%AngleVDot) + call RegPack(RF, InData%ShrH) + call RegPack(RF, InData%ShrHDot) + call RegPack(RF, InData%ShrV) + call RegPack(RF, InData%ShrVDot) + call RegPack(RF, InData%LinShrV) + call RegPack(RF, InData%LinShrVDot) + call RegPack(RF, InData%CosAngleH) + call RegPack(RF, InData%SinAngleH) + call RegPack(RF, InData%CosAngleV) + call RegPack(RF, InData%SinAngleV) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackUniformField_Interp(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackUniformField_Interp(RF, OutData) + type(RegFile), intent(inout) :: RF type(UniformField_Interp), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformField_Interp' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%VelH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelHDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelVDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelGust) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelGustDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngleH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngleHDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngleV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AngleVDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShrH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShrHDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShrV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShrVDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinShrV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinShrVDot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CosAngleH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SinAngleH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CosAngleV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SinAngleV) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%VelH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelGust); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelGustDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AngleVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrHDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShrVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinShrV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinShrVDot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CosAngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SinAngleH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CosAngleV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SinAngleV); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1052,223 +740,92 @@ subroutine IfW_FlowField_DestroyGrid3DFieldType(Grid3DFieldTypeData, ErrStat, Er end if end subroutine -subroutine IfW_FlowField_PackGrid3DFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackGrid3DFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Grid3DFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WindFileFormat) - call RegPack(Buf, InData%WindProfileType) - call RegPack(Buf, InData%Periodic) - call RegPack(Buf, InData%InterpTower) - call RegPack(Buf, InData%AddMeanAfterInterp) - call RegPack(Buf, InData%RefHeight) - call RegPack(Buf, InData%RefLength) - call RegPack(Buf, allocated(InData%Vel)) - if (allocated(InData%Vel)) then - call RegPackBounds(Buf, 4, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) - call RegPack(Buf, InData%Vel) - end if - call RegPack(Buf, allocated(InData%Acc)) - if (allocated(InData%Acc)) then - call RegPackBounds(Buf, 4, lbound(InData%Acc, kind=B8Ki), ubound(InData%Acc, kind=B8Ki)) - call RegPack(Buf, InData%Acc) - end if - call RegPack(Buf, allocated(InData%VelTower)) - if (allocated(InData%VelTower)) then - call RegPackBounds(Buf, 3, lbound(InData%VelTower, kind=B8Ki), ubound(InData%VelTower, kind=B8Ki)) - call RegPack(Buf, InData%VelTower) - end if - call RegPack(Buf, allocated(InData%AccTower)) - if (allocated(InData%AccTower)) then - call RegPackBounds(Buf, 3, lbound(InData%AccTower, kind=B8Ki), ubound(InData%AccTower, kind=B8Ki)) - call RegPack(Buf, InData%AccTower) - end if - call RegPack(Buf, allocated(InData%VelAvg)) - if (allocated(InData%VelAvg)) then - call RegPackBounds(Buf, 3, lbound(InData%VelAvg, kind=B8Ki), ubound(InData%VelAvg, kind=B8Ki)) - call RegPack(Buf, InData%VelAvg) - end if - call RegPack(Buf, allocated(InData%AccAvg)) - if (allocated(InData%AccAvg)) then - call RegPackBounds(Buf, 3, lbound(InData%AccAvg, kind=B8Ki), ubound(InData%AccAvg, kind=B8Ki)) - call RegPack(Buf, InData%AccAvg) - end if - call RegPack(Buf, InData%DTime) - call RegPack(Buf, InData%Rate) - call RegPack(Buf, InData%YHWid) - call RegPack(Buf, InData%ZHWid) - call RegPack(Buf, InData%GridBase) - call RegPack(Buf, InData%InitXPosition) - call RegPack(Buf, InData%InvDY) - call RegPack(Buf, InData%InvDZ) - call RegPack(Buf, InData%MeanWS) - call RegPack(Buf, InData%InvMWS) - call RegPack(Buf, InData%TotalTime) - call RegPack(Buf, InData%NComp) - call RegPack(Buf, InData%NYGrids) - call RegPack(Buf, InData%NZGrids) - call RegPack(Buf, InData%NTGrids) - call RegPack(Buf, InData%NSteps) - call RegPack(Buf, InData%PLExp) - call RegPack(Buf, InData%Z0) - call RegPack(Buf, InData%VLinShr) - call RegPack(Buf, InData%HLinShr) - call RegPack(Buf, InData%BoxExceedAllow) - call RegPack(Buf, InData%BoxExceedAllowDrv) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileFormat) + call RegPack(RF, InData%WindProfileType) + call RegPack(RF, InData%Periodic) + call RegPack(RF, InData%InterpTower) + call RegPack(RF, InData%AddMeanAfterInterp) + call RegPack(RF, InData%RefHeight) + call RegPack(RF, InData%RefLength) + call RegPackAlloc(RF, InData%Vel) + call RegPackAlloc(RF, InData%Acc) + call RegPackAlloc(RF, InData%VelTower) + call RegPackAlloc(RF, InData%AccTower) + call RegPackAlloc(RF, InData%VelAvg) + call RegPackAlloc(RF, InData%AccAvg) + call RegPack(RF, InData%DTime) + call RegPack(RF, InData%Rate) + call RegPack(RF, InData%YHWid) + call RegPack(RF, InData%ZHWid) + call RegPack(RF, InData%GridBase) + call RegPack(RF, InData%InitXPosition) + call RegPack(RF, InData%InvDY) + call RegPack(RF, InData%InvDZ) + call RegPack(RF, InData%MeanWS) + call RegPack(RF, InData%InvMWS) + call RegPack(RF, InData%TotalTime) + call RegPack(RF, InData%NComp) + call RegPack(RF, InData%NYGrids) + call RegPack(RF, InData%NZGrids) + call RegPack(RF, InData%NTGrids) + call RegPack(RF, InData%NSteps) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%Z0) + call RegPack(RF, InData%VLinShr) + call RegPack(RF, InData%HLinShr) + call RegPack(RF, InData%BoxExceedAllow) + call RegPack(RF, InData%BoxExceedAllowDrv) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackGrid3DFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Grid3DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WindFileFormat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindProfileType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Periodic) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InterpTower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AddMeanAfterInterp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Vel)) deallocate(OutData%Vel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Acc)) deallocate(OutData%Acc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Acc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelTower)) deallocate(OutData%VelTower) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelTower) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AccTower)) deallocate(OutData%AccTower) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AccTower) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%VelAvg)) deallocate(OutData%VelAvg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelAvg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AccAvg)) deallocate(OutData%AccAvg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AccAvg) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%DTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Rate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YHWid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ZHWid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GridBase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InitXPosition) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InvDY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InvDZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MeanWS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InvMWS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TotalTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NComp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NYGrids) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NZGrids) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NTGrids) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NSteps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VLinShr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HLinShr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BoxExceedAllow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BoxExceedAllowDrv) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindProfileType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Periodic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AddMeanAfterInterp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Acc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VelAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YHWid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZHWid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GridBase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InitXPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvDY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvDZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeanWS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InvMWS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TotalTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NComp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NYGrids); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NZGrids); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NTGrids); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllowDrv); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1300,30 +857,23 @@ subroutine IfW_FlowField_DestroyGrid4DFieldType(Grid4DFieldTypeData, ErrStat, Er nullify(Grid4DFieldTypeData%Vel) end subroutine -subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackGrid4DFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Grid4DFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid4DFieldType' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) - call RegPack(Buf, InData%delta) - call RegPack(Buf, InData%pZero) - call RegPack(Buf, associated(InData%Vel)) - if (associated(InData%Vel)) then - call RegPackBounds(Buf, 5, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Vel) - end if - end if - call RegPack(Buf, InData%TimeStart) - call RegPack(Buf, InData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPackPtr(RF, InData%Vel) + call RegPack(RF, InData%TimeStart) + call RegPack(RF, InData%RefHeight) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackGrid4DFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Grid4DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' integer(B8Ki) :: LB(5), UB(5) @@ -1331,41 +881,13 @@ subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pZero) - if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%Vel)) deallocate(OutData%Vel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vel, UB(1:5)-LB(1:5)) - OutData%Vel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vel - else - allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Vel) - call RegUnpack(Buf, OutData%Vel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Vel => null() - end if - call RegUnpack(Buf, OutData%TimeStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Vel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1405,41 +927,24 @@ subroutine IfW_FlowField_DestroyPointsFieldType(PointsFieldTypeData, ErrStat, Er end if end subroutine -subroutine IfW_FlowField_PackPointsFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackPointsFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(PointsFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackPointsFieldType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Vel)) - if (allocated(InData%Vel)) then - call RegPackBounds(Buf, 2, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) - call RegPack(Buf, InData%Vel) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Vel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackPointsFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackPointsFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(PointsFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Vel)) deallocate(OutData%Vel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vel) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Vel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IfW_FlowField_CopyUserFieldType(SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1463,22 +968,21 @@ subroutine IfW_FlowField_DestroyUserFieldType(UserFieldTypeData, ErrStat, ErrMsg ErrMsg = '' end subroutine -subroutine IfW_FlowField_PackUserFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackUserFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(UserFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackUserFieldType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RefHeight) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackUserFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackUserFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(UserFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUserFieldType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RefHeight); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine IfW_FlowField_CopyFlowFieldType(SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1539,56 +1043,47 @@ subroutine IfW_FlowField_DestroyFlowFieldType(FlowFieldTypeData, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine IfW_FlowField_PackFlowFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_PackFlowFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FlowFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackFlowFieldType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FieldType) - call RegPack(Buf, InData%RefPosition) - call RegPack(Buf, InData%PropagationDir) - call RegPack(Buf, InData%VFlowAngle) - call RegPack(Buf, InData%VelInterpCubic) - call RegPack(Buf, InData%RotateWindBox) - call RegPack(Buf, InData%AccFieldValid) - call RegPack(Buf, InData%RotToWind) - call RegPack(Buf, InData%RotFromWind) - call IfW_FlowField_PackUniformFieldType(Buf, InData%Uniform) - call IfW_FlowField_PackGrid3DFieldType(Buf, InData%Grid3D) - call IfW_FlowField_PackGrid4DFieldType(Buf, InData%Grid4D) - call IfW_FlowField_PackPointsFieldType(Buf, InData%Points) - call IfW_FlowField_PackUserFieldType(Buf, InData%User) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FieldType) + call RegPack(RF, InData%RefPosition) + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%VFlowAngle) + call RegPack(RF, InData%VelInterpCubic) + call RegPack(RF, InData%RotateWindBox) + call RegPack(RF, InData%AccFieldValid) + call RegPack(RF, InData%RotToWind) + call RegPack(RF, InData%RotFromWind) + call IfW_FlowField_PackUniformFieldType(RF, InData%Uniform) + call IfW_FlowField_PackGrid3DFieldType(RF, InData%Grid3D) + call IfW_FlowField_PackGrid4DFieldType(RF, InData%Grid4D) + call IfW_FlowField_PackPointsFieldType(RF, InData%Points) + call IfW_FlowField_PackUserFieldType(RF, InData%User) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine IfW_FlowField_UnPackFlowFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine IfW_FlowField_UnPackFlowFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FlowFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackFlowFieldType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FieldType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefPosition) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VFlowAngle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelInterpCubic) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotateWindBox) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AccFieldValid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotToWind) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotFromWind) - if (RegCheckErr(Buf, RoutineName)) return - call IfW_FlowField_UnpackUniformFieldType(Buf, OutData%Uniform) ! Uniform - call IfW_FlowField_UnpackGrid3DFieldType(Buf, OutData%Grid3D) ! Grid3D - call IfW_FlowField_UnpackGrid4DFieldType(Buf, OutData%Grid4D) ! Grid4D - call IfW_FlowField_UnpackPointsFieldType(Buf, OutData%Points) ! Points - call IfW_FlowField_UnpackUserFieldType(Buf, OutData%User) ! User + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FieldType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VFlowAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelInterpCubic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotateWindBox); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AccFieldValid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotToWind); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotFromWind); if (RegCheckErr(RF, RoutineName)) return + call IfW_FlowField_UnpackUniformFieldType(RF, OutData%Uniform) ! Uniform + call IfW_FlowField_UnpackGrid3DFieldType(RF, OutData%Grid3D) ! Grid3D + call IfW_FlowField_UnpackGrid4DFieldType(RF, OutData%Grid4D) ! Grid4D + call IfW_FlowField_UnpackPointsFieldType(RF, OutData%Points) ! Points + call IfW_FlowField_UnpackUserFieldType(RF, OutData%User) ! User end subroutine END MODULE IfW_FlowField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 310d88ebc9..ef7fb7f1f5 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -180,73 +180,55 @@ subroutine InflowWind_IO_DestroyWindFileDat(WindFileDatData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackWindFileDat(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackWindFileDat(RF, Indata) + type(RegFile), intent(inout) :: RF type(WindFileDat), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackWindFileDat' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%FileName) - call RegPack(Buf, InData%WindType) - call RegPack(Buf, InData%RefHt) - call RegPack(Buf, InData%RefHt_Set) - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%NumTSteps) - call RegPack(Buf, InData%ConstantDT) - call RegPack(Buf, InData%TRange) - call RegPack(Buf, InData%TRange_Limited) - call RegPack(Buf, InData%YRange) - call RegPack(Buf, InData%YRange_Limited) - call RegPack(Buf, InData%ZRange) - call RegPack(Buf, InData%ZRange_Limited) - call RegPack(Buf, InData%BinaryFormat) - call RegPack(Buf, InData%IsBinary) - call RegPack(Buf, InData%TI) - call RegPack(Buf, InData%TI_listed) - call RegPack(Buf, InData%MWS) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine InflowWind_IO_UnPackWindFileDat(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%FileName) + call RegPack(RF, InData%WindType) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%RefHt_Set) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%NumTSteps) + call RegPack(RF, InData%ConstantDT) + call RegPack(RF, InData%TRange) + call RegPack(RF, InData%TRange_Limited) + call RegPack(RF, InData%YRange) + call RegPack(RF, InData%YRange_Limited) + call RegPack(RF, InData%ZRange) + call RegPack(RF, InData%ZRange_Limited) + call RegPack(RF, InData%BinaryFormat) + call RegPack(RF, InData%IsBinary) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%TI_listed) + call RegPack(RF, InData%MWS) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackWindFileDat(RF, OutData) + type(RegFile), intent(inout) :: RF type(WindFileDat), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackWindFileDat' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt_Set) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTSteps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ConstantDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TRange) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TRange_Limited) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YRange) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YRange_Limited) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ZRange) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ZRange_Limited) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BinaryFormat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IsBinary) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_listed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MWS) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt_Set); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConstantDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TRange_Limited); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YRange_Limited); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ZRange_Limited); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BinaryFormat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsBinary); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_listed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MWS); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopySteady_InitInputType(SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -272,28 +254,25 @@ subroutine InflowWind_IO_DestroySteady_InitInputType(Steady_InitInputTypeData, E ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackSteady_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackSteady_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Steady_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%HWindSpeed) - call RegPack(Buf, InData%RefHt) - call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%HWindSpeed) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%PLExp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_IO_UnPackSteady_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_UnPackSteady_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Steady_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyUniform_InitInputType(SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -330,36 +309,31 @@ subroutine InflowWind_IO_DestroyUniform_InitInputType(Uniform_InitInputTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_IO_PackUniform_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackUniform_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Uniform_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WindFileName) - call RegPack(Buf, InData%RefHt) - call RegPack(Buf, InData%RefLength) - call RegPack(Buf, InData%PropagationDir) - call RegPack(Buf, InData%UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine InflowWind_IO_UnPackUniform_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUniform_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Uniform_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData end subroutine subroutine InflowWind_IO_CopyGrid3D_InitInputType(SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -394,55 +368,43 @@ subroutine InflowWind_IO_DestroyGrid3D_InitInputType(Grid3D_InitInputTypeData, E ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackGrid3D_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackGrid3D_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Grid3D_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%ScaleMethod) - call RegPack(Buf, InData%SF) - call RegPack(Buf, InData%SigmaF) - call RegPack(Buf, InData%WindProfileType) - call RegPack(Buf, InData%RefHt) - call RegPack(Buf, InData%URef) - call RegPack(Buf, InData%PLExp) - call RegPack(Buf, InData%VLinShr) - call RegPack(Buf, InData%HLinShr) - call RegPack(Buf, InData%RefLength) - call RegPack(Buf, InData%Z0) - call RegPack(Buf, InData%XOffset) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine InflowWind_IO_UnPackGrid3D_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ScaleMethod) + call RegPack(RF, InData%SF) + call RegPack(RF, InData%SigmaF) + call RegPack(RF, InData%WindProfileType) + call RegPack(RF, InData%RefHt) + call RegPack(RF, InData%URef) + call RegPack(RF, InData%PLExp) + call RegPack(RF, InData%VLinShr) + call RegPack(RF, InData%HLinShr) + call RegPack(RF, InData%RefLength) + call RegPack(RF, InData%Z0) + call RegPack(RF, InData%XOffset) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid3D_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Grid3D_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid3D_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%ScaleMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SigmaF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindProfileType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%URef) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VLinShr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HLinShr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%XOffset) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ScaleMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SigmaF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindProfileType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PLExp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HLinShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%XOffset); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyTurbSim_InitInputType(SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -466,22 +428,21 @@ subroutine InflowWind_IO_DestroyTurbSim_InitInputType(TurbSim_InitInputTypeData, ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackTurbSim_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackTurbSim_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(TurbSim_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackTurbSim_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_IO_UnPackTurbSim_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_UnPackTurbSim_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(TurbSim_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyBladed_InitInputType(SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -510,37 +471,31 @@ subroutine InflowWind_IO_DestroyBladed_InitInputType(Bladed_InitInputTypeData, E ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackBladed_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackBladed_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Bladed_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WindFileName) - call RegPack(Buf, InData%WindType) - call RegPack(Buf, InData%NativeBladedFmt) - call RegPack(Buf, InData%TowerFileExist) - call RegPack(Buf, InData%TurbineID) - call RegPack(Buf, InData%FixedWindFileRootName) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine InflowWind_IO_UnPackBladed_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + call RegPack(RF, InData%WindType) + call RegPack(RF, InData%NativeBladedFmt) + call RegPack(RF, InData%TowerFileExist) + call RegPack(RF, InData%TurbineID) + call RegPack(RF, InData%FixedWindFileRootName) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Bladed_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NativeBladedFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TowerFileExist) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TurbineID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FixedWindFileRootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NativeBladedFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerFileExist); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbineID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FixedWindFileRootName); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyBladed_InitOutputType(SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -565,25 +520,23 @@ subroutine InflowWind_IO_DestroyBladed_InitOutputType(Bladed_InitOutputTypeData, ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackBladed_InitOutputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackBladed_InitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Bladed_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%PropagationDir) - call RegPack(Buf, InData%VFlowAngle) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%VFlowAngle) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_IO_UnPackBladed_InitOutputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_UnPackBladed_InitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Bladed_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VFlowAngle) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VFlowAngle); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyHAWC_InitInputType(SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -622,42 +575,35 @@ subroutine InflowWind_IO_DestroyHAWC_InitInputType(HAWC_InitInputTypeData, ErrSt call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_IO_PackHAWC_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackHAWC_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(HAWC_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WindFileName) - call RegPack(Buf, InData%nx) - call RegPack(Buf, InData%ny) - call RegPack(Buf, InData%nz) - call RegPack(Buf, InData%dx) - call RegPack(Buf, InData%dy) - call RegPack(Buf, InData%dz) - call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%G3D) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine InflowWind_IO_UnPackHAWC_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WindFileName) + call RegPack(RF, InData%nx) + call RegPack(RF, InData%ny) + call RegPack(RF, InData%nz) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%dy) + call RegPack(RF, InData%dz) + call InflowWind_IO_PackGrid3D_InitInputType(RF, InData%G3D) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackHAWC_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(HAWC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackHAWC_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nz) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dy) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dz) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%G3D) ! G3D + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WindFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dz); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_IO_UnpackGrid3D_InitInputType(RF, OutData%G3D) ! G3D end subroutine subroutine InflowWind_IO_CopyUser_InitInputType(SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -681,22 +627,21 @@ subroutine InflowWind_IO_DestroyUser_InitInputType(User_InitInputTypeData, ErrSt ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackUser_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackUser_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(User_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackUser_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_IO_UnPackUser_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_UnPackUser_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(User_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -726,28 +671,21 @@ subroutine InflowWind_IO_DestroyGrid4D_InitInputType(Grid4D_InitInputTypeData, E nullify(Grid4D_InitInputTypeData%Vel) end subroutine -subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackGrid4D_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Grid4D_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid4D_InitInputType' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) - call RegPack(Buf, InData%delta) - call RegPack(Buf, InData%pZero) - call RegPack(Buf, associated(InData%Vel)) - if (associated(InData%Vel)) then - call RegPackBounds(Buf, 5, lbound(InData%Vel, kind=B8Ki), ubound(InData%Vel, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Vel) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPackPtr(RF, InData%Vel) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid4D_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Grid4D_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' integer(B8Ki) :: LB(5), UB(5) @@ -755,37 +693,11 @@ subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pZero) - if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%Vel)) deallocate(OutData%Vel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Vel, UB(1:5)-LB(1:5)) - OutData%Vel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vel - else - allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Vel) - call RegUnpack(Buf, OutData%Vel) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Vel => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Vel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_IO_CopyPoints_InitInputType(SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -809,22 +721,21 @@ subroutine InflowWind_IO_DestroyPoints_InitInputType(Points_InitInputTypeData, E ErrMsg = '' end subroutine -subroutine InflowWind_IO_PackPoints_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_PackPoints_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Points_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackPoints_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumWindPoints) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumWindPoints) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_IO_UnPackPoints_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_IO_UnPackPoints_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Points_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumWindPoints) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumWindPoints); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE InflowWind_IO_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index b637ad8deb..98cd599ab4 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -375,271 +375,114 @@ subroutine InflowWind_DestroyInputFile(InputFileData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%EchoFlag) - call RegPack(Buf, InData%WindType) - call RegPack(Buf, InData%PropagationDir) - call RegPack(Buf, InData%VFlowAngle) - call RegPack(Buf, InData%VelInterpCubic) - call RegPack(Buf, InData%NWindVel) - call RegPack(Buf, allocated(InData%WindVxiList)) - if (allocated(InData%WindVxiList)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVxiList, kind=B8Ki), ubound(InData%WindVxiList, kind=B8Ki)) - call RegPack(Buf, InData%WindVxiList) - end if - call RegPack(Buf, allocated(InData%WindVyiList)) - if (allocated(InData%WindVyiList)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVyiList, kind=B8Ki), ubound(InData%WindVyiList, kind=B8Ki)) - call RegPack(Buf, InData%WindVyiList) - end if - call RegPack(Buf, allocated(InData%WindVziList)) - if (allocated(InData%WindVziList)) then - call RegPackBounds(Buf, 1, lbound(InData%WindVziList, kind=B8Ki), ubound(InData%WindVziList, kind=B8Ki)) - call RegPack(Buf, InData%WindVziList) - end if - call RegPack(Buf, InData%Steady_HWindSpeed) - call RegPack(Buf, InData%Steady_RefHt) - call RegPack(Buf, InData%Steady_PLexp) - call RegPack(Buf, InData%Uniform_FileName) - call RegPack(Buf, InData%Uniform_RefHt) - call RegPack(Buf, InData%Uniform_RefLength) - call RegPack(Buf, InData%TSFF_FileName) - call RegPack(Buf, InData%BladedFF_FileName) - call RegPack(Buf, InData%BladedFF_TowerFile) - call RegPack(Buf, InData%CTTS_CoherentTurb) - call RegPack(Buf, InData%CTTS_FileName) - call RegPack(Buf, InData%CTTS_Path) - call RegPack(Buf, InData%HAWC_FileName_u) - call RegPack(Buf, InData%HAWC_FileName_v) - call RegPack(Buf, InData%HAWC_FileName_w) - call RegPack(Buf, InData%HAWC_nx) - call RegPack(Buf, InData%HAWC_ny) - call RegPack(Buf, InData%HAWC_nz) - call RegPack(Buf, InData%HAWC_dx) - call RegPack(Buf, InData%HAWC_dy) - call RegPack(Buf, InData%HAWC_dz) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%NumBeam) - call RegPack(Buf, InData%NumPulseGate) - call RegPack(Buf, InData%RotorApexOffsetPos) - call RegPack(Buf, allocated(InData%FocalDistanceX)) - if (allocated(InData%FocalDistanceX)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX, kind=B8Ki), ubound(InData%FocalDistanceX, kind=B8Ki)) - call RegPack(Buf, InData%FocalDistanceX) - end if - call RegPack(Buf, allocated(InData%FocalDistanceY)) - if (allocated(InData%FocalDistanceY)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY, kind=B8Ki), ubound(InData%FocalDistanceY, kind=B8Ki)) - call RegPack(Buf, InData%FocalDistanceY) - end if - call RegPack(Buf, allocated(InData%FocalDistanceZ)) - if (allocated(InData%FocalDistanceZ)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ, kind=B8Ki), ubound(InData%FocalDistanceZ, kind=B8Ki)) - call RegPack(Buf, InData%FocalDistanceZ) - end if - call RegPack(Buf, InData%PulseSpacing) - call RegPack(Buf, InData%MeasurementInterval) - call RegPack(Buf, InData%URefLid) - call RegPack(Buf, InData%LidRadialVel) - call RegPack(Buf, InData%ConsiderHubMotion) - call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%FF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPack(RF, InData%WindType) + call RegPack(RF, InData%PropagationDir) + call RegPack(RF, InData%VFlowAngle) + call RegPack(RF, InData%VelInterpCubic) + call RegPack(RF, InData%NWindVel) + call RegPackAlloc(RF, InData%WindVxiList) + call RegPackAlloc(RF, InData%WindVyiList) + call RegPackAlloc(RF, InData%WindVziList) + call RegPack(RF, InData%Steady_HWindSpeed) + call RegPack(RF, InData%Steady_RefHt) + call RegPack(RF, InData%Steady_PLexp) + call RegPack(RF, InData%Uniform_FileName) + call RegPack(RF, InData%Uniform_RefHt) + call RegPack(RF, InData%Uniform_RefLength) + call RegPack(RF, InData%TSFF_FileName) + call RegPack(RF, InData%BladedFF_FileName) + call RegPack(RF, InData%BladedFF_TowerFile) + call RegPack(RF, InData%CTTS_CoherentTurb) + call RegPack(RF, InData%CTTS_FileName) + call RegPack(RF, InData%CTTS_Path) + call RegPack(RF, InData%HAWC_FileName_u) + call RegPack(RF, InData%HAWC_FileName_v) + call RegPack(RF, InData%HAWC_FileName_w) + call RegPack(RF, InData%HAWC_nx) + call RegPack(RF, InData%HAWC_ny) + call RegPack(RF, InData%HAWC_nz) + call RegPack(RF, InData%HAWC_dx) + call RegPack(RF, InData%HAWC_dy) + call RegPack(RF, InData%HAWC_dz) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%RotorApexOffsetPos) + call RegPackAlloc(RF, InData%FocalDistanceX) + call RegPackAlloc(RF, InData%FocalDistanceY) + call RegPackAlloc(RF, InData%FocalDistanceZ) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%MeasurementInterval) + call RegPack(RF, InData%URefLid) + call RegPack(RF, InData%LidRadialVel) + call RegPack(RF, InData%ConsiderHubMotion) + call InflowWind_IO_PackGrid3D_InitInputType(RF, InData%FF) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%EchoFlag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VFlowAngle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VelInterpCubic) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWindVel) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WindVxiList)) deallocate(OutData%WindVxiList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindVxiList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindVxiList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindVyiList)) deallocate(OutData%WindVyiList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindVyiList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindVyiList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindVziList)) deallocate(OutData%WindVziList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindVziList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindVziList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Steady_HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Steady_RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Steady_PLexp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Uniform_FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Uniform_RefHt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Uniform_RefLength) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TSFF_FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BladedFF_FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BladedFF_TowerFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTTS_CoherentTurb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTTS_FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CTTS_Path) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_FileName_u) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_FileName_v) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_FileName_w) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_nz) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_dx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_dy) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HAWC_dz) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotorApexOffsetPos) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FocalDistanceX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FocalDistanceX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FocalDistanceY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FocalDistanceY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FocalDistanceZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FocalDistanceZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MeasurementInterval) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ConsiderHubMotion) - if (RegCheckErr(Buf, RoutineName)) return - call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%FF) ! FF + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropagationDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VFlowAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VelInterpCubic); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVxiList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVyiList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindVziList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Steady_HWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Steady_RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Steady_PLexp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uniform_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uniform_RefHt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Uniform_RefLength); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSFF_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladedFF_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladedFF_TowerFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTTS_CoherentTurb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTTS_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CTTS_Path); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_FileName_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_FileName_v); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_FileName_w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_nz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HAWC_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorApexOffsetPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeasurementInterval); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConsiderHubMotion); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_IO_UnpackGrid3D_InitInputType(RF, OutData%FF) ! FF end subroutine subroutine InflowWind_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -701,72 +544,57 @@ subroutine InflowWind_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFileName) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%Use4Dext) - call RegPack(Buf, InData%NumWindPoints) - call RegPack(Buf, InData%TurbineID) - call RegPack(Buf, InData%FixedWindFileRootName) - call RegPack(Buf, InData%UseInputFile) - call RegPack(Buf, InData%RootName) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - call RegPack(Buf, InData%WindType2UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%WindType2Data) - call RegPack(Buf, InData%OutputAccel) - call Lidar_PackInitInput(Buf, InData%lidar) - call InflowWind_IO_PackGrid4D_InitInputType(Buf, InData%FDext) - call RegPack(Buf, InData%RadAvg) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%BoxExceedAllow) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFileName) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%Use4Dext) + call RegPack(RF, InData%NumWindPoints) + call RegPack(RF, InData%TurbineID) + call RegPack(RF, InData%FixedWindFileRootName) + call RegPack(RF, InData%UseInputFile) + call RegPack(RF, InData%RootName) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, InData%WindType2UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%WindType2Data) + call RegPack(RF, InData%OutputAccel) + call Lidar_PackInitInput(RF, InData%lidar) + call InflowWind_IO_PackGrid4D_InitInputType(RF, InData%FDext) + call RegPack(RF, InData%RadAvg) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%BoxExceedAllow) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Use4Dext) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumWindPoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TurbineID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FixedWindFileRootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - call RegUnpack(Buf, OutData%WindType2UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%WindType2Data) ! WindType2Data - call RegUnpack(Buf, OutData%OutputAccel) - if (RegCheckErr(Buf, RoutineName)) return - call Lidar_UnpackInitInput(Buf, OutData%lidar) ! lidar - call InflowWind_IO_UnpackGrid4D_InitInputType(Buf, OutData%FDext) ! FDext - call RegUnpack(Buf, OutData%RadAvg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BoxExceedAllow) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Use4Dext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumWindPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbineID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FixedWindFileRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%WindType2UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%WindType2Data) ! WindType2Data + call RegUnpack(RF, OutData%OutputAccel); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackInitInput(RF, OutData%lidar) ! lidar + call InflowWind_IO_UnpackGrid4D_InitInputType(RF, OutData%FDext) ! FDext + call RegUnpack(RF, OutData%RadAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BoxExceedAllow); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -911,61 +739,33 @@ subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%FlowField) end subroutine -subroutine InflowWind_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInitOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call InflowWind_IO_PackWindFileDat(Buf, InData%WindFileInfo) - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, associated(InData%FlowField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call InflowWind_IO_PackWindFileDat(RF, InData%WindFileInfo) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPack(RF, associated(InData%FlowField)) if (associated(InData%FlowField)) then - call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) @@ -973,123 +773,30 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call InflowWind_IO_UnpackWindFileDat(Buf, OutData%WindFileInfo) ! WindFileInfo - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call InflowWind_IO_UnpackWindFileDat(RF, OutData%WindFileInfo) ! WindFileInfo + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%FlowField) else allocate(OutData%FlowField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if else OutData%FlowField => null() @@ -1237,61 +944,45 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%RootFileName) - call RegPack(Buf, InData%DT) - call RegPack(Buf, allocated(InData%WindViXYZprime)) - if (allocated(InData%WindViXYZprime)) then - call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime, kind=B8Ki), ubound(InData%WindViXYZprime, kind=B8Ki)) - call RegPack(Buf, InData%WindViXYZprime) - end if - call RegPack(Buf, allocated(InData%WindViXYZ)) - if (allocated(InData%WindViXYZ)) then - call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ, kind=B8Ki), ubound(InData%WindViXYZ, kind=B8Ki)) - call RegPack(Buf, InData%WindViXYZ) - end if - call RegPack(Buf, associated(InData%FlowField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RootFileName) + call RegPack(RF, InData%DT) + call RegPackAlloc(RF, InData%WindViXYZprime) + call RegPackAlloc(RF, InData%WindViXYZ) + call RegPack(RF, associated(InData%FlowField)) if (associated(InData%FlowField)) then - call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) if (.not. PtrInIndex) then - call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) end if end if - call RegPack(Buf, allocated(InData%PositionAvg)) - if (allocated(InData%PositionAvg)) then - call RegPackBounds(Buf, 2, lbound(InData%PositionAvg, kind=B8Ki), ubound(InData%PositionAvg, kind=B8Ki)) - call RegPack(Buf, InData%PositionAvg) - end if - call RegPack(Buf, InData%NWindVel) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutParam)) + call RegPackAlloc(RF, InData%PositionAvg) + call RegPack(RF, InData%NWindVel) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, allocated(InData%OutParamLinIndx)) - if (allocated(InData%OutParamLinIndx)) then - call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx, kind=B8Ki), ubound(InData%OutParamLinIndx, kind=B8Ki)) - call RegPack(Buf, InData%OutParamLinIndx) - end if - call Lidar_PackParam(Buf, InData%lidar) - call RegPack(Buf, InData%OutputAccel) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%OutParamLinIndx) + call Lidar_PackParam(RF, InData%lidar) + call RegPack(RF, InData%OutputAccel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' integer(B8Ki) :: i1, i2 @@ -1300,109 +991,48 @@ subroutine InflowWind_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%RootFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WindViXYZprime)) deallocate(OutData%WindViXYZprime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindViXYZprime) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindViXYZ)) deallocate(OutData%WindViXYZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindViXYZ) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RootFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindViXYZprime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindViXYZ); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%FlowField)) deallocate(OutData%FlowField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%FlowField) else allocate(OutData%FlowField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) - call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField end if else OutData%FlowField => null() end if - if (allocated(OutData%PositionAvg)) deallocate(OutData%PositionAvg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PositionAvg(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PositionAvg) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NWindVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PositionAvg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWindVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutParamLinIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call Lidar_UnpackParam(Buf, OutData%lidar) ! lidar - call RegUnpack(Buf, OutData%OutputAccel) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutParamLinIndx); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackParam(RF, OutData%lidar) ! lidar + call RegUnpack(RF, OutData%OutputAccel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -1452,49 +1082,30 @@ subroutine InflowWind_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%PositionXYZ)) - if (allocated(InData%PositionXYZ)) then - call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ, kind=B8Ki), ubound(InData%PositionXYZ, kind=B8Ki)) - call RegPack(Buf, InData%PositionXYZ) - end if - call Lidar_PackInput(Buf, InData%lidar) - call RegPack(Buf, InData%HubPosition) - call RegPack(Buf, InData%HubOrientation) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%PositionXYZ) + call Lidar_PackInput(RF, InData%lidar) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%HubOrientation) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%PositionXYZ)) deallocate(OutData%PositionXYZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PositionXYZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call Lidar_UnpackInput(Buf, OutData%lidar) ! lidar - call RegUnpack(Buf, OutData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubOrientation) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%PositionXYZ); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackInput(RF, OutData%lidar) ! lidar + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubOrientation); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1574,87 +1185,34 @@ subroutine InflowWind_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%VelocityUVW)) - if (allocated(InData%VelocityUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW, kind=B8Ki), ubound(InData%VelocityUVW, kind=B8Ki)) - call RegPack(Buf, InData%VelocityUVW) - end if - call RegPack(Buf, allocated(InData%AccelUVW)) - if (allocated(InData%AccelUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%AccelUVW, kind=B8Ki), ubound(InData%AccelUVW, kind=B8Ki)) - call RegPack(Buf, InData%AccelUVW) - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, InData%DiskVel) - call RegPack(Buf, InData%HubVel) - call Lidar_PackOutput(Buf, InData%lidar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%VelocityUVW) + call RegPackAlloc(RF, InData%AccelUVW) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPack(RF, InData%DiskVel) + call RegPack(RF, InData%HubVel) + call Lidar_PackOutput(RF, InData%lidar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%VelocityUVW)) deallocate(OutData%VelocityUVW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VelocityUVW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AccelUVW)) deallocate(OutData%AccelUVW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AccelUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AccelUVW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%DiskVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubVel) - if (RegCheckErr(Buf, RoutineName)) return - call Lidar_UnpackOutput(Buf, OutData%lidar) ! lidar + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%VelocityUVW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AccelUVW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DiskVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubVel); if (RegCheckErr(RF, RoutineName)) return + call Lidar_UnpackOutput(RF, OutData%lidar) ! lidar end subroutine subroutine InflowWind_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1678,22 +1236,21 @@ subroutine InflowWind_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine InflowWind_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -1717,22 +1274,21 @@ subroutine InflowWind_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine InflowWind_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1756,22 +1312,21 @@ subroutine InflowWind_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine InflowWind_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1795,22 +1350,21 @@ subroutine InflowWind_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine InflowWind_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1903,87 +1457,36 @@ subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine InflowWind_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - call RegPack(Buf, allocated(InData%WindViUVW)) - if (allocated(InData%WindViUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%WindViUVW, kind=B8Ki), ubound(InData%WindViUVW, kind=B8Ki)) - call RegPack(Buf, InData%WindViUVW) - end if - call RegPack(Buf, allocated(InData%WindAiUVW)) - if (allocated(InData%WindAiUVW)) then - call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW, kind=B8Ki), ubound(InData%WindAiUVW, kind=B8Ki)) - call RegPack(Buf, InData%WindAiUVW) - end if - call InflowWind_PackInput(Buf, InData%u_Avg) - call InflowWind_PackOutput(Buf, InData%y_Avg) - call InflowWind_PackInput(Buf, InData%u_Hub) - call InflowWind_PackOutput(Buf, InData%y_Hub) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AllOuts) + call RegPackAlloc(RF, InData%WindViUVW) + call RegPackAlloc(RF, InData%WindAiUVW) + call InflowWind_PackInput(RF, InData%u_Avg) + call InflowWind_PackOutput(RF, InData%y_Avg) + call InflowWind_PackInput(RF, InData%u_Hub) + call InflowWind_PackOutput(RF, InData%y_Hub) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine InflowWind_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine InflowWind_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindViUVW)) deallocate(OutData%WindViUVW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindViUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindViUVW) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WindAiUVW)) deallocate(OutData%WindAiUVW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAiUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WindAiUVW) - if (RegCheckErr(Buf, RoutineName)) return - end if - call InflowWind_UnpackInput(Buf, OutData%u_Avg) ! u_Avg - call InflowWind_UnpackOutput(Buf, OutData%y_Avg) ! y_Avg - call InflowWind_UnpackInput(Buf, OutData%u_Hub) ! u_Hub - call InflowWind_UnpackOutput(Buf, OutData%y_Hub) ! y_Hub + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindViUVW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WindAiUVW); if (RegCheckErr(RF, RoutineName)) return + call InflowWind_UnpackInput(RF, OutData%u_Avg) ! u_Avg + call InflowWind_UnpackOutput(RF, OutData%y_Avg) ! y_Avg + call InflowWind_UnpackInput(RF, OutData%u_Hub) ! u_Hub + call InflowWind_UnpackOutput(RF, OutData%y_Hub) ! y_Hub end subroutine subroutine InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 9c2eb09d1c..bb71c0ad4b 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -151,37 +151,31 @@ subroutine Lidar_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%Tmax) - call RegPack(Buf, InData%RotorApexOffsetPos) - call RegPack(Buf, InData%HubPosition) - call RegPack(Buf, InData%NumPulseGate) - call RegPack(Buf, InData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%RotorApexOffsetPos) + call RegPack(RF, InData%HubPosition) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%LidRadialVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotorApexOffsetPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorApexOffsetPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -205,22 +199,21 @@ subroutine Lidar_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyInitOut) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyInitOut) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyInitOut) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyInitOut); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -325,158 +318,70 @@ subroutine Lidar_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine Lidar_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumPulseGate) - call RegPack(Buf, InData%RotorApexOffsetPos) - call RegPack(Buf, InData%RayRangeSq) - call RegPack(Buf, InData%SpatialRes) - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%WtFnTrunc) - call RegPack(Buf, InData%PulseRangeOne) - call RegPack(Buf, InData%DeltaP) - call RegPack(Buf, InData%DeltaR) - call RegPack(Buf, InData%r_p) - call RegPack(Buf, InData%LidRadialVel) - call RegPack(Buf, InData%DisplacementLidarX) - call RegPack(Buf, InData%DisplacementLidarY) - call RegPack(Buf, InData%DisplacementLidarZ) - call RegPack(Buf, InData%NumBeam) - call RegPack(Buf, allocated(InData%FocalDistanceX)) - if (allocated(InData%FocalDistanceX)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX, kind=B8Ki), ubound(InData%FocalDistanceX, kind=B8Ki)) - call RegPack(Buf, InData%FocalDistanceX) - end if - call RegPack(Buf, allocated(InData%FocalDistanceY)) - if (allocated(InData%FocalDistanceY)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY, kind=B8Ki), ubound(InData%FocalDistanceY, kind=B8Ki)) - call RegPack(Buf, InData%FocalDistanceY) - end if - call RegPack(Buf, allocated(InData%FocalDistanceZ)) - if (allocated(InData%FocalDistanceZ)) then - call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ, kind=B8Ki), ubound(InData%FocalDistanceZ, kind=B8Ki)) - call RegPack(Buf, InData%FocalDistanceZ) - end if - call RegPack(Buf, allocated(InData%MsrPosition)) - if (allocated(InData%MsrPosition)) then - call RegPackBounds(Buf, 2, lbound(InData%MsrPosition, kind=B8Ki), ubound(InData%MsrPosition, kind=B8Ki)) - call RegPack(Buf, InData%MsrPosition) - end if - call RegPack(Buf, InData%PulseSpacing) - call RegPack(Buf, InData%URefLid) - call RegPack(Buf, InData%ConsiderHubMotion) - call RegPack(Buf, InData%MeasurementInterval) - call RegPack(Buf, InData%LidPosition) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%RotorApexOffsetPos) + call RegPack(RF, InData%RayRangeSq) + call RegPack(RF, InData%SpatialRes) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%WtFnTrunc) + call RegPack(RF, InData%PulseRangeOne) + call RegPack(RF, InData%DeltaP) + call RegPack(RF, InData%DeltaR) + call RegPack(RF, InData%r_p) + call RegPack(RF, InData%LidRadialVel) + call RegPack(RF, InData%DisplacementLidarX) + call RegPack(RF, InData%DisplacementLidarY) + call RegPack(RF, InData%DisplacementLidarZ) + call RegPack(RF, InData%NumBeam) + call RegPackAlloc(RF, InData%FocalDistanceX) + call RegPackAlloc(RF, InData%FocalDistanceY) + call RegPackAlloc(RF, InData%FocalDistanceZ) + call RegPackAlloc(RF, InData%MsrPosition) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + call RegPack(RF, InData%ConsiderHubMotion) + call RegPack(RF, InData%MeasurementInterval) + call RegPack(RF, InData%LidPosition) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotorApexOffsetPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RayRangeSq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpatialRes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtFnTrunc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PulseRangeOne) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DeltaP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DeltaR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%r_p) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DisplacementLidarX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DisplacementLidarY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DisplacementLidarZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FocalDistanceX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FocalDistanceX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FocalDistanceY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FocalDistanceY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FocalDistanceZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FocalDistanceZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPosition)) deallocate(OutData%MsrPosition) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPosition) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ConsiderHubMotion) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MeasurementInterval) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LidPosition) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotorApexOffsetPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RayRangeSq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpatialRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtFnTrunc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseRangeOne); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DeltaP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DeltaR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DisplacementLidarX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DisplacementLidarY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DisplacementLidarZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FocalDistanceZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ConsiderHubMotion); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeasurementInterval); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidPosition); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -500,22 +405,21 @@ subroutine Lidar_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -539,22 +443,21 @@ subroutine Lidar_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -578,22 +481,21 @@ subroutine Lidar_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -617,22 +519,21 @@ subroutine Lidar_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -656,22 +557,21 @@ subroutine Lidar_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyMiscVar) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyMiscVar) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyMiscVar); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -699,34 +599,29 @@ subroutine Lidar_DestroyInput(InputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Lidar_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%PulseLidEl) - call RegPack(Buf, InData%PulseLidAz) - call RegPack(Buf, InData%HubDisplacementX) - call RegPack(Buf, InData%HubDisplacementY) - call RegPack(Buf, InData%HubDisplacementZ) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PulseLidEl) + call RegPack(RF, InData%PulseLidAz) + call RegPack(RF, InData%HubDisplacementX) + call RegPack(RF, InData%HubDisplacementY) + call RegPack(RF, InData%HubDisplacementZ) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%PulseLidEl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PulseLidAz) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubDisplacementX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubDisplacementY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubDisplacementZ) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PulseLidEl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseLidAz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDisplacementX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDisplacementY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubDisplacementZ); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -826,117 +721,32 @@ subroutine Lidar_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Lidar_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lidar_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%LidSpeed)) - if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) - call RegPack(Buf, InData%LidSpeed) - end if - call RegPack(Buf, allocated(InData%WtTrunc)) - if (allocated(InData%WtTrunc)) then - call RegPackBounds(Buf, 1, lbound(InData%WtTrunc, kind=B8Ki), ubound(InData%WtTrunc, kind=B8Ki)) - call RegPack(Buf, InData%WtTrunc) - end if - call RegPack(Buf, allocated(InData%MsrPositionsX)) - if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsX) - end if - call RegPack(Buf, allocated(InData%MsrPositionsY)) - if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsY) - end if - call RegPack(Buf, allocated(InData%MsrPositionsZ)) - if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsZ) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%WtTrunc) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Lidar_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Lidar_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lidar_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LidSpeed) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WtTrunc)) deallocate(OutData%WtTrunc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WtTrunc(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WtTrunc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsZ) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WtTrunc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Lidar_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 25a5ca9be2..76bc63b701 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -75,22 +75,21 @@ subroutine MAP_Fortran_DestroyLin_InitInputType(Lin_InitInputTypeData, ErrStat, ErrMsg = '' end subroutine -subroutine MAP_Fortran_PackLin_InitInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_Fortran_PackLin_InitInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lin_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%linearize) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_Fortran_UnPackLin_InitInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_Fortran_UnPackLin_InitInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lin_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%linearize); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -160,79 +159,28 @@ subroutine MAP_Fortran_DestroyLin_InitOutputType(Lin_InitOutputTypeData, ErrStat end if end subroutine -subroutine MAP_Fortran_PackLin_InitOutputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_Fortran_PackLin_InitOutputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lin_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%IsLoad_u) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_Fortran_UnPackLin_InitOutputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lin_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg) @@ -274,47 +222,28 @@ subroutine MAP_Fortran_DestroyLin_ParamType(Lin_ParamTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine MAP_Fortran_PackLin_ParamType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_Fortran_PackLin_ParamType(RF, Indata) + type(RegFile), intent(inout) :: RF type(Lin_ParamType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, InData%du) - call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPack(RF, InData%du) + call RegPack(RF, InData%Jac_ny) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_Fortran_UnPackLin_ParamType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_Fortran_UnPackLin_ParamType(RF, OutData) + type(RegFile), intent(inout) :: RF type(Lin_ParamType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE MAP_Fortran_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index a75a018aff..ae02cdbd28 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -294,61 +294,52 @@ subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine MAP_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%gravity) - call RegPack(Buf, InData%sea_density) - call RegPack(Buf, InData%depth) - call RegPack(Buf, InData%file_name) - call RegPack(Buf, InData%summary_file_name) - call RegPack(Buf, InData%library_input_str) - call RegPack(Buf, InData%node_input_str) - call RegPack(Buf, InData%line_input_str) - call RegPack(Buf, InData%option_input_str) - call MAP_Fortran_PackLin_InitInputType(Buf, InData%LinInitInp) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%gravity) + call RegPack(RF, InData%sea_density) + call RegPack(RF, InData%depth) + call RegPack(RF, InData%file_name) + call RegPack(RF, InData%summary_file_name) + call RegPack(RF, InData%library_input_str) + call RegPack(RF, InData%node_input_str) + call RegPack(RF, InData%line_input_str) + call RegPack(RF, InData%option_input_str) + call MAP_Fortran_PackLin_InitInputType(RF, InData%LinInitInp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%gravity) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%gravity); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%gravity = OutData%gravity - call RegUnpack(Buf, OutData%sea_density) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%sea_density); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%sea_density = OutData%sea_density - call RegUnpack(Buf, OutData%depth) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%depth = OutData%depth - call RegUnpack(Buf, OutData%file_name) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%file_name); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%file_name = transfer(OutData%file_name, OutData%C_obj%file_name ) - call RegUnpack(Buf, OutData%summary_file_name) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%summary_file_name); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%summary_file_name = transfer(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - call RegUnpack(Buf, OutData%library_input_str) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%library_input_str); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%library_input_str = transfer(OutData%library_input_str, OutData%C_obj%library_input_str ) - call RegUnpack(Buf, OutData%node_input_str) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%node_input_str); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%node_input_str = transfer(OutData%node_input_str, OutData%C_obj%node_input_str ) - call RegUnpack(Buf, OutData%line_input_str) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%line_input_str); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) - call RegUnpack(Buf, OutData%option_input_str) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%option_input_str); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) - call MAP_Fortran_UnpackLin_InitInputType(Buf, OutData%LinInitInp) ! LinInitInp + call MAP_Fortran_UnpackLin_InitInputType(RF, OutData%LinInitInp) ! LinInitInp end subroutine SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) @@ -474,80 +465,43 @@ subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine MAP_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%progName) - call RegPack(Buf, InData%version) - call RegPack(Buf, InData%compilingData) - call RegPack(Buf, allocated(InData%writeOutputHdr)) - if (allocated(InData%writeOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr, kind=B8Ki), ubound(InData%writeOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%writeOutputHdr) - end if - call RegPack(Buf, allocated(InData%writeOutputUnt)) - if (allocated(InData%writeOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt, kind=B8Ki), ubound(InData%writeOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%writeOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call MAP_Fortran_PackLin_InitOutputType(Buf, InData%LinInitOut) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%progName) + call RegPack(RF, InData%version) + call RegPack(RF, InData%compilingData) + call RegPackAlloc(RF, InData%writeOutputHdr) + call RegPackAlloc(RF, InData%writeOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call MAP_Fortran_PackLin_InitOutputType(RF, InData%LinInitOut) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%progName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%progName); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) - call RegUnpack(Buf, OutData%version) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%version); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%version = transfer(OutData%version, OutData%C_obj%version ) - call RegUnpack(Buf, OutData%compilingData) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%compilingData); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%compilingData = transfer(OutData%compilingData, OutData%C_obj%compilingData ) - if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%writeOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%writeOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%writeOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%writeOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call MAP_Fortran_UnpackLin_InitOutputType(Buf, OutData%LinInitOut) ! LinInitOut + call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call MAP_Fortran_UnpackLin_InitOutputType(RF, OutData%LinInitOut) ! LinInitOut end subroutine SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -612,26 +566,25 @@ subroutine MAP_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MAP_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackContState' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%dummy = OutData%dummy end subroutine @@ -693,26 +646,25 @@ subroutine MAP_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MAP_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%dummy = OutData%dummy end subroutine @@ -1110,149 +1062,37 @@ subroutine MAP_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine MAP_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackOtherState' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%H)) - if (associated(InData%H)) then - call RegPackBounds(Buf, 1, lbound(InData%H, kind=B8Ki), ubound(InData%H, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%H) - end if - end if - call RegPack(Buf, associated(InData%V)) - if (associated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%V) - end if - end if - call RegPack(Buf, associated(InData%Ha)) - if (associated(InData%Ha)) then - call RegPackBounds(Buf, 1, lbound(InData%Ha, kind=B8Ki), ubound(InData%Ha, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Ha), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Ha) - end if - end if - call RegPack(Buf, associated(InData%Va)) - if (associated(InData%Va)) then - call RegPackBounds(Buf, 1, lbound(InData%Va, kind=B8Ki), ubound(InData%Va, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Va), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Va) - end if - end if - call RegPack(Buf, associated(InData%x)) - if (associated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%x) - end if - end if - call RegPack(Buf, associated(InData%y)) - if (associated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%y) - end if - end if - call RegPack(Buf, associated(InData%z)) - if (associated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%z) - end if - end if - call RegPack(Buf, associated(InData%xa)) - if (associated(InData%xa)) then - call RegPackBounds(Buf, 1, lbound(InData%xa, kind=B8Ki), ubound(InData%xa, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%xa), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%xa) - end if - end if - call RegPack(Buf, associated(InData%ya)) - if (associated(InData%ya)) then - call RegPackBounds(Buf, 1, lbound(InData%ya, kind=B8Ki), ubound(InData%ya, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%ya), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%ya) - end if - end if - call RegPack(Buf, associated(InData%za)) - if (associated(InData%za)) then - call RegPackBounds(Buf, 1, lbound(InData%za, kind=B8Ki), ubound(InData%za, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%za), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%za) - end if - end if - call RegPack(Buf, associated(InData%Fx_connect)) - if (associated(InData%Fx_connect)) then - call RegPackBounds(Buf, 1, lbound(InData%Fx_connect, kind=B8Ki), ubound(InData%Fx_connect, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fx_connect), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fx_connect) - end if - end if - call RegPack(Buf, associated(InData%Fy_connect)) - if (associated(InData%Fy_connect)) then - call RegPackBounds(Buf, 1, lbound(InData%Fy_connect, kind=B8Ki), ubound(InData%Fy_connect, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fy_connect), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fy_connect) - end if - end if - call RegPack(Buf, associated(InData%Fz_connect)) - if (associated(InData%Fz_connect)) then - call RegPackBounds(Buf, 1, lbound(InData%Fz_connect, kind=B8Ki), ubound(InData%Fz_connect, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fz_connect), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fz_connect) - end if - end if - call RegPack(Buf, associated(InData%Fx_anchor)) - if (associated(InData%Fx_anchor)) then - call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor, kind=B8Ki), ubound(InData%Fx_anchor, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fx_anchor), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fx_anchor) - end if - end if - call RegPack(Buf, associated(InData%Fy_anchor)) - if (associated(InData%Fy_anchor)) then - call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor, kind=B8Ki), ubound(InData%Fy_anchor, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fy_anchor), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fy_anchor) - end if - end if - call RegPack(Buf, associated(InData%Fz_anchor)) - if (associated(InData%Fz_anchor)) then - call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor, kind=B8Ki), ubound(InData%Fz_anchor, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fz_anchor), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fz_anchor) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%H) + call RegPackPtr(RF, InData%V) + call RegPackPtr(RF, InData%Ha) + call RegPackPtr(RF, InData%Va) + call RegPackPtr(RF, InData%x) + call RegPackPtr(RF, InData%y) + call RegPackPtr(RF, InData%z) + call RegPackPtr(RF, InData%xa) + call RegPackPtr(RF, InData%ya) + call RegPackPtr(RF, InData%za) + call RegPackPtr(RF, InData%Fx_connect) + call RegPackPtr(RF, InData%Fy_connect) + call RegPackPtr(RF, InData%Fz_connect) + call RegPackPtr(RF, InData%Fx_anchor) + call RegPackPtr(RF, InData%Fy_anchor) + call RegPackPtr(RF, InData%Fz_anchor) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' integer(B8Ki) :: LB(1), UB(1) @@ -1260,423 +1100,23 @@ subroutine MAP_UnPackOtherState(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%H)) deallocate(OutData%H) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%H, UB(1:1)-LB(1:1)) - OutData%H(LB(1):) => OutData%H - else - allocate(OutData%H(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%H) - OutData%C_obj%H_Len = size(OutData%H) - if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) - call RegUnpack(Buf, OutData%H) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%H => null() - end if - if (associated(OutData%V)) deallocate(OutData%V) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%V, UB(1:1)-LB(1:1)) - OutData%V(LB(1):) => OutData%V - else - allocate(OutData%V(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%V) - OutData%C_obj%V_Len = size(OutData%V) - if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) - call RegUnpack(Buf, OutData%V) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%V => null() - end if - if (associated(OutData%Ha)) deallocate(OutData%Ha) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Ha, UB(1:1)-LB(1:1)) - OutData%Ha(LB(1):) => OutData%Ha - else - allocate(OutData%Ha(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Ha) - OutData%C_obj%Ha_Len = size(OutData%Ha) - if (OutData%C_obj%Ha_Len > 0) OutData%C_obj%Ha = c_loc(OutData%Ha(LB(1))) - call RegUnpack(Buf, OutData%Ha) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Ha => null() - end if - if (associated(OutData%Va)) deallocate(OutData%Va) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Va, UB(1:1)-LB(1:1)) - OutData%Va(LB(1):) => OutData%Va - else - allocate(OutData%Va(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Va.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Va) - OutData%C_obj%Va_Len = size(OutData%Va) - if (OutData%C_obj%Va_Len > 0) OutData%C_obj%Va = c_loc(OutData%Va(LB(1))) - call RegUnpack(Buf, OutData%Va) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Va => null() - end if - if (associated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) - OutData%x(LB(1):) => OutData%x - else - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%x) - OutData%C_obj%x_Len = size(OutData%x) - if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) - call RegUnpack(Buf, OutData%x) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%x => null() - end if - if (associated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) - OutData%y(LB(1):) => OutData%y - else - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%y) - OutData%C_obj%y_Len = size(OutData%y) - if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%y => null() - end if - if (associated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) - OutData%z(LB(1):) => OutData%z - else - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%z) - OutData%C_obj%z_Len = size(OutData%z) - if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) - call RegUnpack(Buf, OutData%z) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%z => null() - end if - if (associated(OutData%xa)) deallocate(OutData%xa) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%xa, UB(1:1)-LB(1:1)) - OutData%xa(LB(1):) => OutData%xa - else - allocate(OutData%xa(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%xa) - OutData%C_obj%xa_Len = size(OutData%xa) - if (OutData%C_obj%xa_Len > 0) OutData%C_obj%xa = c_loc(OutData%xa(LB(1))) - call RegUnpack(Buf, OutData%xa) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%xa => null() - end if - if (associated(OutData%ya)) deallocate(OutData%ya) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%ya, UB(1:1)-LB(1:1)) - OutData%ya(LB(1):) => OutData%ya - else - allocate(OutData%ya(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ya.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%ya) - OutData%C_obj%ya_Len = size(OutData%ya) - if (OutData%C_obj%ya_Len > 0) OutData%C_obj%ya = c_loc(OutData%ya(LB(1))) - call RegUnpack(Buf, OutData%ya) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%ya => null() - end if - if (associated(OutData%za)) deallocate(OutData%za) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%za, UB(1:1)-LB(1:1)) - OutData%za(LB(1):) => OutData%za - else - allocate(OutData%za(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%za.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%za) - OutData%C_obj%za_Len = size(OutData%za) - if (OutData%C_obj%za_Len > 0) OutData%C_obj%za = c_loc(OutData%za(LB(1))) - call RegUnpack(Buf, OutData%za) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%za => null() - end if - if (associated(OutData%Fx_connect)) deallocate(OutData%Fx_connect) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fx_connect, UB(1:1)-LB(1:1)) - OutData%Fx_connect(LB(1):) => OutData%Fx_connect - else - allocate(OutData%Fx_connect(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fx_connect) - OutData%C_obj%Fx_connect_Len = size(OutData%Fx_connect) - if (OutData%C_obj%Fx_connect_Len > 0) OutData%C_obj%Fx_connect = c_loc(OutData%Fx_connect(LB(1))) - call RegUnpack(Buf, OutData%Fx_connect) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fx_connect => null() - end if - if (associated(OutData%Fy_connect)) deallocate(OutData%Fy_connect) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fy_connect, UB(1:1)-LB(1:1)) - OutData%Fy_connect(LB(1):) => OutData%Fy_connect - else - allocate(OutData%Fy_connect(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fy_connect) - OutData%C_obj%Fy_connect_Len = size(OutData%Fy_connect) - if (OutData%C_obj%Fy_connect_Len > 0) OutData%C_obj%Fy_connect = c_loc(OutData%Fy_connect(LB(1))) - call RegUnpack(Buf, OutData%Fy_connect) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fy_connect => null() - end if - if (associated(OutData%Fz_connect)) deallocate(OutData%Fz_connect) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fz_connect, UB(1:1)-LB(1:1)) - OutData%Fz_connect(LB(1):) => OutData%Fz_connect - else - allocate(OutData%Fz_connect(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fz_connect) - OutData%C_obj%Fz_connect_Len = size(OutData%Fz_connect) - if (OutData%C_obj%Fz_connect_Len > 0) OutData%C_obj%Fz_connect = c_loc(OutData%Fz_connect(LB(1))) - call RegUnpack(Buf, OutData%Fz_connect) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fz_connect => null() - end if - if (associated(OutData%Fx_anchor)) deallocate(OutData%Fx_anchor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fx_anchor, UB(1:1)-LB(1:1)) - OutData%Fx_anchor(LB(1):) => OutData%Fx_anchor - else - allocate(OutData%Fx_anchor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fx_anchor) - OutData%C_obj%Fx_anchor_Len = size(OutData%Fx_anchor) - if (OutData%C_obj%Fx_anchor_Len > 0) OutData%C_obj%Fx_anchor = c_loc(OutData%Fx_anchor(LB(1))) - call RegUnpack(Buf, OutData%Fx_anchor) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fx_anchor => null() - end if - if (associated(OutData%Fy_anchor)) deallocate(OutData%Fy_anchor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fy_anchor, UB(1:1)-LB(1:1)) - OutData%Fy_anchor(LB(1):) => OutData%Fy_anchor - else - allocate(OutData%Fy_anchor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fy_anchor) - OutData%C_obj%Fy_anchor_Len = size(OutData%Fy_anchor) - if (OutData%C_obj%Fy_anchor_Len > 0) OutData%C_obj%Fy_anchor = c_loc(OutData%Fy_anchor(LB(1))) - call RegUnpack(Buf, OutData%Fy_anchor) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fy_anchor => null() - end if - if (associated(OutData%Fz_anchor)) deallocate(OutData%Fz_anchor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fz_anchor, UB(1:1)-LB(1:1)) - OutData%Fz_anchor(LB(1):) => OutData%Fz_anchor - else - allocate(OutData%Fz_anchor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fz_anchor) - OutData%C_obj%Fz_anchor_Len = size(OutData%Fz_anchor) - if (OutData%C_obj%Fz_anchor_Len > 0) OutData%C_obj%Fz_anchor = c_loc(OutData%Fz_anchor(LB(1))) - call RegUnpack(Buf, OutData%Fz_anchor) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fz_anchor => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%H); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Ha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Va); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%xa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%ya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%za); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fx_connect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fy_connect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fz_connect); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fx_anchor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fy_anchor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fz_anchor); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE MAP_C2Fary_CopyOtherState(OtherStateData, ErrStat, ErrMsg, SkipPointers) @@ -2176,61 +1616,26 @@ subroutine MAP_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end if end subroutine -subroutine MAP_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackConstrState' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%H)) - if (associated(InData%H)) then - call RegPackBounds(Buf, 1, lbound(InData%H, kind=B8Ki), ubound(InData%H, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%H) - end if - end if - call RegPack(Buf, associated(InData%V)) - if (associated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%V) - end if - end if - call RegPack(Buf, associated(InData%x)) - if (associated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%x) - end if - end if - call RegPack(Buf, associated(InData%y)) - if (associated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%y) - end if - end if - call RegPack(Buf, associated(InData%z)) - if (associated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%z) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%H) + call RegPackPtr(RF, InData%V) + call RegPackPtr(RF, InData%x) + call RegPackPtr(RF, InData%y) + call RegPackPtr(RF, InData%z) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' integer(B8Ki) :: LB(1), UB(1) @@ -2238,137 +1643,12 @@ subroutine MAP_UnPackConstrState(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%H)) deallocate(OutData%H) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%H, UB(1:1)-LB(1:1)) - OutData%H(LB(1):) => OutData%H - else - allocate(OutData%H(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%H) - OutData%C_obj%H_Len = size(OutData%H) - if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) - call RegUnpack(Buf, OutData%H) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%H => null() - end if - if (associated(OutData%V)) deallocate(OutData%V) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%V, UB(1:1)-LB(1:1)) - OutData%V(LB(1):) => OutData%V - else - allocate(OutData%V(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%V) - OutData%C_obj%V_Len = size(OutData%V) - if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) - call RegUnpack(Buf, OutData%V) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%V => null() - end if - if (associated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) - OutData%x(LB(1):) => OutData%x - else - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%x) - OutData%C_obj%x_Len = size(OutData%x) - if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) - call RegUnpack(Buf, OutData%x) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%x => null() - end if - if (associated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) - OutData%y(LB(1):) => OutData%y - else - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%y) - OutData%C_obj%y_Len = size(OutData%y) - if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%y => null() - end if - if (associated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) - OutData%z(LB(1):) => OutData%z - else - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%z) - OutData%C_obj%z_Len = size(OutData%z) - if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) - call RegUnpack(Buf, OutData%z) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%z => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%H); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE MAP_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) @@ -2551,51 +1831,44 @@ subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine MAP_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackParam' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%g) - call RegPack(Buf, InData%depth) - call RegPack(Buf, InData%rho_sea) - call RegPack(Buf, InData%dt) - call RegPack(Buf, InData%InputLines) - call RegPack(Buf, InData%InputLineType) - call RegPack(Buf, InData%numOuts) - call MAP_Fortran_PackLin_ParamType(Buf, InData%LinParams) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%g) + call RegPack(RF, InData%depth) + call RegPack(RF, InData%rho_sea) + call RegPack(RF, InData%dt) + call RegPack(RF, InData%InputLines) + call RegPack(RF, InData%InputLineType) + call RegPack(RF, InData%numOuts) + call MAP_Fortran_PackLin_ParamType(RF, InData%LinParams) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackParam' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%g) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%g = OutData%g - call RegUnpack(Buf, OutData%depth) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%depth); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%depth = OutData%depth - call RegUnpack(Buf, OutData%rho_sea) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%rho_sea); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%rho_sea = OutData%rho_sea - call RegUnpack(Buf, OutData%dt) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%dt); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%dt = OutData%dt - call RegUnpack(Buf, OutData%InputLines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InputLineType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numOuts) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%InputLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InputLineType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numOuts); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%numOuts = OutData%numOuts - call MAP_Fortran_UnpackLin_ParamType(Buf, OutData%LinParams) ! LinParams + call MAP_Fortran_UnpackLin_ParamType(RF, OutData%LinParams) ! LinParams end subroutine SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) @@ -2735,46 +2008,25 @@ subroutine MAP_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine MAP_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%x)) - if (associated(InData%x)) then - call RegPackBounds(Buf, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%x) - end if - end if - call RegPack(Buf, associated(InData%y)) - if (associated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%y) - end if - end if - call RegPack(Buf, associated(InData%z)) - if (associated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%z) - end if - end if - call MeshPack(Buf, InData%PtFairDisplacement) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%x) + call RegPackPtr(RF, InData%y) + call RegPackPtr(RF, InData%z) + call MeshPack(RF, InData%PtFairDisplacement) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInput' integer(B8Ki) :: LB(1), UB(1) @@ -2782,86 +2034,11 @@ subroutine MAP_UnPackInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) - OutData%x(LB(1):) => OutData%x - else - allocate(OutData%x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%x) - OutData%C_obj%x_Len = size(OutData%x) - if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) - call RegUnpack(Buf, OutData%x) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%x => null() - end if - if (associated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) - OutData%y(LB(1):) => OutData%y - else - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%y) - OutData%C_obj%y_Len = size(OutData%y) - if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%y => null() - end if - if (associated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) - OutData%z(LB(1):) => OutData%z - else - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%z) - OutData%C_obj%z_Len = size(OutData%z) - if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) - call RegUnpack(Buf, OutData%z) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%z => null() - end if - call MeshUnpack(Buf, OutData%PtFairDisplacement) ! PtFairDisplacement + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtFairDisplacement) ! PtFairDisplacement end subroutine SUBROUTINE MAP_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) @@ -3090,59 +2267,27 @@ subroutine MAP_DestroyOutput(OutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine MAP_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_PackOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%Fx)) - if (associated(InData%Fx)) then - call RegPackBounds(Buf, 1, lbound(InData%Fx, kind=B8Ki), ubound(InData%Fx, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fx), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fx) - end if - end if - call RegPack(Buf, associated(InData%Fy)) - if (associated(InData%Fy)) then - call RegPackBounds(Buf, 1, lbound(InData%Fy, kind=B8Ki), ubound(InData%Fy, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fy), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fy) - end if - end if - call RegPack(Buf, associated(InData%Fz)) - if (associated(InData%Fz)) then - call RegPackBounds(Buf, 1, lbound(InData%Fz, kind=B8Ki), ubound(InData%Fz, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Fz), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Fz) - end if - end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, associated(InData%wrtOutput)) - if (associated(InData%wrtOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%wrtOutput, kind=B8Ki), ubound(InData%wrtOutput, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%wrtOutput), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%wrtOutput) - end if - end if - call MeshPack(Buf, InData%ptFairleadLoad) - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%Fx) + call RegPackPtr(RF, InData%Fy) + call RegPackPtr(RF, InData%Fz) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackPtr(RF, InData%wrtOutput) + call MeshPack(RF, InData%ptFairleadLoad) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MAP_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MAP_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) @@ -3150,126 +2295,13 @@ subroutine MAP_UnPackOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%Fx)) deallocate(OutData%Fx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fx, UB(1:1)-LB(1:1)) - OutData%Fx(LB(1):) => OutData%Fx - else - allocate(OutData%Fx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fx) - OutData%C_obj%Fx_Len = size(OutData%Fx) - if (OutData%C_obj%Fx_Len > 0) OutData%C_obj%Fx = c_loc(OutData%Fx(LB(1))) - call RegUnpack(Buf, OutData%Fx) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fx => null() - end if - if (associated(OutData%Fy)) deallocate(OutData%Fy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fy, UB(1:1)-LB(1:1)) - OutData%Fy(LB(1):) => OutData%Fy - else - allocate(OutData%Fy(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fy) - OutData%C_obj%Fy_Len = size(OutData%Fy) - if (OutData%C_obj%Fy_Len > 0) OutData%C_obj%Fy = c_loc(OutData%Fy(LB(1))) - call RegUnpack(Buf, OutData%Fy) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fy => null() - end if - if (associated(OutData%Fz)) deallocate(OutData%Fz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Fz, UB(1:1)-LB(1:1)) - OutData%Fz(LB(1):) => OutData%Fz - else - allocate(OutData%Fz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Fz) - OutData%C_obj%Fz_Len = size(OutData%Fz) - if (OutData%C_obj%Fz_Len > 0) OutData%C_obj%Fz = c_loc(OutData%Fz(LB(1))) - call RegUnpack(Buf, OutData%Fz) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Fz => null() - end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (associated(OutData%wrtOutput)) deallocate(OutData%wrtOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%wrtOutput, UB(1:1)-LB(1:1)) - OutData%wrtOutput(LB(1):) => OutData%wrtOutput - else - allocate(OutData%wrtOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wrtOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%wrtOutput) - OutData%C_obj%wrtOutput_Len = size(OutData%wrtOutput) - if (OutData%C_obj%wrtOutput_Len > 0) OutData%C_obj%wrtOutput = c_loc(OutData%wrtOutput(LB(1))) - call RegUnpack(Buf, OutData%wrtOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%wrtOutput => null() - end if - call MeshUnpack(Buf, OutData%ptFairleadLoad) ! ptFairleadLoad + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%Fx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Fz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%wrtOutput); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%ptFairleadLoad) ! ptFairleadLoad end subroutine SUBROUTINE MAP_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 4d09dee8d2..98b68013a5 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -499,31 +499,27 @@ subroutine MD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackInputFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_InputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInputFileType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DTIC) - call RegPack(Buf, InData%TMaxIC) - call RegPack(Buf, InData%CdScaleIC) - call RegPack(Buf, InData%threshIC) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DTIC) + call RegPack(RF, InData%TMaxIC) + call RegPack(RF, InData%CdScaleIC) + call RegPack(RF, InData%threshIC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackInputFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInputFileType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DTIC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TMaxIC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CdScaleIC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%threshIC) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DTIC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMaxIC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CdScaleIC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%threshIC); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -612,114 +608,52 @@ subroutine MD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%g) - call RegPack(Buf, InData%rhoW) - call RegPack(Buf, InData%WtrDepth) - call RegPack(Buf, allocated(InData%PtfmInit)) - if (allocated(InData%PtfmInit)) then - call RegPackBounds(Buf, 2, lbound(InData%PtfmInit, kind=B8Ki), ubound(InData%PtfmInit, kind=B8Ki)) - call RegPack(Buf, InData%PtfmInit) - end if - call RegPack(Buf, InData%FarmSize) - call RegPack(Buf, allocated(InData%TurbineRefPos)) - if (allocated(InData%TurbineRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos, kind=B8Ki), ubound(InData%TurbineRefPos, kind=B8Ki)) - call RegPack(Buf, InData%TurbineRefPos) - end if - call RegPack(Buf, InData%Tmax) - call RegPack(Buf, InData%FileName) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%UsePrimaryInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%g) + call RegPack(RF, InData%rhoW) + call RegPack(RF, InData%WtrDepth) + call RegPackAlloc(RF, InData%PtfmInit) + call RegPack(RF, InData%FarmSize) + call RegPackAlloc(RF, InData%TurbineRefPos) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%FileName) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%UsePrimaryInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%Echo) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%VisMeshes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%g) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhoW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDepth) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PtfmInit)) deallocate(OutData%PtfmInit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PtfmInit(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PtfmInit) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FarmSize) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TurbineRefPos) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UsePrimaryInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDepth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmSize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsePrimaryInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyLineProp(SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg) @@ -765,88 +699,65 @@ subroutine MD_DestroyLineProp(LinePropData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackLineProp(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackLineProp(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_LineProp), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackLineProp' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - call RegPack(Buf, InData%name) - call RegPack(Buf, InData%d) - call RegPack(Buf, InData%w) - call RegPack(Buf, InData%EA) - call RegPack(Buf, InData%EA_D) - call RegPack(Buf, InData%BA) - call RegPack(Buf, InData%BA_D) - call RegPack(Buf, InData%EI) - call RegPack(Buf, InData%Can) - call RegPack(Buf, InData%Cat) - call RegPack(Buf, InData%Cdn) - call RegPack(Buf, InData%Cdt) - call RegPack(Buf, InData%ElasticMod) - call RegPack(Buf, InData%nEApoints) - call RegPack(Buf, InData%stiffXs) - call RegPack(Buf, InData%stiffYs) - call RegPack(Buf, InData%nBApoints) - call RegPack(Buf, InData%dampXs) - call RegPack(Buf, InData%dampYs) - call RegPack(Buf, InData%nEIpoints) - call RegPack(Buf, InData%bstiffXs) - call RegPack(Buf, InData%bstiffYs) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%name) + call RegPack(RF, InData%d) + call RegPack(RF, InData%w) + call RegPack(RF, InData%EA) + call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%BA) + call RegPack(RF, InData%BA_D) + call RegPack(RF, InData%EI) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%ElasticMod) + call RegPack(RF, InData%nEApoints) + call RegPack(RF, InData%stiffXs) + call RegPack(RF, InData%stiffYs) + call RegPack(RF, InData%nBApoints) + call RegPack(RF, InData%dampXs) + call RegPack(RF, InData%dampYs) + call RegPack(RF, InData%nEIpoints) + call RegPack(RF, InData%bstiffXs) + call RegPack(RF, InData%bstiffYs) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackLineProp(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackLineProp(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_LineProp), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackLineProp' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%name) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%w) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EA_D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BA_D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Can) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElasticMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nEApoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%stiffXs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%stiffYs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nBApoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dampXs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dampYs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nEIpoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bstiffXs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bstiffYs) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElasticMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEIpoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffYs); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyRodProp(SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg) @@ -879,49 +790,39 @@ subroutine MD_DestroyRodProp(RodPropData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackRodProp(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackRodProp(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_RodProp), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackRodProp' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - call RegPack(Buf, InData%name) - call RegPack(Buf, InData%d) - call RegPack(Buf, InData%w) - call RegPack(Buf, InData%Can) - call RegPack(Buf, InData%Cat) - call RegPack(Buf, InData%Cdn) - call RegPack(Buf, InData%Cdt) - call RegPack(Buf, InData%CdEnd) - call RegPack(Buf, InData%CaEnd) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%name) + call RegPack(RF, InData%d) + call RegPack(RF, InData%w) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%CdEnd) + call RegPack(RF, InData%CaEnd) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackRodProp(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackRodProp(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_RodProp), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackRodProp' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%name) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%w) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Can) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CdEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CaEnd) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CdEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CaEnd); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyBody(SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg) @@ -970,97 +871,71 @@ subroutine MD_DestroyBody(BodyData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackBody(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackBody(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_Body), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackBody' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - call RegPack(Buf, InData%typeNum) - call RegPack(Buf, InData%AttachedC) - call RegPack(Buf, InData%AttachedR) - call RegPack(Buf, InData%nAttachedC) - call RegPack(Buf, InData%nAttachedR) - call RegPack(Buf, InData%rPointRel) - call RegPack(Buf, InData%r6RodRel) - call RegPack(Buf, InData%bodyM) - call RegPack(Buf, InData%bodyV) - call RegPack(Buf, InData%bodyI) - call RegPack(Buf, InData%bodyCdA) - call RegPack(Buf, InData%bodyCa) - call RegPack(Buf, InData%time) - call RegPack(Buf, InData%r6) - call RegPack(Buf, InData%v6) - call RegPack(Buf, InData%a6) - call RegPack(Buf, InData%U) - call RegPack(Buf, InData%Ud) - call RegPack(Buf, InData%zeta) - call RegPack(Buf, InData%F6net) - call RegPack(Buf, InData%M6net) - call RegPack(Buf, InData%M) - call RegPack(Buf, InData%M0) - call RegPack(Buf, InData%OrMat) - call RegPack(Buf, InData%rCG) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%typeNum) + call RegPack(RF, InData%AttachedC) + call RegPack(RF, InData%AttachedR) + call RegPack(RF, InData%nAttachedC) + call RegPack(RF, InData%nAttachedR) + call RegPack(RF, InData%rPointRel) + call RegPack(RF, InData%r6RodRel) + call RegPack(RF, InData%bodyM) + call RegPack(RF, InData%bodyV) + call RegPack(RF, InData%bodyI) + call RegPack(RF, InData%bodyCdA) + call RegPack(RF, InData%bodyCa) + call RegPack(RF, InData%time) + call RegPack(RF, InData%r6) + call RegPack(RF, InData%v6) + call RegPack(RF, InData%a6) + call RegPack(RF, InData%U) + call RegPack(RF, InData%Ud) + call RegPack(RF, InData%zeta) + call RegPack(RF, InData%F6net) + call RegPack(RF, InData%M6net) + call RegPack(RF, InData%M) + call RegPack(RF, InData%M0) + call RegPack(RF, InData%OrMat) + call RegPack(RF, InData%rCG) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackBody(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackBody(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_Body), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackBody' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%typeNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AttachedC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AttachedR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAttachedC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAttachedR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rPointRel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%r6RodRel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bodyM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bodyV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bodyI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bodyCdA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bodyCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%time) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%r6) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%v6) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a6) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%U) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ud) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%zeta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%F6net) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M6net) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OrMat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rCG) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%typeNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rPointRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r6RodRel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyCdA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bodyCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OrMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rCG); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) @@ -1122,107 +997,68 @@ subroutine MD_DestroyPoint(PointData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackPoint(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackPoint(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_Point), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackPoint' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - call RegPack(Buf, InData%type) - call RegPack(Buf, InData%typeNum) - call RegPack(Buf, InData%Attached) - call RegPack(Buf, InData%Top) - call RegPack(Buf, InData%nAttached) - call RegPack(Buf, InData%pointM) - call RegPack(Buf, InData%pointV) - call RegPack(Buf, InData%pointFX) - call RegPack(Buf, InData%pointFY) - call RegPack(Buf, InData%pointFZ) - call RegPack(Buf, InData%pointCa) - call RegPack(Buf, InData%pointCdA) - call RegPack(Buf, InData%time) - call RegPack(Buf, InData%r) - call RegPack(Buf, InData%rd) - call RegPack(Buf, InData%a) - call RegPack(Buf, InData%U) - call RegPack(Buf, InData%Ud) - call RegPack(Buf, InData%zeta) - call RegPack(Buf, allocated(InData%PDyn)) - if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 1, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) - call RegPack(Buf, InData%PDyn) - end if - call RegPack(Buf, InData%Fnet) - call RegPack(Buf, InData%M) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%type) + call RegPack(RF, InData%typeNum) + call RegPack(RF, InData%Attached) + call RegPack(RF, InData%Top) + call RegPack(RF, InData%nAttached) + call RegPack(RF, InData%pointM) + call RegPack(RF, InData%pointV) + call RegPack(RF, InData%pointFX) + call RegPack(RF, InData%pointFY) + call RegPack(RF, InData%pointFZ) + call RegPack(RF, InData%pointCa) + call RegPack(RF, InData%pointCdA) + call RegPack(RF, InData%time) + call RegPack(RF, InData%r) + call RegPack(RF, InData%rd) + call RegPack(RF, InData%a) + call RegPack(RF, InData%U) + call RegPack(RF, InData%Ud) + call RegPack(RF, InData%zeta) + call RegPackAlloc(RF, InData%PDyn) + call RegPack(RF, InData%Fnet) + call RegPack(RF, InData%M) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackPoint(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackPoint(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_Point), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackPoint' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%typeNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Attached) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Top) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAttached) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointFX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointFY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointFZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointCa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pointCdA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%time) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%r) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%U) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ud) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%zeta) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PDyn) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Fnet) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%typeNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Attached); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Top); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttached); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointFX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointFY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointFZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointCa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pointCdA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Fnet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) @@ -1571,500 +1407,138 @@ subroutine MD_DestroyRod(RodData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackRod(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackRod(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_Rod), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackRod' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - call RegPack(Buf, InData%type) - call RegPack(Buf, InData%PropsIdNum) - call RegPack(Buf, InData%typeNum) - call RegPack(Buf, InData%AttachedA) - call RegPack(Buf, InData%AttachedB) - call RegPack(Buf, InData%TopA) - call RegPack(Buf, InData%TopB) - call RegPack(Buf, InData%nAttachedA) - call RegPack(Buf, InData%nAttachedB) - call RegPack(Buf, InData%OutFlagList) - call RegPack(Buf, InData%N) - call RegPack(Buf, InData%endTypeA) - call RegPack(Buf, InData%endTypeB) - call RegPack(Buf, InData%UnstrLen) - call RegPack(Buf, InData%mass) - call RegPack(Buf, InData%rho) - call RegPack(Buf, InData%d) - call RegPack(Buf, InData%Can) - call RegPack(Buf, InData%Cat) - call RegPack(Buf, InData%Cdn) - call RegPack(Buf, InData%Cdt) - call RegPack(Buf, InData%CdEnd) - call RegPack(Buf, InData%CaEnd) - call RegPack(Buf, InData%time) - call RegPack(Buf, InData%roll) - call RegPack(Buf, InData%pitch) - call RegPack(Buf, InData%h0) - call RegPack(Buf, allocated(InData%r)) - if (allocated(InData%r)) then - call RegPackBounds(Buf, 2, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) - call RegPack(Buf, InData%r) - end if - call RegPack(Buf, allocated(InData%rd)) - if (allocated(InData%rd)) then - call RegPackBounds(Buf, 2, lbound(InData%rd, kind=B8Ki), ubound(InData%rd, kind=B8Ki)) - call RegPack(Buf, InData%rd) - end if - call RegPack(Buf, InData%q) - call RegPack(Buf, allocated(InData%l)) - if (allocated(InData%l)) then - call RegPackBounds(Buf, 1, lbound(InData%l, kind=B8Ki), ubound(InData%l, kind=B8Ki)) - call RegPack(Buf, InData%l) - end if - call RegPack(Buf, allocated(InData%V)) - if (allocated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) - call RegPack(Buf, InData%V) - end if - call RegPack(Buf, allocated(InData%U)) - if (allocated(InData%U)) then - call RegPackBounds(Buf, 2, lbound(InData%U, kind=B8Ki), ubound(InData%U, kind=B8Ki)) - call RegPack(Buf, InData%U) - end if - call RegPack(Buf, allocated(InData%Ud)) - if (allocated(InData%Ud)) then - call RegPackBounds(Buf, 2, lbound(InData%Ud, kind=B8Ki), ubound(InData%Ud, kind=B8Ki)) - call RegPack(Buf, InData%Ud) - end if - call RegPack(Buf, allocated(InData%zeta)) - if (allocated(InData%zeta)) then - call RegPackBounds(Buf, 1, lbound(InData%zeta, kind=B8Ki), ubound(InData%zeta, kind=B8Ki)) - call RegPack(Buf, InData%zeta) - end if - call RegPack(Buf, allocated(InData%PDyn)) - if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 1, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) - call RegPack(Buf, InData%PDyn) - end if - call RegPack(Buf, allocated(InData%W)) - if (allocated(InData%W)) then - call RegPackBounds(Buf, 2, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - call RegPack(Buf, InData%W) - end if - call RegPack(Buf, allocated(InData%Bo)) - if (allocated(InData%Bo)) then - call RegPackBounds(Buf, 2, lbound(InData%Bo, kind=B8Ki), ubound(InData%Bo, kind=B8Ki)) - call RegPack(Buf, InData%Bo) - end if - call RegPack(Buf, allocated(InData%Pd)) - if (allocated(InData%Pd)) then - call RegPackBounds(Buf, 2, lbound(InData%Pd, kind=B8Ki), ubound(InData%Pd, kind=B8Ki)) - call RegPack(Buf, InData%Pd) - end if - call RegPack(Buf, allocated(InData%Dp)) - if (allocated(InData%Dp)) then - call RegPackBounds(Buf, 2, lbound(InData%Dp, kind=B8Ki), ubound(InData%Dp, kind=B8Ki)) - call RegPack(Buf, InData%Dp) - end if - call RegPack(Buf, allocated(InData%Dq)) - if (allocated(InData%Dq)) then - call RegPackBounds(Buf, 2, lbound(InData%Dq, kind=B8Ki), ubound(InData%Dq, kind=B8Ki)) - call RegPack(Buf, InData%Dq) - end if - call RegPack(Buf, allocated(InData%Ap)) - if (allocated(InData%Ap)) then - call RegPackBounds(Buf, 2, lbound(InData%Ap, kind=B8Ki), ubound(InData%Ap, kind=B8Ki)) - call RegPack(Buf, InData%Ap) - end if - call RegPack(Buf, allocated(InData%Aq)) - if (allocated(InData%Aq)) then - call RegPackBounds(Buf, 2, lbound(InData%Aq, kind=B8Ki), ubound(InData%Aq, kind=B8Ki)) - call RegPack(Buf, InData%Aq) - end if - call RegPack(Buf, allocated(InData%B)) - if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) - call RegPack(Buf, InData%B) - end if - call RegPack(Buf, allocated(InData%Fnet)) - if (allocated(InData%Fnet)) then - call RegPackBounds(Buf, 2, lbound(InData%Fnet, kind=B8Ki), ubound(InData%Fnet, kind=B8Ki)) - call RegPack(Buf, InData%Fnet) - end if - call RegPack(Buf, allocated(InData%M)) - if (allocated(InData%M)) then - call RegPackBounds(Buf, 3, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) - call RegPack(Buf, InData%M) - end if - call RegPack(Buf, InData%FextA) - call RegPack(Buf, InData%FextB) - call RegPack(Buf, InData%Mext) - call RegPack(Buf, InData%r6) - call RegPack(Buf, InData%v6) - call RegPack(Buf, InData%a6) - call RegPack(Buf, InData%F6net) - call RegPack(Buf, InData%M6net) - call RegPack(Buf, InData%OrMat) - call RegPack(Buf, InData%RodUnOut) - call RegPack(Buf, allocated(InData%RodWrOutput)) - if (allocated(InData%RodWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput, kind=B8Ki), ubound(InData%RodWrOutput, kind=B8Ki)) - call RegPack(Buf, InData%RodWrOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%type) + call RegPack(RF, InData%PropsIdNum) + call RegPack(RF, InData%typeNum) + call RegPack(RF, InData%AttachedA) + call RegPack(RF, InData%AttachedB) + call RegPack(RF, InData%TopA) + call RegPack(RF, InData%TopB) + call RegPack(RF, InData%nAttachedA) + call RegPack(RF, InData%nAttachedB) + call RegPack(RF, InData%OutFlagList) + call RegPack(RF, InData%N) + call RegPack(RF, InData%endTypeA) + call RegPack(RF, InData%endTypeB) + call RegPack(RF, InData%UnstrLen) + call RegPack(RF, InData%mass) + call RegPack(RF, InData%rho) + call RegPack(RF, InData%d) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%CdEnd) + call RegPack(RF, InData%CaEnd) + call RegPack(RF, InData%time) + call RegPack(RF, InData%roll) + call RegPack(RF, InData%pitch) + call RegPack(RF, InData%h0) + call RegPackAlloc(RF, InData%r) + call RegPackAlloc(RF, InData%rd) + call RegPack(RF, InData%q) + call RegPackAlloc(RF, InData%l) + call RegPackAlloc(RF, InData%V) + call RegPackAlloc(RF, InData%U) + call RegPackAlloc(RF, InData%Ud) + call RegPackAlloc(RF, InData%zeta) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%W) + call RegPackAlloc(RF, InData%Bo) + call RegPackAlloc(RF, InData%Pd) + call RegPackAlloc(RF, InData%Dp) + call RegPackAlloc(RF, InData%Dq) + call RegPackAlloc(RF, InData%Ap) + call RegPackAlloc(RF, InData%Aq) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%Fnet) + call RegPackAlloc(RF, InData%M) + call RegPack(RF, InData%FextA) + call RegPack(RF, InData%FextB) + call RegPack(RF, InData%Mext) + call RegPack(RF, InData%r6) + call RegPack(RF, InData%v6) + call RegPack(RF, InData%a6) + call RegPack(RF, InData%F6net) + call RegPack(RF, InData%M6net) + call RegPack(RF, InData%OrMat) + call RegPack(RF, InData%RodUnOut) + call RegPackAlloc(RF, InData%RodWrOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackRod(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackRod(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_Rod), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackRod' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropsIdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%typeNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AttachedA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AttachedB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TopA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TopB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAttachedA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nAttachedB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFlagList) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%N) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%endTypeA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%endTypeB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnstrLen) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%mass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rho) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Can) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CdEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CaEnd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%time) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%roll) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%h0) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%r)) deallocate(OutData%r) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rd)) deallocate(OutData%rd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rd(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rd) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%q) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%l)) deallocate(OutData%l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%V)) deallocate(OutData%V) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U)) deallocate(OutData%U) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ud)) deallocate(OutData%Ud) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ud(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ud) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zeta)) deallocate(OutData%zeta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zeta(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zeta) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PDyn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%W(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%W) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Bo)) deallocate(OutData%Bo) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Bo(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Bo) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pd)) deallocate(OutData%Pd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pd(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Dp)) deallocate(OutData%Dp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Dp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Dp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Dq)) deallocate(OutData%Dq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Dq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ap)) deallocate(OutData%Ap) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ap(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ap) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Aq)) deallocate(OutData%Aq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Aq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Aq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%B)) deallocate(OutData%B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fnet(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fnet) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M)) deallocate(OutData%M) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FextA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FextB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mext) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%r6) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%v6) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%a6) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%F6net) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M6net) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OrMat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RodUnOut) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%RodWrOutput)) deallocate(OutData%RodWrOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RodWrOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RodWrOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropsIdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%typeNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AttachedB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TopA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TopB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nAttachedB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFlagList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnstrLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CdEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CaEnd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%roll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%h0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Aq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fnet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FextA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FextB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%r6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%a6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M6net); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OrMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RodUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodWrOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) @@ -2544,659 +2018,148 @@ subroutine MD_DestroyLine(LineData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackLine(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackLine(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_Line), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackLine' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - call RegPack(Buf, InData%PropsIdNum) - call RegPack(Buf, InData%ElasticMod) - call RegPack(Buf, InData%OutFlagList) - call RegPack(Buf, InData%CtrlChan) - call RegPack(Buf, InData%FairPoint) - call RegPack(Buf, InData%AnchPoint) - call RegPack(Buf, InData%N) - call RegPack(Buf, InData%endTypeA) - call RegPack(Buf, InData%endTypeB) - call RegPack(Buf, InData%UnstrLen) - call RegPack(Buf, InData%rho) - call RegPack(Buf, InData%d) - call RegPack(Buf, InData%EA) - call RegPack(Buf, InData%EA_D) - call RegPack(Buf, InData%BA) - call RegPack(Buf, InData%BA_D) - call RegPack(Buf, InData%EI) - call RegPack(Buf, InData%Can) - call RegPack(Buf, InData%Cat) - call RegPack(Buf, InData%Cdn) - call RegPack(Buf, InData%Cdt) - call RegPack(Buf, InData%nEApoints) - call RegPack(Buf, InData%stiffXs) - call RegPack(Buf, InData%stiffYs) - call RegPack(Buf, InData%nBApoints) - call RegPack(Buf, InData%dampXs) - call RegPack(Buf, InData%dampYs) - call RegPack(Buf, InData%nEIpoints) - call RegPack(Buf, InData%bstiffXs) - call RegPack(Buf, InData%bstiffYs) - call RegPack(Buf, InData%time) - call RegPack(Buf, allocated(InData%r)) - if (allocated(InData%r)) then - call RegPackBounds(Buf, 2, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) - call RegPack(Buf, InData%r) - end if - call RegPack(Buf, allocated(InData%rd)) - if (allocated(InData%rd)) then - call RegPackBounds(Buf, 2, lbound(InData%rd, kind=B8Ki), ubound(InData%rd, kind=B8Ki)) - call RegPack(Buf, InData%rd) - end if - call RegPack(Buf, allocated(InData%q)) - if (allocated(InData%q)) then - call RegPackBounds(Buf, 2, lbound(InData%q, kind=B8Ki), ubound(InData%q, kind=B8Ki)) - call RegPack(Buf, InData%q) - end if - call RegPack(Buf, allocated(InData%qs)) - if (allocated(InData%qs)) then - call RegPackBounds(Buf, 2, lbound(InData%qs, kind=B8Ki), ubound(InData%qs, kind=B8Ki)) - call RegPack(Buf, InData%qs) - end if - call RegPack(Buf, allocated(InData%l)) - if (allocated(InData%l)) then - call RegPackBounds(Buf, 1, lbound(InData%l, kind=B8Ki), ubound(InData%l, kind=B8Ki)) - call RegPack(Buf, InData%l) - end if - call RegPack(Buf, allocated(InData%ld)) - if (allocated(InData%ld)) then - call RegPackBounds(Buf, 1, lbound(InData%ld, kind=B8Ki), ubound(InData%ld, kind=B8Ki)) - call RegPack(Buf, InData%ld) - end if - call RegPack(Buf, allocated(InData%lstr)) - if (allocated(InData%lstr)) then - call RegPackBounds(Buf, 1, lbound(InData%lstr, kind=B8Ki), ubound(InData%lstr, kind=B8Ki)) - call RegPack(Buf, InData%lstr) - end if - call RegPack(Buf, allocated(InData%lstrd)) - if (allocated(InData%lstrd)) then - call RegPackBounds(Buf, 1, lbound(InData%lstrd, kind=B8Ki), ubound(InData%lstrd, kind=B8Ki)) - call RegPack(Buf, InData%lstrd) - end if - call RegPack(Buf, allocated(InData%Kurv)) - if (allocated(InData%Kurv)) then - call RegPackBounds(Buf, 1, lbound(InData%Kurv, kind=B8Ki), ubound(InData%Kurv, kind=B8Ki)) - call RegPack(Buf, InData%Kurv) - end if - call RegPack(Buf, allocated(InData%dl_1)) - if (allocated(InData%dl_1)) then - call RegPackBounds(Buf, 1, lbound(InData%dl_1, kind=B8Ki), ubound(InData%dl_1, kind=B8Ki)) - call RegPack(Buf, InData%dl_1) - end if - call RegPack(Buf, allocated(InData%V)) - if (allocated(InData%V)) then - call RegPackBounds(Buf, 1, lbound(InData%V, kind=B8Ki), ubound(InData%V, kind=B8Ki)) - call RegPack(Buf, InData%V) - end if - call RegPack(Buf, allocated(InData%U)) - if (allocated(InData%U)) then - call RegPackBounds(Buf, 2, lbound(InData%U, kind=B8Ki), ubound(InData%U, kind=B8Ki)) - call RegPack(Buf, InData%U) - end if - call RegPack(Buf, allocated(InData%Ud)) - if (allocated(InData%Ud)) then - call RegPackBounds(Buf, 2, lbound(InData%Ud, kind=B8Ki), ubound(InData%Ud, kind=B8Ki)) - call RegPack(Buf, InData%Ud) - end if - call RegPack(Buf, allocated(InData%zeta)) - if (allocated(InData%zeta)) then - call RegPackBounds(Buf, 1, lbound(InData%zeta, kind=B8Ki), ubound(InData%zeta, kind=B8Ki)) - call RegPack(Buf, InData%zeta) - end if - call RegPack(Buf, allocated(InData%PDyn)) - if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 1, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) - call RegPack(Buf, InData%PDyn) - end if - call RegPack(Buf, allocated(InData%T)) - if (allocated(InData%T)) then - call RegPackBounds(Buf, 2, lbound(InData%T, kind=B8Ki), ubound(InData%T, kind=B8Ki)) - call RegPack(Buf, InData%T) - end if - call RegPack(Buf, allocated(InData%Td)) - if (allocated(InData%Td)) then - call RegPackBounds(Buf, 2, lbound(InData%Td, kind=B8Ki), ubound(InData%Td, kind=B8Ki)) - call RegPack(Buf, InData%Td) - end if - call RegPack(Buf, allocated(InData%W)) - if (allocated(InData%W)) then - call RegPackBounds(Buf, 2, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - call RegPack(Buf, InData%W) - end if - call RegPack(Buf, allocated(InData%Dp)) - if (allocated(InData%Dp)) then - call RegPackBounds(Buf, 2, lbound(InData%Dp, kind=B8Ki), ubound(InData%Dp, kind=B8Ki)) - call RegPack(Buf, InData%Dp) - end if - call RegPack(Buf, allocated(InData%Dq)) - if (allocated(InData%Dq)) then - call RegPackBounds(Buf, 2, lbound(InData%Dq, kind=B8Ki), ubound(InData%Dq, kind=B8Ki)) - call RegPack(Buf, InData%Dq) - end if - call RegPack(Buf, allocated(InData%Ap)) - if (allocated(InData%Ap)) then - call RegPackBounds(Buf, 2, lbound(InData%Ap, kind=B8Ki), ubound(InData%Ap, kind=B8Ki)) - call RegPack(Buf, InData%Ap) - end if - call RegPack(Buf, allocated(InData%Aq)) - if (allocated(InData%Aq)) then - call RegPackBounds(Buf, 2, lbound(InData%Aq, kind=B8Ki), ubound(InData%Aq, kind=B8Ki)) - call RegPack(Buf, InData%Aq) - end if - call RegPack(Buf, allocated(InData%B)) - if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) - call RegPack(Buf, InData%B) - end if - call RegPack(Buf, allocated(InData%Bs)) - if (allocated(InData%Bs)) then - call RegPackBounds(Buf, 2, lbound(InData%Bs, kind=B8Ki), ubound(InData%Bs, kind=B8Ki)) - call RegPack(Buf, InData%Bs) - end if - call RegPack(Buf, allocated(InData%Fnet)) - if (allocated(InData%Fnet)) then - call RegPackBounds(Buf, 2, lbound(InData%Fnet, kind=B8Ki), ubound(InData%Fnet, kind=B8Ki)) - call RegPack(Buf, InData%Fnet) - end if - call RegPack(Buf, allocated(InData%S)) - if (allocated(InData%S)) then - call RegPackBounds(Buf, 3, lbound(InData%S, kind=B8Ki), ubound(InData%S, kind=B8Ki)) - call RegPack(Buf, InData%S) - end if - call RegPack(Buf, allocated(InData%M)) - if (allocated(InData%M)) then - call RegPackBounds(Buf, 3, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) - call RegPack(Buf, InData%M) - end if - call RegPack(Buf, InData%EndMomentA) - call RegPack(Buf, InData%EndMomentB) - call RegPack(Buf, InData%LineUnOut) - call RegPack(Buf, allocated(InData%LineWrOutput)) - if (allocated(InData%LineWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput, kind=B8Ki), ubound(InData%LineWrOutput, kind=B8Ki)) - call RegPack(Buf, InData%LineWrOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + call RegPack(RF, InData%PropsIdNum) + call RegPack(RF, InData%ElasticMod) + call RegPack(RF, InData%OutFlagList) + call RegPack(RF, InData%CtrlChan) + call RegPack(RF, InData%FairPoint) + call RegPack(RF, InData%AnchPoint) + call RegPack(RF, InData%N) + call RegPack(RF, InData%endTypeA) + call RegPack(RF, InData%endTypeB) + call RegPack(RF, InData%UnstrLen) + call RegPack(RF, InData%rho) + call RegPack(RF, InData%d) + call RegPack(RF, InData%EA) + call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%BA) + call RegPack(RF, InData%BA_D) + call RegPack(RF, InData%EI) + call RegPack(RF, InData%Can) + call RegPack(RF, InData%Cat) + call RegPack(RF, InData%Cdn) + call RegPack(RF, InData%Cdt) + call RegPack(RF, InData%nEApoints) + call RegPack(RF, InData%stiffXs) + call RegPack(RF, InData%stiffYs) + call RegPack(RF, InData%nBApoints) + call RegPack(RF, InData%dampXs) + call RegPack(RF, InData%dampYs) + call RegPack(RF, InData%nEIpoints) + call RegPack(RF, InData%bstiffXs) + call RegPack(RF, InData%bstiffYs) + call RegPack(RF, InData%time) + call RegPackAlloc(RF, InData%r) + call RegPackAlloc(RF, InData%rd) + call RegPackAlloc(RF, InData%q) + call RegPackAlloc(RF, InData%qs) + call RegPackAlloc(RF, InData%l) + call RegPackAlloc(RF, InData%ld) + call RegPackAlloc(RF, InData%lstr) + call RegPackAlloc(RF, InData%lstrd) + call RegPackAlloc(RF, InData%Kurv) + call RegPackAlloc(RF, InData%dl_1) + call RegPackAlloc(RF, InData%V) + call RegPackAlloc(RF, InData%U) + call RegPackAlloc(RF, InData%Ud) + call RegPackAlloc(RF, InData%zeta) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%T) + call RegPackAlloc(RF, InData%Td) + call RegPackAlloc(RF, InData%W) + call RegPackAlloc(RF, InData%Dp) + call RegPackAlloc(RF, InData%Dq) + call RegPackAlloc(RF, InData%Ap) + call RegPackAlloc(RF, InData%Aq) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%Bs) + call RegPackAlloc(RF, InData%Fnet) + call RegPackAlloc(RF, InData%S) + call RegPackAlloc(RF, InData%M) + call RegPack(RF, InData%EndMomentA) + call RegPack(RF, InData%EndMomentB) + call RegPack(RF, InData%LineUnOut) + call RegPackAlloc(RF, InData%LineWrOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackLine(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackLine(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_Line), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackLine' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PropsIdNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElasticMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFlagList) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CtrlChan) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FairPoint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AnchPoint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%N) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%endTypeA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%endTypeB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnstrLen) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rho) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%d) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EA_D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BA_D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Can) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nEApoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%stiffXs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%stiffYs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nBApoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dampXs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dampYs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nEIpoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bstiffXs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%bstiffYs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%time) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%r)) deallocate(OutData%r) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rd)) deallocate(OutData%rd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rd(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%q)) deallocate(OutData%q) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%q) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%qs)) deallocate(OutData%qs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%qs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%qs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%l)) deallocate(OutData%l) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%l(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%l) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ld)) deallocate(OutData%ld) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ld(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ld) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%lstr)) deallocate(OutData%lstr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%lstr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%lstr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%lstrd)) deallocate(OutData%lstrd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%lstrd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%lstrd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Kurv)) deallocate(OutData%Kurv) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Kurv(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Kurv) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dl_1)) deallocate(OutData%dl_1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dl_1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dl_1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%V)) deallocate(OutData%V) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U)) deallocate(OutData%U) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ud)) deallocate(OutData%Ud) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ud(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ud) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zeta)) deallocate(OutData%zeta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zeta(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zeta) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PDyn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%T)) deallocate(OutData%T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%T(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%T) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Td)) deallocate(OutData%Td) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Td(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Td) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%W)) deallocate(OutData%W) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%W(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%W) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Dp)) deallocate(OutData%Dp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Dp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Dp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Dq)) deallocate(OutData%Dq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Dq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ap)) deallocate(OutData%Ap) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ap(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ap) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Aq)) deallocate(OutData%Aq) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Aq(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Aq) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%B)) deallocate(OutData%B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Bs)) deallocate(OutData%Bs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Bs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Bs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fnet(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fnet) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%S)) deallocate(OutData%S) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%S) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M)) deallocate(OutData%M) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%EndMomentA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EndMomentB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LineUnOut) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LineWrOutput)) deallocate(OutData%LineWrOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineWrOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineWrOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PropsIdNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElasticMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFlagList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CtrlChan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FairPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AnchPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%endTypeB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnstrLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Can); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Cdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%stiffYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBApoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dampYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nEIpoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffXs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%bstiffYs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%time); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%q); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%l); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ld); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lstr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%lstrd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Kurv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dl_1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ud); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Td); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%W); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Dq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Aq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Bs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fnet); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EndMomentA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EndMomentB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LineUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineWrOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyFail(SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg) @@ -3220,22 +2183,21 @@ subroutine MD_DestroyFail(FailData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackFail(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackFail(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_Fail), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackFail' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%IdNum) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackFail(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackFail(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_Fail), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackFail' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%IdNum); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) @@ -3264,37 +2226,31 @@ subroutine MD_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackOutParmType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackOutParmType(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_OutParmType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOutParmType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Name) - call RegPack(Buf, InData%Units) - call RegPack(Buf, InData%QType) - call RegPack(Buf, InData%OType) - call RegPack(Buf, InData%NodeID) - call RegPack(Buf, InData%ObjID) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Units) + call RegPack(RF, InData%QType) + call RegPack(RF, InData%OType) + call RegPack(RF, InData%NodeID) + call RegPack(RF, InData%ObjID) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackOutParmType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackOutParmType(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_OutParmType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOutParmType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Name) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Units) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%QType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NodeID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ObjID) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Units); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%QType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NodeID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ObjID); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyVisDiam(SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, ErrMsg) @@ -3334,41 +2290,24 @@ subroutine MD_DestroyVisDiam(VisDiamData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackVisDiam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackVisDiam(RF, Indata) + type(RegFile), intent(inout) :: RF type(VisDiam), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackVisDiam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Diam)) - if (allocated(InData%Diam)) then - call RegPackBounds(Buf, 1, lbound(InData%Diam, kind=B8Ki), ubound(InData%Diam, kind=B8Ki)) - call RegPack(Buf, InData%Diam) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Diam) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackVisDiam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackVisDiam(RF, OutData) + type(RegFile), intent(inout) :: RF type(VisDiam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackVisDiam' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Diam)) deallocate(OutData%Diam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Diam(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Diam) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Diam); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -3553,248 +2492,61 @@ subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%RotFrame_y) end if if (allocated(InitOutputData%RotFrame_x)) then - deallocate(InitOutputData%RotFrame_x) - end if - if (allocated(InitOutputData%RotFrame_u)) then - deallocate(InitOutputData%RotFrame_u) - end if - if (allocated(InitOutputData%IsLoad_u)) then - deallocate(InitOutputData%IsLoad_u) - end if - if (allocated(InitOutputData%DerivOrder_x)) then - deallocate(InitOutputData%DerivOrder_x) - end if -end subroutine - -subroutine MD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(MD_InitOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%writeOutputHdr)) - if (allocated(InData%writeOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr, kind=B8Ki), ubound(InData%writeOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%writeOutputHdr) - end if - call RegPack(Buf, allocated(InData%writeOutputUnt)) - if (allocated(InData%writeOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt, kind=B8Ki), ubound(InData%writeOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%writeOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%CableCChanRqst)) - if (allocated(InData%CableCChanRqst)) then - call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst, kind=B8Ki), ubound(InData%CableCChanRqst, kind=B8Ki)) - call RegPack(Buf, InData%CableCChanRqst) - end if - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine MD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(MD_InitOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%writeOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%writeOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%writeOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%writeOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableCChanRqst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableCChanRqst) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return + deallocate(InitOutputData%RotFrame_x) end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) end if end subroutine +subroutine MD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%writeOutputHdr) + call RegPackAlloc(RF, InData%writeOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%CableCChanRqst) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%writeOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%writeOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%CableCChanRqst); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) type(MD_ContinuousStateType), intent(in) :: SrcContStateData type(MD_ContinuousStateType), intent(inout) :: DstContStateData @@ -3832,41 +2584,24 @@ subroutine MD_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%states)) - if (allocated(InData%states)) then - call RegPackBounds(Buf, 1, lbound(InData%states, kind=B8Ki), ubound(InData%states, kind=B8Ki)) - call RegPack(Buf, InData%states) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%states) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackContState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%states)) deallocate(OutData%states) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%states(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%states) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%states); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -3890,22 +2625,21 @@ subroutine MD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -3929,22 +2663,21 @@ subroutine MD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -3968,22 +2701,21 @@ subroutine MD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine MD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -4494,575 +3226,233 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%LineTypeList)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%LineTypeList)) if (allocated(InData%LineTypeList)) then - call RegPackBounds(Buf, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%LineTypeList, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) LB(1:1) = lbound(InData%LineTypeList, kind=B8Ki) UB(1:1) = ubound(InData%LineTypeList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackLineProp(Buf, InData%LineTypeList(i1)) + call MD_PackLineProp(RF, InData%LineTypeList(i1)) end do end if - call RegPack(Buf, allocated(InData%RodTypeList)) + call RegPack(RF, allocated(InData%RodTypeList)) if (allocated(InData%RodTypeList)) then - call RegPackBounds(Buf, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) LB(1:1) = lbound(InData%RodTypeList, kind=B8Ki) UB(1:1) = ubound(InData%RodTypeList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackRodProp(Buf, InData%RodTypeList(i1)) + call MD_PackRodProp(RF, InData%RodTypeList(i1)) end do end if - call MD_PackBody(Buf, InData%GroundBody) - call RegPack(Buf, allocated(InData%BodyList)) + call MD_PackBody(RF, InData%GroundBody) + call RegPack(RF, allocated(InData%BodyList)) if (allocated(InData%BodyList)) then - call RegPackBounds(Buf, 1, lbound(InData%BodyList, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BodyList, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) LB(1:1) = lbound(InData%BodyList, kind=B8Ki) UB(1:1) = ubound(InData%BodyList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackBody(Buf, InData%BodyList(i1)) + call MD_PackBody(RF, InData%BodyList(i1)) end do end if - call RegPack(Buf, allocated(InData%RodList)) + call RegPack(RF, allocated(InData%RodList)) if (allocated(InData%RodList)) then - call RegPackBounds(Buf, 1, lbound(InData%RodList, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%RodList, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) LB(1:1) = lbound(InData%RodList, kind=B8Ki) UB(1:1) = ubound(InData%RodList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackRod(Buf, InData%RodList(i1)) + call MD_PackRod(RF, InData%RodList(i1)) end do end if - call RegPack(Buf, allocated(InData%PointList)) + call RegPack(RF, allocated(InData%PointList)) if (allocated(InData%PointList)) then - call RegPackBounds(Buf, 1, lbound(InData%PointList, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%PointList, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) LB(1:1) = lbound(InData%PointList, kind=B8Ki) UB(1:1) = ubound(InData%PointList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackPoint(Buf, InData%PointList(i1)) + call MD_PackPoint(RF, InData%PointList(i1)) end do end if - call RegPack(Buf, allocated(InData%LineList)) + call RegPack(RF, allocated(InData%LineList)) if (allocated(InData%LineList)) then - call RegPackBounds(Buf, 1, lbound(InData%LineList, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%LineList, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) LB(1:1) = lbound(InData%LineList, kind=B8Ki) UB(1:1) = ubound(InData%LineList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackLine(Buf, InData%LineList(i1)) + call MD_PackLine(RF, InData%LineList(i1)) end do end if - call RegPack(Buf, allocated(InData%FailList)) + call RegPack(RF, allocated(InData%FailList)) if (allocated(InData%FailList)) then - call RegPackBounds(Buf, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) LB(1:1) = lbound(InData%FailList, kind=B8Ki) UB(1:1) = ubound(InData%FailList, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackFail(Buf, InData%FailList(i1)) + call MD_PackFail(RF, InData%FailList(i1)) end do end if - call RegPack(Buf, allocated(InData%FreePointIs)) - if (allocated(InData%FreePointIs)) then - call RegPackBounds(Buf, 1, lbound(InData%FreePointIs, kind=B8Ki), ubound(InData%FreePointIs, kind=B8Ki)) - call RegPack(Buf, InData%FreePointIs) - end if - call RegPack(Buf, allocated(InData%CpldPointIs)) - if (allocated(InData%CpldPointIs)) then - call RegPackBounds(Buf, 2, lbound(InData%CpldPointIs, kind=B8Ki), ubound(InData%CpldPointIs, kind=B8Ki)) - call RegPack(Buf, InData%CpldPointIs) - end if - call RegPack(Buf, allocated(InData%FreeRodIs)) - if (allocated(InData%FreeRodIs)) then - call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs, kind=B8Ki), ubound(InData%FreeRodIs, kind=B8Ki)) - call RegPack(Buf, InData%FreeRodIs) - end if - call RegPack(Buf, allocated(InData%CpldRodIs)) - if (allocated(InData%CpldRodIs)) then - call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs, kind=B8Ki), ubound(InData%CpldRodIs, kind=B8Ki)) - call RegPack(Buf, InData%CpldRodIs) - end if - call RegPack(Buf, allocated(InData%FreeBodyIs)) - if (allocated(InData%FreeBodyIs)) then - call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs, kind=B8Ki), ubound(InData%FreeBodyIs, kind=B8Ki)) - call RegPack(Buf, InData%FreeBodyIs) - end if - call RegPack(Buf, allocated(InData%CpldBodyIs)) - if (allocated(InData%CpldBodyIs)) then - call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs, kind=B8Ki), ubound(InData%CpldBodyIs, kind=B8Ki)) - call RegPack(Buf, InData%CpldBodyIs) - end if - call RegPack(Buf, allocated(InData%LineStateIs1)) - if (allocated(InData%LineStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1, kind=B8Ki), ubound(InData%LineStateIs1, kind=B8Ki)) - call RegPack(Buf, InData%LineStateIs1) - end if - call RegPack(Buf, allocated(InData%LineStateIsN)) - if (allocated(InData%LineStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN, kind=B8Ki), ubound(InData%LineStateIsN, kind=B8Ki)) - call RegPack(Buf, InData%LineStateIsN) - end if - call RegPack(Buf, allocated(InData%PointStateIs1)) - if (allocated(InData%PointStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%PointStateIs1, kind=B8Ki), ubound(InData%PointStateIs1, kind=B8Ki)) - call RegPack(Buf, InData%PointStateIs1) - end if - call RegPack(Buf, allocated(InData%PointStateIsN)) - if (allocated(InData%PointStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%PointStateIsN, kind=B8Ki), ubound(InData%PointStateIsN, kind=B8Ki)) - call RegPack(Buf, InData%PointStateIsN) - end if - call RegPack(Buf, allocated(InData%RodStateIs1)) - if (allocated(InData%RodStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1, kind=B8Ki), ubound(InData%RodStateIs1, kind=B8Ki)) - call RegPack(Buf, InData%RodStateIs1) - end if - call RegPack(Buf, allocated(InData%RodStateIsN)) - if (allocated(InData%RodStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN, kind=B8Ki), ubound(InData%RodStateIsN, kind=B8Ki)) - call RegPack(Buf, InData%RodStateIsN) - end if - call RegPack(Buf, allocated(InData%BodyStateIs1)) - if (allocated(InData%BodyStateIs1)) then - call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1, kind=B8Ki), ubound(InData%BodyStateIs1, kind=B8Ki)) - call RegPack(Buf, InData%BodyStateIs1) - end if - call RegPack(Buf, allocated(InData%BodyStateIsN)) - if (allocated(InData%BodyStateIsN)) then - call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN, kind=B8Ki), ubound(InData%BodyStateIsN, kind=B8Ki)) - call RegPack(Buf, InData%BodyStateIsN) - end if - call RegPack(Buf, InData%Nx) - call RegPack(Buf, InData%WaveTi) - call MD_PackContState(Buf, InData%xTemp) - call MD_PackContState(Buf, InData%xdTemp) - call RegPack(Buf, InData%zeros6) - call RegPack(Buf, allocated(InData%MDWrOutput)) - if (allocated(InData%MDWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput, kind=B8Ki), ubound(InData%MDWrOutput, kind=B8Ki)) - call RegPack(Buf, InData%MDWrOutput) - end if - call RegPack(Buf, InData%LastOutTime) - call RegPack(Buf, InData%PtfmInit) - call RegPack(Buf, allocated(InData%BathymetryGrid)) - if (allocated(InData%BathymetryGrid)) then - call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid, kind=B8Ki), ubound(InData%BathymetryGrid, kind=B8Ki)) - call RegPack(Buf, InData%BathymetryGrid) - end if - call RegPack(Buf, allocated(InData%BathGrid_Xs)) - if (allocated(InData%BathGrid_Xs)) then - call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs, kind=B8Ki), ubound(InData%BathGrid_Xs, kind=B8Ki)) - call RegPack(Buf, InData%BathGrid_Xs) - end if - call RegPack(Buf, allocated(InData%BathGrid_Ys)) - if (allocated(InData%BathGrid_Ys)) then - call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys, kind=B8Ki), ubound(InData%BathGrid_Ys, kind=B8Ki)) - call RegPack(Buf, InData%BathGrid_Ys) - end if - call RegPack(Buf, allocated(InData%BathGrid_npoints)) - if (allocated(InData%BathGrid_npoints)) then - call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints, kind=B8Ki), ubound(InData%BathGrid_npoints, kind=B8Ki)) - call RegPack(Buf, InData%BathGrid_npoints) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%FreePointIs) + call RegPackAlloc(RF, InData%CpldPointIs) + call RegPackAlloc(RF, InData%FreeRodIs) + call RegPackAlloc(RF, InData%CpldRodIs) + call RegPackAlloc(RF, InData%FreeBodyIs) + call RegPackAlloc(RF, InData%CpldBodyIs) + call RegPackAlloc(RF, InData%LineStateIs1) + call RegPackAlloc(RF, InData%LineStateIsN) + call RegPackAlloc(RF, InData%PointStateIs1) + call RegPackAlloc(RF, InData%PointStateIsN) + call RegPackAlloc(RF, InData%RodStateIs1) + call RegPackAlloc(RF, InData%RodStateIsN) + call RegPackAlloc(RF, InData%BodyStateIs1) + call RegPackAlloc(RF, InData%BodyStateIsN) + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%WaveTi) + call MD_PackContState(RF, InData%xTemp) + call MD_PackContState(RF, InData%xdTemp) + call RegPack(RF, InData%zeros6) + call RegPackAlloc(RF, InData%MDWrOutput) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%PtfmInit) + call RegPackAlloc(RF, InData%BathymetryGrid) + call RegPackAlloc(RF, InData%BathGrid_Xs) + call RegPackAlloc(RF, InData%BathGrid_Ys) + call RegPackAlloc(RF, InData%BathGrid_npoints) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackLineProp(Buf, OutData%LineTypeList(i1)) ! LineTypeList + call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList end do end if if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackRodProp(Buf, OutData%RodTypeList(i1)) ! RodTypeList + call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList end do end if - call MD_UnpackBody(Buf, OutData%GroundBody) ! GroundBody + call MD_UnpackBody(RF, OutData%GroundBody) ! GroundBody if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackBody(Buf, OutData%BodyList(i1)) ! BodyList + call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList end do end if if (allocated(OutData%RodList)) deallocate(OutData%RodList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%RodList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackRod(Buf, OutData%RodList(i1)) ! RodList + call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList end do end if if (allocated(OutData%PointList)) deallocate(OutData%PointList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%PointList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackPoint(Buf, OutData%PointList(i1)) ! PointList + call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList end do end if if (allocated(OutData%LineList)) deallocate(OutData%LineList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%LineList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackLine(Buf, OutData%LineList(i1)) ! LineList + call MD_UnpackLine(RF, OutData%LineList(i1)) ! LineList end do end if if (allocated(OutData%FailList)) deallocate(OutData%FailList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%FailList(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackFail(Buf, OutData%FailList(i1)) ! FailList + call MD_UnpackFail(RF, OutData%FailList(i1)) ! FailList end do end if - if (allocated(OutData%FreePointIs)) deallocate(OutData%FreePointIs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FreePointIs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreePointIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FreePointIs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CpldPointIs)) deallocate(OutData%CpldPointIs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CpldPointIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldPointIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CpldPointIs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FreeRodIs)) deallocate(OutData%FreeRodIs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FreeRodIs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FreeRodIs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CpldRodIs)) deallocate(OutData%CpldRodIs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CpldRodIs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FreeBodyIs)) deallocate(OutData%FreeBodyIs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FreeBodyIs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FreeBodyIs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CpldBodyIs)) deallocate(OutData%CpldBodyIs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CpldBodyIs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LineStateIs1)) deallocate(OutData%LineStateIs1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineStateIs1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineStateIs1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LineStateIsN)) deallocate(OutData%LineStateIsN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LineStateIsN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LineStateIsN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PointStateIs1)) deallocate(OutData%PointStateIs1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PointStateIs1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PointStateIs1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PointStateIsN)) deallocate(OutData%PointStateIsN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PointStateIsN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PointStateIsN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RodStateIs1)) deallocate(OutData%RodStateIs1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RodStateIs1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RodStateIs1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RodStateIsN)) deallocate(OutData%RodStateIsN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RodStateIsN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RodStateIsN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BodyStateIs1)) deallocate(OutData%BodyStateIs1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BodyStateIs1(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BodyStateIs1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BodyStateIsN)) deallocate(OutData%BodyStateIsN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BodyStateIsN(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BodyStateIsN) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveTi) - if (RegCheckErr(Buf, RoutineName)) return - call MD_UnpackContState(Buf, OutData%xTemp) ! xTemp - call MD_UnpackContState(Buf, OutData%xdTemp) ! xdTemp - call RegUnpack(Buf, OutData%zeros6) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%MDWrOutput)) deallocate(OutData%MDWrOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MDWrOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MDWrOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmInit) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BathymetryGrid)) deallocate(OutData%BathymetryGrid) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BathymetryGrid) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BathGrid_Xs)) deallocate(OutData%BathGrid_Xs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BathGrid_Xs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BathGrid_Xs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BathGrid_Ys)) deallocate(OutData%BathGrid_Ys) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BathGrid_Ys(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BathGrid_Ys) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BathGrid_npoints)) deallocate(OutData%BathGrid_npoints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BathGrid_npoints(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BathGrid_npoints) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%FreePointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldPointIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldRodIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FreeBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CpldBodyIs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LineStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PointStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RodStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BodyStateIs1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BodyStateIsN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTi); if (RegCheckErr(RF, RoutineName)) return + call MD_UnpackContState(RF, OutData%xTemp) ! xTemp + call MD_UnpackContState(RF, OutData%xdTemp) ! xdTemp + call RegUnpack(RF, OutData%zeros6); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathymetryGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Xs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_Ys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BathGrid_npoints); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -5520,630 +3910,205 @@ subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%nLineTypes) - call RegPack(Buf, InData%nRodTypes) - call RegPack(Buf, InData%nPoints) - call RegPack(Buf, InData%nPointsExtra) - call RegPack(Buf, InData%nBodies) - call RegPack(Buf, InData%nRods) - call RegPack(Buf, InData%nLines) - call RegPack(Buf, InData%nCtrlChans) - call RegPack(Buf, InData%nFails) - call RegPack(Buf, InData%nFreeBodies) - call RegPack(Buf, InData%nFreeRods) - call RegPack(Buf, InData%nFreePoints) - call RegPack(Buf, allocated(InData%nCpldBodies)) - if (allocated(InData%nCpldBodies)) then - call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies, kind=B8Ki), ubound(InData%nCpldBodies, kind=B8Ki)) - call RegPack(Buf, InData%nCpldBodies) - end if - call RegPack(Buf, allocated(InData%nCpldRods)) - if (allocated(InData%nCpldRods)) then - call RegPackBounds(Buf, 1, lbound(InData%nCpldRods, kind=B8Ki), ubound(InData%nCpldRods, kind=B8Ki)) - call RegPack(Buf, InData%nCpldRods) - end if - call RegPack(Buf, allocated(InData%nCpldPoints)) - if (allocated(InData%nCpldPoints)) then - call RegPackBounds(Buf, 1, lbound(InData%nCpldPoints, kind=B8Ki), ubound(InData%nCpldPoints, kind=B8Ki)) - call RegPack(Buf, InData%nCpldPoints) - end if - call RegPack(Buf, InData%NConns) - call RegPack(Buf, InData%NAnchs) - call RegPack(Buf, InData%Tmax) - call RegPack(Buf, InData%g) - call RegPack(Buf, InData%rhoW) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%kBot) - call RegPack(Buf, InData%cBot) - call RegPack(Buf, InData%dtM0) - call RegPack(Buf, InData%dtCoupling) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%dtOut) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%nLineTypes) + call RegPack(RF, InData%nRodTypes) + call RegPack(RF, InData%nPoints) + call RegPack(RF, InData%nPointsExtra) + call RegPack(RF, InData%nBodies) + call RegPack(RF, InData%nRods) + call RegPack(RF, InData%nLines) + call RegPack(RF, InData%nCtrlChans) + call RegPack(RF, InData%nFails) + call RegPack(RF, InData%nFreeBodies) + call RegPack(RF, InData%nFreeRods) + call RegPack(RF, InData%nFreePoints) + call RegPackAlloc(RF, InData%nCpldBodies) + call RegPackAlloc(RF, InData%nCpldRods) + call RegPackAlloc(RF, InData%nCpldPoints) + call RegPack(RF, InData%NConns) + call RegPack(RF, InData%NAnchs) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%g) + call RegPack(RF, InData%rhoW) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%kBot) + call RegPack(RF, InData%cBot) + call RegPack(RF, InData%dtM0) + call RegPack(RF, InData%dtCoupling) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%dtOut) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackOutParmType(Buf, InData%OutParam(i1)) + call MD_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%MDUnOut) - call RegPack(Buf, InData%PriPath) - call RegPack(Buf, InData%writeLog) - call RegPack(Buf, InData%UnLog) - call RegPack(Buf, InData%WaveKin) - call RegPack(Buf, InData%Current) - call RegPack(Buf, InData%nTurbines) - call RegPack(Buf, allocated(InData%TurbineRefPos)) - if (allocated(InData%TurbineRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos, kind=B8Ki), ubound(InData%TurbineRefPos, kind=B8Ki)) - call RegPack(Buf, InData%TurbineRefPos) - end if - call RegPack(Buf, InData%mu_kT) - call RegPack(Buf, InData%mu_kA) - call RegPack(Buf, InData%mc) - call RegPack(Buf, InData%cv) - call RegPack(Buf, InData%nxWave) - call RegPack(Buf, InData%nyWave) - call RegPack(Buf, InData%nzWave) - call RegPack(Buf, InData%ntWave) - call RegPack(Buf, allocated(InData%pxWave)) - if (allocated(InData%pxWave)) then - call RegPackBounds(Buf, 1, lbound(InData%pxWave, kind=B8Ki), ubound(InData%pxWave, kind=B8Ki)) - call RegPack(Buf, InData%pxWave) - end if - call RegPack(Buf, allocated(InData%pyWave)) - if (allocated(InData%pyWave)) then - call RegPackBounds(Buf, 1, lbound(InData%pyWave, kind=B8Ki), ubound(InData%pyWave, kind=B8Ki)) - call RegPack(Buf, InData%pyWave) - end if - call RegPack(Buf, allocated(InData%pzWave)) - if (allocated(InData%pzWave)) then - call RegPackBounds(Buf, 1, lbound(InData%pzWave, kind=B8Ki), ubound(InData%pzWave, kind=B8Ki)) - call RegPack(Buf, InData%pzWave) - end if - call RegPack(Buf, InData%dtWave) - call RegPack(Buf, allocated(InData%uxWave)) - if (allocated(InData%uxWave)) then - call RegPackBounds(Buf, 4, lbound(InData%uxWave, kind=B8Ki), ubound(InData%uxWave, kind=B8Ki)) - call RegPack(Buf, InData%uxWave) - end if - call RegPack(Buf, allocated(InData%uyWave)) - if (allocated(InData%uyWave)) then - call RegPackBounds(Buf, 4, lbound(InData%uyWave, kind=B8Ki), ubound(InData%uyWave, kind=B8Ki)) - call RegPack(Buf, InData%uyWave) - end if - call RegPack(Buf, allocated(InData%uzWave)) - if (allocated(InData%uzWave)) then - call RegPackBounds(Buf, 4, lbound(InData%uzWave, kind=B8Ki), ubound(InData%uzWave, kind=B8Ki)) - call RegPack(Buf, InData%uzWave) - end if - call RegPack(Buf, allocated(InData%axWave)) - if (allocated(InData%axWave)) then - call RegPackBounds(Buf, 4, lbound(InData%axWave, kind=B8Ki), ubound(InData%axWave, kind=B8Ki)) - call RegPack(Buf, InData%axWave) - end if - call RegPack(Buf, allocated(InData%ayWave)) - if (allocated(InData%ayWave)) then - call RegPackBounds(Buf, 4, lbound(InData%ayWave, kind=B8Ki), ubound(InData%ayWave, kind=B8Ki)) - call RegPack(Buf, InData%ayWave) - end if - call RegPack(Buf, allocated(InData%azWave)) - if (allocated(InData%azWave)) then - call RegPackBounds(Buf, 4, lbound(InData%azWave, kind=B8Ki), ubound(InData%azWave, kind=B8Ki)) - call RegPack(Buf, InData%azWave) - end if - call RegPack(Buf, allocated(InData%PDyn)) - if (allocated(InData%PDyn)) then - call RegPackBounds(Buf, 4, lbound(InData%PDyn, kind=B8Ki), ubound(InData%PDyn, kind=B8Ki)) - call RegPack(Buf, InData%PDyn) - end if - call RegPack(Buf, allocated(InData%zeta)) - if (allocated(InData%zeta)) then - call RegPackBounds(Buf, 3, lbound(InData%zeta, kind=B8Ki), ubound(InData%zeta, kind=B8Ki)) - call RegPack(Buf, InData%zeta) - end if - call RegPack(Buf, InData%nzCurrent) - call RegPack(Buf, allocated(InData%pzCurrent)) - if (allocated(InData%pzCurrent)) then - call RegPackBounds(Buf, 1, lbound(InData%pzCurrent, kind=B8Ki), ubound(InData%pzCurrent, kind=B8Ki)) - call RegPack(Buf, InData%pzCurrent) - end if - call RegPack(Buf, allocated(InData%uxCurrent)) - if (allocated(InData%uxCurrent)) then - call RegPackBounds(Buf, 1, lbound(InData%uxCurrent, kind=B8Ki), ubound(InData%uxCurrent, kind=B8Ki)) - call RegPack(Buf, InData%uxCurrent) - end if - call RegPack(Buf, allocated(InData%uyCurrent)) - if (allocated(InData%uyCurrent)) then - call RegPackBounds(Buf, 1, lbound(InData%uyCurrent, kind=B8Ki), ubound(InData%uyCurrent, kind=B8Ki)) - call RegPack(Buf, InData%uyCurrent) - end if - call RegPack(Buf, InData%Nx0) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, allocated(InData%dx)) - if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) - call RegPack(Buf, InData%dx) - end if - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%Jac_nx) - call RegPack(Buf, allocated(InData%dxIdx_map2_xStateIdx)) - if (allocated(InData%dxIdx_map2_xStateIdx)) then - call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx, kind=B8Ki), ubound(InData%dxIdx_map2_xStateIdx, kind=B8Ki)) - call RegPack(Buf, InData%dxIdx_map2_xStateIdx) - end if - call RegPack(Buf, InData%VisMeshes) - call RegPack(Buf, allocated(InData%VisRodsDiam)) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%MDUnOut) + call RegPack(RF, InData%PriPath) + call RegPack(RF, InData%writeLog) + call RegPack(RF, InData%UnLog) + call RegPack(RF, InData%WaveKin) + call RegPack(RF, InData%Current) + call RegPack(RF, InData%nTurbines) + call RegPackAlloc(RF, InData%TurbineRefPos) + call RegPack(RF, InData%mu_kT) + call RegPack(RF, InData%mu_kA) + call RegPack(RF, InData%mc) + call RegPack(RF, InData%cv) + call RegPack(RF, InData%nxWave) + call RegPack(RF, InData%nyWave) + call RegPack(RF, InData%nzWave) + call RegPack(RF, InData%ntWave) + call RegPackAlloc(RF, InData%pxWave) + call RegPackAlloc(RF, InData%pyWave) + call RegPackAlloc(RF, InData%pzWave) + call RegPack(RF, InData%dtWave) + call RegPackAlloc(RF, InData%uxWave) + call RegPackAlloc(RF, InData%uyWave) + call RegPackAlloc(RF, InData%uzWave) + call RegPackAlloc(RF, InData%axWave) + call RegPackAlloc(RF, InData%ayWave) + call RegPackAlloc(RF, InData%azWave) + call RegPackAlloc(RF, InData%PDyn) + call RegPackAlloc(RF, InData%zeta) + call RegPack(RF, InData%nzCurrent) + call RegPackAlloc(RF, InData%pzCurrent) + call RegPackAlloc(RF, InData%uxCurrent) + call RegPackAlloc(RF, InData%uyCurrent) + call RegPack(RF, InData%Nx0) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%dxIdx_map2_xStateIdx) + call RegPack(RF, InData%VisMeshes) + call RegPack(RF, allocated(InData%VisRodsDiam)) if (allocated(InData%VisRodsDiam)) then - call RegPackBounds(Buf, 1, lbound(InData%VisRodsDiam, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VisRodsDiam, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) LB(1:1) = lbound(InData%VisRodsDiam, kind=B8Ki) UB(1:1) = ubound(InData%VisRodsDiam, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackVisDiam(Buf, InData%VisRodsDiam(i1)) + call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackParam' integer(B8Ki) :: i1, i2, i3, i4 integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%nLineTypes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nRodTypes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nPoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nPointsExtra) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nBodies) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nRods) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nLines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nCtrlChans) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFails) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFreeBodies) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFreeRods) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nFreePoints) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%nCpldBodies)) deallocate(OutData%nCpldBodies) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%nCpldBodies(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%nCpldBodies) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%nCpldRods)) deallocate(OutData%nCpldRods) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%nCpldRods(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%nCpldRods) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%nCpldPoints)) deallocate(OutData%nCpldPoints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%nCpldPoints(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%nCpldPoints) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NConns) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NAnchs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%g) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rhoW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%kBot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%cBot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dtM0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dtCoupling) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dtOut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nLineTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRodTypes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nPointsExtra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nCtrlChans); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFails); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreeRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nFreePoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldBodies); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldRods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nCpldPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NConns); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NAnchs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rhoW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%kBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cBot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtM0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtCoupling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MDUnOut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PriPath) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%writeLog) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnLog) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveKin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Current) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nTurbines) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TurbineRefPos) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%mu_kT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%mu_kA) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%mc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%cv) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nxWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nyWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nzWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ntWave) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%pxWave)) deallocate(OutData%pxWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%pxWave(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%pxWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%pyWave)) deallocate(OutData%pyWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%pyWave(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%pyWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%pzWave)) deallocate(OutData%pzWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%pzWave(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%pzWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%dtWave) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%uxWave)) deallocate(OutData%uxWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uxWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%uyWave)) deallocate(OutData%uyWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uyWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%uzWave)) deallocate(OutData%uzWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uzWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uzWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%axWave)) deallocate(OutData%axWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%axWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ayWave)) deallocate(OutData%ayWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ayWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ayWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%azWave)) deallocate(OutData%azWave) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%azWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%azWave) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PDyn) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%zeta)) deallocate(OutData%zeta) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%zeta) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nzCurrent) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%pzCurrent)) deallocate(OutData%pzCurrent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%pzCurrent(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%pzCurrent) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%uxCurrent)) deallocate(OutData%uxCurrent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uxCurrent(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uxCurrent) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%uyCurrent)) deallocate(OutData%uyCurrent) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%uyCurrent(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%uyCurrent) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Nx0) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%dxIdx_map2_xStateIdx)) deallocate(OutData%dxIdx_map2_xStateIdx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dxIdx_map2_xStateIdx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dxIdx_map2_xStateIdx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%VisMeshes) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MDUnOut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PriPath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%writeLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnLog); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Current); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TurbineRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mu_kA); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%mc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%cv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ntWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dtWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uzWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%axWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ayWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%azWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PDyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%zeta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%pzCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uxCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%uyCurrent); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nx0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxIdx_map2_xStateIdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VisMeshes); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%VisRodsDiam)) deallocate(OutData%VisRodsDiam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VisRodsDiam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsDiam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackVisDiam(Buf, OutData%VisRodsDiam(i1)) ! VisRodsDiam + call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam end do end if end subroutine @@ -6231,87 +4196,51 @@ subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%CoupledKinematics)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledKinematics)) if (allocated(InData%CoupledKinematics)) then - call RegPackBounds(Buf, 1, lbound(InData%CoupledKinematics, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%CoupledKinematics, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) LB(1:1) = lbound(InData%CoupledKinematics, kind=B8Ki) UB(1:1) = ubound(InData%CoupledKinematics, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%CoupledKinematics(i1)) + call MeshPack(RF, InData%CoupledKinematics(i1)) end do end if - call RegPack(Buf, allocated(InData%DeltaL)) - if (allocated(InData%DeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%DeltaL, kind=B8Ki), ubound(InData%DeltaL, kind=B8Ki)) - call RegPack(Buf, InData%DeltaL) - end if - call RegPack(Buf, allocated(InData%DeltaLdot)) - if (allocated(InData%DeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot, kind=B8Ki), ubound(InData%DeltaLdot, kind=B8Ki)) - call RegPack(Buf, InData%DeltaLdot) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%DeltaL) + call RegPackAlloc(RF, InData%DeltaLdot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%CoupledKinematics(i1)) ! CoupledKinematics + call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics end do end if - if (allocated(OutData%DeltaL)) deallocate(OutData%DeltaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DeltaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DeltaL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DeltaLdot)) deallocate(OutData%DeltaLdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DeltaLdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%DeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DeltaLdot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -6482,162 +4411,135 @@ subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine MD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(MD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%CoupledLoads)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%CoupledLoads)) if (allocated(InData%CoupledLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%CoupledLoads, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%CoupledLoads, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) LB(1:1) = lbound(InData%CoupledLoads, kind=B8Ki) UB(1:1) = ubound(InData%CoupledLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%CoupledLoads(i1)) + call MeshPack(RF, InData%CoupledLoads(i1)) end do end if - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, allocated(InData%VisLinesMesh)) + call RegPackAlloc(RF, InData%WriteOutput) + call RegPack(RF, allocated(InData%VisLinesMesh)) if (allocated(InData%VisLinesMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisLinesMesh, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VisLinesMesh, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) LB(1:1) = lbound(InData%VisLinesMesh, kind=B8Ki) UB(1:1) = ubound(InData%VisLinesMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%VisLinesMesh(i1)) + call MeshPack(RF, InData%VisLinesMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%VisRodsMesh)) + call RegPack(RF, allocated(InData%VisRodsMesh)) if (allocated(InData%VisRodsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisRodsMesh, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VisRodsMesh, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) LB(1:1) = lbound(InData%VisRodsMesh, kind=B8Ki) UB(1:1) = ubound(InData%VisRodsMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%VisRodsMesh(i1)) + call MeshPack(RF, InData%VisRodsMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%VisBodiesMesh)) + call RegPack(RF, allocated(InData%VisBodiesMesh)) if (allocated(InData%VisBodiesMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisBodiesMesh, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VisBodiesMesh, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) LB(1:1) = lbound(InData%VisBodiesMesh, kind=B8Ki) UB(1:1) = ubound(InData%VisBodiesMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%VisBodiesMesh(i1)) + call MeshPack(RF, InData%VisBodiesMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%VisAnchsMesh)) + call RegPack(RF, allocated(InData%VisAnchsMesh)) if (allocated(InData%VisAnchsMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%VisAnchsMesh, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%VisAnchsMesh, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) LB(1:1) = lbound(InData%VisAnchsMesh, kind=B8Ki) UB(1:1) = ubound(InData%VisAnchsMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%VisAnchsMesh(i1)) + call MeshPack(RF, InData%VisAnchsMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine MD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine MD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(MD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOutput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%CoupledLoads(i1)) ! CoupledLoads + call MeshUnpack(RF, OutData%CoupledLoads(i1)) ! CoupledLoads end do end if - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%VisLinesMesh)) deallocate(OutData%VisLinesMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VisLinesMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisLinesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%VisLinesMesh(i1)) ! VisLinesMesh + call MeshUnpack(RF, OutData%VisLinesMesh(i1)) ! VisLinesMesh end do end if if (allocated(OutData%VisRodsMesh)) deallocate(OutData%VisRodsMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VisRodsMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisRodsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%VisRodsMesh(i1)) ! VisRodsMesh + call MeshUnpack(RF, OutData%VisRodsMesh(i1)) ! VisRodsMesh end do end if if (allocated(OutData%VisBodiesMesh)) deallocate(OutData%VisBodiesMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VisBodiesMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisBodiesMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh + call MeshUnpack(RF, OutData%VisBodiesMesh(i1)) ! VisBodiesMesh end do end if if (allocated(OutData%VisAnchsMesh)) deallocate(OutData%VisAnchsMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%VisAnchsMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VisAnchsMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh + call MeshUnpack(RF, OutData%VisAnchsMesh(i1)) ! VisAnchsMesh end do end if end subroutine diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index cc7a669296..dc0e51e50d 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -68,6 +68,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 src/ModReg.f90 + src/ModVar.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 diff --git a/modules/nwtc-library/src/ModVar.f90 b/modules/nwtc-library/src/ModVar.f90 new file mode 100644 index 0000000000..f6c7db7fc0 --- /dev/null +++ b/modules/nwtc-library/src/ModVar.f90 @@ -0,0 +1,984 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2023 National Renewable Energy Laboratory +! +! This file is part of the NWTC Subroutine Library. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +!********************************************************************************************************************************** +!> The modules ModVar and ModVar_Types provide data structures and subroutines for representing and manipulating meshes +!! and meshed data in the FAST modular framework. +!! +!! Module variables provide a structured way for documenting, locating, and orchestrating the interdependencies between modules. +!! + +module ModVar +use NWTC_Library_Types +use NWTC_IO +use ModMesh +implicit none + +private + +integer(IntKi), parameter :: & + LoadFields(*) = [VF_Force, VF_Moment], & + TransFields(*) = [VF_TransDisp, VF_TransVel, VF_TransAcc], & + AngularFields(*) = [VF_Orientation, VF_AngularDisp, VF_AngularVel, VF_AngularAcc], & + MotionFields(*) = [VF_TransDisp, VF_Orientation, VF_TransVel, VF_AngularVel, VF_TransAcc, VF_AngularAcc], & + MeshFields(*) = [LoadFields, MotionFields] + +interface MV_PackVar + module procedure MV_PackVarR4, MV_PackVarR4Ary + module procedure MV_PackVarR8, MV_PackVarR8Ary +end interface + +interface MV_UnpackVar + module procedure MV_UnpackVarR4, MV_UnpackVarR4Ary + module procedure MV_UnpackVarR8, MV_UnpackVarR8Ary +end interface + +public :: MV_InitVarsVals, MV_LinkOutputInput, MV_VarIndex, MV_PackMesh, MV_UnpackMesh, MV_PackVar, MV_UnpackVar +public :: MV_ComputeCentralDiff, MV_Perturb, MV_ComputeDiff +public :: MV_AddVar, MV_AddMeshVar, MV_AddModule, SetFlags +public :: LoadFields, MotionFields, TransFields, AngularFields, MeshFields +public :: wm_to_dcm, wm_compose, wm_from_dcm, wm_inv, wm_to_xyz, wm_from_xyz +public :: MV_FieldString, IdxStr + +contains + +function MV_FieldString(Field) result(str) + integer(IntKi), intent(in) :: Field + character(16) :: str + select case (Field) + case (VF_AngularAcc) + str = "VF_AngularAcc" + case (VF_AngularDisp) + str = "VF_AngularDisp" + case (VF_AngularVel) + str = "VF_AngularVel" + case (VF_Force) + str = "VF_Force" + case (VF_Moment) + str = "VF_Moment" + case (VF_Orientation) + str = "VF_Orientation" + case (VF_TransAcc) + str = "VF_TransAcc" + case (VF_TransDisp) + str = "VF_TransDisp" + case (VF_TransVel) + str = "VF_TransVel" + case default + str = "Unknown" + end select +end function + +subroutine MV_InitVarsVals(Vars, Vals, Linearize, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: Vars + type(ModValsType), intent(inout) :: Vals + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_InitMod' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, StartIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Initialize state variables + if (.not. allocated(Vars%x)) allocate (Vars%x(0)) + StartIndex = 1 + do i = 1, size(Vars%x) + call ModVarType_Init(Vars%x(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Initialize input variables + if (.not. allocated(Vars%u)) allocate (Vars%u(0)) + StartIndex = 1 + do i = 1, size(Vars%u) + call ModVarType_Init(Vars%u(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Initialize output variables + if (.not. allocated(Vars%y)) allocate (Vars%y(0)) + StartIndex = 1 + do i = 1, size(Vars%y) + call ModVarType_Init(Vars%y(i), StartIndex, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + end do + + ! Calculate number of state, input, and output variables + Vars%Nx = sum(Vars%x%Num) + Vars%Nu = sum(Vars%u%Num) + Vars%Ny = sum(Vars%y%Num) + + ! Allocate state, input, and output values + call AllocAry(Vals%x, Vars%Nx, "Vals%x", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%dxdt, Vars%Nx, "Vals%dxdt", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%u, Vars%Nu, "Vals%u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%y, Vars%Ny, "Vals%y", ErrStat2, ErrMsg2); if (Failed()) return + + ! Allocate perturbation input and output values + call AllocAry(Vals%u_perturb, Vars%Nu, "Vals%u_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%x_perturb, Vars%Nx, "Vals%x_perturb", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%xp, Vars%Nx, "Vals%xp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%xn, Vars%Nx, "Vals%xn", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%yp, Vars%Ny, "Vals%yp", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(Vals%yn, Vars%Ny, "Vals%yn", ErrStat2, ErrMsg2); if (Failed()) return + +contains + + function Failed() + logical Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function + + function FailedAlloc() + logical FailedAlloc + FailedAlloc = ErrStat2 /= 0 + if (FailedAlloc) call SetErrStat(ErrID_Fatal, 'error allocating Vals', ErrStat, ErrMsg, RoutineName) + end function + +end subroutine + +elemental function IsMesh(Var) result(r) + type(ModVarType), intent(in) :: Var + logical :: r + r = iand(Var%Flags, VF_Mesh) > 0 +end function + +subroutine ModVarType_Init(Var, Index, Linearize, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(inout) :: Index + logical, intent(in) :: Linearize + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'ModVarsType_Init' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i, j + integer(IntKi) :: nNodes + character(1), parameter :: Comp(3) = ['X', 'Y', 'Z'] + character(*), parameter :: Fmt = '(A," ",A,", node",I0,", ",A)' + character(2) :: UnitDesc + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + !---------------------------------------------------------------------------- + ! Mesh + !---------------------------------------------------------------------------- + + ! If this variable belongs to a mesh + if (iand(Var%Flags, VF_Mesh) > 0) then + + ! Size is the number of nodes in a mesh + Var%Nodes = Var%Num + + ! Number of values + Var%Num = Var%Nodes*3 + + ! If linearization requested + if (Linearize) then + + ! Set unit description for line mesh + UnitDesc = '' + if (iand(Var%Flags, VF_Line) > 0) UnitDesc = "/m" + + ! Switch based on field number + select case (Var%Field) + case (VF_Force) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" force, node "//trim(num2lstr(i))//', N'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_Moment) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" moment, node "//trim(num2lstr(i))//', Nm'//UnitDesc, j=1, 3), i=1, nNodes)] + case (VF_TransDisp) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation displacement, node "//trim(num2lstr(i))//', m', j=1, 3), i=1, nNodes)] + case (VF_Orientation) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" orientation angle, node "//trim(num2lstr(i))//', rad', j=1, 3), i=1, nNodes)] + case (VF_TransVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation velocity, node "//trim(num2lstr(i))//', m/s', j=1, 3), i=1, nNodes)] + case (VF_AngularVel) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation velocity, node "//trim(num2lstr(i))//', rad/s', j=1, 3), i=1, nNodes)] + case (VF_TransAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" translation acceleration, node "//trim(num2lstr(i))//', m/s^2', j=1, 3), i=1, nNodes)] + case (VF_AngularAcc) + Var%LinNames = [character(LinChanLen) ::((trim(Var%Name)//" "//Comp(j)//" rotation acceleration, node "//trim(num2lstr(i))//', rad/s^2', j=1, 3), i=1, nNodes)] + case default + call SetErrStat(ErrID_Fatal, "Invalid mesh field type", ErrStat, ErrMsg, RoutineName) + return + end select + + end if + end if + + !---------------------------------------------------------------------------- + ! Linearization + !---------------------------------------------------------------------------- + + if (Linearize) then + + ! If incorrect number of linearization names, return error + if (size(Var%LinNames) < Var%Num) then + call SetErrStat(ErrID_Fatal, "insufficient LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + else if (size(Var%LinNames) > Var%Num) then + call SetErrStat(ErrID_Fatal, "excessive LinNames given for "//Var%Name, ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Indices + !---------------------------------------------------------------------------- + + ! Initialize local index + call AllocAry(Var%iLoc, Var%Num, "Var%iLoc", ErrStat2, ErrMsg2); if (Failed()) return + Var%iLoc = [(index + i, i=0, Var%Num - 1)] + + ! Update index based on variable size + index = index + Var%Num + +contains + function Failed() + logical :: Failed + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + +!------------------------------------------------------------------------------- +! Functions for packing and unpacking data by variable +!------------------------------------------------------------------------------- + +subroutine MV_PackVarR4(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc(1)) = real(Val, R8Ki) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR8(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Val + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc(1)) = Val + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR4Ary(VarAry, iVar, Val, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Val(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc) = real(pack(Val, .true.), R4Ki) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackVarR8Ary(VarAry, iVar, Vals, Ary) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Vals(:) + real(R8Ki), intent(inout) :: Ary(:) + Ary(VarAry(iVar)%iLoc) = pack(Vals, .true.) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR4(VarAry, iVar, Ary, Val) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Val + Val = Ary(VarAry(iVar)%iLoc(1)) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR4Ary(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R4Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals = Ary(VarAry(iVar)%iLoc) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR8(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals + Vals = Ary(VarAry(iVar)%iLoc(1)) + iVar = iVar + 1 +end subroutine + +subroutine MV_UnpackVarR8Ary(VarAry, iVar, Ary, Vals) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Ary(:) + real(R8Ki), intent(inout) :: Vals(:) + Vals = Ary(VarAry(iVar)%iLoc) + iVar = iVar + 1 +end subroutine + +subroutine MV_PackMesh(VarAry, iVar, Mesh, Values) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + type(MeshType), intent(in) :: Mesh + real(R8Ki), intent(inout) :: Values(:) + integer(IntKi) :: MeshID, j + MeshID = VarAry(iVar)%MeshID + do while (VarAry(iVar)%MeshID == MeshID) + select case (VarAry(iVar)%Field) + case (VF_Force) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Force, .true.) + case (VF_Moment) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Moment, .true.) + case (VF_TransDisp) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationDisp, .true.) + case (VF_Orientation) + do j = 1, VarAry(iVar)%Nodes + Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j)) = wm_from_dcm(Mesh%Orientation(:, :, j)) + end do + case (VF_TransVel) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationVel, .true.) + case (VF_AngularVel) + Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationVel, .true.) + case (VF_TransAcc) + Values(VarAry(iVar)%iLoc) = pack(Mesh%TranslationAcc, .true.) + case (VF_AngularAcc) + Values(VarAry(iVar)%iLoc) = pack(Mesh%RotationAcc, .true.) + case (VF_Scalar) + Values(VarAry(iVar)%iLoc) = pack(Mesh%Scalars, .true.) + end select + iVar = iVar + 1 + if (iVar > size(VarAry)) exit + end do +end subroutine + +subroutine MV_UnpackMesh(VarAry, iVar, Values, Mesh) + type(ModVarType), intent(in) :: VarAry(:) + integer(IntKi), intent(inout) :: iVar + real(R8Ki), intent(in) :: Values(:) + type(MeshType), intent(inout) :: Mesh + integer(IntKi) :: MeshID, j + MeshID = VarAry(iVar)%MeshID + do while (VarAry(iVar)%MeshID == MeshID) + select case (VarAry(iVar)%Field) + case (VF_Force) + Mesh%Force = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Force)) + case (VF_Moment) + Mesh%Moment = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Moment)) + case (VF_TransDisp) + Mesh%TranslationDisp = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationDisp)) + case (VF_Orientation) + do j = 1, VarAry(iVar)%Nodes + Mesh%Orientation(:, :, j) = wm_to_dcm(Values(VarAry(iVar)%iLoc(3*(j - 1) + 1:3*j))) + end do + case (VF_TransVel) + Mesh%TranslationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationVel)) + case (VF_AngularVel) + Mesh%RotationVel = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationVel)) + case (VF_TransAcc) + Mesh%TranslationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%TranslationAcc)) + case (VF_AngularAcc) + Mesh%RotationAcc = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%RotationAcc)) + case (VF_Scalar) + Mesh%Scalars = reshape(Values(VarAry(iVar)%iLoc), shape(Mesh%Scalars)) + end select + iVar = iVar + 1 + if (iVar > size(VarAry)) exit + end do +end subroutine + +subroutine MV_Perturb(Var, iLin, PerturbSign, BaseAry, PerturbAry, iPerturb) + type(ModVarType), intent(in) :: Var + integer(IntKi), intent(in) :: iLin + integer(IntKi), intent(in) :: PerturbSign + real(R8Ki), intent(in) :: BaseAry(:) + real(R8Ki), intent(inout) :: PerturbAry(:) + integer(IntKi), intent(out) :: iPerturb + real(R8Ki) :: Perturb + real(R8Ki) :: WM(3), WMp(3) + integer(IntKi) :: i, j, iLoc(3) + + ! Copy base array to perturbed array + PerturbAry = BaseAry + + ! Get variable perturbation and combine with sign + Perturb = Var%Perturb*real(PerturbSign, R8Ki) + + ! Perturbation index within array + iPerturb = Var%iLoc(iLin) + + ! If variable field is orientation, perturbation is in WM parameters + if (Var%Field == VF_Orientation) then + j = mod(iLin - 1, 3) ! component being modified (0, 1, 2) + i = iLin - j ! index of start of WM parameters (3) + iLoc = Var%iLoc(i:i + 2) ! array index vector + WMp = 0.0_R8Ki ! Init WM perturbation to zero + WMp(j + 1) = Perturb ! WM perturbation around X,Y,Z axis + WM = PerturbAry(iLoc) ! Current WM parameters value + PerturbAry(iLoc) = wm_compose(WM, wm_from_xyz(WMp)) ! Compose value and perturbation + else + PerturbAry(Var%iLoc(iLin)) = PerturbAry(Var%iLoc(iLin)) + Perturb + end if + +end subroutine + +subroutine MV_ComputeDiff(VarAry, PosAry, NegAry, DiffAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: PosAry(:) ! Positive result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative result array + real(R8Ki), intent(inout) :: DiffAry(:) ! Array containing difference + integer(IntKi) :: i, j, ind(3) + real(R8Ki) :: DeltaWM(3) + + ! Loop through variables + do i = 1, size(VarAry) + + ! If variable field is orientation + if (VarAry(i)%Field == VF_Orientation) then + + ! Loop through nodes + do j = 1, VarAry(i)%Nodes + + ! Get vector of indicies of WM rotation parameters in array + ind = VarAry(i)%iLoc(3*(j - 1) + 1:3*j) + + ! Compose WM parameters to go from negative to positive array + DeltaWM = wm_compose(wm_inv(NegAry(ind)), PosAry(ind)) + + ! Calculate change in rotation in XYZ in radians + DiffAry(ind) = wm_to_xyz(DeltaWM) ! store delta as radians + end do + + else + + ! Subtract negative array from positive array + DiffAry(VarAry(i)%iLoc) = PosAry(VarAry(i)%iLoc) - NegAry(VarAry(i)%iLoc) + end if + end do +end subroutine + +subroutine MV_ComputeCentralDiff(VarAry, Delta, PosAry, NegAry, DerivAry) + type(ModVarType), intent(in) :: VarAry(:) ! Array of variables + real(R8Ki), intent(in) :: Delta ! Positive perturbation value + real(R8Ki), intent(in) :: PosAry(:) ! Positive perturbation result array + real(R8Ki), intent(in) :: NegAry(:) ! Negative perturbation result array + real(R8Ki), intent(inout) :: DerivAry(:) ! Array containing derivative + + ! Compute difference between all values + call MV_ComputeDiff(VarAry, PosAry, NegAry, DerivAry) + + ! Divide derivative array by twice delta + DerivAry = DerivAry/(2.0_R8Ki*Delta) + +end subroutine + +!------------------------------------------------------------------------------- +! Functions for adding Variables an Modules +!------------------------------------------------------------------------------- + +subroutine MV_AddModule(ModAry, ModID, ModAbbr, Instance, ModDT, SolverDT, Vars, ErrStat, ErrMsg) + type(ModDataType), allocatable, intent(inout) :: ModAry(:) + integer(IntKi), intent(in) :: ModID + character(*), intent(in) :: ModAbbr + integer(IntKi), intent(in) :: Instance + real(R8Ki), intent(in) :: ModDT + real(R8Ki), intent(in) :: SolverDT + type(ModVarsType), pointer, intent(in) :: Vars + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_AddModule' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + type(ModDataType) :: ModData + + ErrStat = ErrID_None + ErrMsg = '' + + ! If module array hasn't been allocated, allocate with zero size + if (.not. allocated(ModAry)) allocate (ModAry(0)) + + ! Populate ModuleDataType derived type + ModData = ModDataType(Idx=size(ModAry) + 1, ID=ModID, Abbr=ModAbbr, & + Ins=Instance, DT=ModDT, Vars=Vars) + + ! Allocate source and destination mapping arrays + call AllocAry(ModData%SrcMaps, 0, "ModData%SrcMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AllocAry(ModData%DstMaps, 0, "ModData%DstMaps", ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + + !---------------------------------------------------------------------------- + ! Calculate Module Substepping + !---------------------------------------------------------------------------- + + ! If module time step is same as global time step, set substeps to 1 + if (EqualRealNos(ModData%DT, SolverDT)) then + ModData%SubSteps = 1 + else + ! If the module time step is greater than the global time step, set error + if (ModData%DT > SolverDT) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "cannot be larger than FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + + ! Calculate the number of substeps + ModData%SubSteps = nint(SolverDT/ModData%DT) + + ! If the module DT is not an exact integer divisor of the global time step, set error + if (.not. EqualRealNos(SolverDT, ModData%DT*ModData%SubSteps)) then + call SetErrStat(ErrID_Fatal, "The "//trim(ModData%Abbr)// & + " module time step ("//trim(Num2LStr(ModData%DT))//" s) "// & + "must be an integer divisor of the FAST time step ("//trim(Num2LStr(SolverDT))//" s).", & + ErrStat, ErrMsg, RoutineName) + return + end if + end if + + !---------------------------------------------------------------------------- + ! Add module data to array + !---------------------------------------------------------------------------- + + ModAry = [ModAry, ModData] + +end subroutine + +subroutine MV_AddMeshVar(VarAry, Name, Fields, Mesh, Flags, Perturbs) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Fields(:) + integer(IntKi), optional, intent(in) :: Flags + type(MeshType), intent(inout) :: Mesh + real(R8Ki), optional, intent(in) :: Perturbs(:) + integer(IntKi) :: i, FlagsLocal + logical :: ActiveLocal + real(R8Ki), allocatable :: PerturbsLocal(:) + if (.not. Mesh%committed) return + if (allocated(VarAry)) then + Mesh%ID = size(VarAry) + 1 + else + Mesh%ID = 1 + end if + FlagsLocal = 0 + if (present(Flags)) FlagsLocal = Flags + FlagsLocal = ior(FlagsLocal, VF_Mesh) + PerturbsLocal = [(0.0_R8Ki, i=1, size(Fields))] + if (present(Perturbs)) PerturbsLocal = Perturbs + do i = 1, size(Fields) + call MV_AddVar(VarAry, Name, Fields(i), Num=Mesh%Nnodes, Flags=FlagsLocal, & + Perturb=PerturbsLocal(i)) + VarAry(size(VarAry))%MeshID = Mesh%ID + end do +end subroutine + +subroutine MV_AddVar(VarAry, Name, Field, Num, Flags, iUsr, jUsr, DerivOrder, Perturb, LinNames, Active) + type(ModVarType), allocatable, intent(inout) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + integer(IntKi), optional, intent(in) :: Num, Flags, iUsr, jUsr + real(R8Ki), optional, intent(in) :: Perturb + integer(IntKi), optional, intent(in) :: DerivOrder + logical, optional, intent(in) :: Active + character(*), optional, intent(in) :: LinNames(:) + integer(IntKi) :: i + type(ModVarType) :: Var + + ! If active argument specified and not active, return + if (present(Active)) then + if (.not. Active) return + end if + + ! Initialize var with default values + Var = ModVarType(Name=Name, Field=Field) + + ! Set optional values + if (present(Num)) Var%Num = Num + if (present(Flags)) Var%Flags = Flags + if (present(iUsr)) Var%iUsr = [iUsr, iUsr + Var%Num - 1] + if (present(jUsr)) Var%jUsr = jUsr + if (present(Perturb)) Var%Perturb = Perturb + if (present(LinNames)) then + allocate (Var%LinNames(size(LinNames))) + do i = 1, size(LinNames) + Var%LinNames(i) = LinNames(i) + end do + end if + + ! Set Derivative Order + if (present(DerivOrder)) then + Var%DerivOrder = DerivOrder + else + select case (Var%Field) + case (VF_Orientation, VF_TransDisp, VF_AngularDisp) ! Position/displacement + Var%DerivOrder = 0 + case (VF_TransVel, VF_AngularVel) ! Velocity + Var%DerivOrder = 1 + case (VF_TransAcc, VF_AngularAcc) ! Acceleration + Var%DerivOrder = 2 + case default + Var%DerivOrder = -1 + end select + end if + + ! Append Var to VarArray + if (allocated(VarAry)) then + VarAry = [VarAry, Var] + else + VarAry = [Var] + end if +end subroutine + +! Get index of variable in array matching name and field +function MV_VarIndex(VarAry, Name, Field) result(Indx) + type(ModVarType), intent(in) :: VarAry(:) + character(*), intent(in) :: Name + integer(IntKi), intent(in) :: Field + integer(IntKi) :: Indx + do Indx = 1, size(VarAry) + if (string_equal_ci(VarAry(Indx)%Name, Name) .and. & + VarAry(Indx)%Field == Field) exit + end do + if (Indx > size(VarAry)) Indx = 0 +end function + +!------------------------------------------------------------------------------- +! Functions for linking variables (Output and Input) +!------------------------------------------------------------------------------- + +subroutine MV_LinkOutputInput(OutVars, InpVars, OutName, InpName, Field, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: OutVars, InpVars + character(*), intent(in) :: OutName, InpName + integer(IntKi), intent(in) :: Field + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'MV_LinkOutputInput' + ! integer(IntKi) :: ErrStat2 + ! character(ErrMsgLen) :: ErrMsg2 + ! integer(IntKi) :: i + integer(IntKi) :: InpVarIndex, OutVarIndex + + ! Initialize error outputs + ErrStat = ErrID_None + ErrMsg = '' + + ! Find name/field in input vars + InpVarIndex = MV_VarIndex(InpVars%u, InpName, Field) + if (InpVarIndex == 0) then + call SetErrStat(ErrID_Fatal, 'Input variable "'//InpName//'" with field '// & + trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) + return + end if + + ! Find name/field in output vars + OutVarIndex = MV_VarIndex(OutVars%u, OutName, Field) + if (OutVarIndex == 0) then + call SetErrStat(ErrID_Fatal, 'Output variable "'//OutName//'" with field '// & + trim(num2lstr(Field))//' not found', ErrStat, ErrMsg, RoutineName) + return + end if + + ! If error finding input or output variable, return + if (ErrStat >= AbortErrLev) return + + ! TODO: figure out what to do here + +end subroutine + +!------------------------------------------------------------------------------- +! Flag Utilities +!------------------------------------------------------------------------------- + +subroutine SetFlags(Var, Mask) + type(ModVarType), intent(inout) :: Var + integer(IntKi), intent(in) :: Mask + integer(IntKi) :: i + Var%Flags = ior(Var%Flags, Mask) +end subroutine + +!------------------------------------------------------------------------------- +! String Utilities +!------------------------------------------------------------------------------- + +! Compare strings s1 and s2 while ignoring case +function string_equal_ci(s1, s2) result(is_equal) + character(*), intent(in) :: s1, s2 + logical :: is_equal + integer(IntKi), parameter :: ca = iachar("a") + integer(IntKi), parameter :: cz = iachar("z") + integer(IntKi) :: i, j + integer(IntKi) :: c1, c2 + is_equal = .false. + i = len_trim(s1) + j = len_trim(s2) + if (i /= j) return + do i = 1, j + c1 = iachar(s1(i:i)) + c2 = iachar(s2(i:i)) + if (c1 == c2) cycle + if (c1 >= ca .and. c1 <= cz) c1 = c1 - 32 + if (c2 >= ca .and. c2 <= cz) c2 = c2 - 32 + if (c1 /= c2) return + end do + is_equal = .true. +end function + +function IdxStr(i1, i2, i3, i4, i5) result(s) + integer(IntKi), intent(in) :: i1 + integer(IntKi), optional, intent(in) :: i2, i3, i4, i5 + character(100) :: s + if (present(i5)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//','//trim(Num2LStr(i5))//')' + else if (present(i4)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//','//trim(Num2LStr(i4))//')' + else if (present(i3)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//','//trim(Num2LStr(i3))//')' + else if (present(i2)) then + s = '('//trim(Num2LStr(i1))//','//trim(Num2LStr(i2))//')' + else + s = '('//trim(Num2LStr(i1))//')' + end if +end function + +!------------------------------------------------------------------------------- +! Rotation Utilities +!------------------------------------------------------------------------------- + +pure function quat_from_dcm(R) result(q) + real(R8Ki), intent(in) :: R(3, 3) + real(R8Ki) :: q(4), C + integer(IntKi) :: j + + q = [(1.0_R8Ki + R(1, 1) - R(2, 2) - R(3, 3)), & + (1.0_R8Ki - R(1, 1) + R(2, 2) - R(3, 3)), & + (1.0_R8Ki - R(1, 1) - R(2, 2) + R(3, 3)), & + (1.0_R8Ki + R(1, 1) + R(2, 2) + R(3, 3))] + + ! Get index of max value in q + j = maxloc(q, dim=1) + + ! Calculate quaternion from direction cosine matrix + C = q(j) + select case (j) + case (1) + q = [C, (R(1, 2) + R(2, 1)), (R(3, 1) + R(1, 3)), (R(2, 3) - R(3, 2))] + case (2) + q = [(R(1, 2) + R(2, 1)), C, (R(2, 3) + R(3, 2)), (R(3, 1) - R(1, 3))] + case (3) + q = [(R(3, 1) + R(1, 3)), (R(2, 3) + R(3, 2)), C, (R(1, 2) - R(2, 1))] + case (4) + q = [(R(2, 3) - R(3, 2)), (R(3, 1) - R(1, 3)), (R(1, 2) - R(2, 1)), C] + end select + q = q/(2.0_R8Ki*sqrt(C)) + if (q(4) < 0.0_R8Ki) q = -q +end function + +pure function quat_to_dcm(q) result(R) + real(R8Ki), intent(in) :: q(4) + real(R8Ki) :: R(3, 3) + real(R8Ki) :: q1, q2, q3, q4 + q1 = q(1); q2 = q(2); q3 = q(3); q4 = q(4) + R(1, :) = [q4*q4 + q1*q1 - q2*q2 - q3*q3, 2*(q1*q2 + q3*q4), 2*(q1*q3 - q2*q4)] + R(2, :) = [2*(q1*q2 - q3*q4), q4*q4 - q1*q1 + q2*q2 - q3*q3, 2*(q2*q3 + q1*q4)] + R(3, :) = [2*(q1*q3 + q2*q4), 2*(q2*q3 - q1*q4), q4*q4 - q1*q1 - q2*q2 + q3*q3] +end function + +pure function wm_to_quat(c) result(q) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: q(4) + real(R8Ki) :: c0, e0, e(3) + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + e0 = c0/(4.0_R8Ki - c0) + e = c/(4.0_R8Ki - c0) + q = [e, e0] +end function + +pure function wm_from_quat(q) result(c) + real(R8Ki), intent(in) :: q(4) + real(R8Ki) :: c(3) + real(R8Ki) :: e0, e(3) + e0 = q(4) + e = q(1:3) + c = 4.0_R8Ki*e/(1.0_R8Ki + e0) +end function + +! pure function wm_to_dcm(c) result(R) +! real(R8Ki), intent(in) :: c(3) +! real(R8Ki) :: R(3, 3) +! R = quat_to_dcm(wm_to_quat(c)) +! end function + +! pure function wm_to_dcm(c) result(R) +! real(R8Ki), intent(in) :: c(3) +! real(R8Ki) :: R(3, 3), cct, F(3, 3) +! integer(IntKi) :: i, j +! cct = dot_product(c, c) +! F = reshape([0.0_R8Ki, -c(3), c(2), c(3), 0.0_R8Ki, -c(1), -c(2), c(1), 0.0_R8Ki], [3, 3])/2.0_R8Ki +! do i = 1, 3 +! F(i, i) = F(i, i) + 1.0_R8Ki - cct/16.0_R8Ki +! do j = 1, 3 +! F(i, j) = F(i, j) + c(i)*c(j)/8.0_R8Ki +! end do +! end do +! F = F/(1.0_R8Ki + cct/16.0_R8Ki) +! R = matmul(F, F) +! end function + +pure function wm_to_dcm(c) result(R) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: R(3, 3), c0, vc, ct(3, 3) + integer(IntKi) :: i, j + ct(1, :) = [0.0_R8Ki, -c(3), c(2)] + ct(2, :) = [c(3), 0.0_R8Ki, -c(1)] + ct(3, :) = [-c(2), c(1), 0.0_R8Ki] + c0 = 2.0_R8Ki - dot_product(c, c)/8.0_R8Ki + vc = 2.0_R8Ki/(4.0_R8Ki - c0) + R = vc*vc*(c0*ct + matmul(ct, ct))/2.0_R8Ki + do i = 1, 3 + R(i, i) = R(i, i) + 1.0_R8Ki + end do +end function + +! pure function wm_from_dcm(R) result(c) +! real(R8Ki), intent(in) :: R(3, 3) +! real(R8Ki) :: c(3), cct +! c = wm_from_quat(quat_from_dcm(R)) +! end function + +pure function wm_from_dcm(R) result(c) + real(R8Ki), intent(in) :: R(3, 3) + real(R8Ki) :: pivot(4) ! Trace of the rotation matrix and diagonal elements + real(R8Ki) :: sm(0:3) + real(R8Ki) :: em + real(R8Ki) :: Rr(3, 3), c(3) + integer :: i ! case indicator + + Rr = R + + ! mjs--find max value of T := Tr(Rr) and diagonal elements of Rr + ! This tells us which denominator is largest (and less likely to produce numerical noise) + pivot = (/Rr(1, 1) + Rr(2, 2) + Rr(3, 3), Rr(1, 1), Rr(2, 2), Rr(3, 3)/) + i = maxloc(pivot, 1) - 1 ! our sm array starts at 0, so we need to subtract 1 here to get the correct index + + select case (i) + case (3) + sm(0) = Rr(2, 1) - Rr(1, 2) ! 4 c_0 c_3 t_{r0} + sm(1) = Rr(1, 3) + Rr(3, 1) ! 4 c_1 c_3 t_{r0} + sm(2) = Rr(2, 3) + Rr(3, 2) ! 4 c_2 c_3 t_{r0} + sm(3) = 1.0_R8Ki - Rr(1, 1) - Rr(2, 2) + Rr(3, 3) ! 4 c_3 c_3 t_{r0} + case (2) + sm(0) = Rr(1, 3) - Rr(3, 1) ! 4 c_0 c_2 t_{r0} + sm(1) = Rr(1, 2) + Rr(2, 1) ! 4 c_1 c_2 t_{r0} + sm(2) = 1.0_R8Ki - Rr(1, 1) + Rr(2, 2) - Rr(3, 3) ! 4 c_2 c_2 t_{r0} + sm(3) = Rr(2, 3) + Rr(3, 2) ! 4 c_3 c_2 t_{r0} + case (1) + sm(0) = Rr(3, 2) - Rr(2, 3) ! 4 c_0 c_1 t_{r0} + sm(1) = 1.0_R8Ki + Rr(1, 1) - Rr(2, 2) - Rr(3, 3) ! 4 c_1 c_1 t_{r0} + sm(2) = Rr(1, 2) + Rr(2, 1) ! 4 c_2 c_1 t_{r0} + sm(3) = Rr(1, 3) + Rr(3, 1) ! 4 c_3 c_1 t_{r0} + case (0) + sm(0) = 1.0_R8Ki + Rr(1, 1) + Rr(2, 2) + Rr(3, 3) ! 4 c_0 c_0 t_{r0} + sm(1) = Rr(3, 2) - Rr(2, 3) ! 4 c_1 c_0 t_{r0} + sm(2) = Rr(1, 3) - Rr(3, 1) ! 4 c_2 c_0 t_{r0} + sm(3) = Rr(2, 1) - Rr(1, 2) ! 4 c_3 c_0 t_{r0} + end select + + em = sm(0) + SIGN(2.0_R8Ki*SQRT(sm(i)), sm(0)) + em = 4.0_R8Ki/em ! 1 / ( 4 t_{r0} c_{i} ), assuming 0 <= c_0 < 4 and c_{i} > 0 + c = em*sm(1:3) +end function + +pure function wm_to_xyz(c) result(xyz) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: phi, n(3), xyz(3), m + m = sqrt(dot_product(c,c)) + if (m == 0.0_R8Ki) then + xyz = 0.0_R8Ki + return + end if + n = c/m + phi = 4.0_R8Ki*atan(m/4.0_R8Ki) + xyz = phi*n + ! xyz = c +end function + +pure function wm_from_xyz(xyz) result(c) + real(R8Ki), intent(in) :: xyz(3) + real(R8Ki) :: phi, n(3), c(3) + phi = sqrt(dot_product(xyz,xyz)) + if (phi == 0.0_R8Ki) then + c = 0.0_R8Ki + return + end if + n = xyz / phi + c = 4.0_R8Ki*tan(phi/4.0_R8Ki) * n + ! c = xyz +end function + +! pure function wm_from_dcm(R) result(c) +! real(R8Ki), intent(in) :: R(3, 3) +! real(R8Ki) :: c(3), t1, t2, cct +! t1 = 1.0_R8Ki + R(1,1) + R(2,2) + R(3,3) +! t2 = 2.0_R8Ki*sqrt(t1) +! c(1) = (R(3,2) - R(2,3)) +! c(2) = (R(1,3) - R(3,1)) +! c(3) = (R(2,1) - R(1,2)) +! c = 4.0_R8Ki * c / (t1 + t2) +! cct = dot_product(c,c) +! if (cct > 16.0_R8Ki) c = 16.0_R8Ki*c / cct +! end function + +pure function wm_compose(p, q) result(r) + real(R8Ki), intent(in) :: p(3), q(3) + real(R8Ki) :: r(3) + real(R8Ki) :: p0, q0, D1, D2 + p0 = 2.0_R8Ki - dot_product(p, p)/8.0_R8Ki + q0 = 2.0_R8Ki - dot_product(q, q)/8.0_R8Ki + D1 = (4.0_R8Ki - p0)*(4.0_R8Ki - q0) + D2 = p0*q0 - dot_product(p, q) + if (D2 >= 0.0_R8Ki) then + r = 4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 + D2) + else + r = -4.0_R8Ki*(q0*p + p0*q + cross(p, q))/(D1 - D2) + end if +end function + +pure function wm_inv(c) result(cinv) + real(R8Ki), intent(in) :: c(3) + real(R8Ki) :: cinv(3) + cinv = -c +end function + +pure function cross(a, b) result(c) + real(R8Ki), intent(in) :: a(3), b(3) + real(R8Ki) :: c(3) + c = [a(2)*b(3) - a(3)*b(2), a(3)*b(1) - a(1)*b(3), a(1)*b(2) - b(1)*a(2)] +end function + +end module diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 57aece75f5..5abb7071cf 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -1725,56 +1725,56 @@ END SUBROUTINE DispCopyrightLicense !======================================================================= !> This routine packs the DLL_Type (nwtc_base::dll_type) data into an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypeUnPack (nwtc_io::dlltypeunpack). - SUBROUTINE DLLTypePack(Buf, InData) - type(PackBuffer), intent(inout) :: Buf + SUBROUTINE DLLTypePack(RF, InData) + type(RegFile), intent(inout) :: RF TYPE(DLL_Type), intent(in) :: InData !< DLL data to pack INTEGER(IntKi) :: i ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return ! has the DLL procedure been loaded? - call RegPack(Buf, c_associated(InData%ProcAddr(1))) + call RegPack(RF, c_associated(InData%ProcAddr(1))) ! Pack strings - call RegPack(Buf, InData%FileName) + call RegPack(RF, InData%FileName) do i = 1, NWTC_MAX_DLL_PROC - call RegPack(Buf, InData%ProcName(i)) + call RegPack(RF, InData%ProcName(i)) end do ! If buffer error, return - if (RegCheckErr(Buf, 'DLLTypeUnPack')) return + if (RegCheckErr(RF, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypePack !======================================================================= !> This routine unpacks the DLL_Type data from an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypePack (nwtc_io::dlltypepack). - subroutine DLLTypeUnPack(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(DLL_Type), intent(out) :: OutData !< Reconstituted OutData structure + subroutine DLLTypeUnPack(RF, OutData) + type(RegFile), intent(inout) :: RF + type(DLL_Type), intent(out) :: OutData !< Reconstituted OutData structure logical :: WasAssociated integer(IntKi) :: i ! If buffer error, return - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return ! Get flag indicating if dll was associated - call RegUnpack(Buf, WasAssociated) + call RegUnpack(RF, WasAssociated) ! Unpack strings - call RegUnpack(Buf, OutData%FileName) + call RegUnpack(RF, OutData%FileName) do i = 1, NWTC_MAX_DLL_PROC - call RegUnpack(Buf, OutData%ProcName(i)) + call RegUnpack(RF, OutData%ProcName(i)) end do ! If buffer error, return - if (RegCheckErr(Buf, 'DLLTypeUnPack')) return + if (RegCheckErr(RF, 'DLLTypeUnPack')) return ! If dll was loaded, and data in filename and procname, load dll IF (WasAssociated .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0) THEN - CALL LoadDynamicLib(OutData, Buf%ErrStat, Buf%ErrMsg) + CALL LoadDynamicLib(OutData, RF%ErrStat, RF%ErrMsg) else ! Nullifying OutData%FileAddr = INT(0,C_INTPTR_T) @@ -1783,7 +1783,7 @@ subroutine DLLTypeUnPack(Buf, OutData) END IF ! If buffer error, return - if (RegCheckErr(Buf, 'DLLTypeUnPack')) return + if (RegCheckErr(RF, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypeUnPack !======================================================================= diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index c27ede5c1c..5f71471eca 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -75,6 +75,7 @@ MODULE NWTC_Library USE NWTC_Num ! technically we don't need to specify this if we have ModMesh (because ModMesh USEs NWTC_Num) USE ModMesh USE ModReg + USE ModVar #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines diff --git a/modules/nwtc-library/src/NWTC_Library_Subs.f90 b/modules/nwtc-library/src/NWTC_Library_Subs.f90 new file mode 100644 index 0000000000..911e63e131 --- /dev/null +++ b/modules/nwtc-library/src/NWTC_Library_Subs.f90 @@ -0,0 +1,577 @@ +!STARTOFREGISTRYGENERATEDFILE 'NWTC_Library_Subs.f90' +! +! WARNING This file is generated automatically by the FAST registry. +! Do not edit. Your changes to this file will be lost. +! +! FAST Registry' + +subroutine NWTC_Library_CopyMapType(SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(MapType), intent(in) :: SrcMapTypeData + type(MapType), intent(inout) :: DstMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMapType' + ErrStat = ErrID_None + ErrMsg = '' + DstMapTypeData%OtherMesh_Element = SrcMapTypeData%OtherMesh_Element + DstMapTypeData%distance = SrcMapTypeData%distance + DstMapTypeData%couple_arm = SrcMapTypeData%couple_arm + DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn +end subroutine + +subroutine NWTC_Library_DestroyMapType(MapTypeData, ErrStat, ErrMsg) + type(MapType), intent(inout) :: MapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMapType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine NWTC_Library_PackMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMapType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%OtherMesh_Element) + call RegPack(RF, InData%distance) + call RegPack(RF, InData%couple_arm) + call RegPack(RF, InData%shape_fn) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMapType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%OtherMesh_Element); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%distance); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%couple_arm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%shape_fn); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshMapLinearizationType), intent(in) :: SrcMeshMapLinearizationTypeData + type(MeshMapLinearizationType), intent(inout) :: DstMeshMapLinearizationTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMeshMapLinearizationTypeData%mi)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%mi)) then + allocate(DstMeshMapLinearizationTypeData%mi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%mi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi + end if + if (allocated(SrcMeshMapLinearizationTypeData%fx_p)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%fx_p)) then + allocate(DstMeshMapLinearizationTypeData%fx_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%fx_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p + end if + if (allocated(SrcMeshMapLinearizationTypeData%tv_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uD)) then + allocate(DstMeshMapLinearizationTypeData%tv_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%tv_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uS)) then + allocate(DstMeshMapLinearizationTypeData%tv_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%tv_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uD)) then + allocate(DstMeshMapLinearizationTypeData%ta_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uS)) then + allocate(DstMeshMapLinearizationTypeData%ta_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%ta_rv)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%ta_rv)) then + allocate(DstMeshMapLinearizationTypeData%ta_rv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%ta_rv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv + end if + if (allocated(SrcMeshMapLinearizationTypeData%li)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%li)) then + allocate(DstMeshMapLinearizationTypeData%li(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%li.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_uS)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_uS)) then + allocate(DstMeshMapLinearizationTypeData%M_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_uD)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_uD)) then + allocate(DstMeshMapLinearizationTypeData%M_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_uD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD + end if + if (allocated(SrcMeshMapLinearizationTypeData%M_f)) then + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) + if (.not. allocated(DstMeshMapLinearizationTypeData%M_f)) then + allocate(DstMeshMapLinearizationTypeData%M_f(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapLinearizationTypeData%M_f.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapLinearizationTypeData%M_f = SrcMeshMapLinearizationTypeData%M_f + end if +end subroutine + +subroutine NWTC_Library_DestroyMeshMapLinearizationType(MeshMapLinearizationTypeData, ErrStat, ErrMsg) + type(MeshMapLinearizationType), intent(inout) :: MeshMapLinearizationTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshMapLinearizationTypeData%mi)) then + deallocate(MeshMapLinearizationTypeData%mi) + end if + if (allocated(MeshMapLinearizationTypeData%fx_p)) then + deallocate(MeshMapLinearizationTypeData%fx_p) + end if + if (allocated(MeshMapLinearizationTypeData%tv_uD)) then + deallocate(MeshMapLinearizationTypeData%tv_uD) + end if + if (allocated(MeshMapLinearizationTypeData%tv_uS)) then + deallocate(MeshMapLinearizationTypeData%tv_uS) + end if + if (allocated(MeshMapLinearizationTypeData%ta_uD)) then + deallocate(MeshMapLinearizationTypeData%ta_uD) + end if + if (allocated(MeshMapLinearizationTypeData%ta_uS)) then + deallocate(MeshMapLinearizationTypeData%ta_uS) + end if + if (allocated(MeshMapLinearizationTypeData%ta_rv)) then + deallocate(MeshMapLinearizationTypeData%ta_rv) + end if + if (allocated(MeshMapLinearizationTypeData%li)) then + deallocate(MeshMapLinearizationTypeData%li) + end if + if (allocated(MeshMapLinearizationTypeData%M_uS)) then + deallocate(MeshMapLinearizationTypeData%M_uS) + end if + if (allocated(MeshMapLinearizationTypeData%M_uD)) then + deallocate(MeshMapLinearizationTypeData%M_uD) + end if + if (allocated(MeshMapLinearizationTypeData%M_f)) then + deallocate(MeshMapLinearizationTypeData%M_f) + end if +end subroutine + +subroutine NWTC_Library_PackMeshMapLinearizationType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshMapLinearizationType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%mi) + call RegPackAlloc(RF, InData%fx_p) + call RegPackAlloc(RF, InData%tv_uD) + call RegPackAlloc(RF, InData%tv_uS) + call RegPackAlloc(RF, InData%ta_uD) + call RegPackAlloc(RF, InData%ta_uS) + call RegPackAlloc(RF, InData%ta_rv) + call RegPackAlloc(RF, InData%li) + call RegPackAlloc(RF, InData%M_uS) + call RegPackAlloc(RF, InData%M_uD) + call RegPackAlloc(RF, InData%M_f) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapLinearizationType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshMapLinearizationType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%mi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fx_p); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tv_uD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%tv_uS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ta_uD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ta_uS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ta_rv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%li); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_uS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_uD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_f); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshMapType), intent(inout) :: SrcMeshMapTypeData + type(MeshMapType), intent(inout) :: DstMeshMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMeshMapTypeData%MapLoads)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%MapLoads)) then + allocate(DstMeshMapTypeData%MapLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapLoads(i1), DstMeshMapTypeData%MapLoads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshMapTypeData%MapMotions)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%MapMotions)) then + allocate(DstMeshMapTypeData%MapMotions(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapMotions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapMotions(i1), DstMeshMapTypeData%MapMotions(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMeshMapTypeData%MapSrcToAugmt)) then + LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%MapSrcToAugmt)) then + allocate(DstMeshMapTypeData%MapSrcToAugmt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%MapSrcToAugmt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMapType(SrcMeshMapTypeData%MapSrcToAugmt(i1), DstMeshMapTypeData%MapSrcToAugmt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcMeshMapTypeData%Augmented_Ln2_Src, DstMeshMapTypeData%Augmented_Ln2_Src, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMeshMapTypeData%Lumped_Points_Src, DstMeshMapTypeData%Lumped_Points_Src, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) then + LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) + UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) then + allocate(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv + end if + if (allocated(SrcMeshMapTypeData%DisplacedPosition)) then + LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) + UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%DisplacedPosition)) then + allocate(DstMeshMapTypeData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%DisplacedPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat)) then + allocate(DstMeshMapTypeData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_A_Mat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_F)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_F)) then + allocate(DstMeshMapTypeData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F + end if + if (allocated(SrcMeshMapTypeData%LoadLn2_M)) then + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) + if (.not. allocated(DstMeshMapTypeData%LoadLn2_M)) then + allocate(DstMeshMapTypeData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshMapTypeData%LoadLn2_M = SrcMeshMapTypeData%LoadLn2_M + end if + call NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapTypeData%dM, DstMeshMapTypeData%dM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) + type(MeshMapType), intent(inout) :: MeshMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshMapTypeData%MapLoads)) then + LB(1:1) = lbound(MeshMapTypeData%MapLoads, kind=B8Ki) + UB(1:1) = ubound(MeshMapTypeData%MapLoads, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapLoads) + end if + if (allocated(MeshMapTypeData%MapMotions)) then + LB(1:1) = lbound(MeshMapTypeData%MapMotions, kind=B8Ki) + UB(1:1) = ubound(MeshMapTypeData%MapMotions, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapMotions) + end if + if (allocated(MeshMapTypeData%MapSrcToAugmt)) then + LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMapType(MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MeshMapTypeData%MapSrcToAugmt) + end if + call MeshDestroy( MeshMapTypeData%Augmented_Ln2_Src, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MeshMapTypeData%Lumped_Points_Src, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MeshMapTypeData%LoadLn2_A_Mat_Piv)) then + deallocate(MeshMapTypeData%LoadLn2_A_Mat_Piv) + end if + if (allocated(MeshMapTypeData%DisplacedPosition)) then + deallocate(MeshMapTypeData%DisplacedPosition) + end if + if (allocated(MeshMapTypeData%LoadLn2_A_Mat)) then + deallocate(MeshMapTypeData%LoadLn2_A_Mat) + end if + if (allocated(MeshMapTypeData%LoadLn2_F)) then + deallocate(MeshMapTypeData%LoadLn2_F) + end if + if (allocated(MeshMapTypeData%LoadLn2_M)) then + deallocate(MeshMapTypeData%LoadLn2_M) + end if + call NWTC_Library_DestroyMeshMapLinearizationType(MeshMapTypeData%dM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine NWTC_Library_PackMeshMapType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(MeshMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%MapLoads)) + if (allocated(InData%MapLoads)) then + call RegPackBounds(RF, 1, lbound(InData%MapLoads, kind=B8Ki), ubound(InData%MapLoads, kind=B8Ki)) + LB(1:1) = lbound(InData%MapLoads, kind=B8Ki) + UB(1:1) = ubound(InData%MapLoads, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(RF, InData%MapLoads(i1)) + end do + end if + call RegPack(RF, allocated(InData%MapMotions)) + if (allocated(InData%MapMotions)) then + call RegPackBounds(RF, 1, lbound(InData%MapMotions, kind=B8Ki), ubound(InData%MapMotions, kind=B8Ki)) + LB(1:1) = lbound(InData%MapMotions, kind=B8Ki) + UB(1:1) = ubound(InData%MapMotions, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(RF, InData%MapMotions(i1)) + end do + end if + call RegPack(RF, allocated(InData%MapSrcToAugmt)) + if (allocated(InData%MapSrcToAugmt)) then + call RegPackBounds(RF, 1, lbound(InData%MapSrcToAugmt, kind=B8Ki), ubound(InData%MapSrcToAugmt, kind=B8Ki)) + LB(1:1) = lbound(InData%MapSrcToAugmt, kind=B8Ki) + UB(1:1) = ubound(InData%MapSrcToAugmt, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(RF, InData%MapSrcToAugmt(i1)) + end do + end if + call MeshPack(RF, InData%Augmented_Ln2_Src) + call MeshPack(RF, InData%Lumped_Points_Src) + call RegPackAlloc(RF, InData%LoadLn2_A_Mat_Piv) + call RegPackAlloc(RF, InData%DisplacedPosition) + call RegPackAlloc(RF, InData%LoadLn2_A_Mat) + call RegPackAlloc(RF, InData%LoadLn2_F) + call RegPackAlloc(RF, InData%LoadLn2_M) + call NWTC_Library_PackMeshMapLinearizationType(RF, InData%dM) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(MeshMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%MapLoads)) deallocate(OutData%MapLoads) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MapLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(RF, OutData%MapLoads(i1)) ! MapLoads + end do + end if + if (allocated(OutData%MapMotions)) deallocate(OutData%MapMotions) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MapMotions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(RF, OutData%MapMotions(i1)) ! MapMotions + end do + end if + if (allocated(OutData%MapSrcToAugmt)) deallocate(OutData%MapSrcToAugmt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%MapSrcToAugmt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(RF, OutData%MapSrcToAugmt(i1)) ! MapSrcToAugmt + end do + end if + call MeshUnpack(RF, OutData%Augmented_Ln2_Src) ! Augmented_Ln2_Src + call MeshUnpack(RF, OutData%Lumped_Points_Src) ! Lumped_Points_Src + call RegUnpackAlloc(RF, OutData%LoadLn2_A_Mat_Piv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DisplacedPosition); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LoadLn2_A_Mat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LoadLn2_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LoadLn2_M); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackMeshMapLinearizationType(RF, OutData%dM) ! dM +end subroutine +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 83b2fd1dd0..14ecb2c8a4 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -34,6 +34,27 @@ MODULE NWTC_Library_Types USE SysSubs USE ModReg IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: VarNameLen = 64 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Force = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Moment = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Orientation = 3 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransDisp = 4 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularDisp = 5 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransVel = 6 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularVel = 7 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_TransAcc = 8 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_AngularAcc = 9 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Scalar = 10 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_None = 0 ! Variable with no flags [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Mesh = 1 ! Variable contained in mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Line = 2 ! Variable is for a line mesh [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_RotFrame = 4 ! Variable in rotating frame [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Ext = 8 ! Variable for extended linearization [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VF_Any = 4095 ! Enable all flags (used for filtering) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_None = 0 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Tight = 1 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option1 = 2 ! [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: VC_Option2 = 3 ! [-] ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc CHARACTER(99) :: Name !< Name of the program or module [-] @@ -85,6 +106,73 @@ MODULE NWTC_Library_Types CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= +! ========= ModVarType ======= + TYPE, PUBLIC :: ModVarType + character(VarNameLen) :: Name !< [-] + INTEGER(IntKi) :: Field = 0 !< [-] + INTEGER(IntKi) :: Nodes = 1 !< [-] + INTEGER(IntKi) :: Num = 1 !< [-] + INTEGER(IntKi) :: Flags = 0 !< [-] + INTEGER(IntKi) :: DerivOrder = 0 !< [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLoc !< indices in local arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iSol !< indices in solver arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iLin !< indices in linearization arrays [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iq !< row index in solver q matrix [-] + INTEGER(IntKi) , DIMENSION(1:2) :: iUsr = 0_IntKi !< first user defined index for variable, can be used a lower/upper bounds [-] + INTEGER(IntKi) :: jUsr = 0 !< second user defined index for variable [-] + INTEGER(IntKi) :: MeshID = 0 !< Mesh identification number [-] + LOGICAL :: Solve = .false. !< flag indicating that variable is used by solver [-] + REAL(R8Ki) :: Perturb = 0 !< perturbation [-] + character(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames !< [-] + END TYPE ModVarType +! ======================= +! ========= ModVarsType ======= + TYPE, PUBLIC :: ModVarsType + INTEGER(IntKi) :: ModNum = 0 !< [-] + character(6) :: ModAbbr !< [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: x !< Module state variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: u !< Module input variable array [-] + TYPE(ModVarType) , DIMENSION(:), ALLOCATABLE :: y !< Module output variable array [-] + INTEGER(IntKi) :: Nx = 0_IntKi !< [-] + INTEGER(IntKi) :: Nu = 0_IntKi !< [-] + INTEGER(IntKi) :: Ny = 0_IntKi !< [-] + END TYPE ModVarsType +! ======================= +! ========= ModValsType ======= + TYPE, PUBLIC :: ModValsType + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dxdt !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: y !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: u_perturb !< input perturbation array [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x_perturb !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: xn !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yp !< [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: yn !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdx !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dYdu !< [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: dXdu !< [-] + END TYPE ModValsType +! ======================= +! ========= ModDataType ======= + TYPE, PUBLIC :: ModDataType + INTEGER(IntKi) :: Idx = 0 !< Module index in array of modules [-] + INTEGER(IntKi) :: ID = 0 !< Module identification number [-] + character(ChanLen) :: Abbr !< Module name abbreviation [-] + INTEGER(IntKi) :: Ins = 0 !< Module instance number [-] + LOGICAL :: IsTC = .false. !< Flag indicating module is part of tight coupling [-] + REAL(R8Ki) :: DT = 0 !< Module time step [-] + INTEGER(IntKi) :: SubSteps = 0 !< Module number of substeps per solver time step [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ixs !< index array mapping local x vector to global x vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ius !< index array mapping local u vector to global u vector [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: iys !< index array mapping local y vector to global y vector [-] + TYPE(ModVarsType) , POINTER :: Vars => NULL() !< Pointer to module variables type [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: SrcMaps !< Indices of mappings where module is the source [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DstMaps !< Indices of mappings where module is the destination [-] + END TYPE ModDataType +! ======================= CONTAINS subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) @@ -110,28 +198,25 @@ subroutine NWTC_Library_DestroyProgDesc(ProgDescData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine NWTC_Library_PackProgDesc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_PackProgDesc(RF, Indata) + type(RegFile), intent(inout) :: RF type(ProgDesc), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackProgDesc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Name) - call RegPack(Buf, InData%Ver) - call RegPack(Buf, InData%Date) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Ver) + call RegPack(RF, InData%Date) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackProgDesc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_UnPackProgDesc(RF, OutData) + type(RegFile), intent(inout) :: RF type(ProgDesc), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackProgDesc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Name) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ver) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Date) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ver); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Date); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg) @@ -206,94 +291,38 @@ subroutine NWTC_Library_DestroyFASTdataType(FASTdataTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine NWTC_Library_PackFASTdataType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_PackFASTdataType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FASTdataType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackFASTdataType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%File) - call RegPack(Buf, InData%Descr) - call RegPack(Buf, InData%NumChans) - call RegPack(Buf, InData%NumRecs) - call RegPack(Buf, InData%TimeStep) - call RegPack(Buf, allocated(InData%ChanNames)) - if (allocated(InData%ChanNames)) then - call RegPackBounds(Buf, 1, lbound(InData%ChanNames, kind=B8Ki), ubound(InData%ChanNames, kind=B8Ki)) - call RegPack(Buf, InData%ChanNames) - end if - call RegPack(Buf, allocated(InData%ChanUnits)) - if (allocated(InData%ChanUnits)) then - call RegPackBounds(Buf, 1, lbound(InData%ChanUnits, kind=B8Ki), ubound(InData%ChanUnits, kind=B8Ki)) - call RegPack(Buf, InData%ChanUnits) - end if - call RegPack(Buf, allocated(InData%Data)) - if (allocated(InData%Data)) then - call RegPackBounds(Buf, 2, lbound(InData%Data, kind=B8Ki), ubound(InData%Data, kind=B8Ki)) - call RegPack(Buf, InData%Data) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%File) + call RegPack(RF, InData%Descr) + call RegPack(RF, InData%NumChans) + call RegPack(RF, InData%NumRecs) + call RegPack(RF, InData%TimeStep) + call RegPackAlloc(RF, InData%ChanNames) + call RegPackAlloc(RF, InData%ChanUnits) + call RegPackAlloc(RF, InData%Data) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFASTdataType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FASTdataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%File) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Descr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumChans) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumRecs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimeStep) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ChanNames)) deallocate(OutData%ChanNames) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChanNames(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ChanNames) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ChanUnits)) deallocate(OutData%ChanUnits) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChanUnits(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ChanUnits) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Data)) deallocate(OutData%Data) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Data(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Data) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%File); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Descr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumChans); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRecs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChanNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChanUnits); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Data); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) @@ -320,31 +349,27 @@ subroutine NWTC_Library_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine NWTC_Library_PackOutParmType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_PackOutParmType(RF, Indata) + type(RegFile), intent(inout) :: RF type(OutParmType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackOutParmType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Indx) - call RegPack(Buf, InData%Name) - call RegPack(Buf, InData%Units) - call RegPack(Buf, InData%SignM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Indx) + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Units) + call RegPack(RF, InData%SignM) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackOutParmType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_UnPackOutParmType(RF, OutData) + type(RegFile), intent(inout) :: RF type(OutParmType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackOutParmType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Indx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Name) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Units) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SignM) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Units); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SignM); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg) @@ -431,104 +456,34 @@ subroutine NWTC_Library_DestroyFileInfoType(FileInfoTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine NWTC_Library_PackFileInfoType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_PackFileInfoType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FileInfoType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackFileInfoType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumLines) - call RegPack(Buf, InData%NumFiles) - call RegPack(Buf, allocated(InData%FileLine)) - if (allocated(InData%FileLine)) then - call RegPackBounds(Buf, 1, lbound(InData%FileLine, kind=B8Ki), ubound(InData%FileLine, kind=B8Ki)) - call RegPack(Buf, InData%FileLine) - end if - call RegPack(Buf, allocated(InData%FileIndx)) - if (allocated(InData%FileIndx)) then - call RegPackBounds(Buf, 1, lbound(InData%FileIndx, kind=B8Ki), ubound(InData%FileIndx, kind=B8Ki)) - call RegPack(Buf, InData%FileIndx) - end if - call RegPack(Buf, allocated(InData%FileList)) - if (allocated(InData%FileList)) then - call RegPackBounds(Buf, 1, lbound(InData%FileList, kind=B8Ki), ubound(InData%FileList, kind=B8Ki)) - call RegPack(Buf, InData%FileList) - end if - call RegPack(Buf, allocated(InData%Lines)) - if (allocated(InData%Lines)) then - call RegPackBounds(Buf, 1, lbound(InData%Lines, kind=B8Ki), ubound(InData%Lines, kind=B8Ki)) - call RegPack(Buf, InData%Lines) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumLines) + call RegPack(RF, InData%NumFiles) + call RegPackAlloc(RF, InData%FileLine) + call RegPackAlloc(RF, InData%FileIndx) + call RegPackAlloc(RF, InData%FileList) + call RegPackAlloc(RF, InData%Lines) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFileInfoType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FileInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumLines) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumFiles) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%FileLine)) deallocate(OutData%FileLine) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FileLine(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FileLine) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FileIndx)) deallocate(OutData%FileIndx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FileIndx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FileIndx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FileList)) deallocate(OutData%FileList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FileList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FileList) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Lines)) deallocate(OutData%Lines) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Lines(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Lines) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumFiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FileLine); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FileIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FileList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Lines); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyQuaternion(SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg) @@ -553,25 +508,23 @@ subroutine NWTC_Library_DestroyQuaternion(QuaternionData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine NWTC_Library_PackQuaternion(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_PackQuaternion(RF, Indata) + type(RegFile), intent(inout) :: RF type(Quaternion), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackQuaternion' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%q0) - call RegPack(Buf, InData%v) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%q0) + call RegPack(RF, InData%v) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackQuaternion(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_UnPackQuaternion(RF, OutData) + type(RegFile), intent(inout) :: RF type(Quaternion), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackQuaternion' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%q0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%v) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%q0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%v); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) @@ -614,50 +567,850 @@ subroutine NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(NWTC_RandomNumber end if end subroutine -subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(RF, Indata) + type(RegFile), intent(inout) :: RF type(NWTC_RandomNumber_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%pRNG) - call RegPack(Buf, InData%RandSeed) - call RegPack(Buf, allocated(InData%RandSeedAry)) - if (allocated(InData%RandSeedAry)) then - call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry, kind=B8Ki), ubound(InData%RandSeedAry, kind=B8Ki)) - call RegPack(Buf, InData%RandSeedAry) - end if - call RegPack(Buf, InData%RNG_type) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%pRNG) + call RegPack(RF, InData%RandSeed) + call RegPackAlloc(RF, InData%RandSeedAry) + call RegPack(RF, InData%RNG_type) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(RF, OutData) + type(RegFile), intent(inout) :: RF type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%pRNG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RandSeed) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%RandSeedAry)) deallocate(OutData%RandSeedAry) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%pRNG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RandSeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RandSeedAry); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RNG_type); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModVarType(SrcModVarTypeData, DstModVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModVarType), intent(in) :: SrcModVarTypeData + type(ModVarType), intent(inout) :: DstModVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarTypeData%Name = SrcModVarTypeData%Name + DstModVarTypeData%Field = SrcModVarTypeData%Field + DstModVarTypeData%Nodes = SrcModVarTypeData%Nodes + DstModVarTypeData%Num = SrcModVarTypeData%Num + DstModVarTypeData%Flags = SrcModVarTypeData%Flags + DstModVarTypeData%DerivOrder = SrcModVarTypeData%DerivOrder + if (allocated(SrcModVarTypeData%iLoc)) then + LB(1:1) = lbound(SrcModVarTypeData%iLoc, kind=B8Ki) + UB(1:1) = ubound(SrcModVarTypeData%iLoc, kind=B8Ki) + if (.not. allocated(DstModVarTypeData%iLoc)) then + allocate(DstModVarTypeData%iLoc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLoc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iLoc = SrcModVarTypeData%iLoc + end if + if (allocated(SrcModVarTypeData%iSol)) then + LB(1:1) = lbound(SrcModVarTypeData%iSol, kind=B8Ki) + UB(1:1) = ubound(SrcModVarTypeData%iSol, kind=B8Ki) + if (.not. allocated(DstModVarTypeData%iSol)) then + allocate(DstModVarTypeData%iSol(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iSol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iSol = SrcModVarTypeData%iSol + end if + if (allocated(SrcModVarTypeData%iLin)) then + LB(1:1) = lbound(SrcModVarTypeData%iLin, kind=B8Ki) + UB(1:1) = ubound(SrcModVarTypeData%iLin, kind=B8Ki) + if (.not. allocated(DstModVarTypeData%iLin)) then + allocate(DstModVarTypeData%iLin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iLin = SrcModVarTypeData%iLin + end if + if (allocated(SrcModVarTypeData%iq)) then + LB(1:1) = lbound(SrcModVarTypeData%iq, kind=B8Ki) + UB(1:1) = ubound(SrcModVarTypeData%iq, kind=B8Ki) + if (.not. allocated(DstModVarTypeData%iq)) then + allocate(DstModVarTypeData%iq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%iq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%iq = SrcModVarTypeData%iq + end if + DstModVarTypeData%iUsr = SrcModVarTypeData%iUsr + DstModVarTypeData%jUsr = SrcModVarTypeData%jUsr + DstModVarTypeData%MeshID = SrcModVarTypeData%MeshID + DstModVarTypeData%Solve = SrcModVarTypeData%Solve + DstModVarTypeData%Perturb = SrcModVarTypeData%Perturb + if (allocated(SrcModVarTypeData%LinNames)) then + LB(1:1) = lbound(SrcModVarTypeData%LinNames, kind=B8Ki) + UB(1:1) = ubound(SrcModVarTypeData%LinNames, kind=B8Ki) + if (.not. allocated(DstModVarTypeData%LinNames)) then + allocate(DstModVarTypeData%LinNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarTypeData%LinNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModVarTypeData%LinNames = SrcModVarTypeData%LinNames + end if +end subroutine + +subroutine NWTC_Library_DestroyModVarType(ModVarTypeData, ErrStat, ErrMsg) + type(ModVarType), intent(inout) :: ModVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarTypeData%iLoc)) then + deallocate(ModVarTypeData%iLoc) + end if + if (allocated(ModVarTypeData%iSol)) then + deallocate(ModVarTypeData%iSol) + end if + if (allocated(ModVarTypeData%iLin)) then + deallocate(ModVarTypeData%iLin) + end if + if (allocated(ModVarTypeData%iq)) then + deallocate(ModVarTypeData%iq) + end if + if (allocated(ModVarTypeData%LinNames)) then + deallocate(ModVarTypeData%LinNames) + end if +end subroutine + +subroutine NWTC_Library_PackModVarType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Name) + call RegPack(RF, InData%Field) + call RegPack(RF, InData%Nodes) + call RegPack(RF, InData%Num) + call RegPack(RF, InData%Flags) + call RegPack(RF, InData%DerivOrder) + call RegPackAlloc(RF, InData%iLoc) + call RegPackAlloc(RF, InData%iSol) + call RegPackAlloc(RF, InData%iLin) + call RegPackAlloc(RF, InData%iq) + call RegPack(RF, InData%iUsr) + call RegPack(RF, InData%jUsr) + call RegPack(RF, InData%MeshID) + call RegPack(RF, InData%Solve) + call RegPack(RF, InData%Perturb) + call RegPackAlloc(RF, InData%LinNames) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModVarType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarType' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Name); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Field); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Num); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Flags); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DerivOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iLoc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iSol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%iUsr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%jUsr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MeshID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Solve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModVarsType), intent(in) :: SrcModVarsTypeData + type(ModVarsType), intent(inout) :: DstModVarsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + DstModVarsTypeData%ModNum = SrcModVarsTypeData%ModNum + DstModVarsTypeData%ModAbbr = SrcModVarsTypeData%ModAbbr + if (allocated(SrcModVarsTypeData%x)) then + LB(1:1) = lbound(SrcModVarsTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModVarsTypeData%x, kind=B8Ki) + if (.not. allocated(DstModVarsTypeData%x)) then + allocate(DstModVarsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%x(i1), DstModVarsTypeData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%u)) then + LB(1:1) = lbound(SrcModVarsTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModVarsTypeData%u, kind=B8Ki) + if (.not. allocated(DstModVarsTypeData%u)) then + allocate(DstModVarsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%u(i1), DstModVarsTypeData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcModVarsTypeData%y)) then + LB(1:1) = lbound(SrcModVarsTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModVarsTypeData%y, kind=B8Ki) + if (.not. allocated(DstModVarsTypeData%y)) then + allocate(DstModVarsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModVarsTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyModVarType(SrcModVarsTypeData%y(i1), DstModVarsTypeData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstModVarsTypeData%Nx = SrcModVarsTypeData%Nx + DstModVarsTypeData%Nu = SrcModVarsTypeData%Nu + DstModVarsTypeData%Ny = SrcModVarsTypeData%Ny +end subroutine + +subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) + type(ModVarsType), intent(inout) :: ModVarsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModVarsTypeData%x)) then + LB(1:1) = lbound(ModVarsTypeData%x, kind=B8Ki) + UB(1:1) = ubound(ModVarsTypeData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%x) + end if + if (allocated(ModVarsTypeData%u)) then + LB(1:1) = lbound(ModVarsTypeData%u, kind=B8Ki) + UB(1:1) = ubound(ModVarsTypeData%u, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%u) + end if + if (allocated(ModVarsTypeData%y)) then + LB(1:1) = lbound(ModVarsTypeData%y, kind=B8Ki) + UB(1:1) = ubound(ModVarsTypeData%y, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyModVarType(ModVarsTypeData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModVarsTypeData%y) + end if +end subroutine + +subroutine NWTC_Library_PackModVarsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModVarsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarsType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%ModNum) + call RegPack(RF, InData%ModAbbr) + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + LB(1:1) = lbound(InData%x, kind=B8Ki) + UB(1:1) = ubound(InData%x, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%x(i1)) + end do + end if + call RegPack(RF, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + LB(1:1) = lbound(InData%u, kind=B8Ki) + UB(1:1) = ubound(InData%u, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%u(i1)) + end do + end if + call RegPack(RF, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + LB(1:1) = lbound(InData%y, kind=B8Ki) + UB(1:1) = ubound(InData%y, kind=B8Ki) + do i1 = LB(1), UB(1) + call NWTC_Library_PackModVarType(RF, InData%y(i1)) + end do + end if + call RegPack(RF, InData%Nx) + call RegPack(RF, InData%Nu) + call RegPack(RF, InData%Ny) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModVarsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModVarsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarsType' + integer(B8Ki) :: i1 + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%ModNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModAbbr); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%x(i1)) ! x + end do + end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RandSeedAry(LB(1):UB(1)),stat=stat) + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%RandSeedAry) - if (RegCheckErr(Buf, RoutineName)) return + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackModVarType(RF, OutData%y(i1)) ! y + end do + end if + call RegUnpack(RF, OutData%Nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ny); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModValsType(SrcModValsTypeData, DstModValsTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModValsType), intent(in) :: SrcModValsTypeData + type(ModValsType), intent(inout) :: DstModValsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModValsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModValsTypeData%x)) then + LB(1:1) = lbound(SrcModValsTypeData%x, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%x, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%x)) then + allocate(DstModValsTypeData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%x = SrcModValsTypeData%x + end if + if (allocated(SrcModValsTypeData%dxdt)) then + LB(1:1) = lbound(SrcModValsTypeData%dxdt, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%dxdt, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%dxdt)) then + allocate(DstModValsTypeData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dxdt = SrcModValsTypeData%dxdt + end if + if (allocated(SrcModValsTypeData%u)) then + LB(1:1) = lbound(SrcModValsTypeData%u, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%u, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%u)) then + allocate(DstModValsTypeData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%u = SrcModValsTypeData%u + end if + if (allocated(SrcModValsTypeData%y)) then + LB(1:1) = lbound(SrcModValsTypeData%y, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%y, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%y)) then + allocate(DstModValsTypeData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%y = SrcModValsTypeData%y + end if + if (allocated(SrcModValsTypeData%u_perturb)) then + LB(1:1) = lbound(SrcModValsTypeData%u_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%u_perturb, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%u_perturb)) then + allocate(DstModValsTypeData%u_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%u_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%u_perturb = SrcModValsTypeData%u_perturb + end if + if (allocated(SrcModValsTypeData%x_perturb)) then + LB(1:1) = lbound(SrcModValsTypeData%x_perturb, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%x_perturb, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%x_perturb)) then + allocate(DstModValsTypeData%x_perturb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%x_perturb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%x_perturb = SrcModValsTypeData%x_perturb + end if + if (allocated(SrcModValsTypeData%xp)) then + LB(1:1) = lbound(SrcModValsTypeData%xp, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%xp, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%xp)) then + allocate(DstModValsTypeData%xp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%xp = SrcModValsTypeData%xp + end if + if (allocated(SrcModValsTypeData%xn)) then + LB(1:1) = lbound(SrcModValsTypeData%xn, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%xn, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%xn)) then + allocate(DstModValsTypeData%xn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%xn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%xn = SrcModValsTypeData%xn + end if + if (allocated(SrcModValsTypeData%yp)) then + LB(1:1) = lbound(SrcModValsTypeData%yp, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%yp, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%yp)) then + allocate(DstModValsTypeData%yp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%yp = SrcModValsTypeData%yp + end if + if (allocated(SrcModValsTypeData%yn)) then + LB(1:1) = lbound(SrcModValsTypeData%yn, kind=B8Ki) + UB(1:1) = ubound(SrcModValsTypeData%yn, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%yn)) then + allocate(DstModValsTypeData%yn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%yn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%yn = SrcModValsTypeData%yn + end if + if (allocated(SrcModValsTypeData%dYdx)) then + LB(1:2) = lbound(SrcModValsTypeData%dYdx, kind=B8Ki) + UB(1:2) = ubound(SrcModValsTypeData%dYdx, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%dYdx)) then + allocate(DstModValsTypeData%dYdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dYdx = SrcModValsTypeData%dYdx + end if + if (allocated(SrcModValsTypeData%dXdx)) then + LB(1:2) = lbound(SrcModValsTypeData%dXdx, kind=B8Ki) + UB(1:2) = ubound(SrcModValsTypeData%dXdx, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%dXdx)) then + allocate(DstModValsTypeData%dXdx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dXdx = SrcModValsTypeData%dXdx + end if + if (allocated(SrcModValsTypeData%dYdu)) then + LB(1:2) = lbound(SrcModValsTypeData%dYdu, kind=B8Ki) + UB(1:2) = ubound(SrcModValsTypeData%dYdu, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%dYdu)) then + allocate(DstModValsTypeData%dYdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dYdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dYdu = SrcModValsTypeData%dYdu + end if + if (allocated(SrcModValsTypeData%dXdu)) then + LB(1:2) = lbound(SrcModValsTypeData%dXdu, kind=B8Ki) + UB(1:2) = ubound(SrcModValsTypeData%dXdu, kind=B8Ki) + if (.not. allocated(DstModValsTypeData%dXdu)) then + allocate(DstModValsTypeData%dXdu(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModValsTypeData%dXdu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModValsTypeData%dXdu = SrcModValsTypeData%dXdu + end if +end subroutine + +subroutine NWTC_Library_DestroyModValsType(ModValsTypeData, ErrStat, ErrMsg) + type(ModValsType), intent(inout) :: ModValsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModValsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModValsTypeData%x)) then + deallocate(ModValsTypeData%x) + end if + if (allocated(ModValsTypeData%dxdt)) then + deallocate(ModValsTypeData%dxdt) + end if + if (allocated(ModValsTypeData%u)) then + deallocate(ModValsTypeData%u) + end if + if (allocated(ModValsTypeData%y)) then + deallocate(ModValsTypeData%y) + end if + if (allocated(ModValsTypeData%u_perturb)) then + deallocate(ModValsTypeData%u_perturb) + end if + if (allocated(ModValsTypeData%x_perturb)) then + deallocate(ModValsTypeData%x_perturb) + end if + if (allocated(ModValsTypeData%xp)) then + deallocate(ModValsTypeData%xp) + end if + if (allocated(ModValsTypeData%xn)) then + deallocate(ModValsTypeData%xn) + end if + if (allocated(ModValsTypeData%yp)) then + deallocate(ModValsTypeData%yp) + end if + if (allocated(ModValsTypeData%yn)) then + deallocate(ModValsTypeData%yn) + end if + if (allocated(ModValsTypeData%dYdx)) then + deallocate(ModValsTypeData%dYdx) + end if + if (allocated(ModValsTypeData%dXdx)) then + deallocate(ModValsTypeData%dXdx) + end if + if (allocated(ModValsTypeData%dYdu)) then + deallocate(ModValsTypeData%dYdu) + end if + if (allocated(ModValsTypeData%dXdu)) then + deallocate(ModValsTypeData%dXdu) + end if +end subroutine + +subroutine NWTC_Library_PackModValsType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModValsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModValsType' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%x) + call RegPackAlloc(RF, InData%dxdt) + call RegPackAlloc(RF, InData%u) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%u_perturb) + call RegPackAlloc(RF, InData%x_perturb) + call RegPackAlloc(RF, InData%xp) + call RegPackAlloc(RF, InData%xn) + call RegPackAlloc(RF, InData%yp) + call RegPackAlloc(RF, InData%yn) + call RegPackAlloc(RF, InData%dYdx) + call RegPackAlloc(RF, InData%dXdx) + call RegPackAlloc(RF, InData%dYdu) + call RegPackAlloc(RF, InData%dXdu) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModValsType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModValsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModValsType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dxdt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%u_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_perturb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%yp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%yn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dYdu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dXdu); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_CopyModDataType(SrcModDataTypeData, DstModDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(ModDataType), intent(in) :: SrcModDataTypeData + type(ModDataType), intent(inout) :: DstModDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstModDataTypeData%Idx = SrcModDataTypeData%Idx + DstModDataTypeData%ID = SrcModDataTypeData%ID + DstModDataTypeData%Abbr = SrcModDataTypeData%Abbr + DstModDataTypeData%Ins = SrcModDataTypeData%Ins + DstModDataTypeData%IsTC = SrcModDataTypeData%IsTC + DstModDataTypeData%DT = SrcModDataTypeData%DT + DstModDataTypeData%SubSteps = SrcModDataTypeData%SubSteps + if (allocated(SrcModDataTypeData%ixs)) then + LB(1:2) = lbound(SrcModDataTypeData%ixs, kind=B8Ki) + UB(1:2) = ubound(SrcModDataTypeData%ixs, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%ixs)) then + allocate(DstModDataTypeData%ixs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ixs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%ixs = SrcModDataTypeData%ixs + end if + if (allocated(SrcModDataTypeData%ius)) then + LB(1:2) = lbound(SrcModDataTypeData%ius, kind=B8Ki) + UB(1:2) = ubound(SrcModDataTypeData%ius, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%ius)) then + allocate(DstModDataTypeData%ius(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%ius.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%ius = SrcModDataTypeData%ius + end if + if (allocated(SrcModDataTypeData%iys)) then + LB(1:2) = lbound(SrcModDataTypeData%iys, kind=B8Ki) + UB(1:2) = ubound(SrcModDataTypeData%iys, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%iys)) then + allocate(DstModDataTypeData%iys(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%iys.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%iys = SrcModDataTypeData%iys + end if + DstModDataTypeData%Vars => SrcModDataTypeData%Vars + if (allocated(SrcModDataTypeData%SrcMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%SrcMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%SrcMaps)) then + allocate(DstModDataTypeData%SrcMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%SrcMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%SrcMaps = SrcModDataTypeData%SrcMaps + end if + if (allocated(SrcModDataTypeData%DstMaps)) then + LB(1:1) = lbound(SrcModDataTypeData%DstMaps, kind=B8Ki) + UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) + if (.not. allocated(DstModDataTypeData%DstMaps)) then + allocate(DstModDataTypeData%DstMaps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModDataTypeData%DstMaps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModDataTypeData%DstMaps = SrcModDataTypeData%DstMaps + end if +end subroutine + +subroutine NWTC_Library_DestroyModDataType(ModDataTypeData, ErrStat, ErrMsg) + type(ModDataType), intent(inout) :: ModDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModDataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModDataTypeData%ixs)) then + deallocate(ModDataTypeData%ixs) + end if + if (allocated(ModDataTypeData%ius)) then + deallocate(ModDataTypeData%ius) + end if + if (allocated(ModDataTypeData%iys)) then + deallocate(ModDataTypeData%iys) + end if + nullify(ModDataTypeData%Vars) + if (allocated(ModDataTypeData%SrcMaps)) then + deallocate(ModDataTypeData%SrcMaps) + end if + if (allocated(ModDataTypeData%DstMaps)) then + deallocate(ModDataTypeData%DstMaps) + end if +end subroutine + +subroutine NWTC_Library_PackModDataType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackModDataType' + logical :: PtrInIndex + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Idx) + call RegPack(RF, InData%ID) + call RegPack(RF, InData%Abbr) + call RegPack(RF, InData%Ins) + call RegPack(RF, InData%IsTC) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%SubSteps) + call RegPackAlloc(RF, InData%ixs) + call RegPackAlloc(RF, InData%ius) + call RegPackAlloc(RF, InData%iys) + call RegPack(RF, associated(InData%Vars)) + if (associated(InData%Vars)) then + call RegPackPointer(RF, c_loc(InData%Vars), PtrInIndex) + if (.not. PtrInIndex) then + call NWTC_Library_PackModVarsType(RF, InData%Vars) + end if + end if + call RegPackAlloc(RF, InData%SrcMaps) + call RegPackAlloc(RF, InData%DstMaps) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackModDataType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(ModDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModDataType' + integer(B8Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Idx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Abbr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ins); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsTC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ixs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ius); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%iys); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%Vars)) deallocate(OutData%Vars) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vars) + else + allocate(OutData%Vars,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vars.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%Vars) + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + end if + else + OutData%Vars => null() end if - call RegUnpack(Buf, OutData%RNG_type) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SrcMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DstMaps); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index 5b6e03407e..8882bcc144 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -24,10 +24,10 @@ 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 FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} @@ -35,9 +35,93 @@ typedef NWTC_Library Quaternion ReKi q0 typedef ^ ^ ReKi v {3} typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type + +#------------------------------------------------------------------------------- +# Module Variables +#------------------------------------------------------------------------------- + +param ^ - IntKi VarNameLen - 64 - "" - + +param ^ - IntKi VF_Force - 1 - "" - +param ^ - IntKi VF_Moment - 2 - "" - +param ^ - IntKi VF_Orientation - 3 - "" - +param ^ - IntKi VF_TransDisp - 4 - "" - +param ^ - IntKi VF_AngularDisp - 5 - "" - +param ^ - IntKi VF_TransVel - 6 - "" - +param ^ - IntKi VF_AngularVel - 7 - "" - +param ^ - IntKi VF_TransAcc - 8 - "" - +param ^ - IntKi VF_AngularAcc - 9 - "" - +param ^ - IntKi VF_Scalar - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" # This file defines types that may be used from the NWTC_Library # include this into a component registry file if you wish to use these types @@ -76,6 +160,6 @@ typedef ^ ^ R8Ki DisplacedPo 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" +typedef ^ ^ MeshMapLinearizationType dM +#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt index 40cdaee1b9..310b3de0e9 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_base.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_base.txt @@ -38,3 +38,87 @@ typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi p typedef ^ ^ IntKi RandSeed {3} typedef ^ ^ IntKi RandSeedAry {:} typedef ^ ^ CHARACTER(6) RNG_type + +#------------------------------------------------------------------------------- +# Module Variables +#------------------------------------------------------------------------------- + +param ^ - IntKi VarNameLen - 64 - "" - + +param ^ - IntKi VF_Force - 1 - "" - +param ^ - IntKi VF_Moment - 2 - "" - +param ^ - IntKi VF_Orientation - 3 - "" - +param ^ - IntKi VF_TransDisp - 4 - "" - +param ^ - IntKi VF_AngularDisp - 5 - "" - +param ^ - IntKi VF_TransVel - 6 - "" - +param ^ - IntKi VF_AngularVel - 7 - "" - +param ^ - IntKi VF_TransAcc - 8 - "" - +param ^ - IntKi VF_AngularAcc - 9 - "" - +param ^ - IntKi VF_Scalar - 10 - "" - + +param ^ - IntKi VF_None - 0 - "Variable with no flags" - +param ^ - IntKi VF_Mesh - 1 - "Variable contained in mesh" - +param ^ - IntKi VF_Line - 2 - "Variable is for a line mesh" - +param ^ - IntKi VF_RotFrame - 4 - "Variable in rotating frame" - +param ^ - IntKi VF_Ext - 8 - "Variable for extended linearization" - +param ^ - IntKi VF_Any - 4095 - "Enable all flags (used for filtering)" - + +param ^ - IntKi VC_None - 0 - "" - +param ^ - IntKi VC_Tight - 1 - "" - +param ^ - IntKi VC_Option1 - 2 - "" - +param ^ - IntKi VC_Option2 - 3 - "" - + +typedef ^ ModVarType character(VarNameLen) Name - - - "" - +typedef ^ ^ IntKi Field - 0 - "" - +typedef ^ ^ IntKi Nodes - 1 - "" - +typedef ^ ^ IntKi Num - 1 - "" - +typedef ^ ^ IntKi Flags - 0 - "" - +typedef ^ ^ IntKi DerivOrder - 0 - "" - +typedef ^ ^ IntKi iLoc : - - "indices in local arrays" - +typedef ^ ^ IntKi iSol : - - "indices in solver arrays" - +typedef ^ ^ IntKi iLin : - - "indices in linearization arrays" - +typedef ^ ^ IntKi iq : - - "row index in solver q matrix" - +typedef ^ ^ IntKi iUsr 2 - - "first user defined index for variable, can be used a lower/upper bounds" - +typedef ^ ^ IntKi jUsr - 0 - "second user defined index for variable" - +typedef ^ ^ IntKi MeshID - 0 - "Mesh identification number" - +typedef ^ ^ logical Solve - F - "flag indicating that variable is used by solver" - +typedef ^ ^ R8Ki Perturb - 0 - "perturbation" - +typedef ^ ^ character(LinChanLen) LinNames : - - "" - + +typedef ^ ModVarsType IntKi ModNum - 0 - "" - +typedef ^ ^ character(6) ModAbbr - - - "" - +typedef ^ ^ ModVarType x : - - "Module state variable array" - +typedef ^ ^ ModVarType u : - - "Module input variable array" - +typedef ^ ^ ModVarType y : - - "Module output variable array" - +typedef ^ ^ IntKi Nx - - - "" - +typedef ^ ^ IntKi Nu - - - "" - +typedef ^ ^ IntKi Ny - - - "" - + +typedef ^ ModValsType R8Ki x : - - "" - +typedef ^ ^ R8Ki dxdt : - - "" - +typedef ^ ^ R8Ki u : - - "" - +typedef ^ ^ R8Ki y : - - "" - +typedef ^ ^ R8Ki u_perturb : - - "input perturbation array" - +typedef ^ ^ R8Ki x_perturb : - - "" - +typedef ^ ^ R8Ki xp : - - "" - +typedef ^ ^ R8Ki xn : - - "" - +typedef ^ ^ R8Ki yp : - - "" - +typedef ^ ^ R8Ki yn : - - "" - +typedef ^ ^ R8Ki dYdx :: - - "" - +typedef ^ ^ R8Ki dXdx :: - - "" - +typedef ^ ^ R8Ki dYdu :: - - "" - +typedef ^ ^ R8Ki dXdu :: - - "" - + +typedef ^ ModDataType IntKi Idx - 0 - "Module index in array of modules" - +typedef ^ ^ IntKi ID - 0 - "Module identification number" - +typedef ^ ^ character(ChanLen) Abbr - - - "Module name abbreviation" - +typedef ^ ^ IntKi Ins - 0 - "Module instance number" - +typedef ^ ^ logical IsTC - F - "Flag indicating module is part of tight coupling" - +typedef ^ ^ R8Ki DT - 0 - "Module time step" - +typedef ^ ^ IntKi SubSteps - 0 - "Module number of substeps per solver time step" - +typedef ^ ^ IntKi ixs :: - - "index array mapping local x vector to global x vector" - +typedef ^ ^ IntKi ius :: - - "index array mapping local u vector to global u vector" - +typedef ^ ^ IntKi iys :: - - "index array mapping local y vector to global y vector" - +typedef ^ ^ ModVarsType *Vars - - - "Pointer to module variables type" - +typedef ^ ^ IntKi SrcMaps : - - "Indices of mappings where module is the source" +typedef ^ ^ IntKi DstMaps : - - "Indices of mappings where module is the destination" diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c809c0aa88..1732086c5f 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7505,7 +7505,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - type(PackBuffer) :: Buf + type(RegFile) :: RF INTEGER(IntKi) :: unOut ! unit number for output file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7519,19 +7519,6 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ! init error status ErrStat = ErrID_None ErrMsg = "" - - ! Initialize the pack buffer - call InitPackBuffer(Buf, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - ! Get the arrays of data to be stored in the output file - call FAST_PackTurbineType(Buf, Turbine) - call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev ) then - call cleanup() - return - end if FileName = TRIM(CheckpointRoot)//'.chkp' DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' @@ -7562,8 +7549,23 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, END IF - ! data from current turbine at time step: - call WritePackBuffer(Buf, unOut, ErrStat2, ErrMsg2) + ! Initialize the registry file + call InitRegFile(RF, unOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + ! Pack data into the registry file + call FAST_PackTurbineType(RF, Turbine) + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) then + call cleanup() + return + end if + + ! Close registry file + call CloseRegFile(RF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return ! If last turbine or no unit, close output unit IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN @@ -7599,7 +7601,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, contains subroutine cleanup() - call DestroyPackBuffer(Buf, ErrStat2, ErrMsg2) + call CloseRegFile(RF, ErrStat2, ErrMsg2) end subroutine cleanup END SUBROUTINE FAST_CreateCheckpoint_T @@ -7664,7 +7666,7 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - type(PackBuffer) :: Buf + type(RegFile) :: RF INTEGER(IntKi) :: unIn ! unit number for input file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7705,14 +7707,14 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) return - ! Read the packed arrays - call ReadPackBuffer(Buf, unIn, ErrStat2, ErrMsg2) + ! Initialize registry file for reading + call OpenRegFile(RF, unIn, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - ! Put the arrays back in the data types - call FAST_UnpackTurbineType(Buf, Turbine) - call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) + ! Unpack registry file into turbine data structure + call FAST_UnpackTurbineType(RF, Turbine) + call SetErrStat(RF%ErrStat, RF%ErrMsg, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return ! close file if necessary (do this after unpacking turbine data, so that TurbID is set) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index c48b7344d9..8c5b43ef30 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -870,41 +870,24 @@ subroutine FAST_DestroyVTK_BLSurfaceType(VTK_BLSurfaceTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackVTK_BLSurfaceType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackVTK_BLSurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_VTK_BLSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_BLSurfaceType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%AirfoilCoords)) - if (allocated(InData%AirfoilCoords)) then - call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords, kind=B8Ki), ubound(InData%AirfoilCoords, kind=B8Ki)) - call RegPack(Buf, InData%AirfoilCoords) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%AirfoilCoords) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackVTK_BLSurfaceType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackVTK_BLSurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AirfoilCoords) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%AirfoilCoords); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1025,140 +1008,65 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackVTK_SurfaceType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackVTK_SurfaceType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%NumSectors) - call RegPack(Buf, InData%HubRad) - call RegPack(Buf, InData%GroundRad) - call RegPack(Buf, InData%NacelleBox) - call RegPack(Buf, allocated(InData%TowerRad)) - if (allocated(InData%TowerRad)) then - call RegPackBounds(Buf, 1, lbound(InData%TowerRad, kind=B8Ki), ubound(InData%TowerRad, kind=B8Ki)) - call RegPack(Buf, InData%TowerRad) - end if - call RegPack(Buf, InData%NWaveElevPts) - call RegPack(Buf, allocated(InData%WaveElevXY)) - if (allocated(InData%WaveElevXY)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY, kind=B8Ki), ubound(InData%WaveElevXY, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevXY) - end if - call RegPack(Buf, allocated(InData%WaveElev)) - if (allocated(InData%WaveElev)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElev, kind=B8Ki), ubound(InData%WaveElev, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev) - end if - call RegPack(Buf, allocated(InData%BladeShape)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumSectors) + call RegPack(RF, InData%HubRad) + call RegPack(RF, InData%GroundRad) + call RegPack(RF, InData%NacelleBox) + call RegPackAlloc(RF, InData%TowerRad) + call RegPack(RF, InData%NWaveElevPts) + call RegPackAlloc(RF, InData%WaveElevXY) + call RegPackAlloc(RF, InData%WaveElev) + call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(Buf, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) do i1 = LB(1), UB(1) - call FAST_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) + call FAST_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) end do end if - call RegPack(Buf, allocated(InData%MorisonVisRad)) - if (allocated(InData%MorisonVisRad)) then - call RegPackBounds(Buf, 1, lbound(InData%MorisonVisRad, kind=B8Ki), ubound(InData%MorisonVisRad, kind=B8Ki)) - call RegPack(Buf, InData%MorisonVisRad) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%MorisonVisRad) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumSectors) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GroundRad) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacelleBox) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TowerRad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TowerRad) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NWaveElevPts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevXY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumSectors); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GroundRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleBox); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TowerRad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElevPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FAST_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape + call FAST_UnpackVTK_BLSurfaceType(RF, OutData%BladeShape(i1)) ! BladeShape end do end if - if (allocated(OutData%MorisonVisRad)) deallocate(OutData%MorisonVisRad) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MorisonVisRad(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonVisRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MorisonVisRad) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%MorisonVisRad); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1280,157 +1188,48 @@ subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackVTK_ModeShapeType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_VTK_ModeShapeType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%CheckpointRoot) - call RegPack(Buf, InData%MatlabFileName) - call RegPack(Buf, InData%VTKLinModes) - call RegPack(Buf, allocated(InData%VTKModes)) - if (allocated(InData%VTKModes)) then - call RegPackBounds(Buf, 1, lbound(InData%VTKModes, kind=B8Ki), ubound(InData%VTKModes, kind=B8Ki)) - call RegPack(Buf, InData%VTKModes) - end if - call RegPack(Buf, InData%VTKLinTim) - call RegPack(Buf, InData%VTKNLinTimes) - call RegPack(Buf, InData%VTKLinScale) - call RegPack(Buf, InData%VTKLinPhase) - call RegPack(Buf, allocated(InData%DampingRatio)) - if (allocated(InData%DampingRatio)) then - call RegPackBounds(Buf, 1, lbound(InData%DampingRatio, kind=B8Ki), ubound(InData%DampingRatio, kind=B8Ki)) - call RegPack(Buf, InData%DampingRatio) - end if - call RegPack(Buf, allocated(InData%NaturalFreq_Hz)) - if (allocated(InData%NaturalFreq_Hz)) then - call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz, kind=B8Ki), ubound(InData%NaturalFreq_Hz, kind=B8Ki)) - call RegPack(Buf, InData%NaturalFreq_Hz) - end if - call RegPack(Buf, allocated(InData%DampedFreq_Hz)) - if (allocated(InData%DampedFreq_Hz)) then - call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz, kind=B8Ki), ubound(InData%DampedFreq_Hz, kind=B8Ki)) - call RegPack(Buf, InData%DampedFreq_Hz) - end if - call RegPack(Buf, allocated(InData%x_eig_magnitude)) - if (allocated(InData%x_eig_magnitude)) then - call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude, kind=B8Ki), ubound(InData%x_eig_magnitude, kind=B8Ki)) - call RegPack(Buf, InData%x_eig_magnitude) - end if - call RegPack(Buf, allocated(InData%x_eig_phase)) - if (allocated(InData%x_eig_phase)) then - call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase, kind=B8Ki), ubound(InData%x_eig_phase, kind=B8Ki)) - call RegPack(Buf, InData%x_eig_phase) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CheckpointRoot) + call RegPack(RF, InData%MatlabFileName) + call RegPack(RF, InData%VTKLinModes) + call RegPackAlloc(RF, InData%VTKModes) + call RegPack(RF, InData%VTKLinTim) + call RegPack(RF, InData%VTKNLinTimes) + call RegPack(RF, InData%VTKLinScale) + call RegPack(RF, InData%VTKLinPhase) + call RegPackAlloc(RF, InData%DampingRatio) + call RegPackAlloc(RF, InData%NaturalFreq_Hz) + call RegPackAlloc(RF, InData%DampedFreq_Hz) + call RegPackAlloc(RF, InData%x_eig_magnitude) + call RegPackAlloc(RF, InData%x_eig_phase) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_VTK_ModeShapeType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%CheckpointRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MatlabFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinModes) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%VTKModes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%VTKModes) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%VTKLinTim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKNLinTimes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinScale) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTKLinPhase) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DampingRatio(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DampingRatio) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NaturalFreq_Hz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NaturalFreq_Hz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DampedFreq_Hz(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DampedFreq_Hz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%x_eig_magnitude) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%x_eig_phase) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CheckpointRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MatlabFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%VTKModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinTim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKNLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinScale); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTKLinPhase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampingRatio); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NaturalFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DampedFreq_Hz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_magnitude); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_eig_phase); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopySS_CaseType(SrcSS_CaseTypeData, DstSS_CaseTypeData, CtrlCode, ErrStat, ErrMsg) @@ -1457,31 +1256,27 @@ subroutine FAST_DestroySS_CaseType(SS_CaseTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FAST_PackSS_CaseType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackSS_CaseType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_SS_CaseType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSS_CaseType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%TSR) - call RegPack(Buf, InData%WindSpeed) - call RegPack(Buf, InData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%TSR) + call RegPack(RF, InData%WindSpeed) + call RegPack(RF, InData%Pitch) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackSS_CaseType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackSS_CaseType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_SS_CaseType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSS_CaseType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TSR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1663,380 +1458,230 @@ subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%DT_module) - call RegPack(Buf, InData%n_substeps) - call RegPack(Buf, InData%n_TMax_m1) - call RegPack(Buf, InData%TMax) - call RegPack(Buf, InData%InterpOrder) - call RegPack(Buf, InData%NumCrctn) - call RegPack(Buf, InData%KMax) - call RegPack(Buf, InData%numIceLegs) - call RegPack(Buf, InData%nBeams) - call RegPack(Buf, InData%BD_OutputSibling) - call RegPack(Buf, InData%ModuleInitialized) - call RegPack(Buf, InData%DT_Ujac) - call RegPack(Buf, InData%UJacSclFact) - call RegPack(Buf, InData%SizeJac_Opt1) - call RegPack(Buf, InData%SolveOption) - call RegPack(Buf, InData%CompElast) - call RegPack(Buf, InData%CompInflow) - call RegPack(Buf, InData%CompAero) - call RegPack(Buf, InData%CompServo) - call RegPack(Buf, InData%CompSeaSt) - call RegPack(Buf, InData%CompHydro) - call RegPack(Buf, InData%CompSub) - call RegPack(Buf, InData%CompMooring) - call RegPack(Buf, InData%CompIce) - call RegPack(Buf, InData%MHK) - call RegPack(Buf, InData%UseDWM) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%WaveFieldMod) - call RegPack(Buf, InData%FarmIntegration) - call RegPack(Buf, InData%TurbinePos) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, InData%KinVisc) - call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%Patm) - call RegPack(Buf, InData%Pvap) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%EDFile) - call RegPack(Buf, InData%BDBldFile) - call RegPack(Buf, InData%InflowFile) - call RegPack(Buf, InData%AeroFile) - call RegPack(Buf, InData%ServoFile) - call RegPack(Buf, InData%SeaStFile) - call RegPack(Buf, InData%HydroFile) - call RegPack(Buf, InData%SubFile) - call RegPack(Buf, InData%MooringFile) - call RegPack(Buf, InData%IceFile) - call RegPack(Buf, InData%TStart) - call RegPack(Buf, InData%DT_Out) - call RegPack(Buf, InData%WrSttsTime) - call RegPack(Buf, InData%n_SttsTime) - call RegPack(Buf, InData%n_ChkptTime) - call RegPack(Buf, InData%n_DT_Out) - call RegPack(Buf, InData%n_VTKTime) - call RegPack(Buf, InData%WrBinOutFile) - call RegPack(Buf, InData%WrTxtOutFile) - call RegPack(Buf, InData%WrBinMod) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%WrVTK) - call RegPack(Buf, InData%VTK_Type) - call RegPack(Buf, InData%VTK_fields) - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutFmt_t) - call RegPack(Buf, InData%FmtWidth) - call RegPack(Buf, InData%TChanLen) - call RegPack(Buf, InData%OutFileRoot) - call RegPack(Buf, InData%FTitle) - call RegPack(Buf, InData%VTK_OutFileRoot) - call RegPack(Buf, InData%VTK_tWidth) - call RegPack(Buf, InData%VTK_fps) - call FAST_PackVTK_SurfaceType(Buf, InData%VTK_surface) - call RegPack(Buf, InData%Tdesc) - call RegPack(Buf, InData%CalcSteady) - call RegPack(Buf, InData%TrimCase) - call RegPack(Buf, InData%TrimTol) - call RegPack(Buf, InData%TrimGain) - call RegPack(Buf, InData%Twr_Kdmp) - call RegPack(Buf, InData%Bld_Kdmp) - call RegPack(Buf, InData%NLinTimes) - call RegPack(Buf, InData%AzimDelta) - call RegPack(Buf, InData%LinInputs) - call RegPack(Buf, InData%LinOutputs) - call RegPack(Buf, InData%LinOutJac) - call RegPack(Buf, InData%LinOutMod) - call FAST_PackVTK_ModeShapeType(Buf, InData%VTK_modes) - call RegPack(Buf, InData%UseSC) - call RegPack(Buf, InData%Lin_NumMods) - call RegPack(Buf, InData%Lin_ModOrder) - call RegPack(Buf, InData%LinInterpOrder) - call RegPack(Buf, InData%CompAeroMaps) - call RegPack(Buf, InData%N_UJac) - call RegPack(Buf, InData%NumBl_Lin) - call RegPack(Buf, InData%tolerSquared) - call RegPack(Buf, InData%NumSSCases) - call RegPack(Buf, InData%WindSpeedOrTSR) - call RegPack(Buf, InData%RotSpeedInit) - call RegPack(Buf, allocated(InData%RotSpeed)) - if (allocated(InData%RotSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%RotSpeed, kind=B8Ki), ubound(InData%RotSpeed, kind=B8Ki)) - call RegPack(Buf, InData%RotSpeed) - end if - call RegPack(Buf, allocated(InData%WS_TSR)) - if (allocated(InData%WS_TSR)) then - call RegPackBounds(Buf, 1, lbound(InData%WS_TSR, kind=B8Ki), ubound(InData%WS_TSR, kind=B8Ki)) - call RegPack(Buf, InData%WS_TSR) - end if - call RegPack(Buf, allocated(InData%Pitch)) - if (allocated(InData%Pitch)) then - call RegPackBounds(Buf, 1, lbound(InData%Pitch, kind=B8Ki), ubound(InData%Pitch, kind=B8Ki)) - call RegPack(Buf, InData%Pitch) - end if - call RegPack(Buf, InData%GearBox_index) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%DT_module) + call RegPack(RF, InData%n_substeps) + call RegPack(RF, InData%n_TMax_m1) + call RegPack(RF, InData%TMax) + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%NumCrctn) + call RegPack(RF, InData%KMax) + call RegPack(RF, InData%numIceLegs) + call RegPack(RF, InData%nBeams) + call RegPack(RF, InData%BD_OutputSibling) + call RegPack(RF, InData%ModuleInitialized) + call RegPack(RF, InData%DT_Ujac) + call RegPack(RF, InData%UJacSclFact) + call RegPack(RF, InData%SizeJac_Opt1) + call RegPack(RF, InData%SolveOption) + call RegPack(RF, InData%CompElast) + call RegPack(RF, InData%CompInflow) + call RegPack(RF, InData%CompAero) + call RegPack(RF, InData%CompServo) + call RegPack(RF, InData%CompSeaSt) + call RegPack(RF, InData%CompHydro) + call RegPack(RF, InData%CompSub) + call RegPack(RF, InData%CompMooring) + call RegPack(RF, InData%CompIce) + call RegPack(RF, InData%MHK) + call RegPack(RF, InData%UseDWM) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%FarmIntegration) + call RegPack(RF, InData%TurbinePos) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%KinVisc) + call RegPack(RF, InData%SpdSound) + call RegPack(RF, InData%Patm) + call RegPack(RF, InData%Pvap) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%EDFile) + call RegPack(RF, InData%BDBldFile) + call RegPack(RF, InData%InflowFile) + call RegPack(RF, InData%AeroFile) + call RegPack(RF, InData%ServoFile) + call RegPack(RF, InData%SeaStFile) + call RegPack(RF, InData%HydroFile) + call RegPack(RF, InData%SubFile) + call RegPack(RF, InData%MooringFile) + call RegPack(RF, InData%IceFile) + call RegPack(RF, InData%TStart) + call RegPack(RF, InData%DT_Out) + call RegPack(RF, InData%WrSttsTime) + call RegPack(RF, InData%n_SttsTime) + call RegPack(RF, InData%n_ChkptTime) + call RegPack(RF, InData%n_DT_Out) + call RegPack(RF, InData%n_VTKTime) + call RegPack(RF, InData%WrBinOutFile) + call RegPack(RF, InData%WrTxtOutFile) + call RegPack(RF, InData%WrBinMod) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%WrVTK) + call RegPack(RF, InData%VTK_Type) + call RegPack(RF, InData%VTK_fields) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutFmt_t) + call RegPack(RF, InData%FmtWidth) + call RegPack(RF, InData%TChanLen) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%FTitle) + call RegPack(RF, InData%VTK_OutFileRoot) + call RegPack(RF, InData%VTK_tWidth) + call RegPack(RF, InData%VTK_fps) + call FAST_PackVTK_SurfaceType(RF, InData%VTK_surface) + call RegPack(RF, InData%Tdesc) + call RegPack(RF, InData%CalcSteady) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimTol) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%Twr_Kdmp) + call RegPack(RF, InData%Bld_Kdmp) + call RegPack(RF, InData%NLinTimes) + call RegPack(RF, InData%AzimDelta) + call RegPack(RF, InData%LinInputs) + call RegPack(RF, InData%LinOutputs) + call RegPack(RF, InData%LinOutJac) + call RegPack(RF, InData%LinOutMod) + call FAST_PackVTK_ModeShapeType(RF, InData%VTK_modes) + call RegPack(RF, InData%UseSC) + call RegPack(RF, InData%Lin_NumMods) + call RegPack(RF, InData%Lin_ModOrder) + call RegPack(RF, InData%LinInterpOrder) + call RegPack(RF, InData%CompAeroMaps) + call RegPack(RF, InData%N_UJac) + call RegPack(RF, InData%NumBl_Lin) + call RegPack(RF, InData%tolerSquared) + call RegPack(RF, InData%NumSSCases) + call RegPack(RF, InData%WindSpeedOrTSR) + call RegPack(RF, InData%RotSpeedInit) + call RegPackAlloc(RF, InData%RotSpeed) + call RegPackAlloc(RF, InData%WS_TSR) + call RegPackAlloc(RF, InData%Pitch) + call RegPack(RF, InData%GearBox_index) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackParam' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT_module) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_substeps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_TMax_m1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InterpOrder) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumCrctn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numIceLegs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nBeams) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BD_OutputSibling) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ModuleInitialized) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT_Ujac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UJacSclFact) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SizeJac_Opt1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SolveOption) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompElast) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompInflow) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompServo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompSeaSt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompHydro) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompSub) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompMooring) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompIce) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MHK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseDWM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FarmIntegration) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TurbinePos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Patm) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EDFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BDBldFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%InflowFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AeroFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ServoFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SeaStFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HydroFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SubFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MooringFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IceFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TStart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT_Out) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrSttsTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_SttsTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_ChkptTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_DT_Out) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_VTKTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrBinOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrTxtOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrBinMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_Type) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_fields) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt_t) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FmtWidth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TChanLen) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_tWidth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_fps) - if (RegCheckErr(Buf, RoutineName)) return - call FAST_UnpackVTK_SurfaceType(Buf, OutData%VTK_surface) ! VTK_surface - call RegUnpack(Buf, OutData%Tdesc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CalcSteady) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimCase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimTol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimGain) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Twr_Kdmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Bld_Kdmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NLinTimes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AzimDelta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinInputs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinOutputs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinOutJac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinOutMod) - if (RegCheckErr(Buf, RoutineName)) return - call FAST_UnpackVTK_ModeShapeType(Buf, OutData%VTK_modes) ! VTK_modes - call RegUnpack(Buf, OutData%UseSC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Lin_NumMods) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Lin_ModOrder) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinInterpOrder) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%N_UJac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl_Lin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%tolerSquared) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumSSCases) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindSpeedOrTSR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeedInit) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%RotSpeed)) deallocate(OutData%RotSpeed) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotSpeed(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WS_TSR)) deallocate(OutData%WS_TSR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WS_TSR(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WS_TSR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WS_TSR) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Pitch)) deallocate(OutData%Pitch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Pitch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%GearBox_index) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_module); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_substeps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_TMax_m1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCrctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numIceLegs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nBeams); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BD_OutputSibling); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ModuleInitialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Ujac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UJacSclFact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SizeJac_Opt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SolveOption); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompElast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompInflow); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompServo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSeaSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompHydro); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompMooring); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompIce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmIntegration); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbinePos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Patm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Pvap); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EDFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BDBldFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InflowFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AeroFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ServoFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SeaStFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HydroFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MooringFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IceFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrSttsTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_SttsTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_ChkptTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_DT_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_VTKTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrTxtOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrBinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrVTK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_Type); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_fields); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt_t); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FmtWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TChanLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_tWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_fps); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVTK_SurfaceType(RF, OutData%VTK_surface) ! VTK_surface + call RegUnpack(RF, OutData%Tdesc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CalcSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimTol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Twr_Kdmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Bld_Kdmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NLinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimDelta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinOutMod); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackVTK_ModeShapeType(RF, OutData%VTK_modes) ! VTK_modes + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lin_NumMods); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Lin_ModOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinInterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompAeroMaps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_UJac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl_Lin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%tolerSquared); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSSCases); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeedOrTSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WS_TSR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Pitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GearBox_index); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) @@ -3707,1599 +3352,1471 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackLinStateSave(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackLinStateSave(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_LinStateSave), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%x_IceD)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x_IceD)) if (allocated(InData%x_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%x_IceD, kind=B8Ki), ubound(InData%x_IceD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%x_IceD, kind=B8Ki), ubound(InData%x_IceD, kind=B8Ki)) LB(1:2) = lbound(InData%x_IceD, kind=B8Ki) UB(1:2) = ubound(InData%x_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackContState(Buf, InData%x_IceD(i1,i2)) + call IceD_PackContState(RF, InData%x_IceD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%xd_IceD)) + call RegPack(RF, allocated(InData%xd_IceD)) if (allocated(InData%xd_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%xd_IceD, kind=B8Ki), ubound(InData%xd_IceD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%xd_IceD, kind=B8Ki), ubound(InData%xd_IceD, kind=B8Ki)) LB(1:2) = lbound(InData%xd_IceD, kind=B8Ki) UB(1:2) = ubound(InData%xd_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackDiscState(Buf, InData%xd_IceD(i1,i2)) + call IceD_PackDiscState(RF, InData%xd_IceD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%z_IceD)) + call RegPack(RF, allocated(InData%z_IceD)) if (allocated(InData%z_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%z_IceD, kind=B8Ki), ubound(InData%z_IceD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%z_IceD, kind=B8Ki), ubound(InData%z_IceD, kind=B8Ki)) LB(1:2) = lbound(InData%z_IceD, kind=B8Ki) UB(1:2) = ubound(InData%z_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackConstrState(Buf, InData%z_IceD(i1,i2)) + call IceD_PackConstrState(RF, InData%z_IceD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%OtherSt_IceD)) + call RegPack(RF, allocated(InData%OtherSt_IceD)) if (allocated(InData%OtherSt_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD, kind=B8Ki), ubound(InData%OtherSt_IceD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%OtherSt_IceD, kind=B8Ki), ubound(InData%OtherSt_IceD, kind=B8Ki)) LB(1:2) = lbound(InData%OtherSt_IceD, kind=B8Ki) UB(1:2) = ubound(InData%OtherSt_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackOtherState(Buf, InData%OtherSt_IceD(i1,i2)) + call IceD_PackOtherState(RF, InData%OtherSt_IceD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%u_IceD)) + call RegPack(RF, allocated(InData%u_IceD)) if (allocated(InData%u_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%u_IceD, kind=B8Ki), ubound(InData%u_IceD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_IceD, kind=B8Ki), ubound(InData%u_IceD, kind=B8Ki)) LB(1:2) = lbound(InData%u_IceD, kind=B8Ki) UB(1:2) = ubound(InData%u_IceD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackInput(Buf, InData%u_IceD(i1,i2)) + call IceD_PackInput(RF, InData%u_IceD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%x_BD)) + call RegPack(RF, allocated(InData%x_BD)) if (allocated(InData%x_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%x_BD, kind=B8Ki), ubound(InData%x_BD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%x_BD, kind=B8Ki), ubound(InData%x_BD, kind=B8Ki)) LB(1:2) = lbound(InData%x_BD, kind=B8Ki) UB(1:2) = ubound(InData%x_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackContState(Buf, InData%x_BD(i1,i2)) + call BD_PackContState(RF, InData%x_BD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%xd_BD)) + call RegPack(RF, allocated(InData%xd_BD)) if (allocated(InData%xd_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%xd_BD, kind=B8Ki), ubound(InData%xd_BD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%xd_BD, kind=B8Ki), ubound(InData%xd_BD, kind=B8Ki)) LB(1:2) = lbound(InData%xd_BD, kind=B8Ki) UB(1:2) = ubound(InData%xd_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackDiscState(Buf, InData%xd_BD(i1,i2)) + call BD_PackDiscState(RF, InData%xd_BD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%z_BD)) + call RegPack(RF, allocated(InData%z_BD)) if (allocated(InData%z_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%z_BD, kind=B8Ki), ubound(InData%z_BD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%z_BD, kind=B8Ki), ubound(InData%z_BD, kind=B8Ki)) LB(1:2) = lbound(InData%z_BD, kind=B8Ki) UB(1:2) = ubound(InData%z_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackConstrState(Buf, InData%z_BD(i1,i2)) + call BD_PackConstrState(RF, InData%z_BD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%OtherSt_BD)) + call RegPack(RF, allocated(InData%OtherSt_BD)) if (allocated(InData%OtherSt_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD, kind=B8Ki), ubound(InData%OtherSt_BD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%OtherSt_BD, kind=B8Ki), ubound(InData%OtherSt_BD, kind=B8Ki)) LB(1:2) = lbound(InData%OtherSt_BD, kind=B8Ki) UB(1:2) = ubound(InData%OtherSt_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackOtherState(Buf, InData%OtherSt_BD(i1,i2)) + call BD_PackOtherState(RF, InData%OtherSt_BD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%u_BD)) + call RegPack(RF, allocated(InData%u_BD)) if (allocated(InData%u_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BD, kind=B8Ki), ubound(InData%u_BD, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_BD, kind=B8Ki), ubound(InData%u_BD, kind=B8Ki)) LB(1:2) = lbound(InData%u_BD, kind=B8Ki) UB(1:2) = ubound(InData%u_BD, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackInput(Buf, InData%u_BD(i1,i2)) + call BD_PackInput(RF, InData%u_BD(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%x_ED)) + call RegPack(RF, allocated(InData%x_ED)) if (allocated(InData%x_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%x_ED, kind=B8Ki), ubound(InData%x_ED, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_ED, kind=B8Ki), ubound(InData%x_ED, kind=B8Ki)) LB(1:1) = lbound(InData%x_ED, kind=B8Ki) UB(1:1) = ubound(InData%x_ED, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackContState(Buf, InData%x_ED(i1)) + call ED_PackContState(RF, InData%x_ED(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_ED)) + call RegPack(RF, allocated(InData%xd_ED)) if (allocated(InData%xd_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_ED, kind=B8Ki), ubound(InData%xd_ED, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_ED, kind=B8Ki), ubound(InData%xd_ED, kind=B8Ki)) LB(1:1) = lbound(InData%xd_ED, kind=B8Ki) UB(1:1) = ubound(InData%xd_ED, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackDiscState(Buf, InData%xd_ED(i1)) + call ED_PackDiscState(RF, InData%xd_ED(i1)) end do end if - call RegPack(Buf, allocated(InData%z_ED)) + call RegPack(RF, allocated(InData%z_ED)) if (allocated(InData%z_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%z_ED, kind=B8Ki), ubound(InData%z_ED, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_ED, kind=B8Ki), ubound(InData%z_ED, kind=B8Ki)) LB(1:1) = lbound(InData%z_ED, kind=B8Ki) UB(1:1) = ubound(InData%z_ED, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackConstrState(Buf, InData%z_ED(i1)) + call ED_PackConstrState(RF, InData%z_ED(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_ED)) + call RegPack(RF, allocated(InData%OtherSt_ED)) if (allocated(InData%OtherSt_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED, kind=B8Ki), ubound(InData%OtherSt_ED, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_ED, kind=B8Ki), ubound(InData%OtherSt_ED, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_ED, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_ED, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) + call ED_PackOtherState(RF, InData%OtherSt_ED(i1)) end do end if - call RegPack(Buf, allocated(InData%u_ED)) + call RegPack(RF, allocated(InData%u_ED)) if (allocated(InData%u_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ED, kind=B8Ki), ubound(InData%u_ED, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_ED, kind=B8Ki), ubound(InData%u_ED, kind=B8Ki)) LB(1:1) = lbound(InData%u_ED, kind=B8Ki) UB(1:1) = ubound(InData%u_ED, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackInput(Buf, InData%u_ED(i1)) + call ED_PackInput(RF, InData%u_ED(i1)) end do end if - call RegPack(Buf, allocated(InData%x_SrvD)) + call RegPack(RF, allocated(InData%x_SrvD)) if (allocated(InData%x_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_SrvD, kind=B8Ki), ubound(InData%x_SrvD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_SrvD, kind=B8Ki), ubound(InData%x_SrvD, kind=B8Ki)) LB(1:1) = lbound(InData%x_SrvD, kind=B8Ki) UB(1:1) = ubound(InData%x_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackContState(Buf, InData%x_SrvD(i1)) + call SrvD_PackContState(RF, InData%x_SrvD(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_SrvD)) + call RegPack(RF, allocated(InData%xd_SrvD)) if (allocated(InData%xd_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD, kind=B8Ki), ubound(InData%xd_SrvD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_SrvD, kind=B8Ki), ubound(InData%xd_SrvD, kind=B8Ki)) LB(1:1) = lbound(InData%xd_SrvD, kind=B8Ki) UB(1:1) = ubound(InData%xd_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) + call SrvD_PackDiscState(RF, InData%xd_SrvD(i1)) end do end if - call RegPack(Buf, allocated(InData%z_SrvD)) + call RegPack(RF, allocated(InData%z_SrvD)) if (allocated(InData%z_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_SrvD, kind=B8Ki), ubound(InData%z_SrvD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_SrvD, kind=B8Ki), ubound(InData%z_SrvD, kind=B8Ki)) LB(1:1) = lbound(InData%z_SrvD, kind=B8Ki) UB(1:1) = ubound(InData%z_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) + call SrvD_PackConstrState(RF, InData%z_SrvD(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_SrvD)) + call RegPack(RF, allocated(InData%OtherSt_SrvD)) if (allocated(InData%OtherSt_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD, kind=B8Ki), ubound(InData%OtherSt_SrvD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_SrvD, kind=B8Ki), ubound(InData%OtherSt_SrvD, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_SrvD, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) + call SrvD_PackOtherState(RF, InData%OtherSt_SrvD(i1)) end do end if - call RegPack(Buf, allocated(InData%u_SrvD)) + call RegPack(RF, allocated(InData%u_SrvD)) if (allocated(InData%u_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SrvD, kind=B8Ki), ubound(InData%u_SrvD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_SrvD, kind=B8Ki), ubound(InData%u_SrvD, kind=B8Ki)) LB(1:1) = lbound(InData%u_SrvD, kind=B8Ki) UB(1:1) = ubound(InData%u_SrvD, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackInput(Buf, InData%u_SrvD(i1)) + call SrvD_PackInput(RF, InData%u_SrvD(i1)) end do end if - call RegPack(Buf, allocated(InData%x_AD)) + call RegPack(RF, allocated(InData%x_AD)) if (allocated(InData%x_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_AD, kind=B8Ki), ubound(InData%x_AD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_AD, kind=B8Ki), ubound(InData%x_AD, kind=B8Ki)) LB(1:1) = lbound(InData%x_AD, kind=B8Ki) UB(1:1) = ubound(InData%x_AD, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackContState(Buf, InData%x_AD(i1)) + call AD_PackContState(RF, InData%x_AD(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_AD)) + call RegPack(RF, allocated(InData%xd_AD)) if (allocated(InData%xd_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_AD, kind=B8Ki), ubound(InData%xd_AD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_AD, kind=B8Ki), ubound(InData%xd_AD, kind=B8Ki)) LB(1:1) = lbound(InData%xd_AD, kind=B8Ki) UB(1:1) = ubound(InData%xd_AD, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackDiscState(Buf, InData%xd_AD(i1)) + call AD_PackDiscState(RF, InData%xd_AD(i1)) end do end if - call RegPack(Buf, allocated(InData%z_AD)) + call RegPack(RF, allocated(InData%z_AD)) if (allocated(InData%z_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_AD, kind=B8Ki), ubound(InData%z_AD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_AD, kind=B8Ki), ubound(InData%z_AD, kind=B8Ki)) LB(1:1) = lbound(InData%z_AD, kind=B8Ki) UB(1:1) = ubound(InData%z_AD, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackConstrState(Buf, InData%z_AD(i1)) + call AD_PackConstrState(RF, InData%z_AD(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_AD)) + call RegPack(RF, allocated(InData%OtherSt_AD)) if (allocated(InData%OtherSt_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD, kind=B8Ki), ubound(InData%OtherSt_AD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_AD, kind=B8Ki), ubound(InData%OtherSt_AD, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_AD, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_AD, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) + call AD_PackOtherState(RF, InData%OtherSt_AD(i1)) end do end if - call RegPack(Buf, allocated(InData%u_AD)) + call RegPack(RF, allocated(InData%u_AD)) if (allocated(InData%u_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_AD, kind=B8Ki), ubound(InData%u_AD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_AD, kind=B8Ki), ubound(InData%u_AD, kind=B8Ki)) LB(1:1) = lbound(InData%u_AD, kind=B8Ki) UB(1:1) = ubound(InData%u_AD, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackInput(Buf, InData%u_AD(i1)) + call AD_PackInput(RF, InData%u_AD(i1)) end do end if - call RegPack(Buf, allocated(InData%x_IfW)) + call RegPack(RF, allocated(InData%x_IfW)) if (allocated(InData%x_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%x_IfW, kind=B8Ki), ubound(InData%x_IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_IfW, kind=B8Ki), ubound(InData%x_IfW, kind=B8Ki)) LB(1:1) = lbound(InData%x_IfW, kind=B8Ki) UB(1:1) = ubound(InData%x_IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackContState(Buf, InData%x_IfW(i1)) + call InflowWind_PackContState(RF, InData%x_IfW(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_IfW)) + call RegPack(RF, allocated(InData%xd_IfW)) if (allocated(InData%xd_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_IfW, kind=B8Ki), ubound(InData%xd_IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_IfW, kind=B8Ki), ubound(InData%xd_IfW, kind=B8Ki)) LB(1:1) = lbound(InData%xd_IfW, kind=B8Ki) UB(1:1) = ubound(InData%xd_IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) + call InflowWind_PackDiscState(RF, InData%xd_IfW(i1)) end do end if - call RegPack(Buf, allocated(InData%z_IfW)) + call RegPack(RF, allocated(InData%z_IfW)) if (allocated(InData%z_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%z_IfW, kind=B8Ki), ubound(InData%z_IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_IfW, kind=B8Ki), ubound(InData%z_IfW, kind=B8Ki)) LB(1:1) = lbound(InData%z_IfW, kind=B8Ki) UB(1:1) = ubound(InData%z_IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) + call InflowWind_PackConstrState(RF, InData%z_IfW(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_IfW)) + call RegPack(RF, allocated(InData%OtherSt_IfW)) if (allocated(InData%OtherSt_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW, kind=B8Ki), ubound(InData%OtherSt_IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_IfW, kind=B8Ki), ubound(InData%OtherSt_IfW, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_IfW, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) + call InflowWind_PackOtherState(RF, InData%OtherSt_IfW(i1)) end do end if - call RegPack(Buf, allocated(InData%u_IfW)) + call RegPack(RF, allocated(InData%u_IfW)) if (allocated(InData%u_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%u_IfW, kind=B8Ki), ubound(InData%u_IfW, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_IfW, kind=B8Ki), ubound(InData%u_IfW, kind=B8Ki)) LB(1:1) = lbound(InData%u_IfW, kind=B8Ki) UB(1:1) = ubound(InData%u_IfW, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackInput(Buf, InData%u_IfW(i1)) + call InflowWind_PackInput(RF, InData%u_IfW(i1)) end do end if - call RegPack(Buf, allocated(InData%x_SD)) + call RegPack(RF, allocated(InData%x_SD)) if (allocated(InData%x_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_SD, kind=B8Ki), ubound(InData%x_SD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_SD, kind=B8Ki), ubound(InData%x_SD, kind=B8Ki)) LB(1:1) = lbound(InData%x_SD, kind=B8Ki) UB(1:1) = ubound(InData%x_SD, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackContState(Buf, InData%x_SD(i1)) + call SD_PackContState(RF, InData%x_SD(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_SD)) + call RegPack(RF, allocated(InData%xd_SD)) if (allocated(InData%xd_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_SD, kind=B8Ki), ubound(InData%xd_SD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_SD, kind=B8Ki), ubound(InData%xd_SD, kind=B8Ki)) LB(1:1) = lbound(InData%xd_SD, kind=B8Ki) UB(1:1) = ubound(InData%xd_SD, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackDiscState(Buf, InData%xd_SD(i1)) + call SD_PackDiscState(RF, InData%xd_SD(i1)) end do end if - call RegPack(Buf, allocated(InData%z_SD)) + call RegPack(RF, allocated(InData%z_SD)) if (allocated(InData%z_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_SD, kind=B8Ki), ubound(InData%z_SD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_SD, kind=B8Ki), ubound(InData%z_SD, kind=B8Ki)) LB(1:1) = lbound(InData%z_SD, kind=B8Ki) UB(1:1) = ubound(InData%z_SD, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackConstrState(Buf, InData%z_SD(i1)) + call SD_PackConstrState(RF, InData%z_SD(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_SD)) + call RegPack(RF, allocated(InData%OtherSt_SD)) if (allocated(InData%OtherSt_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD, kind=B8Ki), ubound(InData%OtherSt_SD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_SD, kind=B8Ki), ubound(InData%OtherSt_SD, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_SD, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_SD, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) + call SD_PackOtherState(RF, InData%OtherSt_SD(i1)) end do end if - call RegPack(Buf, allocated(InData%u_SD)) + call RegPack(RF, allocated(InData%u_SD)) if (allocated(InData%u_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SD, kind=B8Ki), ubound(InData%u_SD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_SD, kind=B8Ki), ubound(InData%u_SD, kind=B8Ki)) LB(1:1) = lbound(InData%u_SD, kind=B8Ki) UB(1:1) = ubound(InData%u_SD, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackInput(Buf, InData%u_SD(i1)) + call SD_PackInput(RF, InData%u_SD(i1)) end do end if - call RegPack(Buf, allocated(InData%x_ExtPtfm)) + call RegPack(RF, allocated(InData%x_ExtPtfm)) if (allocated(InData%x_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm, kind=B8Ki), ubound(InData%x_ExtPtfm, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_ExtPtfm, kind=B8Ki), ubound(InData%x_ExtPtfm, kind=B8Ki)) LB(1:1) = lbound(InData%x_ExtPtfm, kind=B8Ki) UB(1:1) = ubound(InData%x_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) + call ExtPtfm_PackContState(RF, InData%x_ExtPtfm(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_ExtPtfm)) + call RegPack(RF, allocated(InData%xd_ExtPtfm)) if (allocated(InData%xd_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm, kind=B8Ki), ubound(InData%xd_ExtPtfm, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_ExtPtfm, kind=B8Ki), ubound(InData%xd_ExtPtfm, kind=B8Ki)) LB(1:1) = lbound(InData%xd_ExtPtfm, kind=B8Ki) UB(1:1) = ubound(InData%xd_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) + call ExtPtfm_PackDiscState(RF, InData%xd_ExtPtfm(i1)) end do end if - call RegPack(Buf, allocated(InData%z_ExtPtfm)) + call RegPack(RF, allocated(InData%z_ExtPtfm)) if (allocated(InData%z_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm, kind=B8Ki), ubound(InData%z_ExtPtfm, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_ExtPtfm, kind=B8Ki), ubound(InData%z_ExtPtfm, kind=B8Ki)) LB(1:1) = lbound(InData%z_ExtPtfm, kind=B8Ki) UB(1:1) = ubound(InData%z_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) + call ExtPtfm_PackConstrState(RF, InData%z_ExtPtfm(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) + call RegPack(RF, allocated(InData%OtherSt_ExtPtfm)) if (allocated(InData%OtherSt_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm, kind=B8Ki), ubound(InData%OtherSt_ExtPtfm, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_ExtPtfm, kind=B8Ki), ubound(InData%OtherSt_ExtPtfm, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_ExtPtfm, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) + call ExtPtfm_PackOtherState(RF, InData%OtherSt_ExtPtfm(i1)) end do end if - call RegPack(Buf, allocated(InData%u_ExtPtfm)) + call RegPack(RF, allocated(InData%u_ExtPtfm)) if (allocated(InData%u_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm, kind=B8Ki), ubound(InData%u_ExtPtfm, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_ExtPtfm, kind=B8Ki), ubound(InData%u_ExtPtfm, kind=B8Ki)) LB(1:1) = lbound(InData%u_ExtPtfm, kind=B8Ki) UB(1:1) = ubound(InData%u_ExtPtfm, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) + call ExtPtfm_PackInput(RF, InData%u_ExtPtfm(i1)) end do end if - call RegPack(Buf, allocated(InData%x_HD)) + call RegPack(RF, allocated(InData%x_HD)) if (allocated(InData%x_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_HD, kind=B8Ki), ubound(InData%x_HD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_HD, kind=B8Ki), ubound(InData%x_HD, kind=B8Ki)) LB(1:1) = lbound(InData%x_HD, kind=B8Ki) UB(1:1) = ubound(InData%x_HD, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackContState(Buf, InData%x_HD(i1)) + call HydroDyn_PackContState(RF, InData%x_HD(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_HD)) + call RegPack(RF, allocated(InData%xd_HD)) if (allocated(InData%xd_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_HD, kind=B8Ki), ubound(InData%xd_HD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_HD, kind=B8Ki), ubound(InData%xd_HD, kind=B8Ki)) LB(1:1) = lbound(InData%xd_HD, kind=B8Ki) UB(1:1) = ubound(InData%xd_HD, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) + call HydroDyn_PackDiscState(RF, InData%xd_HD(i1)) end do end if - call RegPack(Buf, allocated(InData%z_HD)) + call RegPack(RF, allocated(InData%z_HD)) if (allocated(InData%z_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_HD, kind=B8Ki), ubound(InData%z_HD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_HD, kind=B8Ki), ubound(InData%z_HD, kind=B8Ki)) LB(1:1) = lbound(InData%z_HD, kind=B8Ki) UB(1:1) = ubound(InData%z_HD, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) + call HydroDyn_PackConstrState(RF, InData%z_HD(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_HD)) + call RegPack(RF, allocated(InData%OtherSt_HD)) if (allocated(InData%OtherSt_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD, kind=B8Ki), ubound(InData%OtherSt_HD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_HD, kind=B8Ki), ubound(InData%OtherSt_HD, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_HD, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_HD, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) + call HydroDyn_PackOtherState(RF, InData%OtherSt_HD(i1)) end do end if - call RegPack(Buf, allocated(InData%u_HD)) + call RegPack(RF, allocated(InData%u_HD)) if (allocated(InData%u_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_HD, kind=B8Ki), ubound(InData%u_HD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_HD, kind=B8Ki), ubound(InData%u_HD, kind=B8Ki)) LB(1:1) = lbound(InData%u_HD, kind=B8Ki) UB(1:1) = ubound(InData%u_HD, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackInput(Buf, InData%u_HD(i1)) + call HydroDyn_PackInput(RF, InData%u_HD(i1)) end do end if - call RegPack(Buf, allocated(InData%x_IceF)) + call RegPack(RF, allocated(InData%x_IceF)) if (allocated(InData%x_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%x_IceF, kind=B8Ki), ubound(InData%x_IceF, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_IceF, kind=B8Ki), ubound(InData%x_IceF, kind=B8Ki)) LB(1:1) = lbound(InData%x_IceF, kind=B8Ki) UB(1:1) = ubound(InData%x_IceF, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackContState(Buf, InData%x_IceF(i1)) + call IceFloe_PackContState(RF, InData%x_IceF(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_IceF)) + call RegPack(RF, allocated(InData%xd_IceF)) if (allocated(InData%xd_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_IceF, kind=B8Ki), ubound(InData%xd_IceF, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_IceF, kind=B8Ki), ubound(InData%xd_IceF, kind=B8Ki)) LB(1:1) = lbound(InData%xd_IceF, kind=B8Ki) UB(1:1) = ubound(InData%xd_IceF, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) + call IceFloe_PackDiscState(RF, InData%xd_IceF(i1)) end do end if - call RegPack(Buf, allocated(InData%z_IceF)) + call RegPack(RF, allocated(InData%z_IceF)) if (allocated(InData%z_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%z_IceF, kind=B8Ki), ubound(InData%z_IceF, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_IceF, kind=B8Ki), ubound(InData%z_IceF, kind=B8Ki)) LB(1:1) = lbound(InData%z_IceF, kind=B8Ki) UB(1:1) = ubound(InData%z_IceF, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) + call IceFloe_PackConstrState(RF, InData%z_IceF(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_IceF)) + call RegPack(RF, allocated(InData%OtherSt_IceF)) if (allocated(InData%OtherSt_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF, kind=B8Ki), ubound(InData%OtherSt_IceF, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_IceF, kind=B8Ki), ubound(InData%OtherSt_IceF, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_IceF, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_IceF, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) + call IceFloe_PackOtherState(RF, InData%OtherSt_IceF(i1)) end do end if - call RegPack(Buf, allocated(InData%u_IceF)) + call RegPack(RF, allocated(InData%u_IceF)) if (allocated(InData%u_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%u_IceF, kind=B8Ki), ubound(InData%u_IceF, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_IceF, kind=B8Ki), ubound(InData%u_IceF, kind=B8Ki)) LB(1:1) = lbound(InData%u_IceF, kind=B8Ki) UB(1:1) = ubound(InData%u_IceF, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackInput(Buf, InData%u_IceF(i1)) + call IceFloe_PackInput(RF, InData%u_IceF(i1)) end do end if - call RegPack(Buf, allocated(InData%x_MAP)) + call RegPack(RF, allocated(InData%x_MAP)) if (allocated(InData%x_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%x_MAP, kind=B8Ki), ubound(InData%x_MAP, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_MAP, kind=B8Ki), ubound(InData%x_MAP, kind=B8Ki)) LB(1:1) = lbound(InData%x_MAP, kind=B8Ki) UB(1:1) = ubound(InData%x_MAP, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackContState(Buf, InData%x_MAP(i1)) + call MAP_PackContState(RF, InData%x_MAP(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_MAP)) + call RegPack(RF, allocated(InData%xd_MAP)) if (allocated(InData%xd_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_MAP, kind=B8Ki), ubound(InData%xd_MAP, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_MAP, kind=B8Ki), ubound(InData%xd_MAP, kind=B8Ki)) LB(1:1) = lbound(InData%xd_MAP, kind=B8Ki) UB(1:1) = ubound(InData%xd_MAP, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) + call MAP_PackDiscState(RF, InData%xd_MAP(i1)) end do end if - call RegPack(Buf, allocated(InData%z_MAP)) + call RegPack(RF, allocated(InData%z_MAP)) if (allocated(InData%z_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%z_MAP, kind=B8Ki), ubound(InData%z_MAP, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_MAP, kind=B8Ki), ubound(InData%z_MAP, kind=B8Ki)) LB(1:1) = lbound(InData%z_MAP, kind=B8Ki) UB(1:1) = ubound(InData%z_MAP, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackConstrState(Buf, InData%z_MAP(i1)) + call MAP_PackConstrState(RF, InData%z_MAP(i1)) end do end if - call RegPack(Buf, allocated(InData%u_MAP)) + call RegPack(RF, allocated(InData%u_MAP)) if (allocated(InData%u_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%u_MAP, kind=B8Ki), ubound(InData%u_MAP, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_MAP, kind=B8Ki), ubound(InData%u_MAP, kind=B8Ki)) LB(1:1) = lbound(InData%u_MAP, kind=B8Ki) UB(1:1) = ubound(InData%u_MAP, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackInput(Buf, InData%u_MAP(i1)) + call MAP_PackInput(RF, InData%u_MAP(i1)) end do end if - call RegPack(Buf, allocated(InData%x_FEAM)) + call RegPack(RF, allocated(InData%x_FEAM)) if (allocated(InData%x_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%x_FEAM, kind=B8Ki), ubound(InData%x_FEAM, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_FEAM, kind=B8Ki), ubound(InData%x_FEAM, kind=B8Ki)) LB(1:1) = lbound(InData%x_FEAM, kind=B8Ki) UB(1:1) = ubound(InData%x_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackContState(Buf, InData%x_FEAM(i1)) + call FEAM_PackContState(RF, InData%x_FEAM(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_FEAM)) + call RegPack(RF, allocated(InData%xd_FEAM)) if (allocated(InData%xd_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM, kind=B8Ki), ubound(InData%xd_FEAM, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_FEAM, kind=B8Ki), ubound(InData%xd_FEAM, kind=B8Ki)) LB(1:1) = lbound(InData%xd_FEAM, kind=B8Ki) UB(1:1) = ubound(InData%xd_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) + call FEAM_PackDiscState(RF, InData%xd_FEAM(i1)) end do end if - call RegPack(Buf, allocated(InData%z_FEAM)) + call RegPack(RF, allocated(InData%z_FEAM)) if (allocated(InData%z_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%z_FEAM, kind=B8Ki), ubound(InData%z_FEAM, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_FEAM, kind=B8Ki), ubound(InData%z_FEAM, kind=B8Ki)) LB(1:1) = lbound(InData%z_FEAM, kind=B8Ki) UB(1:1) = ubound(InData%z_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) + call FEAM_PackConstrState(RF, InData%z_FEAM(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_FEAM)) + call RegPack(RF, allocated(InData%OtherSt_FEAM)) if (allocated(InData%OtherSt_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM, kind=B8Ki), ubound(InData%OtherSt_FEAM, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_FEAM, kind=B8Ki), ubound(InData%OtherSt_FEAM, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_FEAM, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) + call FEAM_PackOtherState(RF, InData%OtherSt_FEAM(i1)) end do end if - call RegPack(Buf, allocated(InData%u_FEAM)) + call RegPack(RF, allocated(InData%u_FEAM)) if (allocated(InData%u_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%u_FEAM, kind=B8Ki), ubound(InData%u_FEAM, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_FEAM, kind=B8Ki), ubound(InData%u_FEAM, kind=B8Ki)) LB(1:1) = lbound(InData%u_FEAM, kind=B8Ki) UB(1:1) = ubound(InData%u_FEAM, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackInput(Buf, InData%u_FEAM(i1)) + call FEAM_PackInput(RF, InData%u_FEAM(i1)) end do end if - call RegPack(Buf, allocated(InData%x_MD)) + call RegPack(RF, allocated(InData%x_MD)) if (allocated(InData%x_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_MD, kind=B8Ki), ubound(InData%x_MD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%x_MD, kind=B8Ki), ubound(InData%x_MD, kind=B8Ki)) LB(1:1) = lbound(InData%x_MD, kind=B8Ki) UB(1:1) = ubound(InData%x_MD, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackContState(Buf, InData%x_MD(i1)) + call MD_PackContState(RF, InData%x_MD(i1)) end do end if - call RegPack(Buf, allocated(InData%xd_MD)) + call RegPack(RF, allocated(InData%xd_MD)) if (allocated(InData%xd_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_MD, kind=B8Ki), ubound(InData%xd_MD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xd_MD, kind=B8Ki), ubound(InData%xd_MD, kind=B8Ki)) LB(1:1) = lbound(InData%xd_MD, kind=B8Ki) UB(1:1) = ubound(InData%xd_MD, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackDiscState(Buf, InData%xd_MD(i1)) + call MD_PackDiscState(RF, InData%xd_MD(i1)) end do end if - call RegPack(Buf, allocated(InData%z_MD)) + call RegPack(RF, allocated(InData%z_MD)) if (allocated(InData%z_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_MD, kind=B8Ki), ubound(InData%z_MD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%z_MD, kind=B8Ki), ubound(InData%z_MD, kind=B8Ki)) LB(1:1) = lbound(InData%z_MD, kind=B8Ki) UB(1:1) = ubound(InData%z_MD, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackConstrState(Buf, InData%z_MD(i1)) + call MD_PackConstrState(RF, InData%z_MD(i1)) end do end if - call RegPack(Buf, allocated(InData%OtherSt_MD)) + call RegPack(RF, allocated(InData%OtherSt_MD)) if (allocated(InData%OtherSt_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD, kind=B8Ki), ubound(InData%OtherSt_MD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OtherSt_MD, kind=B8Ki), ubound(InData%OtherSt_MD, kind=B8Ki)) LB(1:1) = lbound(InData%OtherSt_MD, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt_MD, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) + call MD_PackOtherState(RF, InData%OtherSt_MD(i1)) end do end if - call RegPack(Buf, allocated(InData%u_MD)) + call RegPack(RF, allocated(InData%u_MD)) if (allocated(InData%u_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_MD, kind=B8Ki), ubound(InData%u_MD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_MD, kind=B8Ki), ubound(InData%u_MD, kind=B8Ki)) LB(1:1) = lbound(InData%u_MD, kind=B8Ki) UB(1:1) = ubound(InData%u_MD, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackInput(Buf, InData%u_MD(i1)) + call MD_PackInput(RF, InData%u_MD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackLinStateSave(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackLinStateSave(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_LinStateSave), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackContState(Buf, OutData%x_IceD(i1,i2)) ! x_IceD + call IceD_UnpackContState(RF, OutData%x_IceD(i1,i2)) ! x_IceD end do end do end if if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackDiscState(Buf, OutData%xd_IceD(i1,i2)) ! xd_IceD + call IceD_UnpackDiscState(RF, OutData%xd_IceD(i1,i2)) ! xd_IceD end do end do end if if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackConstrState(Buf, OutData%z_IceD(i1,i2)) ! z_IceD + call IceD_UnpackConstrState(RF, OutData%z_IceD(i1,i2)) ! z_IceD end do end do end if if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackOtherState(Buf, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD + call IceD_UnpackOtherState(RF, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD end do end do end if if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackInput(Buf, OutData%u_IceD(i1,i2)) ! u_IceD + call IceD_UnpackInput(RF, OutData%u_IceD(i1,i2)) ! u_IceD end do end do end if if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackContState(Buf, OutData%x_BD(i1,i2)) ! x_BD + call BD_UnpackContState(RF, OutData%x_BD(i1,i2)) ! x_BD end do end do end if if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackDiscState(Buf, OutData%xd_BD(i1,i2)) ! xd_BD + call BD_UnpackDiscState(RF, OutData%xd_BD(i1,i2)) ! xd_BD end do end do end if if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackConstrState(Buf, OutData%z_BD(i1,i2)) ! z_BD + call BD_UnpackConstrState(RF, OutData%z_BD(i1,i2)) ! z_BD end do end do end if if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackOtherState(Buf, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD + call BD_UnpackOtherState(RF, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD end do end do end if if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackInput(Buf, OutData%u_BD(i1,i2)) ! u_BD + call BD_UnpackInput(RF, OutData%u_BD(i1,i2)) ! u_BD end do end do end if if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackContState(Buf, OutData%x_ED(i1)) ! x_ED + call ED_UnpackContState(RF, OutData%x_ED(i1)) ! x_ED end do end if if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackDiscState(Buf, OutData%xd_ED(i1)) ! xd_ED + call ED_UnpackDiscState(RF, OutData%xd_ED(i1)) ! xd_ED end do end if if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackConstrState(Buf, OutData%z_ED(i1)) ! z_ED + call ED_UnpackConstrState(RF, OutData%z_ED(i1)) ! z_ED end do end if if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackOtherState(Buf, OutData%OtherSt_ED(i1)) ! OtherSt_ED + call ED_UnpackOtherState(RF, OutData%OtherSt_ED(i1)) ! OtherSt_ED end do end if if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackInput(Buf, OutData%u_ED(i1)) ! u_ED + call ED_UnpackInput(RF, OutData%u_ED(i1)) ! u_ED end do end if if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackContState(Buf, OutData%x_SrvD(i1)) ! x_SrvD + call SrvD_UnpackContState(RF, OutData%x_SrvD(i1)) ! x_SrvD end do end if if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(Buf, OutData%xd_SrvD(i1)) ! xd_SrvD + call SrvD_UnpackDiscState(RF, OutData%xd_SrvD(i1)) ! xd_SrvD end do end if if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(Buf, OutData%z_SrvD(i1)) ! z_SrvD + call SrvD_UnpackConstrState(RF, OutData%z_SrvD(i1)) ! z_SrvD end do end if if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(Buf, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD + call SrvD_UnpackOtherState(RF, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD end do end if if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackInput(Buf, OutData%u_SrvD(i1)) ! u_SrvD + call SrvD_UnpackInput(RF, OutData%u_SrvD(i1)) ! u_SrvD end do end if if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackContState(Buf, OutData%x_AD(i1)) ! x_AD + call AD_UnpackContState(RF, OutData%x_AD(i1)) ! x_AD end do end if if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackDiscState(Buf, OutData%xd_AD(i1)) ! xd_AD + call AD_UnpackDiscState(RF, OutData%xd_AD(i1)) ! xd_AD end do end if if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackConstrState(Buf, OutData%z_AD(i1)) ! z_AD + call AD_UnpackConstrState(RF, OutData%z_AD(i1)) ! z_AD end do end if if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackOtherState(Buf, OutData%OtherSt_AD(i1)) ! OtherSt_AD + call AD_UnpackOtherState(RF, OutData%OtherSt_AD(i1)) ! OtherSt_AD end do end if if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackInput(Buf, OutData%u_AD(i1)) ! u_AD + call AD_UnpackInput(RF, OutData%u_AD(i1)) ! u_AD end do end if if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(Buf, OutData%x_IfW(i1)) ! x_IfW + call InflowWind_UnpackContState(RF, OutData%x_IfW(i1)) ! x_IfW end do end if if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(Buf, OutData%xd_IfW(i1)) ! xd_IfW + call InflowWind_UnpackDiscState(RF, OutData%xd_IfW(i1)) ! xd_IfW end do end if if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(Buf, OutData%z_IfW(i1)) ! z_IfW + call InflowWind_UnpackConstrState(RF, OutData%z_IfW(i1)) ! z_IfW end do end if if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(Buf, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW + call InflowWind_UnpackOtherState(RF, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW end do end if if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(Buf, OutData%u_IfW(i1)) ! u_IfW + call InflowWind_UnpackInput(RF, OutData%u_IfW(i1)) ! u_IfW end do end if if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackContState(Buf, OutData%x_SD(i1)) ! x_SD + call SD_UnpackContState(RF, OutData%x_SD(i1)) ! x_SD end do end if if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackDiscState(Buf, OutData%xd_SD(i1)) ! xd_SD + call SD_UnpackDiscState(RF, OutData%xd_SD(i1)) ! xd_SD end do end if if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackConstrState(Buf, OutData%z_SD(i1)) ! z_SD + call SD_UnpackConstrState(RF, OutData%z_SD(i1)) ! z_SD end do end if if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackOtherState(Buf, OutData%OtherSt_SD(i1)) ! OtherSt_SD + call SD_UnpackOtherState(RF, OutData%OtherSt_SD(i1)) ! OtherSt_SD end do end if if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackInput(Buf, OutData%u_SD(i1)) ! u_SD + call SD_UnpackInput(RF, OutData%u_SD(i1)) ! u_SD end do end if if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(Buf, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm + call ExtPtfm_UnpackContState(RF, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm end do end if if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(Buf, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm + call ExtPtfm_UnpackDiscState(RF, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm end do end if if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(Buf, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm + call ExtPtfm_UnpackConstrState(RF, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm end do end if if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm + call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm end do end if if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(Buf, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm + call ExtPtfm_UnpackInput(RF, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm end do end if if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(Buf, OutData%x_HD(i1)) ! x_HD + call HydroDyn_UnpackContState(RF, OutData%x_HD(i1)) ! x_HD end do end if if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(Buf, OutData%xd_HD(i1)) ! xd_HD + call HydroDyn_UnpackDiscState(RF, OutData%xd_HD(i1)) ! xd_HD end do end if if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(Buf, OutData%z_HD(i1)) ! z_HD + call HydroDyn_UnpackConstrState(RF, OutData%z_HD(i1)) ! z_HD end do end if if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt_HD(i1)) ! OtherSt_HD + call HydroDyn_UnpackOtherState(RF, OutData%OtherSt_HD(i1)) ! OtherSt_HD end do end if if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(Buf, OutData%u_HD(i1)) ! u_HD + call HydroDyn_UnpackInput(RF, OutData%u_HD(i1)) ! u_HD end do end if if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(Buf, OutData%x_IceF(i1)) ! x_IceF + call IceFloe_UnpackContState(RF, OutData%x_IceF(i1)) ! x_IceF end do end if if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(Buf, OutData%xd_IceF(i1)) ! xd_IceF + call IceFloe_UnpackDiscState(RF, OutData%xd_IceF(i1)) ! xd_IceF end do end if if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(Buf, OutData%z_IceF(i1)) ! z_IceF + call IceFloe_UnpackConstrState(RF, OutData%z_IceF(i1)) ! z_IceF end do end if if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(Buf, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF + call IceFloe_UnpackOtherState(RF, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF end do end if if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(Buf, OutData%u_IceF(i1)) ! u_IceF + call IceFloe_UnpackInput(RF, OutData%u_IceF(i1)) ! u_IceF end do end if if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackContState(Buf, OutData%x_MAP(i1)) ! x_MAP + call MAP_UnpackContState(RF, OutData%x_MAP(i1)) ! x_MAP end do end if if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(Buf, OutData%xd_MAP(i1)) ! xd_MAP + call MAP_UnpackDiscState(RF, OutData%xd_MAP(i1)) ! xd_MAP end do end if if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(Buf, OutData%z_MAP(i1)) ! z_MAP + call MAP_UnpackConstrState(RF, OutData%z_MAP(i1)) ! z_MAP end do end if if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackInput(Buf, OutData%u_MAP(i1)) ! u_MAP + call MAP_UnpackInput(RF, OutData%u_MAP(i1)) ! u_MAP end do end if if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackContState(Buf, OutData%x_FEAM(i1)) ! x_FEAM + call FEAM_UnpackContState(RF, OutData%x_FEAM(i1)) ! x_FEAM end do end if if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(Buf, OutData%xd_FEAM(i1)) ! xd_FEAM + call FEAM_UnpackDiscState(RF, OutData%xd_FEAM(i1)) ! xd_FEAM end do end if if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(Buf, OutData%z_FEAM(i1)) ! z_FEAM + call FEAM_UnpackConstrState(RF, OutData%z_FEAM(i1)) ! z_FEAM end do end if if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(Buf, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM + call FEAM_UnpackOtherState(RF, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM end do end if if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackInput(Buf, OutData%u_FEAM(i1)) ! u_FEAM + call FEAM_UnpackInput(RF, OutData%u_FEAM(i1)) ! u_FEAM end do end if if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackContState(Buf, OutData%x_MD(i1)) ! x_MD + call MD_UnpackContState(RF, OutData%x_MD(i1)) ! x_MD end do end if if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackDiscState(Buf, OutData%xd_MD(i1)) ! xd_MD + call MD_UnpackDiscState(RF, OutData%xd_MD(i1)) ! xd_MD end do end if if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackConstrState(Buf, OutData%z_MD(i1)) ! z_MD + call MD_UnpackConstrState(RF, OutData%z_MD(i1)) ! z_MD end do end if if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackOtherState(Buf, OutData%OtherSt_MD(i1)) ! OtherSt_MD + call MD_UnpackOtherState(RF, OutData%OtherSt_MD(i1)) ! OtherSt_MD end do end if if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackInput(Buf, OutData%u_MD(i1)) ! u_MD + call MD_UnpackInput(RF, OutData%u_MD(i1)) ! u_MD end do end if end subroutine @@ -5749,563 +5266,84 @@ subroutine FAST_DestroyLinType(LinTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackLinType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackLinType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_LinType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Names_u)) - if (allocated(InData%Names_u)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_u, kind=B8Ki), ubound(InData%Names_u, kind=B8Ki)) - call RegPack(Buf, InData%Names_u) - end if - call RegPack(Buf, allocated(InData%Names_y)) - if (allocated(InData%Names_y)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_y, kind=B8Ki), ubound(InData%Names_y, kind=B8Ki)) - call RegPack(Buf, InData%Names_y) - end if - call RegPack(Buf, allocated(InData%Names_x)) - if (allocated(InData%Names_x)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_x, kind=B8Ki), ubound(InData%Names_x, kind=B8Ki)) - call RegPack(Buf, InData%Names_x) - end if - call RegPack(Buf, allocated(InData%Names_xd)) - if (allocated(InData%Names_xd)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_xd, kind=B8Ki), ubound(InData%Names_xd, kind=B8Ki)) - call RegPack(Buf, InData%Names_xd) - end if - call RegPack(Buf, allocated(InData%Names_z)) - if (allocated(InData%Names_z)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_z, kind=B8Ki), ubound(InData%Names_z, kind=B8Ki)) - call RegPack(Buf, InData%Names_z) - end if - call RegPack(Buf, allocated(InData%op_u)) - if (allocated(InData%op_u)) then - call RegPackBounds(Buf, 1, lbound(InData%op_u, kind=B8Ki), ubound(InData%op_u, kind=B8Ki)) - call RegPack(Buf, InData%op_u) - end if - call RegPack(Buf, allocated(InData%op_y)) - if (allocated(InData%op_y)) then - call RegPackBounds(Buf, 1, lbound(InData%op_y, kind=B8Ki), ubound(InData%op_y, kind=B8Ki)) - call RegPack(Buf, InData%op_y) - end if - call RegPack(Buf, allocated(InData%op_x)) - if (allocated(InData%op_x)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x, kind=B8Ki), ubound(InData%op_x, kind=B8Ki)) - call RegPack(Buf, InData%op_x) - end if - call RegPack(Buf, allocated(InData%op_dx)) - if (allocated(InData%op_dx)) then - call RegPackBounds(Buf, 1, lbound(InData%op_dx, kind=B8Ki), ubound(InData%op_dx, kind=B8Ki)) - call RegPack(Buf, InData%op_dx) - end if - call RegPack(Buf, allocated(InData%op_xd)) - if (allocated(InData%op_xd)) then - call RegPackBounds(Buf, 1, lbound(InData%op_xd, kind=B8Ki), ubound(InData%op_xd, kind=B8Ki)) - call RegPack(Buf, InData%op_xd) - end if - call RegPack(Buf, allocated(InData%op_z)) - if (allocated(InData%op_z)) then - call RegPackBounds(Buf, 1, lbound(InData%op_z, kind=B8Ki), ubound(InData%op_z, kind=B8Ki)) - call RegPack(Buf, InData%op_z) - end if - call RegPack(Buf, allocated(InData%op_x_eig_mag)) - if (allocated(InData%op_x_eig_mag)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag, kind=B8Ki), ubound(InData%op_x_eig_mag, kind=B8Ki)) - call RegPack(Buf, InData%op_x_eig_mag) - end if - call RegPack(Buf, allocated(InData%op_x_eig_phase)) - if (allocated(InData%op_x_eig_phase)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase, kind=B8Ki), ubound(InData%op_x_eig_phase, kind=B8Ki)) - call RegPack(Buf, InData%op_x_eig_phase) - end if - call RegPack(Buf, allocated(InData%Use_u)) - if (allocated(InData%Use_u)) then - call RegPackBounds(Buf, 1, lbound(InData%Use_u, kind=B8Ki), ubound(InData%Use_u, kind=B8Ki)) - call RegPack(Buf, InData%Use_u) - end if - call RegPack(Buf, allocated(InData%Use_y)) - if (allocated(InData%Use_y)) then - call RegPackBounds(Buf, 1, lbound(InData%Use_y, kind=B8Ki), ubound(InData%Use_y, kind=B8Ki)) - call RegPack(Buf, InData%Use_y) - end if - call RegPack(Buf, allocated(InData%A)) - if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A, kind=B8Ki), ubound(InData%A, kind=B8Ki)) - call RegPack(Buf, InData%A) - end if - call RegPack(Buf, allocated(InData%B)) - if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B, kind=B8Ki), ubound(InData%B, kind=B8Ki)) - call RegPack(Buf, InData%B) - end if - call RegPack(Buf, allocated(InData%C)) - if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C, kind=B8Ki), ubound(InData%C, kind=B8Ki)) - call RegPack(Buf, InData%C) - end if - call RegPack(Buf, allocated(InData%D)) - if (allocated(InData%D)) then - call RegPackBounds(Buf, 2, lbound(InData%D, kind=B8Ki), ubound(InData%D, kind=B8Ki)) - call RegPack(Buf, InData%D) - end if - call RegPack(Buf, allocated(InData%StateRotation)) - if (allocated(InData%StateRotation)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRotation, kind=B8Ki), ubound(InData%StateRotation, kind=B8Ki)) - call RegPack(Buf, InData%StateRotation) - end if - call RegPack(Buf, allocated(InData%StateRel_x)) - if (allocated(InData%StateRel_x)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRel_x, kind=B8Ki), ubound(InData%StateRel_x, kind=B8Ki)) - call RegPack(Buf, InData%StateRel_x) - end if - call RegPack(Buf, allocated(InData%StateRel_xdot)) - if (allocated(InData%StateRel_xdot)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot, kind=B8Ki), ubound(InData%StateRel_xdot, kind=B8Ki)) - call RegPack(Buf, InData%StateRel_xdot) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_z)) - if (allocated(InData%RotFrame_z)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z, kind=B8Ki), ubound(InData%RotFrame_z, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_z) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - call RegPack(Buf, InData%SizeLin) - call RegPack(Buf, InData%LinStartIndx) - call RegPack(Buf, InData%NumOutputs) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackLinType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Names_u) + call RegPackAlloc(RF, InData%Names_y) + call RegPackAlloc(RF, InData%Names_x) + call RegPackAlloc(RF, InData%Names_xd) + call RegPackAlloc(RF, InData%Names_z) + call RegPackAlloc(RF, InData%op_u) + call RegPackAlloc(RF, InData%op_y) + call RegPackAlloc(RF, InData%op_x) + call RegPackAlloc(RF, InData%op_dx) + call RegPackAlloc(RF, InData%op_xd) + call RegPackAlloc(RF, InData%op_z) + call RegPackAlloc(RF, InData%op_x_eig_mag) + call RegPackAlloc(RF, InData%op_x_eig_phase) + call RegPackAlloc(RF, InData%Use_u) + call RegPackAlloc(RF, InData%Use_y) + call RegPackAlloc(RF, InData%A) + call RegPackAlloc(RF, InData%B) + call RegPackAlloc(RF, InData%C) + call RegPackAlloc(RF, InData%D) + call RegPackAlloc(RF, InData%StateRotation) + call RegPackAlloc(RF, InData%StateRel_x) + call RegPackAlloc(RF, InData%StateRel_xdot) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_z) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPack(RF, InData%SizeLin) + call RegPack(RF, InData%LinStartIndx) + call RegPack(RF, InData%NumOutputs) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_LinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Names_u)) deallocate(OutData%Names_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Names_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Names_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Names_y)) deallocate(OutData%Names_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Names_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Names_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Names_x)) deallocate(OutData%Names_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Names_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Names_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Names_xd)) deallocate(OutData%Names_xd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Names_xd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Names_xd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Names_z)) deallocate(OutData%Names_z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Names_z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Names_z) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_u)) deallocate(OutData%op_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_y)) deallocate(OutData%op_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_x)) deallocate(OutData%op_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_dx)) deallocate(OutData%op_dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_xd)) deallocate(OutData%op_xd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_xd(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_xd) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_z)) deallocate(OutData%op_z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_z) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_x_eig_mag)) deallocate(OutData%op_x_eig_mag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_x_eig_mag(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_x_eig_mag) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%op_x_eig_phase)) deallocate(OutData%op_x_eig_phase) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_x_eig_phase(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%op_x_eig_phase) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Use_u)) deallocate(OutData%Use_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Use_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Use_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Use_y)) deallocate(OutData%Use_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Use_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Use_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%A)) deallocate(OutData%A) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%A) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%B)) deallocate(OutData%B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%B) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C)) deallocate(OutData%C) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D)) deallocate(OutData%D) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StateRotation)) deallocate(OutData%StateRotation) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StateRotation(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StateRotation) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StateRel_x)) deallocate(OutData%StateRel_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StateRel_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StateRel_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StateRel_xdot)) deallocate(OutData%StateRel_xdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StateRel_xdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_z)) deallocate(OutData%RotFrame_z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_z) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SizeLin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LinStartIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOutputs) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Names_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Names_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_xd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_x_eig_mag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%op_x_eig_phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Use_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Use_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%A); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%B); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRotation); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRel_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StateRel_xdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SizeLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LinStartIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOutputs); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) @@ -6361,47 +5399,45 @@ subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackModLinType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackModLinType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_ModLinType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModLinType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Instance)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Instance)) if (allocated(InData%Instance)) then - call RegPackBounds(Buf, 1, lbound(InData%Instance, kind=B8Ki), ubound(InData%Instance, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Instance, kind=B8Ki), ubound(InData%Instance, kind=B8Ki)) LB(1:1) = lbound(InData%Instance, kind=B8Ki) UB(1:1) = ubound(InData%Instance, kind=B8Ki) do i1 = LB(1), UB(1) - call FAST_PackLinType(Buf, InData%Instance(i1)) + call FAST_PackLinType(RF, InData%Instance(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackModLinType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackModLinType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_ModLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%Instance)) deallocate(OutData%Instance) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Instance(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FAST_UnpackLinType(Buf, OutData%Instance(i1)) ! Instance + call FAST_UnpackLinType(RF, OutData%Instance(i1)) ! Instance end do end if end subroutine @@ -6455,44 +5491,41 @@ subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackLinFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackLinFileType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_LinFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinFileType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%Modules, kind=B8Ki) UB(1:1) = ubound(InData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call FAST_PackModLinType(Buf, InData%Modules(i1)) + call FAST_PackModLinType(RF, InData%Modules(i1)) end do - call FAST_PackLinType(Buf, InData%Glue) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%Azimuth) - call RegPack(Buf, InData%WindSpeed) - if (RegCheckErr(Buf, RoutineName)) return + call FAST_PackLinType(RF, InData%Glue) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%Azimuth) + call RegPack(RF, InData%WindSpeed) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackLinFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackLinFileType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_LinFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%Modules, kind=B8Ki) UB(1:1) = ubound(OutData%Modules, kind=B8Ki) do i1 = LB(1), UB(1) - call FAST_UnpackModLinType(Buf, OutData%Modules(i1)) ! Modules + call FAST_UnpackModLinType(RF, OutData%Modules(i1)) ! Modules end do - call FAST_UnpackLinType(Buf, OutData%Glue) ! Glue - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Azimuth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindSpeed) - if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackLinType(RF, OutData%Glue) ! Glue + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Azimuth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindSpeed); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg) @@ -6614,157 +5647,48 @@ subroutine FAST_DestroyMiscLinType(MiscLinTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackMiscLinType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackMiscLinType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_MiscLinType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMiscLinType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%LinTimes)) - if (allocated(InData%LinTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%LinTimes, kind=B8Ki), ubound(InData%LinTimes, kind=B8Ki)) - call RegPack(Buf, InData%LinTimes) - end if - call RegPack(Buf, InData%CopyOP_CtrlCode) - call RegPack(Buf, allocated(InData%AzimTarget)) - if (allocated(InData%AzimTarget)) then - call RegPackBounds(Buf, 1, lbound(InData%AzimTarget, kind=B8Ki), ubound(InData%AzimTarget, kind=B8Ki)) - call RegPack(Buf, InData%AzimTarget) - end if - call RegPack(Buf, InData%IsConverged) - call RegPack(Buf, InData%FoundSteady) - call RegPack(Buf, InData%ForceLin) - call RegPack(Buf, InData%n_rot) - call RegPack(Buf, InData%AzimIndx) - call RegPack(Buf, InData%NextLinTimeIndx) - call RegPack(Buf, allocated(InData%Psi)) - if (allocated(InData%Psi)) then - call RegPackBounds(Buf, 1, lbound(InData%Psi, kind=B8Ki), ubound(InData%Psi, kind=B8Ki)) - call RegPack(Buf, InData%Psi) - end if - call RegPack(Buf, allocated(InData%y_interp)) - if (allocated(InData%y_interp)) then - call RegPackBounds(Buf, 1, lbound(InData%y_interp, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) - call RegPack(Buf, InData%y_interp) - end if - call RegPack(Buf, allocated(InData%y_ref)) - if (allocated(InData%y_ref)) then - call RegPackBounds(Buf, 1, lbound(InData%y_ref, kind=B8Ki), ubound(InData%y_ref, kind=B8Ki)) - call RegPack(Buf, InData%y_ref) - end if - call RegPack(Buf, allocated(InData%Y_prevRot)) - if (allocated(InData%Y_prevRot)) then - call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot, kind=B8Ki), ubound(InData%Y_prevRot, kind=B8Ki)) - call RegPack(Buf, InData%Y_prevRot) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackMiscLinType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%LinTimes) + call RegPack(RF, InData%CopyOP_CtrlCode) + call RegPackAlloc(RF, InData%AzimTarget) + call RegPack(RF, InData%IsConverged) + call RegPack(RF, InData%FoundSteady) + call RegPack(RF, InData%ForceLin) + call RegPack(RF, InData%n_rot) + call RegPack(RF, InData%AzimIndx) + call RegPack(RF, InData%NextLinTimeIndx) + call RegPackAlloc(RF, InData%Psi) + call RegPackAlloc(RF, InData%y_interp) + call RegPackAlloc(RF, InData%y_ref) + call RegPackAlloc(RF, InData%Y_prevRot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMiscLinType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_MiscLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%LinTimes)) deallocate(OutData%LinTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%CopyOP_CtrlCode) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AzimTarget)) deallocate(OutData%AzimTarget) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AzimTarget(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AzimTarget) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%IsConverged) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FoundSteady) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ForceLin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%n_rot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AzimIndx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NextLinTimeIndx) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Psi)) deallocate(OutData%Psi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Psi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Psi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%y_ref)) deallocate(OutData%y_ref) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y_ref(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%y_ref) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Y_prevRot)) deallocate(OutData%Y_prevRot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Y_prevRot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%LinTimes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CopyOP_CtrlCode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AzimTarget); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IsConverged); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FoundSteady); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ForceLin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_rot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AzimIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NextLinTimeIndx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Psi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_interp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y_ref); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Y_prevRot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) @@ -6891,154 +5815,73 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackOutputFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackOutputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_OutputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%TimeData)) - if (allocated(InData%TimeData)) then - call RegPackBounds(Buf, 1, lbound(InData%TimeData, kind=B8Ki), ubound(InData%TimeData, kind=B8Ki)) - call RegPack(Buf, InData%TimeData) - end if - call RegPack(Buf, allocated(InData%AllOutData)) - if (allocated(InData%AllOutData)) then - call RegPackBounds(Buf, 2, lbound(InData%AllOutData, kind=B8Ki), ubound(InData%AllOutData, kind=B8Ki)) - call RegPack(Buf, InData%AllOutData) - end if - call RegPack(Buf, InData%n_Out) - call RegPack(Buf, InData%NOutSteps) - call RegPack(Buf, InData%numOuts) - call RegPack(Buf, InData%UnOu) - call RegPack(Buf, InData%UnSum) - call RegPack(Buf, InData%UnGra) - call RegPack(Buf, InData%FileDescLines) - call RegPack(Buf, allocated(InData%ChannelNames)) - if (allocated(InData%ChannelNames)) then - call RegPackBounds(Buf, 1, lbound(InData%ChannelNames, kind=B8Ki), ubound(InData%ChannelNames, kind=B8Ki)) - call RegPack(Buf, InData%ChannelNames) - end if - call RegPack(Buf, allocated(InData%ChannelUnits)) - if (allocated(InData%ChannelUnits)) then - call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits, kind=B8Ki), ubound(InData%ChannelUnits, kind=B8Ki)) - call RegPack(Buf, InData%ChannelUnits) - end if + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%TimeData) + call RegPackAlloc(RF, InData%AllOutData) + call RegPack(RF, InData%n_Out) + call RegPack(RF, InData%NOutSteps) + call RegPack(RF, InData%numOuts) + call RegPack(RF, InData%UnOu) + call RegPack(RF, InData%UnSum) + call RegPack(RF, InData%UnGra) + call RegPack(RF, InData%FileDescLines) + call RegPackAlloc(RF, InData%ChannelNames) + call RegPackAlloc(RF, InData%ChannelUnits) LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) + call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) end do - call RegPack(Buf, InData%Module_Abrev) - call RegPack(Buf, InData%WriteThisStep) - call RegPack(Buf, InData%VTK_count) - call RegPack(Buf, InData%VTK_LastWaveIndx) - call FAST_PackLinFileType(Buf, InData%Lin) - call RegPack(Buf, InData%ActualChanLen) - call FAST_PackLinStateSave(Buf, InData%op) - call RegPack(Buf, InData%DriverWriteOutput) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%Module_Abrev) + call RegPack(RF, InData%WriteThisStep) + call RegPack(RF, InData%VTK_count) + call RegPack(RF, InData%VTK_LastWaveIndx) + call FAST_PackLinFileType(RF, InData%Lin) + call RegPack(RF, InData%ActualChanLen) + call FAST_PackLinStateSave(RF, InData%op) + call RegPack(RF, InData%DriverWriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackOutputFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackOutputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_OutputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TimeData) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOutData) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%n_Out) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NOutSteps) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%numOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnOu) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnGra) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FileDescLines) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ChannelNames)) deallocate(OutData%ChannelNames) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChannelNames(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ChannelNames) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ChannelUnits)) deallocate(OutData%ChannelUnits) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChannelUnits(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ChannelUnits) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%TimeData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOutData); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%n_Out); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutSteps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%numOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnGra); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChannelNames); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ChannelUnits); if (RegCheckErr(RF, RoutineName)) return LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver + call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver end do - call RegUnpack(Buf, OutData%Module_Abrev) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WriteThisStep) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_count) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VTK_LastWaveIndx) - if (RegCheckErr(Buf, RoutineName)) return - call FAST_UnpackLinFileType(Buf, OutData%Lin) ! Lin - call RegUnpack(Buf, OutData%ActualChanLen) - if (RegCheckErr(Buf, RoutineName)) return - call FAST_UnpackLinStateSave(Buf, OutData%op) ! op - call RegUnpack(Buf, OutData%DriverWriteOutput) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%Module_Abrev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WriteThisStep); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_count); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VTK_LastWaveIndx); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackLinFileType(RF, OutData%Lin) ! Lin + call RegUnpack(RF, OutData%ActualChanLen); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackLinStateSave(RF, OutData%op) ! op + call RegUnpack(RF, OutData%DriverWriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7329,280 +6172,245 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackIceDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackIceDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%x)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) LB(1:2) = lbound(InData%x, kind=B8Ki) UB(1:2) = ubound(InData%x, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackContState(Buf, InData%x(i1,i2)) + call IceD_PackContState(RF, InData%x(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%xd)) + call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(Buf, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) LB(1:2) = lbound(InData%xd, kind=B8Ki) UB(1:2) = ubound(InData%xd, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackDiscState(Buf, InData%xd(i1,i2)) + call IceD_PackDiscState(RF, InData%xd(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%z)) + call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) LB(1:2) = lbound(InData%z, kind=B8Ki) UB(1:2) = ubound(InData%z, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackConstrState(Buf, InData%z(i1,i2)) + call IceD_PackConstrState(RF, InData%z(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%OtherSt)) + call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + call IceD_PackOtherState(RF, InData%OtherSt(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%p)) + call RegPack(RF, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(Buf, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) LB(1:1) = lbound(InData%p, kind=B8Ki) UB(1:1) = ubound(InData%p, kind=B8Ki) do i1 = LB(1), UB(1) - call IceD_PackParam(Buf, InData%p(i1)) + call IceD_PackParam(RF, InData%p(i1)) end do end if - call RegPack(Buf, allocated(InData%u)) + call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) LB(1:1) = lbound(InData%u, kind=B8Ki) UB(1:1) = ubound(InData%u, kind=B8Ki) do i1 = LB(1), UB(1) - call IceD_PackInput(Buf, InData%u(i1)) + call IceD_PackInput(RF, InData%u(i1)) end do end if - call RegPack(Buf, allocated(InData%y)) + call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) LB(1:1) = lbound(InData%y, kind=B8Ki) UB(1:1) = ubound(InData%y, kind=B8Ki) do i1 = LB(1), UB(1) - call IceD_PackOutput(Buf, InData%y(i1)) + call IceD_PackOutput(RF, InData%y(i1)) end do end if - call RegPack(Buf, allocated(InData%m)) + call RegPack(RF, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(Buf, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) LB(1:1) = lbound(InData%m, kind=B8Ki) UB(1:1) = ubound(InData%m, kind=B8Ki) do i1 = LB(1), UB(1) - call IceD_PackMisc(Buf, InData%m(i1)) + call IceD_PackMisc(RF, InData%m(i1)) end do end if - call RegPack(Buf, allocated(InData%Input)) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:2) = lbound(InData%Input, kind=B8Ki) UB(1:2) = ubound(InData%Input, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackInput(Buf, InData%Input(i1,i2)) + call IceD_PackInput(RF, InData%Input(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 2, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackIceDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackIceDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + call IceD_UnpackContState(RF, OutData%x(i1,i2)) ! x end do end do end if if (allocated(OutData%xd)) deallocate(OutData%xd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + call IceD_UnpackDiscState(RF, OutData%xd(i1,i2)) ! xd end do end do end if if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + call IceD_UnpackConstrState(RF, OutData%z(i1,i2)) ! z end do end do end if if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + call IceD_UnpackOtherState(RF, OutData%OtherSt(i1,i2)) ! OtherSt end do end do end if if (allocated(OutData%p)) deallocate(OutData%p) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%p(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceD_UnpackParam(Buf, OutData%p(i1)) ! p + call IceD_UnpackParam(RF, OutData%p(i1)) ! p end do end if if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceD_UnpackInput(Buf, OutData%u(i1)) ! u + call IceD_UnpackInput(RF, OutData%u(i1)) ! u end do end if if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceD_UnpackOutput(Buf, OutData%y(i1)) ! y + call IceD_UnpackOutput(RF, OutData%y(i1)) ! y end do end if if (allocated(OutData%m)) deallocate(OutData%m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%m(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceD_UnpackMisc(Buf, OutData%m(i1)) ! m + call IceD_UnpackMisc(RF, OutData%m(i1)) ! m end do end if if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + call IceD_UnpackInput(RF, OutData%Input(i1,i2)) ! Input end do end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7947,332 +6755,293 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackBeamDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackBeamDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(BeamDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%x)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(Buf, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) LB(1:2) = lbound(InData%x, kind=B8Ki) UB(1:2) = ubound(InData%x, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackContState(Buf, InData%x(i1,i2)) + call BD_PackContState(RF, InData%x(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%xd)) + call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(Buf, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) LB(1:2) = lbound(InData%xd, kind=B8Ki) UB(1:2) = ubound(InData%xd, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackDiscState(Buf, InData%xd(i1,i2)) + call BD_PackDiscState(RF, InData%xd(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%z)) + call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(Buf, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) LB(1:2) = lbound(InData%z, kind=B8Ki) UB(1:2) = ubound(InData%z, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackConstrState(Buf, InData%z(i1,i2)) + call BD_PackConstrState(RF, InData%z(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%OtherSt)) + call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + call BD_PackOtherState(RF, InData%OtherSt(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%p)) + call RegPack(RF, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(Buf, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) LB(1:1) = lbound(InData%p, kind=B8Ki) UB(1:1) = ubound(InData%p, kind=B8Ki) do i1 = LB(1), UB(1) - call BD_PackParam(Buf, InData%p(i1)) + call BD_PackParam(RF, InData%p(i1)) end do end if - call RegPack(Buf, allocated(InData%u)) + call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) LB(1:1) = lbound(InData%u, kind=B8Ki) UB(1:1) = ubound(InData%u, kind=B8Ki) do i1 = LB(1), UB(1) - call BD_PackInput(Buf, InData%u(i1)) + call BD_PackInput(RF, InData%u(i1)) end do end if - call RegPack(Buf, allocated(InData%y)) + call RegPack(RF, allocated(InData%y)) if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) LB(1:1) = lbound(InData%y, kind=B8Ki) UB(1:1) = ubound(InData%y, kind=B8Ki) do i1 = LB(1), UB(1) - call BD_PackOutput(Buf, InData%y(i1)) + call BD_PackOutput(RF, InData%y(i1)) end do end if - call RegPack(Buf, allocated(InData%m)) + call RegPack(RF, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(Buf, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) LB(1:1) = lbound(InData%m, kind=B8Ki) UB(1:1) = ubound(InData%m, kind=B8Ki) do i1 = LB(1), UB(1) - call BD_PackMisc(Buf, InData%m(i1)) + call BD_PackMisc(RF, InData%m(i1)) end do end if - call RegPack(Buf, allocated(InData%Output)) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 2, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:2) = lbound(InData%Output, kind=B8Ki) UB(1:2) = ubound(InData%Output, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackOutput(Buf, InData%Output(i1,i2)) + call BD_PackOutput(RF, InData%Output(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%y_interp)) + call RegPack(RF, allocated(InData%y_interp)) if (allocated(InData%y_interp)) then - call RegPackBounds(Buf, 1, lbound(InData%y_interp, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y_interp, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) LB(1:1) = lbound(InData%y_interp, kind=B8Ki) UB(1:1) = ubound(InData%y_interp, kind=B8Ki) do i1 = LB(1), UB(1) - call BD_PackOutput(Buf, InData%y_interp(i1)) + call BD_PackOutput(RF, InData%y_interp(i1)) end do end if - call RegPack(Buf, allocated(InData%Input)) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:2) = lbound(InData%Input, kind=B8Ki) UB(1:2) = ubound(InData%Input, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackInput(Buf, InData%Input(i1,i2)) + call BD_PackInput(RF, InData%Input(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 2, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackBeamDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(BeamDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%x)) deallocate(OutData%x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + call BD_UnpackContState(RF, OutData%x(i1,i2)) ! x end do end do end if if (allocated(OutData%xd)) deallocate(OutData%xd) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + call BD_UnpackDiscState(RF, OutData%xd(i1,i2)) ! xd end do end do end if if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + call BD_UnpackConstrState(RF, OutData%z(i1,i2)) ! z end do end do end if if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + call BD_UnpackOtherState(RF, OutData%OtherSt(i1,i2)) ! OtherSt end do end do end if if (allocated(OutData%p)) deallocate(OutData%p) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%p(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackParam(Buf, OutData%p(i1)) ! p + call BD_UnpackParam(RF, OutData%p(i1)) ! p end do end if if (allocated(OutData%u)) deallocate(OutData%u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackInput(Buf, OutData%u(i1)) ! u + call BD_UnpackInput(RF, OutData%u(i1)) ! u end do end if if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackOutput(Buf, OutData%y(i1)) ! y + call BD_UnpackOutput(RF, OutData%y(i1)) ! y end do end if if (allocated(OutData%m)) deallocate(OutData%m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%m(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackMisc(Buf, OutData%m(i1)) ! m + call BD_UnpackMisc(RF, OutData%m(i1)) ! m end do end if if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackOutput(Buf, OutData%Output(i1,i2)) ! Output + call BD_UnpackOutput(RF, OutData%Output(i1,i2)) ! Output end do end do end if if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackOutput(Buf, OutData%y_interp(i1)) ! y_interp + call BD_UnpackOutput(RF, OutData%y_interp(i1)) ! y_interp end do end if if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + call BD_UnpackInput(RF, OutData%Input(i1,i2)) ! Input end do end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -8445,142 +7214,121 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackElastoDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackElastoDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackContState(Buf, InData%x(i1)) + call ED_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackDiscState(Buf, InData%xd(i1)) + call ED_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackConstrState(Buf, InData%z(i1)) + call ED_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackOtherState(Buf, InData%OtherSt(i1)) + call ED_PackOtherState(RF, InData%OtherSt(i1)) end do - call ED_PackParam(Buf, InData%p) - call ED_PackInput(Buf, InData%u) - call ED_PackOutput(Buf, InData%y) - call ED_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Output)) + call ED_PackParam(RF, InData%p) + call ED_PackInput(RF, InData%u) + call ED_PackOutput(RF, InData%y) + call ED_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackOutput(Buf, InData%Output(i1)) + call ED_PackOutput(RF, InData%Output(i1)) end do end if - call ED_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call ED_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_PackInput(Buf, InData%Input(i1)) + call ED_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackElastoDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_UnpackContState(Buf, OutData%x(i1)) ! x + call ED_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_UnpackConstrState(Buf, OutData%z(i1)) ! z + call ED_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call ED_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call ED_UnpackParam(Buf, OutData%p) ! p - call ED_UnpackInput(Buf, OutData%u) ! u - call ED_UnpackOutput(Buf, OutData%y) ! y - call ED_UnpackMisc(Buf, OutData%m) ! m + call ED_UnpackParam(RF, OutData%p) ! p + call ED_UnpackInput(RF, OutData%u) ! u + call ED_UnpackOutput(RF, OutData%y) ! y + call ED_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call ED_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call ED_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call ED_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ED_UnpackInput(Buf, OutData%Input(i1)) ! Input + call ED_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -8753,142 +7501,121 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackServoDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackServoDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(ServoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackContState(Buf, InData%x(i1)) + call SrvD_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackDiscState(Buf, InData%xd(i1)) + call SrvD_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackConstrState(Buf, InData%z(i1)) + call SrvD_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) + call SrvD_PackOtherState(RF, InData%OtherSt(i1)) end do - call SrvD_PackParam(Buf, InData%p) - call SrvD_PackInput(Buf, InData%u) - call SrvD_PackOutput(Buf, InData%y) - call SrvD_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Output)) + call SrvD_PackParam(RF, InData%p) + call SrvD_PackInput(RF, InData%u) + call SrvD_PackOutput(RF, InData%y) + call SrvD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackOutput(Buf, InData%Output(i1)) + call SrvD_PackOutput(RF, InData%Output(i1)) end do end if - call SrvD_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call SrvD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_PackInput(Buf, InData%Input(i1)) + call SrvD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackServoDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackServoDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(ServoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_UnpackContState(Buf, OutData%x(i1)) ! x + call SrvD_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call SrvD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call SrvD_UnpackParam(Buf, OutData%p) ! p - call SrvD_UnpackInput(Buf, OutData%u) ! u - call SrvD_UnpackOutput(Buf, OutData%y) ! y - call SrvD_UnpackMisc(Buf, OutData%m) ! m + call SrvD_UnpackParam(RF, OutData%p) ! p + call SrvD_UnpackInput(RF, OutData%u) ! u + call SrvD_UnpackOutput(RF, OutData%y) ! y + call SrvD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call SrvD_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call SrvD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call SrvD_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call SrvD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9031,116 +7758,97 @@ subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackAeroDyn14_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackAeroDyn14_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(AeroDyn14_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDyn14_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_PackContState(Buf, InData%x(i1)) + call AD14_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_PackDiscState(Buf, InData%xd(i1)) + call AD14_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_PackConstrState(Buf, InData%z(i1)) + call AD14_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_PackOtherState(Buf, InData%OtherSt(i1)) + call AD14_PackOtherState(RF, InData%OtherSt(i1)) end do - call AD14_PackParam(Buf, InData%p) - call AD14_PackInput(Buf, InData%u) - call AD14_PackOutput(Buf, InData%y) - call AD14_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call AD14_PackParam(RF, InData%p) + call AD14_PackInput(RF, InData%u) + call AD14_PackOutput(RF, InData%y) + call AD14_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_PackInput(Buf, InData%Input(i1)) + call AD14_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackAeroDyn14_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(AeroDyn14_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn14_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_UnpackContState(Buf, OutData%x(i1)) ! x + call AD14_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call AD14_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_UnpackConstrState(Buf, OutData%z(i1)) ! z + call AD14_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call AD14_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call AD14_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call AD14_UnpackParam(Buf, OutData%p) ! p - call AD14_UnpackInput(Buf, OutData%u) ! u - call AD14_UnpackOutput(Buf, OutData%y) ! y - call AD14_UnpackMisc(Buf, OutData%m) ! m + call AD14_UnpackParam(RF, OutData%p) ! p + call AD14_UnpackInput(RF, OutData%u) ! u + call AD14_UnpackOutput(RF, OutData%y) ! y + call AD14_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD14_UnpackInput(Buf, OutData%Input(i1)) ! Input + call AD14_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9313,142 +8021,121 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackAeroDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackAeroDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(AeroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackContState(Buf, InData%x(i1)) + call AD_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackDiscState(Buf, InData%xd(i1)) + call AD_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackConstrState(Buf, InData%z(i1)) + call AD_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackOtherState(Buf, InData%OtherSt(i1)) + call AD_PackOtherState(RF, InData%OtherSt(i1)) end do - call AD_PackParam(Buf, InData%p) - call AD_PackInput(Buf, InData%u) - call AD_PackOutput(Buf, InData%y) - call AD_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Output)) + call AD_PackParam(RF, InData%p) + call AD_PackInput(RF, InData%u) + call AD_PackOutput(RF, InData%y) + call AD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackOutput(Buf, InData%Output(i1)) + call AD_PackOutput(RF, InData%Output(i1)) end do end if - call AD_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call AD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_PackInput(Buf, InData%Input(i1)) + call AD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackAeroDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(AeroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_UnpackContState(Buf, OutData%x(i1)) ! x + call AD_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call AD_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call AD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call AD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call AD_UnpackParam(Buf, OutData%p) ! p - call AD_UnpackInput(Buf, OutData%u) ! u - call AD_UnpackOutput(Buf, OutData%y) ! y - call AD_UnpackMisc(Buf, OutData%m) ! m + call AD_UnpackParam(RF, OutData%p) ! p + call AD_UnpackInput(RF, OutData%u) ! u + call AD_UnpackOutput(RF, OutData%y) ! y + call AD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call AD_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call AD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call AD_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call AD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9621,142 +8308,121 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackInflowWind_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackInflowWind_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(InflowWind_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackContState(Buf, InData%x(i1)) + call InflowWind_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(Buf, InData%xd(i1)) + call InflowWind_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(Buf, InData%z(i1)) + call InflowWind_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) + call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) end do - call InflowWind_PackParam(Buf, InData%p) - call InflowWind_PackInput(Buf, InData%u) - call InflowWind_PackOutput(Buf, InData%y) - call InflowWind_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Output)) + call InflowWind_PackParam(RF, InData%p) + call InflowWind_PackInput(RF, InData%u) + call InflowWind_PackOutput(RF, InData%y) + call InflowWind_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackOutput(Buf, InData%Output(i1)) + call InflowWind_PackOutput(RF, InData%Output(i1)) end do end if - call InflowWind_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call InflowWind_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_PackInput(Buf, InData%Input(i1)) + call InflowWind_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackInflowWind_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackInflowWind_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(InflowWind_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(Buf, OutData%x(i1)) ! x + call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(Buf, OutData%z(i1)) ! z + call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call InflowWind_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call InflowWind_UnpackParam(Buf, OutData%p) ! p - call InflowWind_UnpackInput(Buf, OutData%u) ! u - call InflowWind_UnpackOutput(Buf, OutData%y) ! y - call InflowWind_UnpackMisc(Buf, OutData%m) ! m + call InflowWind_UnpackParam(RF, OutData%p) ! p + call InflowWind_UnpackInput(RF, OutData%u) ! u + call InflowWind_UnpackOutput(RF, OutData%y) ! y + call InflowWind_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call InflowWind_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call InflowWind_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call InflowWind_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(Buf, OutData%Input(i1)) ! Input + call InflowWind_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExternalInflow_Data(SrcExternalInflow_DataData, DstExternalInflow_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9803,27 +8469,27 @@ subroutine FAST_DestroyExternalInflow_Data(ExternalInflow_DataData, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackExternalInflow_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackExternalInflow_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExternalInflow_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExternalInflow_Data' - if (Buf%ErrStat >= AbortErrLev) return - call ExtInfw_PackInput(Buf, InData%u) - call ExtInfw_PackOutput(Buf, InData%y) - call ExtInfw_PackParam(Buf, InData%p) - call ExtInfw_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call ExtInfw_PackInput(RF, InData%u) + call ExtInfw_PackOutput(RF, InData%y) + call ExtInfw_PackParam(RF, InData%p) + call ExtInfw_PackMisc(RF, InData%m) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackExternalInflow_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackExternalInflow_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExternalInflow_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternalInflow_Data' - if (Buf%ErrStat /= ErrID_None) return - call ExtInfw_UnpackInput(Buf, OutData%u) ! u - call ExtInfw_UnpackOutput(Buf, OutData%y) ! y - call ExtInfw_UnpackParam(Buf, OutData%p) ! p - call ExtInfw_UnpackMisc(Buf, OutData%m) ! m + if (RF%ErrStat /= ErrID_None) return + call ExtInfw_UnpackInput(RF, OutData%u) ! u + call ExtInfw_UnpackOutput(RF, OutData%y) ! y + call ExtInfw_UnpackParam(RF, OutData%p) ! p + call ExtInfw_UnpackMisc(RF, OutData%m) ! m end subroutine subroutine FAST_CopySCDataEx_Data(SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg) @@ -9865,25 +8531,25 @@ subroutine FAST_DestroySCDataEx_Data(SCDataEx_DataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackSCDataEx_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackSCDataEx_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(SCDataEx_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' - if (Buf%ErrStat >= AbortErrLev) return - call SC_DX_PackInput(Buf, InData%u) - call SC_DX_PackOutput(Buf, InData%y) - call SC_DX_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call SC_DX_PackInput(RF, InData%u) + call SC_DX_PackOutput(RF, InData%y) + call SC_DX_PackParam(RF, InData%p) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackSCDataEx_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackSCDataEx_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(SCDataEx_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSCDataEx_Data' - if (Buf%ErrStat /= ErrID_None) return - call SC_DX_UnpackInput(Buf, OutData%u) ! u - call SC_DX_UnpackOutput(Buf, OutData%y) ! y - call SC_DX_UnpackParam(Buf, OutData%p) ! p + if (RF%ErrStat /= ErrID_None) return + call SC_DX_UnpackInput(RF, OutData%u) ! u + call SC_DX_UnpackOutput(RF, OutData%y) ! y + call SC_DX_UnpackParam(RF, OutData%p) ! p end subroutine subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10056,142 +8722,121 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackSubDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackSubDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(SubDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackContState(Buf, InData%x(i1)) + call SD_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackDiscState(Buf, InData%xd(i1)) + call SD_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackConstrState(Buf, InData%z(i1)) + call SD_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackOtherState(Buf, InData%OtherSt(i1)) + call SD_PackOtherState(RF, InData%OtherSt(i1)) end do - call SD_PackParam(Buf, InData%p) - call SD_PackInput(Buf, InData%u) - call SD_PackOutput(Buf, InData%y) - call SD_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call SD_PackParam(RF, InData%p) + call SD_PackInput(RF, InData%u) + call SD_PackOutput(RF, InData%y) + call SD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackInput(Buf, InData%Input(i1)) + call SD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%Output)) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackOutput(Buf, InData%Output(i1)) + call SD_PackOutput(RF, InData%Output(i1)) end do end if - call SD_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call SD_PackOutput(RF, InData%y_interp) + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackSubDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackSubDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(SubDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_UnpackContState(Buf, OutData%x(i1)) ! x + call SD_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call SD_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call SD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call SD_UnpackParam(Buf, OutData%p) ! p - call SD_UnpackInput(Buf, OutData%u) ! u - call SD_UnpackOutput(Buf, OutData%y) ! y - call SD_UnpackMisc(Buf, OutData%m) ! m + call SD_UnpackParam(RF, OutData%p) ! p + call SD_UnpackInput(RF, OutData%u) ! u + call SD_UnpackOutput(RF, OutData%y) ! y + call SD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call SD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call SD_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call SD_UnpackOutput(Buf, OutData%y_interp) ! y_interp - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call SD_UnpackOutput(RF, OutData%y_interp) ! y_interp + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10334,116 +8979,97 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackExtPtfm_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackExtPtfm_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(ExtPtfm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(Buf, InData%x(i1)) + call ExtPtfm_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) + call ExtPtfm_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(Buf, InData%z(i1)) + call ExtPtfm_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) + call ExtPtfm_PackOtherState(RF, InData%OtherSt(i1)) end do - call ExtPtfm_PackParam(Buf, InData%p) - call ExtPtfm_PackInput(Buf, InData%u) - call ExtPtfm_PackOutput(Buf, InData%y) - call ExtPtfm_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call ExtPtfm_PackParam(RF, InData%p) + call ExtPtfm_PackInput(RF, InData%u) + call ExtPtfm_PackOutput(RF, InData%y) + call ExtPtfm_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(Buf, InData%Input(i1)) + call ExtPtfm_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackExtPtfm_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(ExtPtfm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(Buf, OutData%x(i1)) ! x + call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(Buf, OutData%z(i1)) ! z + call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call ExtPtfm_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call ExtPtfm_UnpackParam(Buf, OutData%p) ! p - call ExtPtfm_UnpackInput(Buf, OutData%u) ! u - call ExtPtfm_UnpackOutput(Buf, OutData%y) ! y - call ExtPtfm_UnpackMisc(Buf, OutData%m) ! m + call ExtPtfm_UnpackParam(RF, OutData%p) ! p + call ExtPtfm_UnpackInput(RF, OutData%u) ! u + call ExtPtfm_UnpackOutput(RF, OutData%y) ! y + call ExtPtfm_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(Buf, OutData%Input(i1)) ! Input + call ExtPtfm_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10616,142 +9242,121 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackSeaState_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackSeaState_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaState_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_PackContState(Buf, InData%x(i1)) + call SeaSt_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(Buf, InData%xd(i1)) + call SeaSt_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(Buf, InData%z(i1)) + call SeaSt_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) + call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) end do - call SeaSt_PackParam(Buf, InData%p) - call SeaSt_PackInput(Buf, InData%u) - call SeaSt_PackOutput(Buf, InData%y) - call SeaSt_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call SeaSt_PackParam(RF, InData%p) + call SeaSt_PackInput(RF, InData%u) + call SeaSt_PackOutput(RF, InData%y) + call SeaSt_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_PackInput(Buf, InData%Input(i1)) + call SeaSt_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%Output)) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_PackOutput(Buf, InData%Output(i1)) + call SeaSt_PackOutput(RF, InData%Output(i1)) end do end if - call SeaSt_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call SeaSt_PackOutput(RF, InData%y_interp) + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackSeaState_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackSeaState_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaState_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(Buf, OutData%x(i1)) ! x + call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(Buf, OutData%z(i1)) ! z + call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call SeaSt_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call SeaSt_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call SeaSt_UnpackParam(Buf, OutData%p) ! p - call SeaSt_UnpackInput(Buf, OutData%u) ! u - call SeaSt_UnpackOutput(Buf, OutData%y) ! y - call SeaSt_UnpackMisc(Buf, OutData%m) ! m + call SeaSt_UnpackParam(RF, OutData%p) ! p + call SeaSt_UnpackInput(RF, OutData%u) ! u + call SeaSt_UnpackOutput(RF, OutData%y) ! y + call SeaSt_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(Buf, OutData%Input(i1)) ! Input + call SeaSt_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SeaSt_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call SeaSt_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call SeaSt_UnpackOutput(Buf, OutData%y_interp) ! y_interp - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call SeaSt_UnpackOutput(RF, OutData%y_interp) ! y_interp + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10924,142 +9529,121 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackHydroDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackHydroDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(HydroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackContState(Buf, InData%x(i1)) + call HydroDyn_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(Buf, InData%xd(i1)) + call HydroDyn_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(Buf, InData%z(i1)) + call HydroDyn_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) + call HydroDyn_PackOtherState(RF, InData%OtherSt(i1)) end do - call HydroDyn_PackParam(Buf, InData%p) - call HydroDyn_PackInput(Buf, InData%u) - call HydroDyn_PackOutput(Buf, InData%y) - call HydroDyn_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Output)) + call HydroDyn_PackParam(RF, InData%p) + call HydroDyn_PackInput(RF, InData%u) + call HydroDyn_PackOutput(RF, InData%y) + call HydroDyn_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackOutput(Buf, InData%Output(i1)) + call HydroDyn_PackOutput(RF, InData%Output(i1)) end do end if - call HydroDyn_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call HydroDyn_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_PackInput(Buf, InData%Input(i1)) + call HydroDyn_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackHydroDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(HydroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x + call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(Buf, OutData%z(i1)) ! z + call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call HydroDyn_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call HydroDyn_UnpackParam(Buf, OutData%p) ! p - call HydroDyn_UnpackInput(Buf, OutData%u) ! u - call HydroDyn_UnpackOutput(Buf, OutData%y) ! y - call HydroDyn_UnpackMisc(Buf, OutData%m) ! m + call HydroDyn_UnpackParam(RF, OutData%p) ! p + call HydroDyn_UnpackInput(RF, OutData%u) ! u + call HydroDyn_UnpackOutput(RF, OutData%y) ! y + call HydroDyn_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call HydroDyn_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call HydroDyn_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call HydroDyn_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(Buf, OutData%Input(i1)) ! Input + call HydroDyn_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11202,116 +9786,97 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackIceFloe_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackIceFloe_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(IceFloe_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackContState(Buf, InData%x(i1)) + call IceFloe_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(Buf, InData%xd(i1)) + call IceFloe_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(Buf, InData%z(i1)) + call IceFloe_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) + call IceFloe_PackOtherState(RF, InData%OtherSt(i1)) end do - call IceFloe_PackParam(Buf, InData%p) - call IceFloe_PackInput(Buf, InData%u) - call IceFloe_PackOutput(Buf, InData%y) - call IceFloe_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call IceFloe_PackParam(RF, InData%p) + call IceFloe_PackInput(RF, InData%u) + call IceFloe_PackOutput(RF, InData%y) + call IceFloe_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_PackInput(Buf, InData%Input(i1)) + call IceFloe_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackIceFloe_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackIceFloe_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(IceFloe_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(Buf, OutData%x(i1)) ! x + call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(Buf, OutData%z(i1)) ! z + call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call IceFloe_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call IceFloe_UnpackParam(Buf, OutData%p) ! p - call IceFloe_UnpackInput(Buf, OutData%u) ! u - call IceFloe_UnpackOutput(Buf, OutData%y) ! y - call IceFloe_UnpackMisc(Buf, OutData%m) ! m + call IceFloe_UnpackParam(RF, OutData%p) ! p + call IceFloe_UnpackInput(RF, OutData%u) ! u + call IceFloe_UnpackOutput(RF, OutData%y) ! y + call IceFloe_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(Buf, OutData%Input(i1)) ! Input + call IceFloe_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11476,134 +10041,113 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackMAP_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackMAP_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(MAP_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackContState(Buf, InData%x(i1)) + call MAP_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackDiscState(Buf, InData%xd(i1)) + call MAP_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackConstrState(Buf, InData%z(i1)) + call MAP_PackConstrState(RF, InData%z(i1)) end do - call MAP_PackOtherState(Buf, InData%OtherSt) - call MAP_PackParam(Buf, InData%p) - call MAP_PackInput(Buf, InData%u) - call MAP_PackOutput(Buf, InData%y) - call MAP_PackOtherState(Buf, InData%OtherSt_old) - call RegPack(Buf, allocated(InData%Output)) + call MAP_PackOtherState(RF, InData%OtherSt) + call MAP_PackParam(RF, InData%p) + call MAP_PackInput(RF, InData%u) + call MAP_PackOutput(RF, InData%y) + call MAP_PackOtherState(RF, InData%OtherSt_old) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackOutput(Buf, InData%Output(i1)) + call MAP_PackOutput(RF, InData%Output(i1)) end do end if - call MAP_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call MAP_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_PackInput(Buf, InData%Input(i1)) + call MAP_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackMAP_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackMAP_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(MAP_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_UnpackContState(Buf, OutData%x(i1)) ! x + call MAP_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(Buf, OutData%z(i1)) ! z + call MAP_UnpackConstrState(RF, OutData%z(i1)) ! z end do - call MAP_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - call MAP_UnpackParam(Buf, OutData%p) ! p - call MAP_UnpackInput(Buf, OutData%u) ! u - call MAP_UnpackOutput(Buf, OutData%y) ! y - call MAP_UnpackOtherState(Buf, OutData%OtherSt_old) ! OtherSt_old + call MAP_UnpackOtherState(RF, OutData%OtherSt) ! OtherSt + call MAP_UnpackParam(RF, OutData%p) ! p + call MAP_UnpackInput(RF, OutData%u) ! u + call MAP_UnpackOutput(RF, OutData%y) ! y + call MAP_UnpackOtherState(RF, OutData%OtherSt_old) ! OtherSt_old if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call MAP_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call MAP_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call MAP_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MAP_UnpackInput(Buf, OutData%Input(i1)) ! Input + call MAP_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg) @@ -11746,116 +10290,97 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackFEAMooring_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackFEAMooring_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(FEAMooring_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackContState(Buf, InData%x(i1)) + call FEAM_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackDiscState(Buf, InData%xd(i1)) + call FEAM_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackConstrState(Buf, InData%z(i1)) + call FEAM_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) + call FEAM_PackOtherState(RF, InData%OtherSt(i1)) end do - call FEAM_PackParam(Buf, InData%p) - call FEAM_PackInput(Buf, InData%u) - call FEAM_PackOutput(Buf, InData%y) - call FEAM_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call FEAM_PackParam(RF, InData%p) + call FEAM_PackInput(RF, InData%u) + call FEAM_PackOutput(RF, InData%y) + call FEAM_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_PackInput(Buf, InData%Input(i1)) + call FEAM_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackFEAMooring_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(FEAMooring_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_UnpackContState(Buf, OutData%x(i1)) ! x + call FEAM_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(Buf, OutData%z(i1)) ! z + call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call FEAM_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call FEAM_UnpackParam(Buf, OutData%p) ! p - call FEAM_UnpackInput(Buf, OutData%u) ! u - call FEAM_UnpackOutput(Buf, OutData%y) ! y - call FEAM_UnpackMisc(Buf, OutData%m) ! m + call FEAM_UnpackParam(RF, OutData%p) ! p + call FEAM_UnpackInput(RF, OutData%u) ! u + call FEAM_UnpackOutput(RF, OutData%y) ! y + call FEAM_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackInput(Buf, OutData%Input(i1)) ! Input + call FEAM_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -12028,142 +10553,121 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackMoorDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackMoorDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(MoorDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackContState(Buf, InData%x(i1)) + call MD_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackDiscState(Buf, InData%xd(i1)) + call MD_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackConstrState(Buf, InData%z(i1)) + call MD_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackOtherState(Buf, InData%OtherSt(i1)) + call MD_PackOtherState(RF, InData%OtherSt(i1)) end do - call MD_PackParam(Buf, InData%p) - call MD_PackInput(Buf, InData%u) - call MD_PackOutput(Buf, InData%y) - call MD_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Output)) + call MD_PackParam(RF, InData%p) + call MD_PackInput(RF, InData%u) + call MD_PackOutput(RF, InData%y) + call MD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Output)) if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) LB(1:1) = lbound(InData%Output, kind=B8Ki) UB(1:1) = ubound(InData%Output, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackOutput(Buf, InData%Output(i1)) + call MD_PackOutput(RF, InData%Output(i1)) end do end if - call MD_PackOutput(Buf, InData%y_interp) - call RegPack(Buf, allocated(InData%Input)) + call MD_PackOutput(RF, InData%y_interp) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_PackInput(Buf, InData%Input(i1)) + call MD_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackMoorDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackMoorDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(MoorDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_UnpackContState(Buf, OutData%x(i1)) ! x + call MD_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call MD_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call MD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call MD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call MD_UnpackParam(Buf, OutData%p) ! p - call MD_UnpackInput(Buf, OutData%u) ! u - call MD_UnpackOutput(Buf, OutData%y) ! y - call MD_UnpackMisc(Buf, OutData%m) ! m + call MD_UnpackParam(RF, OutData%p) ! p + call MD_UnpackInput(RF, OutData%u) ! u + call MD_UnpackOutput(RF, OutData%y) ! y + call MD_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call MD_UnpackOutput(RF, OutData%Output(i1)) ! Output end do end if - call MD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + call MD_UnpackOutput(RF, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call MD_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg) @@ -12306,116 +10810,97 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackOrcaFlex_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackOrcaFlex_Data(RF, Indata) + type(RegFile), intent(inout) :: RF type(OrcaFlex_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return LB(1:1) = lbound(InData%x, kind=B8Ki) UB(1:1) = ubound(InData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_PackContState(Buf, InData%x(i1)) + call Orca_PackContState(RF, InData%x(i1)) end do LB(1:1) = lbound(InData%xd, kind=B8Ki) UB(1:1) = ubound(InData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_PackDiscState(Buf, InData%xd(i1)) + call Orca_PackDiscState(RF, InData%xd(i1)) end do LB(1:1) = lbound(InData%z, kind=B8Ki) UB(1:1) = ubound(InData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_PackConstrState(Buf, InData%z(i1)) + call Orca_PackConstrState(RF, InData%z(i1)) end do LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_PackOtherState(Buf, InData%OtherSt(i1)) + call Orca_PackOtherState(RF, InData%OtherSt(i1)) end do - call Orca_PackParam(Buf, InData%p) - call Orca_PackInput(Buf, InData%u) - call Orca_PackOutput(Buf, InData%y) - call Orca_PackMisc(Buf, InData%m) - call RegPack(Buf, allocated(InData%Input)) + call Orca_PackParam(RF, InData%p) + call Orca_PackInput(RF, InData%u) + call Orca_PackOutput(RF, InData%y) + call Orca_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) LB(1:1) = lbound(InData%Input, kind=B8Ki) UB(1:1) = ubound(InData%Input, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_PackInput(Buf, InData%Input(i1)) + call Orca_PackInput(RF, InData%Input(i1)) end do end if - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes, kind=B8Ki), ubound(InData%InputTimes, kind=B8Ki)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackOrcaFlex_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) + type(RegFile), intent(inout) :: RF type(OrcaFlex_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return LB(1:1) = lbound(OutData%x, kind=B8Ki) UB(1:1) = ubound(OutData%x, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_UnpackContState(Buf, OutData%x(i1)) ! x + call Orca_UnpackContState(RF, OutData%x(i1)) ! x end do LB(1:1) = lbound(OutData%xd, kind=B8Ki) UB(1:1) = ubound(OutData%xd, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do LB(1:1) = lbound(OutData%z, kind=B8Ki) UB(1:1) = ubound(OutData%z, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_UnpackConstrState(Buf, OutData%z(i1)) ! z + call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z end do LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) do i1 = LB(1), UB(1) - call Orca_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call Orca_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do - call Orca_UnpackParam(Buf, OutData%p) ! p - call Orca_UnpackInput(Buf, OutData%u) ! u - call Orca_UnpackOutput(Buf, OutData%y) ! y - call Orca_UnpackMisc(Buf, OutData%m) ! m + call Orca_UnpackParam(RF, OutData%p) ! p + call Orca_UnpackInput(RF, OutData%u) ! u + call Orca_UnpackOutput(RF, OutData%y) ! y + call Orca_UnpackMisc(RF, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call Orca_UnpackInput(Buf, OutData%Input(i1)) ! Input + call Orca_UnpackInput(RF, OutData%Input(i1)) ! Input end do end if - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) @@ -13267,737 +11752,623 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine FAST_PackModuleMapType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackModuleMapType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%ED_P_2_BD_P)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%ED_P_2_BD_P)) if (allocated(InData%ED_P_2_BD_P)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P, kind=B8Ki), ubound(InData%ED_P_2_BD_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P, kind=B8Ki), ubound(InData%ED_P_2_BD_P, kind=B8Ki)) LB(1:1) = lbound(InData%ED_P_2_BD_P, kind=B8Ki) UB(1:1) = ubound(InData%ED_P_2_BD_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P(i1)) end do end if - call RegPack(Buf, allocated(InData%BD_P_2_ED_P)) + call RegPack(RF, allocated(InData%BD_P_2_ED_P)) if (allocated(InData%BD_P_2_ED_P)) then - call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P, kind=B8Ki), ubound(InData%BD_P_2_ED_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BD_P_2_ED_P, kind=B8Ki), ubound(InData%BD_P_2_ED_P, kind=B8Ki)) LB(1:1) = lbound(InData%BD_P_2_ED_P, kind=B8Ki) UB(1:1) = ubound(InData%BD_P_2_ED_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BD_P_2_ED_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%BD_P_2_ED_P(i1)) end do end if - call RegPack(Buf, allocated(InData%ED_P_2_BD_P_Hub)) + call RegPack(RF, allocated(InData%ED_P_2_BD_P_Hub)) if (allocated(InData%ED_P_2_BD_P_Hub)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki), ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki), ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki)) LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P_Hub(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P_Hub(i1)) end do end if - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_HD_PRP_P) - call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_W_P) - call NWTC_Library_PackMeshMapType(Buf, InData%HD_W_P_2_SubStructure) - call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_M_P) - call NWTC_Library_PackMeshMapType(Buf, InData%HD_M_P_2_SubStructure) - call NWTC_Library_PackMeshMapType(Buf, InData%Structure_2_Mooring) - call NWTC_Library_PackMeshMapType(Buf, InData%Mooring_2_Structure) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SD_TP) - call NWTC_Library_PackMeshMapType(Buf, InData%SD_TP_2_ED_P) - call RegPack(Buf, allocated(InData%ED_P_2_NStC_P_N)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_HD_PRP_P) + call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_HD_W_P) + call NWTC_Library_PackMeshMapType(RF, InData%HD_W_P_2_SubStructure) + call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_HD_M_P) + call NWTC_Library_PackMeshMapType(RF, InData%HD_M_P_2_SubStructure) + call NWTC_Library_PackMeshMapType(RF, InData%Structure_2_Mooring) + call NWTC_Library_PackMeshMapType(RF, InData%Mooring_2_Structure) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_SD_TP) + call NWTC_Library_PackMeshMapType(RF, InData%SD_TP_2_ED_P) + call RegPack(RF, allocated(InData%ED_P_2_NStC_P_N)) if (allocated(InData%ED_P_2_NStC_P_N)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki), ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki), ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki)) LB(1:1) = lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki) UB(1:1) = ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_NStC_P_N(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_NStC_P_N(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC_P_2_ED_P_N)) + call RegPack(RF, allocated(InData%NStC_P_2_ED_P_N)) if (allocated(InData%NStC_P_2_ED_P_N)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki), ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki), ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki)) LB(1:1) = lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki) UB(1:1) = ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%NStC_P_2_ED_P_N(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%NStC_P_2_ED_P_N(i1)) end do end if - call RegPack(Buf, allocated(InData%ED_L_2_TStC_P_T)) + call RegPack(RF, allocated(InData%ED_L_2_TStC_P_T)) if (allocated(InData%ED_L_2_TStC_P_T)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki), ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki), ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki)) LB(1:1) = lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki) UB(1:1) = ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_TStC_P_T(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_TStC_P_T(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC_P_2_ED_P_T)) + call RegPack(RF, allocated(InData%TStC_P_2_ED_P_T)) if (allocated(InData%TStC_P_2_ED_P_T)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki), ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki), ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki)) LB(1:1) = lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki) UB(1:1) = ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%TStC_P_2_ED_P_T(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%TStC_P_2_ED_P_T(i1)) end do end if - call RegPack(Buf, allocated(InData%ED_L_2_BStC_P_B)) + call RegPack(RF, allocated(InData%ED_L_2_BStC_P_B)) if (allocated(InData%ED_L_2_BStC_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki), ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki), ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki)) LB(1:2) = lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki) UB(1:2) = ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_BStC_P_B(i1,i2)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_BStC_P_B(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%BStC_P_2_ED_P_B)) + call RegPack(RF, allocated(InData%BStC_P_2_ED_P_B)) if (allocated(InData%BStC_P_2_ED_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki), ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki), ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki)) LB(1:2) = lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki) UB(1:2) = ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_ED_P_B(i1,i2)) + call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_ED_P_B(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%BD_L_2_BStC_P_B)) + call RegPack(RF, allocated(InData%BD_L_2_BStC_P_B)) if (allocated(InData%BD_L_2_BStC_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki), ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki), ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki)) LB(1:2) = lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki) UB(1:2) = ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BStC_P_B(i1,i2)) + call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BStC_P_B(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%BStC_P_2_BD_P_B)) + call RegPack(RF, allocated(InData%BStC_P_2_BD_P_B)) if (allocated(InData%BStC_P_2_BD_P_B)) then - call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki), ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki), ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki)) LB(1:2) = lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki) UB(1:2) = ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_BD_P_B(i1,i2)) + call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_BD_P_B(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%SStC_P_P_2_SubStructure)) + call RegPack(RF, allocated(InData%SStC_P_P_2_SubStructure)) if (allocated(InData%SStC_P_P_2_SubStructure)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki), ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki), ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki)) LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%SStC_P_P_2_SubStructure(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%SStC_P_P_2_SubStructure(i1)) end do end if - call RegPack(Buf, allocated(InData%SubStructure_2_SStC_P_P)) + call RegPack(RF, allocated(InData%SubStructure_2_SStC_P_P)) if (allocated(InData%SubStructure_2_SStC_P_P)) then - call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki), ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki), ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki)) LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_SStC_P_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_SStC_P_P(i1)) end do end if - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SrvD_P_P) - call RegPack(Buf, allocated(InData%BDED_L_2_AD_L_B)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_SrvD_P_P) + call RegPack(RF, allocated(InData%BDED_L_2_AD_L_B)) if (allocated(InData%BDED_L_2_AD_L_B)) then - call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki), ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki), ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki)) LB(1:1) = lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki) UB(1:1) = ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BDED_L_2_AD_L_B(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_AD_L_B(i1)) end do end if - call RegPack(Buf, allocated(InData%AD_L_2_BDED_B)) + call RegPack(RF, allocated(InData%AD_L_2_BDED_B)) if (allocated(InData%AD_L_2_BDED_B)) then - call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B, kind=B8Ki), ubound(InData%AD_L_2_BDED_B, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_BDED_B, kind=B8Ki), ubound(InData%AD_L_2_BDED_B, kind=B8Ki)) LB(1:1) = lbound(InData%AD_L_2_BDED_B, kind=B8Ki) UB(1:1) = ubound(InData%AD_L_2_BDED_B, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_BDED_B(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_BDED_B(i1)) end do end if - call RegPack(Buf, allocated(InData%BD_L_2_BD_L)) + call RegPack(RF, allocated(InData%BD_L_2_BD_L)) if (allocated(InData%BD_L_2_BD_L)) then - call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L, kind=B8Ki), ubound(InData%BD_L_2_BD_L, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BD_L_2_BD_L, kind=B8Ki), ubound(InData%BD_L_2_BD_L, kind=B8Ki)) LB(1:1) = lbound(InData%BD_L_2_BD_L, kind=B8Ki) UB(1:1) = ubound(InData%BD_L_2_BD_L, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BD_L(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BD_L(i1)) end do end if - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_N) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_TF) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_AD_L_T) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_ED_P_T) - call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_N) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_N) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_TF) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_TF) + call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_AD_L_T) + call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ED_P_T) + call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) end do end if - call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) - call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_H) - call NWTC_Library_PackMeshMapType(Buf, InData%IceF_P_2_SD_P) - call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceF_P) - call RegPack(Buf, allocated(InData%IceD_P_2_SD_P)) + call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_H) + call NWTC_Library_PackMeshMapType(RF, InData%IceF_P_2_SD_P) + call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceF_P) + call RegPack(RF, allocated(InData%IceD_P_2_SD_P)) if (allocated(InData%IceD_P_2_SD_P)) then - call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P, kind=B8Ki), ubound(InData%IceD_P_2_SD_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%IceD_P_2_SD_P, kind=B8Ki), ubound(InData%IceD_P_2_SD_P, kind=B8Ki)) LB(1:1) = lbound(InData%IceD_P_2_SD_P, kind=B8Ki) UB(1:1) = ubound(InData%IceD_P_2_SD_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%IceD_P_2_SD_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%IceD_P_2_SD_P(i1)) end do end if - call RegPack(Buf, allocated(InData%SDy3_P_2_IceD_P)) + call RegPack(RF, allocated(InData%SDy3_P_2_IceD_P)) if (allocated(InData%SDy3_P_2_IceD_P)) then - call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki), ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki), ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki)) LB(1:1) = lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki) UB(1:1) = ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceD_P(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceD_P(i1)) end do end if - call RegPack(Buf, allocated(InData%Jacobian_Opt1)) - if (allocated(InData%Jacobian_Opt1)) then - call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1, kind=B8Ki), ubound(InData%Jacobian_Opt1, kind=B8Ki)) - call RegPack(Buf, InData%Jacobian_Opt1) - end if - call RegPack(Buf, allocated(InData%Jacobian_pivot)) - if (allocated(InData%Jacobian_pivot)) then - call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot, kind=B8Ki), ubound(InData%Jacobian_pivot, kind=B8Ki)) - call RegPack(Buf, InData%Jacobian_pivot) - end if - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call MeshPack(Buf, InData%u_ED_NacelleLoads) - call MeshPack(Buf, InData%SubstructureLoads_Tmp) - call MeshPack(Buf, InData%SubstructureLoads_Tmp2) - call MeshPack(Buf, InData%PlatformLoads_Tmp) - call MeshPack(Buf, InData%PlatformLoads_Tmp2) - call MeshPack(Buf, InData%SubstructureLoads_Tmp_Farm) - call MeshPack(Buf, InData%u_ED_TowerPtloads) - call RegPack(Buf, allocated(InData%u_ED_BladePtLoads)) + call RegPackAlloc(RF, InData%Jacobian_Opt1) + call RegPackAlloc(RF, InData%Jacobian_pivot) + call RegPackAlloc(RF, InData%Jac_u_indx) + call MeshPack(RF, InData%u_ED_NacelleLoads) + call MeshPack(RF, InData%SubstructureLoads_Tmp) + call MeshPack(RF, InData%SubstructureLoads_Tmp2) + call MeshPack(RF, InData%PlatformLoads_Tmp) + call MeshPack(RF, InData%PlatformLoads_Tmp2) + call MeshPack(RF, InData%SubstructureLoads_Tmp_Farm) + call MeshPack(RF, InData%u_ED_TowerPtloads) + call RegPack(RF, allocated(InData%u_ED_BladePtLoads)) if (allocated(InData%u_ED_BladePtLoads)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads, kind=B8Ki), ubound(InData%u_ED_BladePtLoads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_ED_BladePtLoads, kind=B8Ki), ubound(InData%u_ED_BladePtLoads, kind=B8Ki)) LB(1:1) = lbound(InData%u_ED_BladePtLoads, kind=B8Ki) UB(1:1) = ubound(InData%u_ED_BladePtLoads, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%u_ED_BladePtLoads(i1)) + call MeshPack(RF, InData%u_ED_BladePtLoads(i1)) end do end if - call MeshPack(Buf, InData%u_SD_TPMesh) - call MeshPack(Buf, InData%u_HD_M_Mesh) - call MeshPack(Buf, InData%u_HD_W_Mesh) - call MeshPack(Buf, InData%u_ED_HubPtLoad) - call MeshPack(Buf, InData%u_ED_HubPtLoad_2) - call RegPack(Buf, allocated(InData%u_BD_RootMotion)) + call MeshPack(RF, InData%u_SD_TPMesh) + call MeshPack(RF, InData%u_HD_M_Mesh) + call MeshPack(RF, InData%u_HD_W_Mesh) + call MeshPack(RF, InData%u_ED_HubPtLoad) + call MeshPack(RF, InData%u_ED_HubPtLoad_2) + call RegPack(RF, allocated(InData%u_BD_RootMotion)) if (allocated(InData%u_BD_RootMotion)) then - call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion, kind=B8Ki), ubound(InData%u_BD_RootMotion, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_BD_RootMotion, kind=B8Ki), ubound(InData%u_BD_RootMotion, kind=B8Ki)) LB(1:1) = lbound(InData%u_BD_RootMotion, kind=B8Ki) UB(1:1) = ubound(InData%u_BD_RootMotion, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%u_BD_RootMotion(i1)) + call MeshPack(RF, InData%u_BD_RootMotion(i1)) end do end if - call RegPack(Buf, allocated(InData%y_BD_BldMotion_4Loads)) + call RegPack(RF, allocated(InData%y_BD_BldMotion_4Loads)) if (allocated(InData%y_BD_BldMotion_4Loads)) then - call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki), ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki), ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki)) LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%y_BD_BldMotion_4Loads(i1)) + call MeshPack(RF, InData%y_BD_BldMotion_4Loads(i1)) end do end if - call RegPack(Buf, allocated(InData%u_BD_Distrload)) + call RegPack(RF, allocated(InData%u_BD_Distrload)) if (allocated(InData%u_BD_Distrload)) then - call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload, kind=B8Ki), ubound(InData%u_BD_Distrload, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_BD_Distrload, kind=B8Ki), ubound(InData%u_BD_Distrload, kind=B8Ki)) LB(1:1) = lbound(InData%u_BD_Distrload, kind=B8Ki) UB(1:1) = ubound(InData%u_BD_Distrload, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%u_BD_Distrload(i1)) + call MeshPack(RF, InData%u_BD_Distrload(i1)) end do end if - call MeshPack(Buf, InData%u_Orca_PtfmMesh) - call MeshPack(Buf, InData%u_ExtPtfm_PtfmMesh) - call RegPack(Buf, allocated(InData%HubOrient)) - if (allocated(InData%HubOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%HubOrient, kind=B8Ki), ubound(InData%HubOrient, kind=B8Ki)) - call RegPack(Buf, InData%HubOrient) - end if - if (RegCheckErr(Buf, RoutineName)) return + call MeshPack(RF, InData%u_Orca_PtfmMesh) + call MeshPack(RF, InData%u_ExtPtfm_PtfmMesh) + call RegPackAlloc(RF, InData%HubOrient) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine FAST_UnPackModuleMapType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_UnPackModuleMapType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%ED_P_2_BD_P)) deallocate(OutData%ED_P_2_BD_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_P_2_BD_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P(i1)) ! ED_P_2_BD_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_BD_P(i1)) ! ED_P_2_BD_P end do end if if (allocated(OutData%BD_P_2_ED_P)) deallocate(OutData%BD_P_2_ED_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BD_P_2_ED_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_P_2_ED_P(i1)) ! BD_P_2_ED_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%BD_P_2_ED_P(i1)) ! BD_P_2_ED_P end do end if if (allocated(OutData%ED_P_2_BD_P_Hub)) deallocate(OutData%ED_P_2_BD_P_Hub) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_P_2_BD_P_Hub(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P_Hub(i1)) ! ED_P_2_BD_P_Hub + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_BD_P_Hub(i1)) ! ED_P_2_BD_P_Hub end do end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_HD_PRP_P) ! ED_P_2_HD_PRP_P - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_W_P) ! SubStructure_2_HD_W_P - call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_W_P_2_SubStructure) ! HD_W_P_2_SubStructure - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_M_P) ! SubStructure_2_HD_M_P - call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_M_P_2_SubStructure) ! HD_M_P_2_SubStructure - call NWTC_Library_UnpackMeshMapType(Buf, OutData%Structure_2_Mooring) ! Structure_2_Mooring - call NWTC_Library_UnpackMeshMapType(Buf, OutData%Mooring_2_Structure) ! Mooring_2_Structure - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SD_TP) ! ED_P_2_SD_TP - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SD_TP_2_ED_P) ! SD_TP_2_ED_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_HD_PRP_P) ! ED_P_2_HD_PRP_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%SubStructure_2_HD_W_P) ! SubStructure_2_HD_W_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%HD_W_P_2_SubStructure) ! HD_W_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(RF, OutData%SubStructure_2_HD_M_P) ! SubStructure_2_HD_M_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%HD_M_P_2_SubStructure) ! HD_M_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(RF, OutData%Structure_2_Mooring) ! Structure_2_Mooring + call NWTC_Library_UnpackMeshMapType(RF, OutData%Mooring_2_Structure) ! Mooring_2_Structure + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_SD_TP) ! ED_P_2_SD_TP + call NWTC_Library_UnpackMeshMapType(RF, OutData%SD_TP_2_ED_P) ! SD_TP_2_ED_P if (allocated(OutData%ED_P_2_NStC_P_N)) deallocate(OutData%ED_P_2_NStC_P_N) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_P_2_NStC_P_N(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_NStC_P_N(i1)) ! ED_P_2_NStC_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_NStC_P_N(i1)) ! ED_P_2_NStC_P_N end do end if if (allocated(OutData%NStC_P_2_ED_P_N)) deallocate(OutData%NStC_P_2_ED_P_N) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC_P_2_ED_P_N(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_P_2_ED_P_N(i1)) ! NStC_P_2_ED_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%NStC_P_2_ED_P_N(i1)) ! NStC_P_2_ED_P_N end do end if if (allocated(OutData%ED_L_2_TStC_P_T)) deallocate(OutData%ED_L_2_TStC_P_T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_L_2_TStC_P_T(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_TStC_P_T(i1)) ! ED_L_2_TStC_P_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_TStC_P_T(i1)) ! ED_L_2_TStC_P_T end do end if if (allocated(OutData%TStC_P_2_ED_P_T)) deallocate(OutData%TStC_P_2_ED_P_T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC_P_2_ED_P_T(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_P_2_ED_P_T(i1)) ! TStC_P_2_ED_P_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%TStC_P_2_ED_P_T(i1)) ! TStC_P_2_ED_P_T end do end if if (allocated(OutData%ED_L_2_BStC_P_B)) deallocate(OutData%ED_L_2_BStC_P_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_BStC_P_B(i1,i2)) ! ED_L_2_BStC_P_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_BStC_P_B(i1,i2)) ! ED_L_2_BStC_P_B end do end do end if if (allocated(OutData%BStC_P_2_ED_P_B)) deallocate(OutData%BStC_P_2_ED_P_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_P_2_ED_P_B(i1,i2)) ! BStC_P_2_ED_P_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%BStC_P_2_ED_P_B(i1,i2)) ! BStC_P_2_ED_P_B end do end do end if if (allocated(OutData%BD_L_2_BStC_P_B)) deallocate(OutData%BD_L_2_BStC_P_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BStC_P_B(i1,i2)) ! BD_L_2_BStC_P_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%BD_L_2_BStC_P_B(i1,i2)) ! BD_L_2_BStC_P_B end do end do end if if (allocated(OutData%BStC_P_2_BD_P_B)) deallocate(OutData%BStC_P_2_BD_P_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_P_2_BD_P_B(i1,i2)) ! BStC_P_2_BD_P_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%BStC_P_2_BD_P_B(i1,i2)) ! BStC_P_2_BD_P_B end do end do end if if (allocated(OutData%SStC_P_P_2_SubStructure)) deallocate(OutData%SStC_P_P_2_SubStructure) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC_P_P_2_SubStructure(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_P_P_2_SubStructure(i1)) ! SStC_P_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(RF, OutData%SStC_P_P_2_SubStructure(i1)) ! SStC_P_P_2_SubStructure end do end if if (allocated(OutData%SubStructure_2_SStC_P_P)) deallocate(OutData%SubStructure_2_SStC_P_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SubStructure_2_SStC_P_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_SStC_P_P(i1)) ! SubStructure_2_SStC_P_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%SubStructure_2_SStC_P_P(i1)) ! SubStructure_2_SStC_P_P end do end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SrvD_P_P) ! ED_P_2_SrvD_P_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_SrvD_P_P) ! ED_P_2_SrvD_P_P if (allocated(OutData%BDED_L_2_AD_L_B)) deallocate(OutData%BDED_L_2_AD_L_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BDED_L_2_AD_L_B(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BDED_L_2_AD_L_B(i1)) ! BDED_L_2_AD_L_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%BDED_L_2_AD_L_B(i1)) ! BDED_L_2_AD_L_B end do end if if (allocated(OutData%AD_L_2_BDED_B)) deallocate(OutData%AD_L_2_BDED_B) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%AD_L_2_BDED_B(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_BDED_B(i1)) ! AD_L_2_BDED_B + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_BDED_B(i1)) ! AD_L_2_BDED_B end do end if if (allocated(OutData%BD_L_2_BD_L)) deallocate(OutData%BD_L_2_BD_L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BD_L_2_BD_L(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BD_L(i1)) ! BD_L_2_BD_L + call NWTC_Library_UnpackMeshMapType(RF, OutData%BD_L_2_BD_L(i1)) ! BD_L_2_BD_L end do end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_N) ! AD_P_2_ED_P_N - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_TF) ! AD_P_2_ED_P_TF - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_AD_L_T) ! ED_L_2_AD_L_T - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_ED_P_T) ! AD_L_2_ED_P_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_ED_P_N) ! AD_P_2_ED_P_N + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_ED_P_TF) ! AD_P_2_ED_P_TF + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_L_2_AD_L_T) ! ED_L_2_AD_L_T + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_L_2_ED_P_T) ! AD_L_2_ED_P_T if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R end do end if - call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H - call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_H) ! AD_P_2_ED_P_H - call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceF_P_2_SD_P) ! IceF_P_2_SD_P - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceF_P) ! SDy3_P_2_IceF_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%AD_P_2_ED_P_H) ! AD_P_2_ED_P_H + call NWTC_Library_UnpackMeshMapType(RF, OutData%IceF_P_2_SD_P) ! IceF_P_2_SD_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%SDy3_P_2_IceF_P) ! SDy3_P_2_IceF_P if (allocated(OutData%IceD_P_2_SD_P)) deallocate(OutData%IceD_P_2_SD_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%IceD_P_2_SD_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceD_P_2_SD_P(i1)) ! IceD_P_2_SD_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%IceD_P_2_SD_P(i1)) ! IceD_P_2_SD_P end do end if if (allocated(OutData%SDy3_P_2_IceD_P)) deallocate(OutData%SDy3_P_2_IceD_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SDy3_P_2_IceD_P(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceD_P(i1)) ! SDy3_P_2_IceD_P + call NWTC_Library_UnpackMeshMapType(RF, OutData%SDy3_P_2_IceD_P(i1)) ! SDy3_P_2_IceD_P end do end if - if (allocated(OutData%Jacobian_Opt1)) deallocate(OutData%Jacobian_Opt1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jacobian_Opt1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jacobian_pivot)) deallocate(OutData%Jacobian_pivot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jacobian_pivot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jacobian_pivot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call MeshUnpack(Buf, OutData%u_ED_NacelleLoads) ! u_ED_NacelleLoads - call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp) ! SubstructureLoads_Tmp - call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp2) ! SubstructureLoads_Tmp2 - call MeshUnpack(Buf, OutData%PlatformLoads_Tmp) ! PlatformLoads_Tmp - call MeshUnpack(Buf, OutData%PlatformLoads_Tmp2) ! PlatformLoads_Tmp2 - call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp_Farm) ! SubstructureLoads_Tmp_Farm - call MeshUnpack(Buf, OutData%u_ED_TowerPtloads) ! u_ED_TowerPtloads + call RegUnpackAlloc(RF, OutData%Jacobian_Opt1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jacobian_pivot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%u_ED_NacelleLoads) ! u_ED_NacelleLoads + call MeshUnpack(RF, OutData%SubstructureLoads_Tmp) ! SubstructureLoads_Tmp + call MeshUnpack(RF, OutData%SubstructureLoads_Tmp2) ! SubstructureLoads_Tmp2 + call MeshUnpack(RF, OutData%PlatformLoads_Tmp) ! PlatformLoads_Tmp + call MeshUnpack(RF, OutData%PlatformLoads_Tmp2) ! PlatformLoads_Tmp2 + call MeshUnpack(RF, OutData%SubstructureLoads_Tmp_Farm) ! SubstructureLoads_Tmp_Farm + call MeshUnpack(RF, OutData%u_ED_TowerPtloads) ! u_ED_TowerPtloads if (allocated(OutData%u_ED_BladePtLoads)) deallocate(OutData%u_ED_BladePtLoads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_ED_BladePtLoads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%u_ED_BladePtLoads(i1)) ! u_ED_BladePtLoads + call MeshUnpack(RF, OutData%u_ED_BladePtLoads(i1)) ! u_ED_BladePtLoads end do end if - call MeshUnpack(Buf, OutData%u_SD_TPMesh) ! u_SD_TPMesh - call MeshUnpack(Buf, OutData%u_HD_M_Mesh) ! u_HD_M_Mesh - call MeshUnpack(Buf, OutData%u_HD_W_Mesh) ! u_HD_W_Mesh - call MeshUnpack(Buf, OutData%u_ED_HubPtLoad) ! u_ED_HubPtLoad - call MeshUnpack(Buf, OutData%u_ED_HubPtLoad_2) ! u_ED_HubPtLoad_2 + call MeshUnpack(RF, OutData%u_SD_TPMesh) ! u_SD_TPMesh + call MeshUnpack(RF, OutData%u_HD_M_Mesh) ! u_HD_M_Mesh + call MeshUnpack(RF, OutData%u_HD_W_Mesh) ! u_HD_W_Mesh + call MeshUnpack(RF, OutData%u_ED_HubPtLoad) ! u_ED_HubPtLoad + call MeshUnpack(RF, OutData%u_ED_HubPtLoad_2) ! u_ED_HubPtLoad_2 if (allocated(OutData%u_BD_RootMotion)) deallocate(OutData%u_BD_RootMotion) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_BD_RootMotion(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%u_BD_RootMotion(i1)) ! u_BD_RootMotion + call MeshUnpack(RF, OutData%u_BD_RootMotion(i1)) ! u_BD_RootMotion end do end if if (allocated(OutData%y_BD_BldMotion_4Loads)) deallocate(OutData%y_BD_BldMotion_4Loads) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y_BD_BldMotion_4Loads(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%y_BD_BldMotion_4Loads(i1)) ! y_BD_BldMotion_4Loads + call MeshUnpack(RF, OutData%y_BD_BldMotion_4Loads(i1)) ! y_BD_BldMotion_4Loads end do end if if (allocated(OutData%u_BD_Distrload)) deallocate(OutData%u_BD_Distrload) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_BD_Distrload(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%u_BD_Distrload(i1)) ! u_BD_Distrload + call MeshUnpack(RF, OutData%u_BD_Distrload(i1)) ! u_BD_Distrload end do end if - call MeshUnpack(Buf, OutData%u_Orca_PtfmMesh) ! u_Orca_PtfmMesh - call MeshUnpack(Buf, OutData%u_ExtPtfm_PtfmMesh) ! u_ExtPtfm_PtfmMesh - if (allocated(OutData%HubOrient)) deallocate(OutData%HubOrient) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%HubOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%HubOrient) - if (RegCheckErr(Buf, RoutineName)) return - end if + call MeshUnpack(RF, OutData%u_Orca_PtfmMesh) ! u_Orca_PtfmMesh + call MeshUnpack(RF, OutData%u_ExtPtfm_PtfmMesh) ! u_ExtPtfm_PtfmMesh + call RegUnpackAlloc(RF, OutData%HubOrient); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyExternInputType(SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg) @@ -14030,49 +12401,39 @@ subroutine FAST_DestroyExternInputType(ExternInputTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine FAST_PackExternInputType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackExternInputType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_ExternInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExternInputType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%GenTrq) - call RegPack(Buf, InData%ElecPwr) - call RegPack(Buf, InData%YawPosCom) - call RegPack(Buf, InData%YawRateCom) - call RegPack(Buf, InData%BlPitchCom) - call RegPack(Buf, InData%BlAirfoilCom) - call RegPack(Buf, InData%HSSBrFrac) - call RegPack(Buf, InData%LidarFocus) - call RegPack(Buf, InData%CableDeltaL) - call RegPack(Buf, InData%CableDeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackExternInputType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%ElecPwr) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%BlPitchCom) + call RegPack(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%HSSBrFrac) + call RegPack(RF, InData%LidarFocus) + call RegPack(RF, InData%CableDeltaL) + call RegPack(RF, InData%CableDeltaLdot) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInputType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_ExternInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternInputType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElecPwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawPosCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawRateCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrFrac) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LidarFocus) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CableDeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrFrac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidarFocus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -14118,50 +12479,41 @@ subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%TiLstPrn) - call RegPack(Buf, InData%t_global) - call RegPack(Buf, InData%NextJacCalcTime) - call RegPack(Buf, InData%PrevClockTime) - call RegPack(Buf, InData%UsrTime1) - call RegPack(Buf, InData%UsrTime2) - call RegPack(Buf, InData%StrtTime) - call RegPack(Buf, InData%SimStrtTime) - call RegPack(Buf, InData%calcJacobian) - call FAST_PackExternInputType(Buf, InData%ExternInput) - call FAST_PackMiscLinType(Buf, InData%Lin) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TiLstPrn) + call RegPack(RF, InData%t_global) + call RegPack(RF, InData%NextJacCalcTime) + call RegPack(RF, InData%PrevClockTime) + call RegPack(RF, InData%UsrTime1) + call RegPack(RF, InData%UsrTime2) + call RegPack(RF, InData%StrtTime) + call RegPack(RF, InData%SimStrtTime) + call RegPack(RF, InData%calcJacobian) + call FAST_PackExternInputType(RF, InData%ExternInput) + call FAST_PackMiscLinType(RF, InData%Lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%TiLstPrn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%t_global) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NextJacCalcTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrevClockTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UsrTime1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UsrTime2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StrtTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimStrtTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%calcJacobian) - if (RegCheckErr(Buf, RoutineName)) return - call FAST_UnpackExternInputType(Buf, OutData%ExternInput) ! ExternInput - call FAST_UnpackMiscLinType(Buf, OutData%Lin) ! Lin + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TiLstPrn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%t_global); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NextJacCalcTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrevClockTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsrTime1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UsrTime2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StrtTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimStrtTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%calcJacobian); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackExternInputType(RF, OutData%ExternInput) ! ExternInput + call FAST_UnpackMiscLinType(RF, OutData%Lin) ! Lin end subroutine subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) @@ -14382,115 +12734,113 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackInitData(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackInitData(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_InitData), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInitData' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call ED_PackInitInput(Buf, InData%InData_ED) - call ED_PackInitOutput(Buf, InData%OutData_ED) - call BD_PackInitInput(Buf, InData%InData_BD) - call RegPack(Buf, allocated(InData%OutData_BD)) + if (RF%ErrStat >= AbortErrLev) return + call ED_PackInitInput(RF, InData%InData_ED) + call ED_PackInitOutput(RF, InData%OutData_ED) + call BD_PackInitInput(RF, InData%InData_BD) + call RegPack(RF, allocated(InData%OutData_BD)) if (allocated(InData%OutData_BD)) then - call RegPackBounds(Buf, 1, lbound(InData%OutData_BD, kind=B8Ki), ubound(InData%OutData_BD, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutData_BD, kind=B8Ki), ubound(InData%OutData_BD, kind=B8Ki)) LB(1:1) = lbound(InData%OutData_BD, kind=B8Ki) UB(1:1) = ubound(InData%OutData_BD, kind=B8Ki) do i1 = LB(1), UB(1) - call BD_PackInitOutput(Buf, InData%OutData_BD(i1)) - end do - end if - call SrvD_PackInitInput(Buf, InData%InData_SrvD) - call SrvD_PackInitOutput(Buf, InData%OutData_SrvD) - call AD14_PackInitInput(Buf, InData%InData_AD14) - call AD14_PackInitOutput(Buf, InData%OutData_AD14) - call AD_PackInitInput(Buf, InData%InData_AD) - call AD_PackInitOutput(Buf, InData%OutData_AD) - call InflowWind_PackInitInput(Buf, InData%InData_IfW) - call InflowWind_PackInitOutput(Buf, InData%OutData_IfW) - call ExtInfw_PackInitInput(Buf, InData%InData_ExtInfw) - call ExtInfw_PackInitOutput(Buf, InData%OutData_ExtInfw) - call SeaSt_PackInitInput(Buf, InData%InData_SeaSt) - call SeaSt_PackInitOutput(Buf, InData%OutData_SeaSt) - call HydroDyn_PackInitInput(Buf, InData%InData_HD) - call HydroDyn_PackInitOutput(Buf, InData%OutData_HD) - call SD_PackInitInput(Buf, InData%InData_SD) - call SD_PackInitOutput(Buf, InData%OutData_SD) - call ExtPtfm_PackInitInput(Buf, InData%InData_ExtPtfm) - call ExtPtfm_PackInitOutput(Buf, InData%OutData_ExtPtfm) - call MAP_PackInitInput(Buf, InData%InData_MAP) - call MAP_PackInitOutput(Buf, InData%OutData_MAP) - call FEAM_PackInitInput(Buf, InData%InData_FEAM) - call FEAM_PackInitOutput(Buf, InData%OutData_FEAM) - call MD_PackInitInput(Buf, InData%InData_MD) - call MD_PackInitOutput(Buf, InData%OutData_MD) - call Orca_PackInitInput(Buf, InData%InData_Orca) - call Orca_PackInitOutput(Buf, InData%OutData_Orca) - call IceFloe_PackInitInput(Buf, InData%InData_IceF) - call IceFloe_PackInitOutput(Buf, InData%OutData_IceF) - call IceD_PackInitInput(Buf, InData%InData_IceD) - call IceD_PackInitOutput(Buf, InData%OutData_IceD) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackInitData(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + call BD_PackInitOutput(RF, InData%OutData_BD(i1)) + end do + end if + call SrvD_PackInitInput(RF, InData%InData_SrvD) + call SrvD_PackInitOutput(RF, InData%OutData_SrvD) + call AD14_PackInitInput(RF, InData%InData_AD14) + call AD14_PackInitOutput(RF, InData%OutData_AD14) + call AD_PackInitInput(RF, InData%InData_AD) + call AD_PackInitOutput(RF, InData%OutData_AD) + call InflowWind_PackInitInput(RF, InData%InData_IfW) + call InflowWind_PackInitOutput(RF, InData%OutData_IfW) + call ExtInfw_PackInitInput(RF, InData%InData_ExtInfw) + call ExtInfw_PackInitOutput(RF, InData%OutData_ExtInfw) + call SeaSt_PackInitInput(RF, InData%InData_SeaSt) + call SeaSt_PackInitOutput(RF, InData%OutData_SeaSt) + call HydroDyn_PackInitInput(RF, InData%InData_HD) + call HydroDyn_PackInitOutput(RF, InData%OutData_HD) + call SD_PackInitInput(RF, InData%InData_SD) + call SD_PackInitOutput(RF, InData%OutData_SD) + call ExtPtfm_PackInitInput(RF, InData%InData_ExtPtfm) + call ExtPtfm_PackInitOutput(RF, InData%OutData_ExtPtfm) + call MAP_PackInitInput(RF, InData%InData_MAP) + call MAP_PackInitOutput(RF, InData%OutData_MAP) + call FEAM_PackInitInput(RF, InData%InData_FEAM) + call FEAM_PackInitOutput(RF, InData%OutData_FEAM) + call MD_PackInitInput(RF, InData%InData_MD) + call MD_PackInitOutput(RF, InData%OutData_MD) + call Orca_PackInitInput(RF, InData%InData_Orca) + call Orca_PackInitOutput(RF, InData%OutData_Orca) + call IceFloe_PackInitInput(RF, InData%InData_IceF) + call IceFloe_PackInitOutput(RF, InData%OutData_IceF) + call IceD_PackInitInput(RF, InData%InData_IceD) + call IceD_PackInitOutput(RF, InData%OutData_IceD) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInitData(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_InitData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInitData' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call ED_UnpackInitInput(Buf, OutData%InData_ED) ! InData_ED - call ED_UnpackInitOutput(Buf, OutData%OutData_ED) ! OutData_ED - call BD_UnpackInitInput(Buf, OutData%InData_BD) ! InData_BD + if (RF%ErrStat /= ErrID_None) return + call ED_UnpackInitInput(RF, OutData%InData_ED) ! InData_ED + call ED_UnpackInitOutput(RF, OutData%OutData_ED) ! OutData_ED + call BD_UnpackInitInput(RF, OutData%InData_BD) ! InData_BD if (allocated(OutData%OutData_BD)) deallocate(OutData%OutData_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutData_BD(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call BD_UnpackInitOutput(Buf, OutData%OutData_BD(i1)) ! OutData_BD - end do - end if - call SrvD_UnpackInitInput(Buf, OutData%InData_SrvD) ! InData_SrvD - call SrvD_UnpackInitOutput(Buf, OutData%OutData_SrvD) ! OutData_SrvD - call AD14_UnpackInitInput(Buf, OutData%InData_AD14) ! InData_AD14 - call AD14_UnpackInitOutput(Buf, OutData%OutData_AD14) ! OutData_AD14 - call AD_UnpackInitInput(Buf, OutData%InData_AD) ! InData_AD - call AD_UnpackInitOutput(Buf, OutData%OutData_AD) ! OutData_AD - call InflowWind_UnpackInitInput(Buf, OutData%InData_IfW) ! InData_IfW - call InflowWind_UnpackInitOutput(Buf, OutData%OutData_IfW) ! OutData_IfW - call ExtInfw_UnpackInitInput(Buf, OutData%InData_ExtInfw) ! InData_ExtInfw - call ExtInfw_UnpackInitOutput(Buf, OutData%OutData_ExtInfw) ! OutData_ExtInfw - call SeaSt_UnpackInitInput(Buf, OutData%InData_SeaSt) ! InData_SeaSt - call SeaSt_UnpackInitOutput(Buf, OutData%OutData_SeaSt) ! OutData_SeaSt - call HydroDyn_UnpackInitInput(Buf, OutData%InData_HD) ! InData_HD - call HydroDyn_UnpackInitOutput(Buf, OutData%OutData_HD) ! OutData_HD - call SD_UnpackInitInput(Buf, OutData%InData_SD) ! InData_SD - call SD_UnpackInitOutput(Buf, OutData%OutData_SD) ! OutData_SD - call ExtPtfm_UnpackInitInput(Buf, OutData%InData_ExtPtfm) ! InData_ExtPtfm - call ExtPtfm_UnpackInitOutput(Buf, OutData%OutData_ExtPtfm) ! OutData_ExtPtfm - call MAP_UnpackInitInput(Buf, OutData%InData_MAP) ! InData_MAP - call MAP_UnpackInitOutput(Buf, OutData%OutData_MAP) ! OutData_MAP - call FEAM_UnpackInitInput(Buf, OutData%InData_FEAM) ! InData_FEAM - call FEAM_UnpackInitOutput(Buf, OutData%OutData_FEAM) ! OutData_FEAM - call MD_UnpackInitInput(Buf, OutData%InData_MD) ! InData_MD - call MD_UnpackInitOutput(Buf, OutData%OutData_MD) ! OutData_MD - call Orca_UnpackInitInput(Buf, OutData%InData_Orca) ! InData_Orca - call Orca_UnpackInitOutput(Buf, OutData%OutData_Orca) ! OutData_Orca - call IceFloe_UnpackInitInput(Buf, OutData%InData_IceF) ! InData_IceF - call IceFloe_UnpackInitOutput(Buf, OutData%OutData_IceF) ! OutData_IceF - call IceD_UnpackInitInput(Buf, OutData%InData_IceD) ! InData_IceD - call IceD_UnpackInitOutput(Buf, OutData%OutData_IceD) ! OutData_IceD + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInitOutput(RF, OutData%OutData_BD(i1)) ! OutData_BD + end do + end if + call SrvD_UnpackInitInput(RF, OutData%InData_SrvD) ! InData_SrvD + call SrvD_UnpackInitOutput(RF, OutData%OutData_SrvD) ! OutData_SrvD + call AD14_UnpackInitInput(RF, OutData%InData_AD14) ! InData_AD14 + call AD14_UnpackInitOutput(RF, OutData%OutData_AD14) ! OutData_AD14 + call AD_UnpackInitInput(RF, OutData%InData_AD) ! InData_AD + call AD_UnpackInitOutput(RF, OutData%OutData_AD) ! OutData_AD + call InflowWind_UnpackInitInput(RF, OutData%InData_IfW) ! InData_IfW + call InflowWind_UnpackInitOutput(RF, OutData%OutData_IfW) ! OutData_IfW + call ExtInfw_UnpackInitInput(RF, OutData%InData_ExtInfw) ! InData_ExtInfw + call ExtInfw_UnpackInitOutput(RF, OutData%OutData_ExtInfw) ! OutData_ExtInfw + call SeaSt_UnpackInitInput(RF, OutData%InData_SeaSt) ! InData_SeaSt + call SeaSt_UnpackInitOutput(RF, OutData%OutData_SeaSt) ! OutData_SeaSt + call HydroDyn_UnpackInitInput(RF, OutData%InData_HD) ! InData_HD + call HydroDyn_UnpackInitOutput(RF, OutData%OutData_HD) ! OutData_HD + call SD_UnpackInitInput(RF, OutData%InData_SD) ! InData_SD + call SD_UnpackInitOutput(RF, OutData%OutData_SD) ! OutData_SD + call ExtPtfm_UnpackInitInput(RF, OutData%InData_ExtPtfm) ! InData_ExtPtfm + call ExtPtfm_UnpackInitOutput(RF, OutData%OutData_ExtPtfm) ! OutData_ExtPtfm + call MAP_UnpackInitInput(RF, OutData%InData_MAP) ! InData_MAP + call MAP_UnpackInitOutput(RF, OutData%OutData_MAP) ! OutData_MAP + call FEAM_UnpackInitInput(RF, OutData%InData_FEAM) ! InData_FEAM + call FEAM_UnpackInitOutput(RF, OutData%OutData_FEAM) ! OutData_FEAM + call MD_UnpackInitInput(RF, OutData%InData_MD) ! InData_MD + call MD_UnpackInitOutput(RF, OutData%OutData_MD) ! OutData_MD + call Orca_UnpackInitInput(RF, OutData%InData_Orca) ! InData_Orca + call Orca_UnpackInitOutput(RF, OutData%OutData_Orca) ! OutData_Orca + call IceFloe_UnpackInitInput(RF, OutData%InData_IceF) ! InData_IceF + call IceFloe_UnpackInitOutput(RF, OutData%OutData_IceF) ! OutData_IceF + call IceD_UnpackInitInput(RF, OutData%InData_IceD) ! InData_IceD + call IceD_UnpackInitOutput(RF, OutData%OutData_IceD) ! OutData_IceD end subroutine subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg) @@ -14564,52 +12914,37 @@ subroutine FAST_DestroyExternInitType(ExternInitTypeData, ErrStat, ErrMsg) nullify(ExternInitTypeData%windGrid_data) end subroutine -subroutine FAST_PackExternInitType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackExternInitType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_ExternInitType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExternInitType' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Tmax) - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%LidRadialVel) - call RegPack(Buf, InData%TurbineID) - call RegPack(Buf, InData%TurbinePos) - call RegPack(Buf, InData%WaveFieldMod) - call RegPack(Buf, InData%NumSC2CtrlGlob) - call RegPack(Buf, InData%NumSC2Ctrl) - call RegPack(Buf, InData%NumCtrl2SC) - call RegPack(Buf, allocated(InData%fromSCGlob)) - if (allocated(InData%fromSCGlob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob, kind=B8Ki), ubound(InData%fromSCGlob, kind=B8Ki)) - call RegPack(Buf, InData%fromSCGlob) - end if - call RegPack(Buf, allocated(InData%fromSC)) - if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) - call RegPack(Buf, InData%fromSC) - end if - call RegPack(Buf, InData%FarmIntegration) - call RegPack(Buf, InData%windGrid_n) - call RegPack(Buf, InData%windGrid_delta) - call RegPack(Buf, InData%windGrid_pZero) - call RegPack(Buf, associated(InData%windGrid_data)) - if (associated(InData%windGrid_data)) then - call RegPackBounds(Buf, 5, lbound(InData%windGrid_data, kind=B8Ki), ubound(InData%windGrid_data, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%windGrid_data), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%windGrid_data) - end if - end if - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%NumActForcePtsBlade) - call RegPack(Buf, InData%NumActForcePtsTower) - call RegPack(Buf, InData%NodeClusterType) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackExternInitType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%LidRadialVel) + call RegPack(RF, InData%TurbineID) + call RegPack(RF, InData%TurbinePos) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumCtrl2SC) + call RegPackAlloc(RF, InData%fromSCGlob) + call RegPackAlloc(RF, InData%fromSC) + call RegPack(RF, InData%FarmIntegration) + call RegPack(RF, InData%windGrid_n) + call RegPack(RF, InData%windGrid_delta) + call RegPack(RF, InData%windGrid_pZero) + call RegPackPtr(RF, InData%windGrid_data) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%NumActForcePtsBlade) + call RegPack(RF, InData%NumActForcePtsTower) + call RegPack(RF, InData%NodeClusterType) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInitType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_ExternInitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' integer(B8Ki) :: LB(5), UB(5) @@ -14617,93 +12952,27 @@ subroutine FAST_UnPackExternInitType(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TurbineID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TurbinePos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fromSCGlob) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fromSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%FarmIntegration) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%windGrid_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%windGrid_delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%windGrid_pZero) - if (RegCheckErr(Buf, RoutineName)) return - if (associated(OutData%windGrid_data)) deallocate(OutData%windGrid_data) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%windGrid_data, UB(1:5)-LB(1:5)) - OutData%windGrid_data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%windGrid_data - else - allocate(OutData%windGrid_data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%windGrid_data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%windGrid_data) - call RegUnpack(Buf, OutData%windGrid_data) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%windGrid_data => null() - end if - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumActForcePtsBlade) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumActForcePtsTower) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NodeClusterType) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LidRadialVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbineID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbinePos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FarmIntegration); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%windGrid_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%windGrid_delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%windGrid_pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%windGrid_data); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumActForcePtsBlade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumActForcePtsTower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NodeClusterType); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg) @@ -14841,66 +13110,65 @@ subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine FAST_PackTurbineType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine FAST_PackTurbineType(RF, Indata) + type(RegFile), intent(inout) :: RF type(FAST_TurbineType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackTurbineType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%TurbID) - call FAST_PackParam(Buf, InData%p_FAST) - call FAST_PackOutputFileType(Buf, InData%y_FAST) - call FAST_PackMisc(Buf, InData%m_FAST) - call FAST_PackModuleMapType(Buf, InData%MeshMapData) - call FAST_PackElastoDyn_Data(Buf, InData%ED) - call FAST_PackBeamDyn_Data(Buf, InData%BD) - call FAST_PackServoDyn_Data(Buf, InData%SrvD) - call FAST_PackAeroDyn_Data(Buf, InData%AD) - call FAST_PackAeroDyn14_Data(Buf, InData%AD14) - call FAST_PackInflowWind_Data(Buf, InData%IfW) - call FAST_PackExternalInflow_Data(Buf, InData%ExtInfw) - call FAST_PackSCDataEx_Data(Buf, InData%SC_DX) - call FAST_PackSeaState_Data(Buf, InData%SeaSt) - call FAST_PackHydroDyn_Data(Buf, InData%HD) - call FAST_PackSubDyn_Data(Buf, InData%SD) - call FAST_PackMAP_Data(Buf, InData%MAP) - call FAST_PackFEAMooring_Data(Buf, InData%FEAM) - call FAST_PackMoorDyn_Data(Buf, InData%MD) - call FAST_PackOrcaFlex_Data(Buf, InData%Orca) - call FAST_PackIceFloe_Data(Buf, InData%IceF) - call FAST_PackIceDyn_Data(Buf, InData%IceD) - call FAST_PackExtPtfm_Data(Buf, InData%ExtPtfm) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackTurbineType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%TurbID) + call FAST_PackParam(RF, InData%p_FAST) + call FAST_PackOutputFileType(RF, InData%y_FAST) + call FAST_PackMisc(RF, InData%m_FAST) + call FAST_PackModuleMapType(RF, InData%MeshMapData) + call FAST_PackElastoDyn_Data(RF, InData%ED) + call FAST_PackBeamDyn_Data(RF, InData%BD) + call FAST_PackServoDyn_Data(RF, InData%SrvD) + call FAST_PackAeroDyn_Data(RF, InData%AD) + call FAST_PackAeroDyn14_Data(RF, InData%AD14) + call FAST_PackInflowWind_Data(RF, InData%IfW) + call FAST_PackExternalInflow_Data(RF, InData%ExtInfw) + call FAST_PackSCDataEx_Data(RF, InData%SC_DX) + call FAST_PackSeaState_Data(RF, InData%SeaSt) + call FAST_PackHydroDyn_Data(RF, InData%HD) + call FAST_PackSubDyn_Data(RF, InData%SD) + call FAST_PackMAP_Data(RF, InData%MAP) + call FAST_PackFEAMooring_Data(RF, InData%FEAM) + call FAST_PackMoorDyn_Data(RF, InData%MD) + call FAST_PackOrcaFlex_Data(RF, InData%Orca) + call FAST_PackIceFloe_Data(RF, InData%IceF) + call FAST_PackIceDyn_Data(RF, InData%IceD) + call FAST_PackExtPtfm_Data(RF, InData%ExtPtfm) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTurbineType(RF, OutData) + type(RegFile), intent(inout) :: RF type(FAST_TurbineType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackTurbineType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%TurbID) - if (RegCheckErr(Buf, RoutineName)) return - call FAST_UnpackParam(Buf, OutData%p_FAST) ! p_FAST - call FAST_UnpackOutputFileType(Buf, OutData%y_FAST) ! y_FAST - call FAST_UnpackMisc(Buf, OutData%m_FAST) ! m_FAST - call FAST_UnpackModuleMapType(Buf, OutData%MeshMapData) ! MeshMapData - call FAST_UnpackElastoDyn_Data(Buf, OutData%ED) ! ED - call FAST_UnpackBeamDyn_Data(Buf, OutData%BD) ! BD - call FAST_UnpackServoDyn_Data(Buf, OutData%SrvD) ! SrvD - call FAST_UnpackAeroDyn_Data(Buf, OutData%AD) ! AD - call FAST_UnpackAeroDyn14_Data(Buf, OutData%AD14) ! AD14 - call FAST_UnpackInflowWind_Data(Buf, OutData%IfW) ! IfW - call FAST_UnpackExternalInflow_Data(Buf, OutData%ExtInfw) ! ExtInfw - call FAST_UnpackSCDataEx_Data(Buf, OutData%SC_DX) ! SC_DX - call FAST_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt - call FAST_UnpackHydroDyn_Data(Buf, OutData%HD) ! HD - call FAST_UnpackSubDyn_Data(Buf, OutData%SD) ! SD - call FAST_UnpackMAP_Data(Buf, OutData%MAP) ! MAP - call FAST_UnpackFEAMooring_Data(Buf, OutData%FEAM) ! FEAM - call FAST_UnpackMoorDyn_Data(Buf, OutData%MD) ! MD - call FAST_UnpackOrcaFlex_Data(Buf, OutData%Orca) ! Orca - call FAST_UnpackIceFloe_Data(Buf, OutData%IceF) ! IceF - call FAST_UnpackIceDyn_Data(Buf, OutData%IceD) ! IceD - call FAST_UnpackExtPtfm_Data(Buf, OutData%ExtPtfm) ! ExtPtfm + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%TurbID); if (RegCheckErr(RF, RoutineName)) return + call FAST_UnpackParam(RF, OutData%p_FAST) ! p_FAST + call FAST_UnpackOutputFileType(RF, OutData%y_FAST) ! y_FAST + call FAST_UnpackMisc(RF, OutData%m_FAST) ! m_FAST + call FAST_UnpackModuleMapType(RF, OutData%MeshMapData) ! MeshMapData + call FAST_UnpackElastoDyn_Data(RF, OutData%ED) ! ED + call FAST_UnpackBeamDyn_Data(RF, OutData%BD) ! BD + call FAST_UnpackServoDyn_Data(RF, OutData%SrvD) ! SrvD + call FAST_UnpackAeroDyn_Data(RF, OutData%AD) ! AD + call FAST_UnpackAeroDyn14_Data(RF, OutData%AD14) ! AD14 + call FAST_UnpackInflowWind_Data(RF, OutData%IfW) ! IfW + call FAST_UnpackExternalInflow_Data(RF, OutData%ExtInfw) ! ExtInfw + call FAST_UnpackSCDataEx_Data(RF, OutData%SC_DX) ! SC_DX + call FAST_UnpackSeaState_Data(RF, OutData%SeaSt) ! SeaSt + call FAST_UnpackHydroDyn_Data(RF, OutData%HD) ! HD + call FAST_UnpackSubDyn_Data(RF, OutData%SD) ! SD + call FAST_UnpackMAP_Data(RF, OutData%MAP) ! MAP + call FAST_UnpackFEAMooring_Data(RF, OutData%FEAM) ! FEAM + call FAST_UnpackMoorDyn_Data(RF, OutData%MD) ! MD + call FAST_UnpackOrcaFlex_Data(RF, OutData%Orca) ! Orca + call FAST_UnpackIceFloe_Data(RF, OutData%IceF) ! IceF + call FAST_UnpackIceDyn_Data(RF, OutData%IceD) ! IceD + call FAST_UnpackExtPtfm_Data(RF, OutData%ExtPtfm) ! ExtPtfm end subroutine END MODULE FAST_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 91c1f393e9..9a407c184d 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -398,43 +398,6 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, continue; } - // If allocatable field that is not a derived type, use Fortran 2003 automatic - // allocation to duplicate the source variable - if (field.is_allocatable && field.data_type->tag != DataType::Tag::Derived) - { - // If source is allocated or associated - w << indent << "if (" << alloc_assoc << "(" << src << ")) then"; - indent += " "; - - // Copy values - w << indent << dst << " = " << src; - - // If C code and field isn't a pointer, copy data to C object - if (gen_c_code && !field.is_pointer) - { - if (field.rank == 0) // scalar of any type OR a character array - { - std::string tmp = ddt.name_short + "Data%C_obj%" + field.name; - w << indent << "Dst" << tmp << " = Src" << tmp; - } - } - - // End if dst alloc/assoc - indent.erase(indent.size() - 3); - w << indent << "else if (" << alloc_assoc << "(" << dst << ")) then"; - if (field.is_pointer && !field.is_target) - { - w << indent << " nullify(" << dst << ")"; - } - else - { - w << indent << " deallocate(" << dst << ")"; - } - w << indent << "end if"; - - continue; - } - // If field is allocatable if (field.is_allocatable) { diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 0252be5e3f..6a6e5abce4 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -131,28 +131,25 @@ subroutine Orca_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Orca_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%TMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%TMax) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -215,62 +212,28 @@ subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Orca_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -298,34 +261,29 @@ subroutine Orca_DestroyInputFile(InputFileData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Orca_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DLL_FileName) - call RegPack(Buf, InData%DLL_InitProcName) - call RegPack(Buf, InData%DLL_CalcProcName) - call RegPack(Buf, InData%DLL_EndProcName) - call RegPack(Buf, InData%DirRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DLL_FileName) + call RegPack(RF, InData%DLL_InitProcName) + call RegPack(RF, InData%DLL_CalcProcName) + call RegPack(RF, InData%DLL_EndProcName) + call RegPack(RF, InData%DirRoot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInputFile' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DLL_FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_InitProcName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_CalcProcName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_EndProcName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DirRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_InitProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_CalcProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_EndProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirRoot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -349,22 +307,21 @@ subroutine Orca_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Orca_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -408,53 +365,32 @@ subroutine Orca_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine Orca_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%PtfmAM) - call RegPack(Buf, InData%PtfmFt) - call RegPack(Buf, InData%F_PtfmAM) - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - call RegPack(Buf, InData%LastTimeStep) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PtfmAM) + call RegPack(RF, InData%PtfmFt) + call RegPack(RF, InData%F_PtfmAM) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%LastTimeStep) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackMisc' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%PtfmAM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmFt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%F_PtfmAM) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LastTimeStep) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PtfmAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmFt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%F_PtfmAM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTimeStep); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -517,61 +453,55 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine Orca_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call DLLTypePack(Buf, InData%DLL_Orca) - call RegPack(Buf, InData%SimNamePath) - call RegPack(Buf, InData%SimNamePathLen) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call DLLTypePack(RF, InData%DLL_Orca) + call RegPack(RF, InData%SimNamePath) + call RegPack(RF, InData%SimNamePathLen) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call DLLTypeUnpack(Buf, OutData%DLL_Orca) ! DLL_Orca - call RegUnpack(Buf, OutData%SimNamePath) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimNamePathLen) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Orca) ! DLL_Orca + call RegUnpack(RF, OutData%SimNamePath); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimNamePathLen); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if end subroutine @@ -605,21 +535,21 @@ subroutine Orca_DestroyInput(InputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine Orca_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PtfmMesh) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh end subroutine subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -667,43 +597,26 @@ subroutine Orca_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Orca_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%PtfmMesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%PtfmMesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%PtfmMesh) ! PtfmMesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -727,22 +640,21 @@ subroutine Orca_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Orca_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -766,22 +678,21 @@ subroutine Orca_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Orca_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -805,22 +716,21 @@ subroutine Orca_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Orca_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(Orca_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Orca_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Orca_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(Orca_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Orca_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 02e3286938..4a2917f3a2 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -109,77 +109,48 @@ subroutine Current_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine Current_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Current_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Current_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Current_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%CurrSSV0) - call RegPack(Buf, InData%CurrSSDirChr) - call RegPack(Buf, InData%CurrSSDir) - call RegPack(Buf, InData%CurrNSRef) - call RegPack(Buf, InData%CurrNSV0) - call RegPack(Buf, InData%CurrNSDir) - call RegPack(Buf, InData%CurrDIV) - call RegPack(Buf, InData%CurrDIDir) - call RegPack(Buf, InData%CurrMod) - call RegPack(Buf, InData%EffWtrDpth) - call RegPack(Buf, allocated(InData%WaveKinGridzi)) - if (allocated(InData%WaveKinGridzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi, kind=B8Ki), ubound(InData%WaveKinGridzi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridzi) - end if - call RegPack(Buf, InData%NGridPts) - call RegPack(Buf, InData%DirRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CurrSSV0) + call RegPack(RF, InData%CurrSSDirChr) + call RegPack(RF, InData%CurrSSDir) + call RegPack(RF, InData%CurrNSRef) + call RegPack(RF, InData%CurrNSV0) + call RegPack(RF, InData%CurrNSDir) + call RegPack(RF, InData%CurrDIV) + call RegPack(RF, InData%CurrDIDir) + call RegPack(RF, InData%CurrMod) + call RegPack(RF, InData%EffWtrDpth) + call RegPackAlloc(RF, InData%WaveKinGridzi) + call RegPack(RF, InData%NGridPts) + call RegPack(RF, InData%DirRoot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Current_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Current_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Current_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%CurrSSV0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrSSDirChr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrSSDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrNSRef) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrNSV0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrNSDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrDIV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrDIDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EffWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridzi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NGridPts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DirRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CurrSSV0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrSSDirChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrSSDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrNSRef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrNSV0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrNSDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrDIV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrDIDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirRoot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -236,66 +207,30 @@ subroutine Current_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Current_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Current_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Current_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Current_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%CurrVxi)) - if (allocated(InData%CurrVxi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVxi, kind=B8Ki), ubound(InData%CurrVxi, kind=B8Ki)) - call RegPack(Buf, InData%CurrVxi) - end if - call RegPack(Buf, allocated(InData%CurrVyi)) - if (allocated(InData%CurrVyi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVyi, kind=B8Ki), ubound(InData%CurrVyi, kind=B8Ki)) - call RegPack(Buf, InData%CurrVyi) - end if - call RegPack(Buf, InData%PCurrVxiPz0) - call RegPack(Buf, InData%PCurrVyiPz0) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%CurrVxi) + call RegPackAlloc(RF, InData%CurrVyi) + call RegPack(RF, InData%PCurrVxiPz0) + call RegPack(RF, InData%PCurrVyiPz0) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Current_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Current_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Current_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CurrVxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CurrVxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CurrVyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CurrVyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PCurrVxiPz0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PCurrVyiPz0) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%CurrVxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVxiPz0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVyiPz0); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE Current_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 10331b864d..656e7f8460 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -364,372 +364,96 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E end if end subroutine -subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_WaveFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WaveTime)) - if (allocated(InData%WaveTime)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveTime, kind=B8Ki), ubound(InData%WaveTime, kind=B8Ki)) - call RegPack(Buf, InData%WaveTime) - end if - call RegPack(Buf, allocated(InData%WaveDynP)) - if (allocated(InData%WaveDynP)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP, kind=B8Ki), ubound(InData%WaveDynP, kind=B8Ki)) - call RegPack(Buf, InData%WaveDynP) - end if - call RegPack(Buf, allocated(InData%WaveAcc)) - if (allocated(InData%WaveAcc)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc, kind=B8Ki), ubound(InData%WaveAcc, kind=B8Ki)) - call RegPack(Buf, InData%WaveAcc) - end if - call RegPack(Buf, allocated(InData%WaveAccMCF)) - if (allocated(InData%WaveAccMCF)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF, kind=B8Ki), ubound(InData%WaveAccMCF, kind=B8Ki)) - call RegPack(Buf, InData%WaveAccMCF) - end if - call RegPack(Buf, allocated(InData%WaveVel)) - if (allocated(InData%WaveVel)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel, kind=B8Ki), ubound(InData%WaveVel, kind=B8Ki)) - call RegPack(Buf, InData%WaveVel) - end if - call RegPack(Buf, allocated(InData%PWaveDynP0)) - if (allocated(InData%PWaveDynP0)) then - call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0, kind=B8Ki), ubound(InData%PWaveDynP0, kind=B8Ki)) - call RegPack(Buf, InData%PWaveDynP0) - end if - call RegPack(Buf, allocated(InData%PWaveAcc0)) - if (allocated(InData%PWaveAcc0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0, kind=B8Ki), ubound(InData%PWaveAcc0, kind=B8Ki)) - call RegPack(Buf, InData%PWaveAcc0) - end if - call RegPack(Buf, allocated(InData%PWaveAccMCF0)) - if (allocated(InData%PWaveAccMCF0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0, kind=B8Ki), ubound(InData%PWaveAccMCF0, kind=B8Ki)) - call RegPack(Buf, InData%PWaveAccMCF0) - end if - call RegPack(Buf, allocated(InData%PWaveVel0)) - if (allocated(InData%PWaveVel0)) then - call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0, kind=B8Ki), ubound(InData%PWaveVel0, kind=B8Ki)) - call RegPack(Buf, InData%PWaveVel0) - end if - call RegPack(Buf, allocated(InData%WaveElev0)) - if (allocated(InData%WaveElev0)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElev0, kind=B8Ki), ubound(InData%WaveElev0, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev0) - end if - call RegPack(Buf, allocated(InData%WaveElev1)) - if (allocated(InData%WaveElev1)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev1, kind=B8Ki), ubound(InData%WaveElev1, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev1) - end if - call RegPack(Buf, allocated(InData%WaveElev2)) - if (allocated(InData%WaveElev2)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElev2, kind=B8Ki), ubound(InData%WaveElev2, kind=B8Ki)) - call RegPack(Buf, InData%WaveElev2) - end if - call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) - call RegPack(Buf, InData%WaveStMod) - call RegPack(Buf, InData%EffWtrDpth) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, allocated(InData%WaveElevC)) - if (allocated(InData%WaveElevC)) then - call RegPackBounds(Buf, 3, lbound(InData%WaveElevC, kind=B8Ki), ubound(InData%WaveElevC, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevC) - end if - call RegPack(Buf, allocated(InData%WaveElevC0)) - if (allocated(InData%WaveElevC0)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0, kind=B8Ki), ubound(InData%WaveElevC0, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevC0) - end if - call RegPack(Buf, allocated(InData%WaveDirArr)) - if (allocated(InData%WaveDirArr)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr, kind=B8Ki), ubound(InData%WaveDirArr, kind=B8Ki)) - call RegPack(Buf, InData%WaveDirArr) - end if - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, InData%RhoXg) - call RegPack(Buf, InData%WaveDirMin) - call RegPack(Buf, InData%WaveDirMax) - call RegPack(Buf, InData%WaveDir) - call RegPack(Buf, InData%WaveMultiDir) - call RegPack(Buf, InData%MCFD) - call RegPack(Buf, InData%WvLowCOff) - call RegPack(Buf, InData%WvHiCOff) - call RegPack(Buf, InData%WvLowCOffD) - call RegPack(Buf, InData%WvHiCOffD) - call RegPack(Buf, InData%WvLowCOffS) - call RegPack(Buf, InData%WvHiCOffS) - call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, InData%WaveMod) - call RegPack(Buf, InData%NStepWave) - call RegPack(Buf, InData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WaveTime) + call RegPackAlloc(RF, InData%WaveDynP) + call RegPackAlloc(RF, InData%WaveAcc) + call RegPackAlloc(RF, InData%WaveAccMCF) + call RegPackAlloc(RF, InData%WaveVel) + call RegPackAlloc(RF, InData%PWaveDynP0) + call RegPackAlloc(RF, InData%PWaveAcc0) + call RegPackAlloc(RF, InData%PWaveAccMCF0) + call RegPackAlloc(RF, InData%PWaveVel0) + call RegPackAlloc(RF, InData%WaveElev0) + call RegPackAlloc(RF, InData%WaveElev1) + call RegPackAlloc(RF, InData%WaveElev2) + call SeaSt_Interp_PackParam(RF, InData%SeaSt_Interp_p) + call RegPack(RF, InData%WaveStMod) + call RegPack(RF, InData%EffWtrDpth) + call RegPack(RF, InData%MSL2SWL) + call RegPackAlloc(RF, InData%WaveElevC) + call RegPackAlloc(RF, InData%WaveElevC0) + call RegPackAlloc(RF, InData%WaveDirArr) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%RhoXg) + call RegPack(RF, InData%WaveDirMin) + call RegPack(RF, InData%WaveDirMax) + call RegPack(RF, InData%WaveDir) + call RegPack(RF, InData%WaveMultiDir) + call RegPack(RF, InData%MCFD) + call RegPack(RF, InData%WvLowCOff) + call RegPack(RF, InData%WvHiCOff) + call RegPack(RF, InData%WvLowCOffD) + call RegPack(RF, InData%WvHiCOffD) + call RegPack(RF, InData%WvLowCOffS) + call RegPack(RF, InData%WvHiCOffS) + call RegPack(RF, InData%WaveDOmega) + call RegPack(RF, InData%WaveMod) + call RegPack(RF, InData%NStepWave) + call RegPack(RF, InData%NStepWave2) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_WaveFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveTime) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveDynP) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveAcc) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveAccMCF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveVel)) deallocate(OutData%WaveVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveVel) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PWaveDynP0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PWaveAcc0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PWaveAccMCF0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PWaveVel0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElev2) - if (RegCheckErr(Buf, RoutineName)) return - end if - call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EffWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevC0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveDirArr) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WaveTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDynP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAccMCF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveDynP0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveAcc0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveAccMCF0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PWaveVel0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_Interp_UnpackParam(RF, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevC0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDirArr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RhoXg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMultiDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCFD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDOmega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NStepWave2); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index e02fbe8fc2..3322b030fc 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -89,31 +89,27 @@ subroutine SeaSt_Interp_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_Interp_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) - call RegPack(Buf, InData%delta) - call RegPack(Buf, InData%pZero) - call RegPack(Buf, InData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%Z_Depth) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_Interp_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pZero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_Interp_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -145,21 +141,21 @@ subroutine SeaSt_Interp_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SeaSt_Interp_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_Interp_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine SeaSt_Interp_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -187,34 +183,29 @@ subroutine SeaSt_Interp_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_Interp_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%N3D) - call RegPack(Buf, InData%N4D) - call RegPack(Buf, InData%Indx_Lo) - call RegPack(Buf, InData%Indx_Hi) - call RegPack(Buf, InData%FirstWarn_Clamp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%N3D) + call RegPack(RF, InData%N4D) + call RegPack(RF, InData%Indx_Lo) + call RegPack(RF, InData%Indx_Hi) + call RegPack(RF, InData%FirstWarn_Clamp) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_Interp_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%N3D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%N4D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Indx_Lo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Indx_Hi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FirstWarn_Clamp) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Lo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Hi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_Interp_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -241,31 +232,27 @@ subroutine SeaSt_Interp_DestroyParam(ParamData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_Interp_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%n) - call RegPack(Buf, InData%delta) - call RegPack(Buf, InData%pZero) - call RegPack(Buf, InData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%Z_Depth) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_Interp_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_Interp_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_Interp_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackParam' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%delta) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%pZero) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE SeaState_Interp_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 78b2a16e84..ff4581d486 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -339,238 +339,104 @@ subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine SeaSt_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%EchoFlag) - call RegPack(Buf, InData%MSL2SWL) - call RegPack(Buf, InData%X_HalfWidth) - call RegPack(Buf, InData%Y_HalfWidth) - call RegPack(Buf, InData%Z_Depth) - call RegPack(Buf, InData%NX) - call RegPack(Buf, InData%NY) - call RegPack(Buf, InData%NZ) - call Waves_PackInitInput(Buf, InData%Waves) - call Waves2_PackInitInput(Buf, InData%Waves2) - call Current_PackInitInput(Buf, InData%Current) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%NWaveElev) - call RegPack(Buf, allocated(InData%WaveElevxi)) - if (allocated(InData%WaveElevxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi, kind=B8Ki), ubound(InData%WaveElevxi, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevxi) - end if - call RegPack(Buf, allocated(InData%WaveElevyi)) - if (allocated(InData%WaveElevyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi, kind=B8Ki), ubound(InData%WaveElevyi, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevyi) - end if - call RegPack(Buf, InData%NWaveKin) - call RegPack(Buf, allocated(InData%WaveKinxi)) - if (allocated(InData%WaveKinxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi, kind=B8Ki), ubound(InData%WaveKinxi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinxi) - end if - call RegPack(Buf, allocated(InData%WaveKinyi)) - if (allocated(InData%WaveKinyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi, kind=B8Ki), ubound(InData%WaveKinyi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinyi) - end if - call RegPack(Buf, allocated(InData%WaveKinzi)) - if (allocated(InData%WaveKinzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi, kind=B8Ki), ubound(InData%WaveKinzi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinzi) - end if - call RegPack(Buf, InData%OutSwtch) - call RegPack(Buf, InData%OutAll) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%SeaStSum) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutSFmt) - call RegPack(Buf, InData%WaveStMod) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%WtrDens) - call RegPack(Buf, InData%WaveDirMod) - call RegPack(Buf, InData%WaveDir) - call RegPack(Buf, InData%WaveMultiDir) - call RegPack(Buf, InData%MCFD) - call RegPack(Buf, InData%WvLowCOff) - call RegPack(Buf, InData%WvHiCOff) - call RegPack(Buf, InData%WvLowCOffD) - call RegPack(Buf, InData%WvHiCOffD) - call RegPack(Buf, InData%WvLowCOffS) - call RegPack(Buf, InData%WvHiCOffS) - call RegPack(Buf, InData%WaveDOmega) - call RegPack(Buf, InData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, InData%X_HalfWidth) + call RegPack(RF, InData%Y_HalfWidth) + call RegPack(RF, InData%Z_Depth) + call RegPack(RF, InData%NX) + call RegPack(RF, InData%NY) + call RegPack(RF, InData%NZ) + call Waves_PackInitInput(RF, InData%Waves) + call Waves2_PackInitInput(RF, InData%Waves2) + call Current_PackInitInput(RF, InData%Current) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%NWaveElev) + call RegPackAlloc(RF, InData%WaveElevxi) + call RegPackAlloc(RF, InData%WaveElevyi) + call RegPack(RF, InData%NWaveKin) + call RegPackAlloc(RF, InData%WaveKinxi) + call RegPackAlloc(RF, InData%WaveKinyi) + call RegPackAlloc(RF, InData%WaveKinzi) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutAll) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%SeaStSum) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%WaveStMod) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%WtrDens) + call RegPack(RF, InData%WaveDirMod) + call RegPack(RF, InData%WaveDir) + call RegPack(RF, InData%WaveMultiDir) + call RegPack(RF, InData%MCFD) + call RegPack(RF, InData%WvLowCOff) + call RegPack(RF, InData%WvHiCOff) + call RegPack(RF, InData%WvLowCOffD) + call RegPack(RF, InData%WvHiCOffD) + call RegPack(RF, InData%WvLowCOffS) + call RegPack(RF, InData%WvHiCOffS) + call RegPack(RF, InData%WaveDOmega) + call RegPack(RF, InData%WaveMod) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%EchoFlag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%X_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Y_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NZ) - if (RegCheckErr(Buf, RoutineName)) return - call Waves_UnpackInitInput(Buf, OutData%Waves) ! Waves - call Waves2_UnpackInitInput(Buf, OutData%Waves2) ! Waves2 - call Current_UnpackInitInput(Buf, OutData%Current) ! Current - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWaveElev) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NWaveKin) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinzi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinzi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutAll) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SeaStSum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%X_HalfWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Y_HalfWidth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NZ); if (RegCheckErr(RF, RoutineName)) return + call Waves_UnpackInitInput(RF, OutData%Waves) ! Waves + call Waves2_UnpackInitInput(RF, OutData%Waves2) ! Waves2 + call Current_UnpackInitInput(RF, OutData%Current) ! Current + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SeaStSum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMultiDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%MCFD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvLowCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvHiCOffS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDOmega); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveMod); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -632,85 +498,54 @@ subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine SeaSt_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - call RegPack(Buf, InData%OutRootName) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%defWtrDens) - call RegPack(Buf, InData%defWtrDpth) - call RegPack(Buf, InData%defMSL2SWL) - call RegPack(Buf, InData%TMax) - call RegPack(Buf, allocated(InData%WaveElevXY)) - if (allocated(InData%WaveElevXY)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY, kind=B8Ki), ubound(InData%WaveElevXY, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevXY) - end if - call RegPack(Buf, InData%WaveFieldMod) - call RegPack(Buf, InData%PtfmLocationX) - call RegPack(Buf, InData%PtfmLocationY) - call RegPack(Buf, InData%WrWvKinMod) - call RegPack(Buf, InData%HasIce) - call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedFileData) + call RegPack(RF, InData%OutRootName) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%defWtrDens) + call RegPack(RF, InData%defWtrDpth) + call RegPack(RF, InData%defMSL2SWL) + call RegPack(RF, InData%TMax) + call RegPackAlloc(RF, InData%WaveElevXY) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%PtfmLocationX) + call RegPack(RF, InData%PtfmLocationY) + call RegPack(RF, InData%WrWvKinMod) + call RegPack(RF, InData%HasIce) + call RegPack(RF, InData%Linearize) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - call RegUnpack(Buf, OutData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defWtrDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%defMSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TMax) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevXY) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmLocationX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmLocationY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WrWvKinMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HasIce) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedFileData) ! PassedFileData + call RegUnpack(RF, OutData%OutRootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defWtrDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defWtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%defMSL2SWL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevXY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrWvKinMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HasIce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -791,41 +626,29 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveField) end subroutine -subroutine SeaSt_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInitOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%InvalidWithSSExctn) - call RegPack(Buf, allocated(InData%WaveElevSeries)) - if (allocated(InData%WaveElevSeries)) then - call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries, kind=B8Ki), ubound(InData%WaveElevSeries, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevSeries) - end if - call RegPack(Buf, associated(InData%WaveField)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%InvalidWithSSExctn) + call RegPackAlloc(RF, InData%WaveElevSeries) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' integer(B8Ki) :: LB(2), UB(2) @@ -833,68 +656,26 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%InvalidWithSSExctn) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevSeries) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%InvalidWithSSExctn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevSeries); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -922,22 +703,21 @@ subroutine SeaSt_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -961,22 +741,21 @@ subroutine SeaSt_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1000,22 +779,21 @@ subroutine SeaSt_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1039,22 +817,21 @@ subroutine SeaSt_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%UnusedStates) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%UnusedStates) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%UnusedStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1089,30 +866,27 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SeaSt_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Decimate) - call RegPack(Buf, InData%LastOutTime) - call RegPack(Buf, InData%LastIndWave) - call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Decimate) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%LastIndWave) + call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Decimate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return - call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -1274,73 +1048,53 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine SeaSt_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackParam' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WaveDT) - call RegPack(Buf, InData%NGridPts) - call RegPack(Buf, InData%NGrid) - call RegPack(Buf, InData%deltaGrid) - call RegPack(Buf, InData%NWaveElev) - call RegPack(Buf, allocated(InData%WaveElevxi)) - if (allocated(InData%WaveElevxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi, kind=B8Ki), ubound(InData%WaveElevxi, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevxi) - end if - call RegPack(Buf, allocated(InData%WaveElevyi)) - if (allocated(InData%WaveElevyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi, kind=B8Ki), ubound(InData%WaveElevyi, kind=B8Ki)) - call RegPack(Buf, InData%WaveElevyi) - end if - call RegPack(Buf, InData%NWaveKin) - call RegPack(Buf, allocated(InData%WaveKinxi)) - if (allocated(InData%WaveKinxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi, kind=B8Ki), ubound(InData%WaveKinxi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinxi) - end if - call RegPack(Buf, allocated(InData%WaveKinyi)) - if (allocated(InData%WaveKinyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi, kind=B8Ki), ubound(InData%WaveKinyi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinyi) - end if - call RegPack(Buf, allocated(InData%WaveKinzi)) - if (allocated(InData%WaveKinzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi, kind=B8Ki), ubound(InData%WaveKinzi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinzi) - end if - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WaveDT) + call RegPack(RF, InData%NGridPts) + call RegPack(RF, InData%NGrid) + call RegPack(RF, InData%deltaGrid) + call RegPack(RF, InData%NWaveElev) + call RegPackAlloc(RF, InData%WaveElevxi) + call RegPackAlloc(RF, InData%WaveElevyi) + call RegPack(RF, InData%NWaveKin) + call RegPackAlloc(RF, InData%WaveKinxi) + call RegPackAlloc(RF, InData%WaveKinyi) + call RegPackAlloc(RF, InData%WaveKinzi) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%OutSwtch) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutSFmt) - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%UnOutFile) - call RegPack(Buf, InData%OutDec) - call RegPack(Buf, associated(InData%WaveField)) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UnOutFile) + call RegPack(RF, InData%OutDec) + call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then - call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) if (.not. PtrInIndex) then - call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' integer(B8Ki) :: i1 @@ -1349,134 +1103,52 @@ subroutine SeaSt_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WaveDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NGridPts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NGrid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%deltaGrid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWaveElev) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveElevyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveElevyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NWaveKin) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinzi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinzi) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGridPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%deltaGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinzi); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnOutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutDec) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnOutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return if (c_associated(Ptr)) then call c_f_pointer(Ptr, OutData%WaveField) else allocate(OutData%WaveField,stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) - call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + RF%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(RF, OutData%WaveField) ! WaveField end if else OutData%WaveField => null() @@ -1504,22 +1176,21 @@ subroutine SeaSt_DestroyInput(InputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SeaSt_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyInput) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyInput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyInput) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyInput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1559,41 +1230,24 @@ subroutine SeaSt_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SeaSt_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SeaSt_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SeaSt_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SeaSt_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SeaSt_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 0fdde7f505..a8bd1b7ccf 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -131,97 +131,40 @@ subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine Waves2_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves2_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Waves2_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves2_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%nGrid) - call RegPack(Buf, InData%NWaveElevGrid) - call RegPack(Buf, InData%NWaveKinGrid) - call RegPack(Buf, allocated(InData%WaveKinGridxi)) - if (allocated(InData%WaveKinGridxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi, kind=B8Ki), ubound(InData%WaveKinGridxi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridxi) - end if - call RegPack(Buf, allocated(InData%WaveKinGridyi)) - if (allocated(InData%WaveKinGridyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi, kind=B8Ki), ubound(InData%WaveKinGridyi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridyi) - end if - call RegPack(Buf, allocated(InData%WaveKinGridzi)) - if (allocated(InData%WaveKinGridzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi, kind=B8Ki), ubound(InData%WaveKinGridzi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridzi) - end if - call RegPack(Buf, InData%WvDiffQTFF) - call RegPack(Buf, InData%WvSumQTFF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%nGrid) + call RegPack(RF, InData%NWaveElevGrid) + call RegPack(RF, InData%NWaveKinGrid) + call RegPackAlloc(RF, InData%WaveKinGridxi) + call RegPackAlloc(RF, InData%WaveKinGridyi) + call RegPackAlloc(RF, InData%WaveKinGridzi) + call RegPack(RF, InData%WvDiffQTFF) + call RegPack(RF, InData%WvSumQTFF) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Waves2_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves2_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Waves2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nGrid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWaveElevGrid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWaveKinGrid) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridzi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%WvDiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvSumQTFF) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElevGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKinGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvDiffQTFF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvSumQTFF); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -336,136 +279,34 @@ subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine Waves2_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves2_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Waves2_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WaveAcc2D)) - if (allocated(InData%WaveAcc2D)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D, kind=B8Ki), ubound(InData%WaveAcc2D, kind=B8Ki)) - call RegPack(Buf, InData%WaveAcc2D) - end if - call RegPack(Buf, allocated(InData%WaveDynP2D)) - if (allocated(InData%WaveDynP2D)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D, kind=B8Ki), ubound(InData%WaveDynP2D, kind=B8Ki)) - call RegPack(Buf, InData%WaveDynP2D) - end if - call RegPack(Buf, allocated(InData%WaveAcc2S)) - if (allocated(InData%WaveAcc2S)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S, kind=B8Ki), ubound(InData%WaveAcc2S, kind=B8Ki)) - call RegPack(Buf, InData%WaveAcc2S) - end if - call RegPack(Buf, allocated(InData%WaveDynP2S)) - if (allocated(InData%WaveDynP2S)) then - call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S, kind=B8Ki), ubound(InData%WaveDynP2S, kind=B8Ki)) - call RegPack(Buf, InData%WaveDynP2S) - end if - call RegPack(Buf, allocated(InData%WaveVel2D)) - if (allocated(InData%WaveVel2D)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D, kind=B8Ki), ubound(InData%WaveVel2D, kind=B8Ki)) - call RegPack(Buf, InData%WaveVel2D) - end if - call RegPack(Buf, allocated(InData%WaveVel2S)) - if (allocated(InData%WaveVel2S)) then - call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S, kind=B8Ki), ubound(InData%WaveVel2S, kind=B8Ki)) - call RegPack(Buf, InData%WaveVel2S) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WaveAcc2D) + call RegPackAlloc(RF, InData%WaveDynP2D) + call RegPackAlloc(RF, InData%WaveAcc2S) + call RegPackAlloc(RF, InData%WaveDynP2S) + call RegPackAlloc(RF, InData%WaveVel2D) + call RegPackAlloc(RF, InData%WaveVel2S) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Waves2_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves2_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Waves2_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' integer(B8Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WaveAcc2D)) deallocate(OutData%WaveAcc2D) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveAcc2D) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveDynP2D)) deallocate(OutData%WaveDynP2D) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveDynP2D) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveAcc2S)) deallocate(OutData%WaveAcc2S) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveAcc2S) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveDynP2S)) deallocate(OutData%WaveDynP2S) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveDynP2S) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveVel2D)) deallocate(OutData%WaveVel2D) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveVel2D) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveVel2S)) deallocate(OutData%WaveVel2S) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 5, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveVel2S) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WaveAcc2D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDynP2D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveAcc2S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveDynP2S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel2D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveVel2S); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE Waves2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 4b465fc3a9..4cbea1da35 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -210,200 +210,88 @@ subroutine Waves_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine Waves_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Waves_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%DirRoot) - call RegPack(Buf, InData%WvKinFile) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%nGrid) - call RegPack(Buf, InData%WaveNDir) - call RegPack(Buf, InData%WaveDirSpread) - call RegPack(Buf, InData%WaveDirRange) - call RegPack(Buf, InData%WaveDT) - call RegPack(Buf, InData%WaveHs) - call RegPack(Buf, InData%WaveNDAmp) - call RegPack(Buf, InData%WavePhase) - call RegPack(Buf, InData%WavePkShp) - call RegPack(Buf, InData%WaveTMax) - call RegPack(Buf, InData%WaveTp) - call RegPack(Buf, InData%NWaveElevGrid) - call RegPack(Buf, InData%NWaveKinGrid) - call RegPack(Buf, allocated(InData%WaveKinGridxi)) - if (allocated(InData%WaveKinGridxi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi, kind=B8Ki), ubound(InData%WaveKinGridxi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridxi) - end if - call RegPack(Buf, allocated(InData%WaveKinGridyi)) - if (allocated(InData%WaveKinGridyi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi, kind=B8Ki), ubound(InData%WaveKinGridyi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridyi) - end if - call RegPack(Buf, allocated(InData%WaveKinGridzi)) - if (allocated(InData%WaveKinGridzi)) then - call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi, kind=B8Ki), ubound(InData%WaveKinGridzi, kind=B8Ki)) - call RegPack(Buf, InData%WaveKinGridzi) - end if - call RegPack(Buf, allocated(InData%CurrVxi)) - if (allocated(InData%CurrVxi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVxi, kind=B8Ki), ubound(InData%CurrVxi, kind=B8Ki)) - call RegPack(Buf, InData%CurrVxi) - end if - call RegPack(Buf, allocated(InData%CurrVyi)) - if (allocated(InData%CurrVyi)) then - call RegPackBounds(Buf, 1, lbound(InData%CurrVyi, kind=B8Ki), ubound(InData%CurrVyi, kind=B8Ki)) - call RegPack(Buf, InData%CurrVyi) - end if - call RegPack(Buf, InData%PCurrVxiPz0) - call RegPack(Buf, InData%PCurrVyiPz0) - call NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, InData%RNG) - call RegPack(Buf, InData%ConstWaveMod) - call RegPack(Buf, InData%CrestHmax) - call RegPack(Buf, InData%CrestTime) - call RegPack(Buf, InData%CrestXi) - call RegPack(Buf, InData%CrestYi) - call RegPack(Buf, InData%WaveFieldMod) - call RegPack(Buf, InData%PtfmLocationX) - call RegPack(Buf, InData%PtfmLocationY) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%DirRoot) + call RegPack(RF, InData%WvKinFile) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%nGrid) + call RegPack(RF, InData%WaveNDir) + call RegPack(RF, InData%WaveDirSpread) + call RegPack(RF, InData%WaveDirRange) + call RegPack(RF, InData%WaveDT) + call RegPack(RF, InData%WaveHs) + call RegPack(RF, InData%WaveNDAmp) + call RegPack(RF, InData%WavePhase) + call RegPack(RF, InData%WavePkShp) + call RegPack(RF, InData%WaveTMax) + call RegPack(RF, InData%WaveTp) + call RegPack(RF, InData%NWaveElevGrid) + call RegPack(RF, InData%NWaveKinGrid) + call RegPackAlloc(RF, InData%WaveKinGridxi) + call RegPackAlloc(RF, InData%WaveKinGridyi) + call RegPackAlloc(RF, InData%WaveKinGridzi) + call RegPackAlloc(RF, InData%CurrVxi) + call RegPackAlloc(RF, InData%CurrVyi) + call RegPack(RF, InData%PCurrVxiPz0) + call RegPack(RF, InData%PCurrVyiPz0) + call NWTC_Library_PackNWTC_RandomNumber_ParameterType(RF, InData%RNG) + call RegPack(RF, InData%ConstWaveMod) + call RegPack(RF, InData%CrestHmax) + call RegPack(RF, InData%CrestTime) + call RegPack(RF, InData%CrestXi) + call RegPack(RF, InData%CrestYi) + call RegPack(RF, InData%WaveFieldMod) + call RegPack(RF, InData%PtfmLocationX) + call RegPack(RF, InData%PtfmLocationY) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Waves_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Waves_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DirRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WvKinFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nGrid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveNDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirSpread) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDirRange) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveHs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveNDAmp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WavePhase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WavePkShp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveTMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveTp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWaveElevGrid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NWaveKinGrid) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WaveKinGridzi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CurrVxi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CurrVxi) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CurrVyi(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CurrVyi) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PCurrVxiPz0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PCurrVyiPz0) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackNWTC_RandomNumber_ParameterType(Buf, OutData%RNG) ! RNG - call RegUnpack(Buf, OutData%ConstWaveMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CrestHmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CrestTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CrestXi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CrestYi) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmLocationX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmLocationY) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WvKinFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveNDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirSpread); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDirRange); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveHs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveNDAmp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WavePhase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WavePkShp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveElevGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NWaveKinGrid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveKinGridzi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVxi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CurrVyi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVxiPz0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCurrVyiPz0); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackNWTC_RandomNumber_ParameterType(RF, OutData%RNG) ! RNG + call RegUnpack(RF, OutData%ConstWaveMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestHmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestXi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CrestYi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmLocationY); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -428,25 +316,23 @@ subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine Waves_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(Waves_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%WaveNDir) - call RegPack(Buf, InData%WaveTMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%WaveNDir) + call RegPack(RF, InData%WaveTMax) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine Waves_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine Waves_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(Waves_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%WaveNDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WaveTMax) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%WaveNDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WaveTMax); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE Waves_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index cc7445e5d0..9d2f6de448 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -822,354 +822,116 @@ subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%Linearize) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%BlPitchInit)) - if (allocated(InData%BlPitchInit)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit, kind=B8Ki), ubound(InData%BlPitchInit, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchInit) - end if - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%NacRefPos) - call RegPack(Buf, InData%NacTransDisp) - call RegPack(Buf, InData%NacOrient) - call RegPack(Buf, InData%NacRefOrient) - call RegPack(Buf, InData%TwrBaseRefPos) - call RegPack(Buf, InData%TwrBaseTransDisp) - call RegPack(Buf, InData%TwrBaseOrient) - call RegPack(Buf, InData%TwrBaseRefOrient) - call RegPack(Buf, InData%PtfmRefPos) - call RegPack(Buf, InData%PtfmTransDisp) - call RegPack(Buf, InData%PtfmOrient) - call RegPack(Buf, InData%PtfmRefOrient) - call RegPack(Buf, InData%Tmax) - call RegPack(Buf, InData%AvgWindSpeed) - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%NumSC2CtrlGlob) - call RegPack(Buf, InData%NumSC2Ctrl) - call RegPack(Buf, InData%NumCtrl2SC) - call RegPack(Buf, InData%TrimCase) - call RegPack(Buf, InData%TrimGain) - call RegPack(Buf, InData%RotSpeedRef) - call RegPack(Buf, allocated(InData%BladeRootRefPos)) - if (allocated(InData%BladeRootRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos, kind=B8Ki), ubound(InData%BladeRootRefPos, kind=B8Ki)) - call RegPack(Buf, InData%BladeRootRefPos) - end if - call RegPack(Buf, allocated(InData%BladeRootTransDisp)) - if (allocated(InData%BladeRootTransDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp, kind=B8Ki), ubound(InData%BladeRootTransDisp, kind=B8Ki)) - call RegPack(Buf, InData%BladeRootTransDisp) - end if - call RegPack(Buf, allocated(InData%BladeRootOrient)) - if (allocated(InData%BladeRootOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient, kind=B8Ki), ubound(InData%BladeRootOrient, kind=B8Ki)) - call RegPack(Buf, InData%BladeRootOrient) - end if - call RegPack(Buf, allocated(InData%BladeRootRefOrient)) - if (allocated(InData%BladeRootRefOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient, kind=B8Ki), ubound(InData%BladeRootRefOrient, kind=B8Ki)) - call RegPack(Buf, InData%BladeRootRefOrient) - end if - call RegPack(Buf, InData%UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - call RegPack(Buf, InData%NumCableControl) - call RegPack(Buf, allocated(InData%CableControlRequestor)) - if (allocated(InData%CableControlRequestor)) then - call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor, kind=B8Ki), ubound(InData%CableControlRequestor, kind=B8Ki)) - call RegPack(Buf, InData%CableControlRequestor) - end if - call RegPack(Buf, InData%InterpOrder) - call RegPack(Buf, allocated(InData%fromSCGlob)) - if (allocated(InData%fromSCGlob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob, kind=B8Ki), ubound(InData%fromSCGlob, kind=B8Ki)) - call RegPack(Buf, InData%fromSCGlob) - end if - call RegPack(Buf, allocated(InData%fromSC)) - if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) - call RegPack(Buf, InData%fromSC) - end if - call RegPack(Buf, allocated(InData%LidSpeed)) - if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) - call RegPack(Buf, InData%LidSpeed) - end if - call RegPack(Buf, allocated(InData%MsrPositionsX)) - if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsX) - end if - call RegPack(Buf, allocated(InData%MsrPositionsY)) - if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsY) - end if - call RegPack(Buf, allocated(InData%MsrPositionsZ)) - if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsZ) - end if - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%NumBeam) - call RegPack(Buf, InData%NumPulseGate) - call RegPack(Buf, InData%PulseSpacing) - call RegPack(Buf, InData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%RootName) + call RegPackAlloc(RF, InData%BlPitchInit) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%NacRefPos) + call RegPack(RF, InData%NacTransDisp) + call RegPack(RF, InData%NacOrient) + call RegPack(RF, InData%NacRefOrient) + call RegPack(RF, InData%TwrBaseRefPos) + call RegPack(RF, InData%TwrBaseTransDisp) + call RegPack(RF, InData%TwrBaseOrient) + call RegPack(RF, InData%TwrBaseRefOrient) + call RegPack(RF, InData%PtfmRefPos) + call RegPack(RF, InData%PtfmTransDisp) + call RegPack(RF, InData%PtfmOrient) + call RegPack(RF, InData%PtfmRefOrient) + call RegPack(RF, InData%Tmax) + call RegPack(RF, InData%AvgWindSpeed) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%RotSpeedRef) + call RegPackAlloc(RF, InData%BladeRootRefPos) + call RegPackAlloc(RF, InData%BladeRootTransDisp) + call RegPackAlloc(RF, InData%BladeRootOrient) + call RegPackAlloc(RF, InData%BladeRootRefOrient) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%NumCableControl) + call RegPackAlloc(RF, InData%CableControlRequestor) + call RegPack(RF, InData%InterpOrder) + call RegPackAlloc(RF, InData%fromSCGlob) + call RegPackAlloc(RF, InData%fromSC) + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchInit(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchInit) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacRefPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacTransDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacRefOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseRefPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseTransDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TwrBaseRefOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRefPos) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmTransDisp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtfmRefOrient) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimCase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimGain) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeedRef) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BladeRootRefPos)) deallocate(OutData%BladeRootRefPos) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BladeRootRefPos) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BladeRootTransDisp)) deallocate(OutData%BladeRootTransDisp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootTransDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BladeRootTransDisp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BladeRootOrient)) deallocate(OutData%BladeRootOrient) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BladeRootOrient) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BladeRootRefOrient)) deallocate(OutData%BladeRootRefOrient) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BladeRootRefOrient) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - call RegUnpack(Buf, OutData%NumCableControl) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%CableControlRequestor)) deallocate(OutData%CableControlRequestor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableControlRequestor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableControlRequestor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableControlRequestor) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%InterpOrder) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fromSCGlob) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fromSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LidSpeed) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrBaseRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtfmRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tmax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BladeRootRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableControlRequestor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCGlob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1354,220 +1116,48 @@ subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%CouplingScheme) - call RegPack(Buf, InData%UseHSSBrake) - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%CouplingScheme) + call RegPack(RF, InData%UseHSSBrake) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%CouplingScheme) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseHSSBrake) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%CouplingScheme); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseHSSBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) @@ -1777,395 +1367,196 @@ subroutine SrvD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%PCMode) - call RegPack(Buf, InData%TPCOn) - call RegPack(Buf, InData%TPitManS) - call RegPack(Buf, InData%PitManRat) - call RegPack(Buf, InData%BlPitchF) - call RegPack(Buf, InData%VSContrl) - call RegPack(Buf, InData%GenModel) - call RegPack(Buf, InData%GenEff) - call RegPack(Buf, InData%GenTiStr) - call RegPack(Buf, InData%GenTiStp) - call RegPack(Buf, InData%SpdGenOn) - call RegPack(Buf, InData%TimGenOn) - call RegPack(Buf, InData%TimGenOf) - call RegPack(Buf, InData%VS_RtGnSp) - call RegPack(Buf, InData%VS_RtTq) - call RegPack(Buf, InData%VS_Rgn2K) - call RegPack(Buf, InData%VS_SlPc) - call RegPack(Buf, InData%SIG_SlPc) - call RegPack(Buf, InData%SIG_SySp) - call RegPack(Buf, InData%SIG_RtTq) - call RegPack(Buf, InData%SIG_PORt) - call RegPack(Buf, InData%TEC_Freq) - call RegPack(Buf, InData%TEC_NPol) - call RegPack(Buf, InData%TEC_SRes) - call RegPack(Buf, InData%TEC_RRes) - call RegPack(Buf, InData%TEC_VLL) - call RegPack(Buf, InData%TEC_SLR) - call RegPack(Buf, InData%TEC_RLR) - call RegPack(Buf, InData%TEC_MR) - call RegPack(Buf, InData%HSSBrMode) - call RegPack(Buf, InData%THSSBrDp) - call RegPack(Buf, InData%HSSBrDT) - call RegPack(Buf, InData%HSSBrTqF) - call RegPack(Buf, InData%YCMode) - call RegPack(Buf, InData%TYCOn) - call RegPack(Buf, InData%YawNeut) - call RegPack(Buf, InData%YawSpr) - call RegPack(Buf, InData%YawDamp) - call RegPack(Buf, InData%TYawManS) - call RegPack(Buf, InData%YawManRat) - call RegPack(Buf, InData%NacYawF) - call RegPack(Buf, InData%SumPrint) - call RegPack(Buf, InData%OutFile) - call RegPack(Buf, InData%TabDelim) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%Tstart) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, allocated(InData%OutList)) - if (allocated(InData%OutList)) then - call RegPackBounds(Buf, 1, lbound(InData%OutList, kind=B8Ki), ubound(InData%OutList, kind=B8Ki)) - call RegPack(Buf, InData%OutList) - end if - call RegPack(Buf, InData%DLL_FileName) - call RegPack(Buf, InData%DLL_ProcName) - call RegPack(Buf, InData%DLL_InFile) - call RegPack(Buf, InData%DLL_DT) - call RegPack(Buf, InData%DLL_Ramp) - call RegPack(Buf, InData%BPCutoff) - call RegPack(Buf, InData%NacYaw_North) - call RegPack(Buf, InData%Ptch_Cntrl) - call RegPack(Buf, InData%Ptch_SetPnt) - call RegPack(Buf, InData%Ptch_Min) - call RegPack(Buf, InData%Ptch_Max) - call RegPack(Buf, InData%PtchRate_Min) - call RegPack(Buf, InData%PtchRate_Max) - call RegPack(Buf, InData%Gain_OM) - call RegPack(Buf, InData%GenSpd_MinOM) - call RegPack(Buf, InData%GenSpd_MaxOM) - call RegPack(Buf, InData%GenSpd_Dem) - call RegPack(Buf, InData%GenTrq_Dem) - call RegPack(Buf, InData%GenPwr_Dem) - call RegPack(Buf, InData%DLL_NumTrq) - call RegPack(Buf, allocated(InData%GenSpd_TLU)) - if (allocated(InData%GenSpd_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU, kind=B8Ki), ubound(InData%GenSpd_TLU, kind=B8Ki)) - call RegPack(Buf, InData%GenSpd_TLU) - end if - call RegPack(Buf, allocated(InData%GenTrq_TLU)) - if (allocated(InData%GenTrq_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU, kind=B8Ki), ubound(InData%GenTrq_TLU, kind=B8Ki)) - call RegPack(Buf, InData%GenTrq_TLU) - end if - call RegPack(Buf, InData%UseLegacyInterface) - call RegPack(Buf, InData%NumBStC) - call RegPack(Buf, allocated(InData%BStCfiles)) - if (allocated(InData%BStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%BStCfiles, kind=B8Ki), ubound(InData%BStCfiles, kind=B8Ki)) - call RegPack(Buf, InData%BStCfiles) - end if - call RegPack(Buf, InData%NumNStC) - call RegPack(Buf, allocated(InData%NStCfiles)) - if (allocated(InData%NStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%NStCfiles, kind=B8Ki), ubound(InData%NStCfiles, kind=B8Ki)) - call RegPack(Buf, InData%NStCfiles) - end if - call RegPack(Buf, InData%NumTStC) - call RegPack(Buf, allocated(InData%TStCfiles)) - if (allocated(InData%TStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%TStCfiles, kind=B8Ki), ubound(InData%TStCfiles, kind=B8Ki)) - call RegPack(Buf, InData%TStCfiles) - end if - call RegPack(Buf, InData%NumSStC) - call RegPack(Buf, allocated(InData%SStCfiles)) - if (allocated(InData%SStCfiles)) then - call RegPackBounds(Buf, 1, lbound(InData%SStCfiles, kind=B8Ki), ubound(InData%SStCfiles, kind=B8Ki)) - call RegPack(Buf, InData%SStCfiles) - end if - call RegPack(Buf, InData%AfCmode) - call RegPack(Buf, InData%AfC_Mean) - call RegPack(Buf, InData%AfC_Amp) - call RegPack(Buf, InData%AfC_Phase) - call RegPack(Buf, InData%CCmode) - call RegPack(Buf, InData%EXavrSWAP) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%PCMode) + call RegPack(RF, InData%TPCOn) + call RegPack(RF, InData%TPitManS) + call RegPack(RF, InData%PitManRat) + call RegPack(RF, InData%BlPitchF) + call RegPack(RF, InData%VSContrl) + call RegPack(RF, InData%GenModel) + call RegPack(RF, InData%GenEff) + call RegPack(RF, InData%GenTiStr) + call RegPack(RF, InData%GenTiStp) + call RegPack(RF, InData%SpdGenOn) + call RegPack(RF, InData%TimGenOn) + call RegPack(RF, InData%TimGenOf) + call RegPack(RF, InData%VS_RtGnSp) + call RegPack(RF, InData%VS_RtTq) + call RegPack(RF, InData%VS_Rgn2K) + call RegPack(RF, InData%VS_SlPc) + call RegPack(RF, InData%SIG_SlPc) + call RegPack(RF, InData%SIG_SySp) + call RegPack(RF, InData%SIG_RtTq) + call RegPack(RF, InData%SIG_PORt) + call RegPack(RF, InData%TEC_Freq) + call RegPack(RF, InData%TEC_NPol) + call RegPack(RF, InData%TEC_SRes) + call RegPack(RF, InData%TEC_RRes) + call RegPack(RF, InData%TEC_VLL) + call RegPack(RF, InData%TEC_SLR) + call RegPack(RF, InData%TEC_RLR) + call RegPack(RF, InData%TEC_MR) + call RegPack(RF, InData%HSSBrMode) + call RegPack(RF, InData%THSSBrDp) + call RegPack(RF, InData%HSSBrDT) + call RegPack(RF, InData%HSSBrTqF) + call RegPack(RF, InData%YCMode) + call RegPack(RF, InData%TYCOn) + call RegPack(RF, InData%YawNeut) + call RegPack(RF, InData%YawSpr) + call RegPack(RF, InData%YawDamp) + call RegPack(RF, InData%TYawManS) + call RegPack(RF, InData%YawManRat) + call RegPack(RF, InData%NacYawF) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%OutFile) + call RegPack(RF, InData%TabDelim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%Tstart) + call RegPack(RF, InData%NumOuts) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%DLL_FileName) + call RegPack(RF, InData%DLL_ProcName) + call RegPack(RF, InData%DLL_InFile) + call RegPack(RF, InData%DLL_DT) + call RegPack(RF, InData%DLL_Ramp) + call RegPack(RF, InData%BPCutoff) + call RegPack(RF, InData%NacYaw_North) + call RegPack(RF, InData%Ptch_Cntrl) + call RegPack(RF, InData%Ptch_SetPnt) + call RegPack(RF, InData%Ptch_Min) + call RegPack(RF, InData%Ptch_Max) + call RegPack(RF, InData%PtchRate_Min) + call RegPack(RF, InData%PtchRate_Max) + call RegPack(RF, InData%Gain_OM) + call RegPack(RF, InData%GenSpd_MinOM) + call RegPack(RF, InData%GenSpd_MaxOM) + call RegPack(RF, InData%GenSpd_Dem) + call RegPack(RF, InData%GenTrq_Dem) + call RegPack(RF, InData%GenPwr_Dem) + call RegPack(RF, InData%DLL_NumTrq) + call RegPackAlloc(RF, InData%GenSpd_TLU) + call RegPackAlloc(RF, InData%GenTrq_TLU) + call RegPack(RF, InData%UseLegacyInterface) + call RegPack(RF, InData%NumBStC) + call RegPackAlloc(RF, InData%BStCfiles) + call RegPack(RF, InData%NumNStC) + call RegPackAlloc(RF, InData%NStCfiles) + call RegPack(RF, InData%NumTStC) + call RegPackAlloc(RF, InData%TStCfiles) + call RegPack(RF, InData%NumSStC) + call RegPackAlloc(RF, InData%SStCfiles) + call RegPack(RF, InData%AfCmode) + call RegPack(RF, InData%AfC_Mean) + call RegPack(RF, InData%AfC_Amp) + call RegPack(RF, InData%AfC_Phase) + call RegPack(RF, InData%CCmode) + call RegPack(RF, InData%EXavrSWAP) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PCMode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TPCOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TPitManS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PitManRat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlPitchF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VSContrl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenModel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenEff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTiStr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTiStp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdGenOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimGenOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimGenOf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_RtGnSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_RtTq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_Rgn2K) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_SlPc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_SlPc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_SySp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_RtTq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_PORt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_Freq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_NPol) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_SRes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_RRes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_VLL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_SLR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_RLR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_MR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrMode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%THSSBrDp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrTqF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YCMode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TYCOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawNeut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawDamp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TYawManS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawManRat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYawF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%OutList)) deallocate(OutData%OutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%DLL_FileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_ProcName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_InFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_Ramp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BPCutoff) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYaw_North) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_Cntrl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_SetPnt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_Min) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_Max) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtchRate_Min) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtchRate_Max) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gain_OM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenSpd_MinOM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenSpd_MaxOM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenSpd_Dem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTrq_Dem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenPwr_Dem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_NumTrq) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GenSpd_TLU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GenSpd_TLU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GenTrq_TLU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GenTrq_TLU) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UseLegacyInterface) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBStC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BStCfiles)) deallocate(OutData%BStCfiles) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BStCfiles(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BStCfiles) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumNStC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NStCfiles)) deallocate(OutData%NStCfiles) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NStCfiles(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NStCfiles) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumTStC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TStCfiles)) deallocate(OutData%TStCfiles) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TStCfiles(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TStCfiles) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumSStC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%SStCfiles)) deallocate(OutData%SStCfiles) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SStCfiles(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SStCfiles) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%AfCmode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfC_Mean) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfC_Amp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfC_Phase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CCmode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EXavrSWAP) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_PORt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Freq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_NPol); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tstart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_ProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_InFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BPCutoff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Cntrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_SetPnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gain_OM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MinOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MaxOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenPwr_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_NumTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenSpd_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenTrq_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SStCfiles); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2651,715 +2042,235 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackBladedDLLType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackBladedDLLType(RF, Indata) + type(RegFile), intent(inout) :: RF type(BladedDLLType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%avrSWAP)) - if (allocated(InData%avrSWAP)) then - call RegPackBounds(Buf, 1, lbound(InData%avrSWAP, kind=B8Ki), ubound(InData%avrSWAP, kind=B8Ki)) - call RegPack(Buf, InData%avrSWAP) - end if - call RegPack(Buf, InData%HSSBrTrqDemand) - call RegPack(Buf, InData%YawRateCom) - call RegPack(Buf, InData%GenTrq) - call RegPack(Buf, InData%GenState) - call RegPack(Buf, InData%BlPitchCom) - call RegPack(Buf, InData%PrevBlPitch) - call RegPack(Buf, InData%BlAirfoilCom) - call RegPack(Buf, InData%PrevBlAirfoilCom) - call RegPack(Buf, InData%ElecPwr_prev) - call RegPack(Buf, InData%GenTrq_prev) - call RegPack(Buf, allocated(InData%toSC)) - if (allocated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) - call RegPack(Buf, InData%toSC) - end if - call RegPack(Buf, InData%initialized) - call RegPack(Buf, InData%NumLogChannels) - call RegPack(Buf, allocated(InData%LogChannels_OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%avrSWAP) + call RegPack(RF, InData%HSSBrTrqDemand) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%GenState) + call RegPack(RF, InData%BlPitchCom) + call RegPack(RF, InData%PrevBlPitch) + call RegPack(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%PrevBlAirfoilCom) + call RegPack(RF, InData%ElecPwr_prev) + call RegPack(RF, InData%GenTrq_prev) + call RegPackAlloc(RF, InData%toSC) + call RegPack(RF, InData%initialized) + call RegPack(RF, InData%NumLogChannels) + call RegPack(RF, allocated(InData%LogChannels_OutParam)) if (allocated(InData%LogChannels_OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam, kind=B8Ki), ubound(InData%LogChannels_OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%LogChannels_OutParam, kind=B8Ki), ubound(InData%LogChannels_OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%LogChannels_OutParam, kind=B8Ki) UB(1:1) = ubound(InData%LogChannels_OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%LogChannels_OutParam(i1)) - end do - end if - call RegPack(Buf, allocated(InData%LogChannels)) - if (allocated(InData%LogChannels)) then - call RegPackBounds(Buf, 1, lbound(InData%LogChannels, kind=B8Ki), ubound(InData%LogChannels, kind=B8Ki)) - call RegPack(Buf, InData%LogChannels) - end if - call RegPack(Buf, InData%ErrStat) - call RegPack(Buf, InData%ErrMsg) - call RegPack(Buf, InData%CurrentTime) - call RegPack(Buf, InData%SimStatus) - call RegPack(Buf, InData%ShaftBrakeStatusBinaryFlag) - call RegPack(Buf, InData%HSSBrDeployed) - call RegPack(Buf, InData%TimeHSSBrFullyDeployed) - call RegPack(Buf, InData%TimeHSSBrDeployed) - call RegPack(Buf, InData%OverrideYawRateWithTorque) - call RegPack(Buf, InData%YawTorqueDemand) - call RegPack(Buf, allocated(InData%BlPitchInput)) - if (allocated(InData%BlPitchInput)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput, kind=B8Ki), ubound(InData%BlPitchInput, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchInput) - end if - call RegPack(Buf, InData%YawAngleFromNorth) - call RegPack(Buf, InData%HorWindV) - call RegPack(Buf, InData%HSS_Spd) - call RegPack(Buf, InData%YawErr) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%YawBrTAxp) - call RegPack(Buf, InData%YawBrTAyp) - call RegPack(Buf, InData%LSSTipMys) - call RegPack(Buf, InData%LSSTipMzs) - call RegPack(Buf, InData%LSSTipMya) - call RegPack(Buf, InData%LSSTipMza) - call RegPack(Buf, InData%LSSTipPxa) - call RegPack(Buf, InData%Yaw) - call RegPack(Buf, InData%YawRate) - call RegPack(Buf, InData%YawBrMyn) - call RegPack(Buf, InData%YawBrMzn) - call RegPack(Buf, InData%NcIMURAxs) - call RegPack(Buf, InData%NcIMURAys) - call RegPack(Buf, InData%NcIMURAzs) - call RegPack(Buf, InData%RotPwr) - call RegPack(Buf, InData%LSSTipMxa) - call RegPack(Buf, InData%RootMyc) - call RegPack(Buf, InData%RootMxc) - call RegPack(Buf, InData%LSShftFxa) - call RegPack(Buf, InData%LSShftFys) - call RegPack(Buf, InData%LSShftFzs) - call RegPack(Buf, allocated(InData%LidSpeed)) - if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) - call RegPack(Buf, InData%LidSpeed) - end if - call RegPack(Buf, allocated(InData%MsrPositionsX)) - if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsX) - end if - call RegPack(Buf, allocated(InData%MsrPositionsY)) - if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsY) - end if - call RegPack(Buf, allocated(InData%MsrPositionsZ)) - if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsZ) - end if - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%NumBeam) - call RegPack(Buf, InData%NumPulseGate) - call RegPack(Buf, InData%PulseSpacing) - call RegPack(Buf, InData%URefLid) - call RegPack(Buf, InData%DLL_DT) - call RegPack(Buf, InData%DLL_InFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%GenTrq_Dem) - call RegPack(Buf, InData%GenSpd_Dem) - call RegPack(Buf, InData%Ptch_Max) - call RegPack(Buf, InData%Ptch_Min) - call RegPack(Buf, InData%Ptch_SetPnt) - call RegPack(Buf, InData%PtchRate_Max) - call RegPack(Buf, InData%PtchRate_Min) - call RegPack(Buf, InData%GenPwr_Dem) - call RegPack(Buf, InData%Gain_OM) - call RegPack(Buf, InData%GenSpd_MaxOM) - call RegPack(Buf, InData%GenSpd_MinOM) - call RegPack(Buf, InData%Ptch_Cntrl) - call RegPack(Buf, InData%DLL_NumTrq) - call RegPack(Buf, allocated(InData%GenSpd_TLU)) - if (allocated(InData%GenSpd_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU, kind=B8Ki), ubound(InData%GenSpd_TLU, kind=B8Ki)) - call RegPack(Buf, InData%GenSpd_TLU) - end if - call RegPack(Buf, allocated(InData%GenTrq_TLU)) - if (allocated(InData%GenTrq_TLU)) then - call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU, kind=B8Ki), ubound(InData%GenTrq_TLU, kind=B8Ki)) - call RegPack(Buf, InData%GenTrq_TLU) - end if - call RegPack(Buf, InData%Yaw_Cntrl) - call RegPack(Buf, allocated(InData%PrevCableDeltaL)) - if (allocated(InData%PrevCableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL, kind=B8Ki), ubound(InData%PrevCableDeltaL, kind=B8Ki)) - call RegPack(Buf, InData%PrevCableDeltaL) - end if - call RegPack(Buf, allocated(InData%PrevCableDeltaLdot)) - if (allocated(InData%PrevCableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot, kind=B8Ki), ubound(InData%PrevCableDeltaLdot, kind=B8Ki)) - call RegPack(Buf, InData%PrevCableDeltaLdot) - end if - call RegPack(Buf, allocated(InData%CableDeltaL)) - if (allocated(InData%CableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL, kind=B8Ki), ubound(InData%CableDeltaL, kind=B8Ki)) - call RegPack(Buf, InData%CableDeltaL) - end if - call RegPack(Buf, allocated(InData%CableDeltaLdot)) - if (allocated(InData%CableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot, kind=B8Ki), ubound(InData%CableDeltaLdot, kind=B8Ki)) - call RegPack(Buf, InData%CableDeltaLdot) - end if - call RegPack(Buf, allocated(InData%PrevStCCmdStiff)) - if (allocated(InData%PrevStCCmdStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff, kind=B8Ki), ubound(InData%PrevStCCmdStiff, kind=B8Ki)) - call RegPack(Buf, InData%PrevStCCmdStiff) - end if - call RegPack(Buf, allocated(InData%PrevStCCmdDamp)) - if (allocated(InData%PrevStCCmdDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp, kind=B8Ki), ubound(InData%PrevStCCmdDamp, kind=B8Ki)) - call RegPack(Buf, InData%PrevStCCmdDamp) - end if - call RegPack(Buf, allocated(InData%PrevStCCmdBrake)) - if (allocated(InData%PrevStCCmdBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake, kind=B8Ki), ubound(InData%PrevStCCmdBrake, kind=B8Ki)) - call RegPack(Buf, InData%PrevStCCmdBrake) - end if - call RegPack(Buf, allocated(InData%PrevStCCmdForce)) - if (allocated(InData%PrevStCCmdForce)) then - call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce, kind=B8Ki), ubound(InData%PrevStCCmdForce, kind=B8Ki)) - call RegPack(Buf, InData%PrevStCCmdForce) - end if - call RegPack(Buf, allocated(InData%StCCmdStiff)) - if (allocated(InData%StCCmdStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff, kind=B8Ki), ubound(InData%StCCmdStiff, kind=B8Ki)) - call RegPack(Buf, InData%StCCmdStiff) - end if - call RegPack(Buf, allocated(InData%StCCmdDamp)) - if (allocated(InData%StCCmdDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp, kind=B8Ki), ubound(InData%StCCmdDamp, kind=B8Ki)) - call RegPack(Buf, InData%StCCmdDamp) - end if - call RegPack(Buf, allocated(InData%StCCmdBrake)) - if (allocated(InData%StCCmdBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake, kind=B8Ki), ubound(InData%StCCmdBrake, kind=B8Ki)) - call RegPack(Buf, InData%StCCmdBrake) - end if - call RegPack(Buf, allocated(InData%StCCmdForce)) - if (allocated(InData%StCCmdForce)) then - call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce, kind=B8Ki), ubound(InData%StCCmdForce, kind=B8Ki)) - call RegPack(Buf, InData%StCCmdForce) - end if - call RegPack(Buf, allocated(InData%StCMeasDisp)) - if (allocated(InData%StCMeasDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp, kind=B8Ki), ubound(InData%StCMeasDisp, kind=B8Ki)) - call RegPack(Buf, InData%StCMeasDisp) - end if - call RegPack(Buf, allocated(InData%StCMeasVel)) - if (allocated(InData%StCMeasVel)) then - call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel, kind=B8Ki), ubound(InData%StCMeasVel, kind=B8Ki)) - call RegPack(Buf, InData%StCMeasVel) - end if - if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_PackOutParmType(RF, InData%LogChannels_OutParam(i1)) + end do + end if + call RegPackAlloc(RF, InData%LogChannels) + call RegPack(RF, InData%ErrStat) + call RegPack(RF, InData%ErrMsg) + call RegPack(RF, InData%CurrentTime) + call RegPack(RF, InData%SimStatus) + call RegPack(RF, InData%ShaftBrakeStatusBinaryFlag) + call RegPack(RF, InData%HSSBrDeployed) + call RegPack(RF, InData%TimeHSSBrFullyDeployed) + call RegPack(RF, InData%TimeHSSBrDeployed) + call RegPack(RF, InData%OverrideYawRateWithTorque) + call RegPack(RF, InData%YawTorqueDemand) + call RegPackAlloc(RF, InData%BlPitchInput) + call RegPack(RF, InData%YawAngleFromNorth) + call RegPack(RF, InData%HorWindV) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + call RegPack(RF, InData%DLL_DT) + call RegPack(RF, InData%DLL_InFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%GenTrq_Dem) + call RegPack(RF, InData%GenSpd_Dem) + call RegPack(RF, InData%Ptch_Max) + call RegPack(RF, InData%Ptch_Min) + call RegPack(RF, InData%Ptch_SetPnt) + call RegPack(RF, InData%PtchRate_Max) + call RegPack(RF, InData%PtchRate_Min) + call RegPack(RF, InData%GenPwr_Dem) + call RegPack(RF, InData%Gain_OM) + call RegPack(RF, InData%GenSpd_MaxOM) + call RegPack(RF, InData%GenSpd_MinOM) + call RegPack(RF, InData%Ptch_Cntrl) + call RegPack(RF, InData%DLL_NumTrq) + call RegPackAlloc(RF, InData%GenSpd_TLU) + call RegPackAlloc(RF, InData%GenTrq_TLU) + call RegPack(RF, InData%Yaw_Cntrl) + call RegPackAlloc(RF, InData%PrevCableDeltaL) + call RegPackAlloc(RF, InData%PrevCableDeltaLdot) + call RegPackAlloc(RF, InData%CableDeltaL) + call RegPackAlloc(RF, InData%CableDeltaLdot) + call RegPackAlloc(RF, InData%PrevStCCmdStiff) + call RegPackAlloc(RF, InData%PrevStCCmdDamp) + call RegPackAlloc(RF, InData%PrevStCCmdBrake) + call RegPackAlloc(RF, InData%PrevStCCmdForce) + call RegPackAlloc(RF, InData%StCCmdStiff) + call RegPackAlloc(RF, InData%StCCmdDamp) + call RegPackAlloc(RF, InData%StCCmdBrake) + call RegPackAlloc(RF, InData%StCCmdForce) + call RegPackAlloc(RF, InData%StCMeasDisp) + call RegPackAlloc(RF, InData%StCMeasVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackBladedDLLType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackBladedDLLType(RF, OutData) + type(RegFile), intent(inout) :: RF type(BladedDLLType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%avrSWAP)) deallocate(OutData%avrSWAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%avrSWAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%avrSWAP) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%HSSBrTrqDemand) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawRateCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenState) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrevBlPitch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrevBlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElecPwr_prev) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTrq_prev) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%toSC)) deallocate(OutData%toSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%toSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%toSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%initialized) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumLogChannels) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%avrSWAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqDemand); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenState); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrevBlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrevBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr_prev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq_prev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumLogChannels); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%LogChannels_OutParam)) deallocate(OutData%LogChannels_OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%LogChannels_OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%LogChannels_OutParam(i1)) ! LogChannels_OutParam - end do - end if - if (allocated(OutData%LogChannels)) deallocate(OutData%LogChannels) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LogChannels(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LogChannels) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%ErrStat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ErrMsg) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CurrentTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SimStatus) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShaftBrakeStatusBinaryFlag) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrDeployed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimeHSSBrFullyDeployed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimeHSSBrDeployed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OverrideYawRateWithTorque) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawTorqueDemand) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlPitchInput)) deallocate(OutData%BlPitchInput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchInput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchInput) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%YawAngleFromNorth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HorWindV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrTAxp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrTAyp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMzs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMya) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMza) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipPxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Yaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawRate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAxs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAzs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotPwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMyc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMxc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFzs) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LidSpeed) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsZ) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_InFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTrq_Dem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenSpd_Dem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_Max) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_Min) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_SetPnt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtchRate_Max) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PtchRate_Min) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenPwr_Dem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gain_OM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenSpd_MaxOM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenSpd_MinOM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ptch_Cntrl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_NumTrq) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GenSpd_TLU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GenSpd_TLU) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%GenTrq_TLU(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%GenTrq_TLU) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Yaw_Cntrl) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%PrevCableDeltaL)) deallocate(OutData%PrevCableDeltaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrevCableDeltaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrevCableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PrevCableDeltaLdot)) deallocate(OutData%PrevCableDeltaLdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrevCableDeltaLdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrevCableDeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableDeltaLdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableDeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PrevStCCmdStiff)) deallocate(OutData%PrevStCCmdStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrevStCCmdStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PrevStCCmdDamp)) deallocate(OutData%PrevStCCmdDamp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrevStCCmdDamp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PrevStCCmdBrake)) deallocate(OutData%PrevStCCmdBrake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrevStCCmdBrake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PrevStCCmdForce)) deallocate(OutData%PrevStCCmdForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PrevStCCmdForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StCCmdStiff)) deallocate(OutData%StCCmdStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCCmdStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StCCmdDamp)) deallocate(OutData%StCCmdDamp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCCmdDamp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StCCmdBrake)) deallocate(OutData%StCCmdBrake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCCmdBrake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StCCmdForce)) deallocate(OutData%StCCmdForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCCmdForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StCMeasDisp)) deallocate(OutData%StCMeasDisp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCMeasDisp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StCMeasVel)) deallocate(OutData%StCMeasVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCMeasVel) - if (RegCheckErr(Buf, RoutineName)) return - end if + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%LogChannels_OutParam(i1)) ! LogChannels_OutParam + end do + end if + call RegUnpackAlloc(RF, OutData%LogChannels); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ErrStat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ErrMsg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CurrentTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SimStatus); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShaftBrakeStatusBinaryFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDeployed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeHSSBrFullyDeployed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimeHSSBrDeployed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OverrideYawRateWithTorque); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawTorqueDemand); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngleFromNorth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_InFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_SetPnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Max); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PtchRate_Min); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenPwr_Dem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gain_OM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MaxOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenSpd_MinOM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ptch_Cntrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_NumTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenSpd_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%GenTrq_TLU); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw_Cntrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevCableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -3491,122 +2402,113 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - call RegPack(Buf, allocated(InData%BStC)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) LB(1:1) = lbound(InData%BStC, kind=B8Ki) UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackContState(Buf, InData%BStC(i1)) + call StC_PackContState(RF, InData%BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC)) + call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackContState(Buf, InData%NStC(i1)) + call StC_PackContState(RF, InData%NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC)) + call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackContState(Buf, InData%TStC(i1)) + call StC_PackContState(RF, InData%TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC)) + call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackContState(Buf, InData%SStC(i1)) + call StC_PackContState(RF, InData%SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackContState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackContState(Buf, OutData%BStC(i1)) ! BStC + call StC_UnpackContState(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackContState(Buf, OutData%NStC(i1)) ! NStC + call StC_UnpackContState(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackContState(Buf, OutData%TStC(i1)) ! TStC + call StC_UnpackContState(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackContState(Buf, OutData%SStC(i1)) ! SStC + call StC_UnpackContState(RF, OutData%SStC(i1)) ! SStC end do end if end subroutine @@ -3740,122 +2642,113 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%CtrlOffset) - call RegPack(Buf, allocated(InData%BStC)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%CtrlOffset) + call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) LB(1:1) = lbound(InData%BStC, kind=B8Ki) UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackDiscState(Buf, InData%BStC(i1)) + call StC_PackDiscState(RF, InData%BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC)) + call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackDiscState(Buf, InData%NStC(i1)) + call StC_PackDiscState(RF, InData%NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC)) + call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackDiscState(Buf, InData%TStC(i1)) + call StC_PackDiscState(RF, InData%TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC)) + call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackDiscState(Buf, InData%SStC(i1)) + call StC_PackDiscState(RF, InData%SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%CtrlOffset) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%CtrlOffset); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackDiscState(Buf, OutData%BStC(i1)) ! BStC + call StC_UnpackDiscState(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackDiscState(Buf, OutData%NStC(i1)) ! NStC + call StC_UnpackDiscState(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackDiscState(Buf, OutData%TStC(i1)) ! TStC + call StC_UnpackDiscState(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackDiscState(Buf, OutData%SStC(i1)) ! SStC + call StC_UnpackDiscState(RF, OutData%SStC(i1)) ! SStC end do end if end subroutine @@ -3989,122 +2882,113 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - call RegPack(Buf, allocated(InData%BStC)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) LB(1:1) = lbound(InData%BStC, kind=B8Ki) UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackConstrState(Buf, InData%BStC(i1)) + call StC_PackConstrState(RF, InData%BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC)) + call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackConstrState(Buf, InData%NStC(i1)) + call StC_PackConstrState(RF, InData%NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC)) + call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackConstrState(Buf, InData%TStC(i1)) + call StC_PackConstrState(RF, InData%TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC)) + call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackConstrState(Buf, InData%SStC(i1)) + call StC_PackConstrState(RF, InData%SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackConstrState(Buf, OutData%BStC(i1)) ! BStC + call StC_UnpackConstrState(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackConstrState(Buf, OutData%NStC(i1)) ! NStC + call StC_UnpackConstrState(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackConstrState(Buf, OutData%TStC(i1)) ! TStC + call StC_UnpackConstrState(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackConstrState(Buf, OutData%SStC(i1)) ! SStC + call StC_UnpackConstrState(RF, OutData%SStC(i1)) ! SStC end do end if end subroutine @@ -4333,251 +3217,135 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%BegPitMan)) - if (allocated(InData%BegPitMan)) then - call RegPackBounds(Buf, 1, lbound(InData%BegPitMan, kind=B8Ki), ubound(InData%BegPitMan, kind=B8Ki)) - call RegPack(Buf, InData%BegPitMan) - end if - call RegPack(Buf, allocated(InData%BlPitchI)) - if (allocated(InData%BlPitchI)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchI, kind=B8Ki), ubound(InData%BlPitchI, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchI) - end if - call RegPack(Buf, allocated(InData%TPitManE)) - if (allocated(InData%TPitManE)) then - call RegPackBounds(Buf, 1, lbound(InData%TPitManE, kind=B8Ki), ubound(InData%TPitManE, kind=B8Ki)) - call RegPack(Buf, InData%TPitManE) - end if - call RegPack(Buf, InData%BegYawMan) - call RegPack(Buf, InData%NacYawI) - call RegPack(Buf, InData%TYawManE) - call RegPack(Buf, InData%YawPosComInt) - call RegPack(Buf, allocated(InData%BegTpBr)) - if (allocated(InData%BegTpBr)) then - call RegPackBounds(Buf, 1, lbound(InData%BegTpBr, kind=B8Ki), ubound(InData%BegTpBr, kind=B8Ki)) - call RegPack(Buf, InData%BegTpBr) - end if - call RegPack(Buf, allocated(InData%TTpBrDp)) - if (allocated(InData%TTpBrDp)) then - call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp, kind=B8Ki), ubound(InData%TTpBrDp, kind=B8Ki)) - call RegPack(Buf, InData%TTpBrDp) - end if - call RegPack(Buf, allocated(InData%TTpBrFl)) - if (allocated(InData%TTpBrFl)) then - call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl, kind=B8Ki), ubound(InData%TTpBrFl, kind=B8Ki)) - call RegPack(Buf, InData%TTpBrFl) - end if - call RegPack(Buf, InData%Off4Good) - call RegPack(Buf, InData%GenOnLine) - call RegPack(Buf, allocated(InData%BStC)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%BegPitMan) + call RegPackAlloc(RF, InData%BlPitchI) + call RegPackAlloc(RF, InData%TPitManE) + call RegPack(RF, InData%BegYawMan) + call RegPack(RF, InData%NacYawI) + call RegPack(RF, InData%TYawManE) + call RegPack(RF, InData%YawPosComInt) + call RegPackAlloc(RF, InData%BegTpBr) + call RegPackAlloc(RF, InData%TTpBrDp) + call RegPackAlloc(RF, InData%TTpBrFl) + call RegPack(RF, InData%Off4Good) + call RegPack(RF, InData%GenOnLine) + call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) LB(1:1) = lbound(InData%BStC, kind=B8Ki) UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOtherState(Buf, InData%BStC(i1)) + call StC_PackOtherState(RF, InData%BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC)) + call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOtherState(Buf, InData%NStC(i1)) + call StC_PackOtherState(RF, InData%NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC)) + call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOtherState(Buf, InData%TStC(i1)) + call StC_PackOtherState(RF, InData%TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC)) + call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOtherState(Buf, InData%SStC(i1)) + call StC_PackOtherState(RF, InData%SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%BegPitMan)) deallocate(OutData%BegPitMan) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BegPitMan(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BegPitMan) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlPitchI)) deallocate(OutData%BlPitchI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchI(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TPitManE)) deallocate(OutData%TPitManE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TPitManE(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TPitManE) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%BegYawMan) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYawI) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TYawManE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawPosComInt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BegTpBr)) deallocate(OutData%BegTpBr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BegTpBr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BegTpBr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TTpBrDp)) deallocate(OutData%TTpBrDp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TTpBrDp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TTpBrDp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TTpBrFl)) deallocate(OutData%TTpBrFl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TTpBrFl(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TTpBrFl) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Off4Good) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenOnLine) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%BegPitMan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TPitManE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BegYawMan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosComInt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BegTpBr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TTpBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TTpBrFl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Off4Good); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenOnLine); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOtherState(Buf, OutData%BStC(i1)) ! BStC + call StC_UnpackOtherState(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOtherState(Buf, OutData%NStC(i1)) ! NStC + call StC_UnpackOtherState(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOtherState(Buf, OutData%TStC(i1)) ! TStC + call StC_UnpackOtherState(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOtherState(Buf, OutData%SStC(i1)) ! SStC + call StC_UnpackOtherState(RF, OutData%SStC(i1)) ! SStC end do end if end subroutine @@ -4818,223 +3586,207 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackModuleMapType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackModuleMapType(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%u_BStC_Mot2_BStC)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%u_BStC_Mot2_BStC)) if (allocated(InData%u_BStC_Mot2_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki), ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki), ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki)) LB(1:2) = lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki) UB(1:2) = ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%u_BStC_Mot2_BStC(i1,i2)) + call NWTC_Library_PackMeshMapType(RF, InData%u_BStC_Mot2_BStC(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%u_NStC_Mot2_NStC)) + call RegPack(RF, allocated(InData%u_NStC_Mot2_NStC)) if (allocated(InData%u_NStC_Mot2_NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki), ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki), ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki)) LB(1:1) = lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki) UB(1:1) = ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%u_NStC_Mot2_NStC(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%u_NStC_Mot2_NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%u_TStC_Mot2_TStC)) + call RegPack(RF, allocated(InData%u_TStC_Mot2_TStC)) if (allocated(InData%u_TStC_Mot2_TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki), ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki), ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki)) LB(1:1) = lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki) UB(1:1) = ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%u_TStC_Mot2_TStC(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%u_TStC_Mot2_TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%u_SStC_Mot2_SStC)) + call RegPack(RF, allocated(InData%u_SStC_Mot2_SStC)) if (allocated(InData%u_SStC_Mot2_SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki), ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki), ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki)) LB(1:1) = lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki) UB(1:1) = ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%u_SStC_Mot2_SStC(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%u_SStC_Mot2_SStC(i1)) end do end if - call RegPack(Buf, allocated(InData%BStC_Frc2_y_BStC)) + call RegPack(RF, allocated(InData%BStC_Frc2_y_BStC)) if (allocated(InData%BStC_Frc2_y_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki), ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki), ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki)) LB(1:2) = lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki) UB(1:2) = ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%BStC_Frc2_y_BStC(i1,i2)) + call NWTC_Library_PackMeshMapType(RF, InData%BStC_Frc2_y_BStC(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%NStC_Frc2_y_NStC)) + call RegPack(RF, allocated(InData%NStC_Frc2_y_NStC)) if (allocated(InData%NStC_Frc2_y_NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki), ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki), ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%NStC_Frc2_y_NStC(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%NStC_Frc2_y_NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC_Frc2_y_TStC)) + call RegPack(RF, allocated(InData%TStC_Frc2_y_TStC)) if (allocated(InData%TStC_Frc2_y_TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki), ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki), ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%TStC_Frc2_y_TStC(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%TStC_Frc2_y_TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC_Frc2_y_SStC)) + call RegPack(RF, allocated(InData%SStC_Frc2_y_SStC)) if (allocated(InData%SStC_Frc2_y_SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki), ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki), ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackMeshMapType(Buf, InData%SStC_Frc2_y_SStC(i1)) + call NWTC_Library_PackMeshMapType(RF, InData%SStC_Frc2_y_SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackModuleMapType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackModuleMapType(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%u_BStC_Mot2_BStC)) deallocate(OutData%u_BStC_Mot2_BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_BStC_Mot2_BStC(i1,i2)) ! u_BStC_Mot2_BStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_BStC_Mot2_BStC(i1,i2)) ! u_BStC_Mot2_BStC end do end do end if if (allocated(OutData%u_NStC_Mot2_NStC)) deallocate(OutData%u_NStC_Mot2_NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_NStC_Mot2_NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_NStC_Mot2_NStC(i1)) ! u_NStC_Mot2_NStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_NStC_Mot2_NStC(i1)) ! u_NStC_Mot2_NStC end do end if if (allocated(OutData%u_TStC_Mot2_TStC)) deallocate(OutData%u_TStC_Mot2_TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_TStC_Mot2_TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_TStC_Mot2_TStC(i1)) ! u_TStC_Mot2_TStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_TStC_Mot2_TStC(i1)) ! u_TStC_Mot2_TStC end do end if if (allocated(OutData%u_SStC_Mot2_SStC)) deallocate(OutData%u_SStC_Mot2_SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_SStC_Mot2_SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_SStC_Mot2_SStC(i1)) ! u_SStC_Mot2_SStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%u_SStC_Mot2_SStC(i1)) ! u_SStC_Mot2_SStC end do end if if (allocated(OutData%BStC_Frc2_y_BStC)) deallocate(OutData%BStC_Frc2_y_BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_Frc2_y_BStC(i1,i2)) ! BStC_Frc2_y_BStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%BStC_Frc2_y_BStC(i1,i2)) ! BStC_Frc2_y_BStC end do end do end if if (allocated(OutData%NStC_Frc2_y_NStC)) deallocate(OutData%NStC_Frc2_y_NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC_Frc2_y_NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_Frc2_y_NStC(i1)) ! NStC_Frc2_y_NStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%NStC_Frc2_y_NStC(i1)) ! NStC_Frc2_y_NStC end do end if if (allocated(OutData%TStC_Frc2_y_TStC)) deallocate(OutData%TStC_Frc2_y_TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC_Frc2_y_TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_Frc2_y_TStC(i1)) ! TStC_Frc2_y_TStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%TStC_Frc2_y_TStC(i1)) ! TStC_Frc2_y_TStC end do end if if (allocated(OutData%SStC_Frc2_y_SStC)) deallocate(OutData%SStC_Frc2_y_SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC_Frc2_y_SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_Frc2_y_SStC(i1)) ! SStC_Frc2_y_SStC + call NWTC_Library_UnpackMeshMapType(RF, OutData%SStC_Frc2_y_SStC(i1)) ! SStC_Frc2_y_SStC end do end if end subroutine @@ -5412,364 +4164,319 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SrvD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%LastTimeCalled) - call SrvD_PackBladedDLLType(Buf, InData%dll_data) - call RegPack(Buf, InData%FirstWarn) - call RegPack(Buf, InData%LastTimeFiltered) - call RegPack(Buf, allocated(InData%xd_BlPitchFilter)) - if (allocated(InData%xd_BlPitchFilter)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter, kind=B8Ki), ubound(InData%xd_BlPitchFilter, kind=B8Ki)) - call RegPack(Buf, InData%xd_BlPitchFilter) - end if - call RegPack(Buf, allocated(InData%BStC)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%LastTimeCalled) + call SrvD_PackBladedDLLType(RF, InData%dll_data) + call RegPack(RF, InData%FirstWarn) + call RegPack(RF, InData%LastTimeFiltered) + call RegPackAlloc(RF, InData%xd_BlPitchFilter) + call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) LB(1:1) = lbound(InData%BStC, kind=B8Ki) UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(Buf, InData%BStC(i1)) + call StC_PackMisc(RF, InData%BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC)) + call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(Buf, InData%NStC(i1)) + call StC_PackMisc(RF, InData%NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC)) + call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(Buf, InData%TStC(i1)) + call StC_PackMisc(RF, InData%TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC)) + call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackMisc(Buf, InData%SStC(i1)) + call StC_PackMisc(RF, InData%SStC(i1)) end do end if - call RegPack(Buf, allocated(InData%u_BStC)) + call RegPack(RF, allocated(InData%u_BStC)) if (allocated(InData%u_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BStC, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_BStC, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) LB(1:2) = lbound(InData%u_BStC, kind=B8Ki) UB(1:2) = ubound(InData%u_BStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_PackInput(Buf, InData%u_BStC(i1,i2)) + call StC_PackInput(RF, InData%u_BStC(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%u_NStC)) + call RegPack(RF, allocated(InData%u_NStC)) if (allocated(InData%u_NStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_NStC, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_NStC, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) LB(1:2) = lbound(InData%u_NStC, kind=B8Ki) UB(1:2) = ubound(InData%u_NStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_PackInput(Buf, InData%u_NStC(i1,i2)) + call StC_PackInput(RF, InData%u_NStC(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%u_TStC)) + call RegPack(RF, allocated(InData%u_TStC)) if (allocated(InData%u_TStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_TStC, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_TStC, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) LB(1:2) = lbound(InData%u_TStC, kind=B8Ki) UB(1:2) = ubound(InData%u_TStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_PackInput(Buf, InData%u_TStC(i1,i2)) + call StC_PackInput(RF, InData%u_TStC(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%u_SStC)) + call RegPack(RF, allocated(InData%u_SStC)) if (allocated(InData%u_SStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) LB(1:2) = lbound(InData%u_SStC, kind=B8Ki) UB(1:2) = ubound(InData%u_SStC, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_PackInput(Buf, InData%u_SStC(i1,i2)) + call StC_PackInput(RF, InData%u_SStC(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%y_BStC)) + call RegPack(RF, allocated(InData%y_BStC)) if (allocated(InData%y_BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) LB(1:1) = lbound(InData%y_BStC, kind=B8Ki) UB(1:1) = ubound(InData%y_BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOutput(Buf, InData%y_BStC(i1)) + call StC_PackOutput(RF, InData%y_BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%y_NStC)) + call RegPack(RF, allocated(InData%y_NStC)) if (allocated(InData%y_NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_NStC, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y_NStC, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) LB(1:1) = lbound(InData%y_NStC, kind=B8Ki) UB(1:1) = ubound(InData%y_NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOutput(Buf, InData%y_NStC(i1)) + call StC_PackOutput(RF, InData%y_NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%y_TStC)) + call RegPack(RF, allocated(InData%y_TStC)) if (allocated(InData%y_TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_TStC, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y_TStC, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) LB(1:1) = lbound(InData%y_TStC, kind=B8Ki) UB(1:1) = ubound(InData%y_TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOutput(Buf, InData%y_TStC(i1)) + call StC_PackOutput(RF, InData%y_TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%y_SStC)) + call RegPack(RF, allocated(InData%y_SStC)) if (allocated(InData%y_SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%y_SStC, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%y_SStC, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) LB(1:1) = lbound(InData%y_SStC, kind=B8Ki) UB(1:1) = ubound(InData%y_SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackOutput(Buf, InData%y_SStC(i1)) + call StC_PackOutput(RF, InData%y_SStC(i1)) end do end if - call SrvD_PackModuleMapType(Buf, InData%SrvD_MeshMap) - call RegPack(Buf, InData%PrevTstepNcall) - if (RegCheckErr(Buf, RoutineName)) return + call SrvD_PackModuleMapType(RF, InData%SrvD_MeshMap) + call RegPack(RF, InData%PrevTstepNcall) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%LastTimeCalled) - if (RegCheckErr(Buf, RoutineName)) return - call SrvD_UnpackBladedDLLType(Buf, OutData%dll_data) ! dll_data - call RegUnpack(Buf, OutData%FirstWarn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LastTimeFiltered) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%xd_BlPitchFilter)) deallocate(OutData%xd_BlPitchFilter) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_BlPitchFilter(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xd_BlPitchFilter) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%LastTimeCalled); if (RegCheckErr(RF, RoutineName)) return + call SrvD_UnpackBladedDLLType(RF, OutData%dll_data) ! dll_data + call RegUnpack(RF, OutData%FirstWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastTimeFiltered); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%xd_BlPitchFilter); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(Buf, OutData%BStC(i1)) ! BStC + call StC_UnpackMisc(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(Buf, OutData%NStC(i1)) ! NStC + call StC_UnpackMisc(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(Buf, OutData%TStC(i1)) ! TStC + call StC_UnpackMisc(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(Buf, OutData%SStC(i1)) ! SStC + call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC end do end if if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_UnpackInput(Buf, OutData%u_BStC(i1,i2)) ! u_BStC + call StC_UnpackInput(RF, OutData%u_BStC(i1,i2)) ! u_BStC end do end do end if if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_UnpackInput(Buf, OutData%u_NStC(i1,i2)) ! u_NStC + call StC_UnpackInput(RF, OutData%u_NStC(i1,i2)) ! u_NStC end do end do end if if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_UnpackInput(Buf, OutData%u_TStC(i1,i2)) ! u_TStC + call StC_UnpackInput(RF, OutData%u_TStC(i1,i2)) ! u_TStC end do end do end if if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call StC_UnpackInput(Buf, OutData%u_SStC(i1,i2)) ! u_SStC + call StC_UnpackInput(RF, OutData%u_SStC(i1,i2)) ! u_SStC end do end do end if if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOutput(Buf, OutData%y_BStC(i1)) ! y_BStC + call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC end do end if if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOutput(Buf, OutData%y_NStC(i1)) ! y_NStC + call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC end do end if if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOutput(Buf, OutData%y_TStC(i1)) ! y_TStC + call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC end do end if if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackOutput(Buf, OutData%y_SStC(i1)) ! y_SStC + call StC_UnpackOutput(RF, OutData%y_SStC(i1)) ! y_SStC end do end if - call SrvD_UnpackModuleMapType(Buf, OutData%SrvD_MeshMap) ! SrvD_MeshMap - call RegUnpack(Buf, OutData%PrevTstepNcall) - if (RegCheckErr(Buf, RoutineName)) return + call SrvD_UnpackModuleMapType(RF, OutData%SrvD_MeshMap) ! SrvD_MeshMap + call RegUnpack(RF, OutData%PrevTstepNcall); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -6353,850 +5060,371 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%HSSBrDT) - call RegPack(Buf, InData%HSSBrTqF) - call RegPack(Buf, InData%SIG_POSl) - call RegPack(Buf, InData%SIG_POTq) - call RegPack(Buf, InData%SIG_SlPc) - call RegPack(Buf, InData%SIG_Slop) - call RegPack(Buf, InData%SIG_SySp) - call RegPack(Buf, InData%TEC_A0) - call RegPack(Buf, InData%TEC_C0) - call RegPack(Buf, InData%TEC_C1) - call RegPack(Buf, InData%TEC_C2) - call RegPack(Buf, InData%TEC_K2) - call RegPack(Buf, InData%TEC_MR) - call RegPack(Buf, InData%TEC_Re1) - call RegPack(Buf, InData%TEC_RLR) - call RegPack(Buf, InData%TEC_RRes) - call RegPack(Buf, InData%TEC_SRes) - call RegPack(Buf, InData%TEC_SySp) - call RegPack(Buf, InData%TEC_V1a) - call RegPack(Buf, InData%TEC_VLL) - call RegPack(Buf, InData%TEC_Xe1) - call RegPack(Buf, InData%GenEff) - call RegPack(Buf, allocated(InData%BlPitchInit)) - if (allocated(InData%BlPitchInit)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit, kind=B8Ki), ubound(InData%BlPitchInit, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchInit) - end if - call RegPack(Buf, allocated(InData%BlPitchF)) - if (allocated(InData%BlPitchF)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchF, kind=B8Ki), ubound(InData%BlPitchF, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchF) - end if - call RegPack(Buf, allocated(InData%PitManRat)) - if (allocated(InData%PitManRat)) then - call RegPackBounds(Buf, 1, lbound(InData%PitManRat, kind=B8Ki), ubound(InData%PitManRat, kind=B8Ki)) - call RegPack(Buf, InData%PitManRat) - end if - call RegPack(Buf, InData%YawManRat) - call RegPack(Buf, InData%NacYawF) - call RegPack(Buf, InData%SpdGenOn) - call RegPack(Buf, InData%THSSBrDp) - call RegPack(Buf, InData%THSSBrFl) - call RegPack(Buf, InData%TimGenOf) - call RegPack(Buf, InData%TimGenOn) - call RegPack(Buf, InData%TPCOn) - call RegPack(Buf, allocated(InData%TPitManS)) - if (allocated(InData%TPitManS)) then - call RegPackBounds(Buf, 1, lbound(InData%TPitManS, kind=B8Ki), ubound(InData%TPitManS, kind=B8Ki)) - call RegPack(Buf, InData%TPitManS) - end if - call RegPack(Buf, InData%TYawManS) - call RegPack(Buf, InData%TYCOn) - call RegPack(Buf, InData%VS_RtGnSp) - call RegPack(Buf, InData%VS_RtTq) - call RegPack(Buf, InData%VS_Slope) - call RegPack(Buf, InData%VS_SlPc) - call RegPack(Buf, InData%VS_SySp) - call RegPack(Buf, InData%VS_TrGnSp) - call RegPack(Buf, InData%YawPosCom) - call RegPack(Buf, InData%YawRateCom) - call RegPack(Buf, InData%GenModel) - call RegPack(Buf, InData%HSSBrMode) - call RegPack(Buf, InData%PCMode) - call RegPack(Buf, InData%VSContrl) - call RegPack(Buf, InData%YCMode) - call RegPack(Buf, InData%GenTiStp) - call RegPack(Buf, InData%GenTiStr) - call RegPack(Buf, InData%VS_Rgn2K) - call RegPack(Buf, InData%YawNeut) - call RegPack(Buf, InData%YawSpr) - call RegPack(Buf, InData%YawDamp) - call RegPack(Buf, InData%TpBrDT) - call RegPack(Buf, allocated(InData%TBDepISp)) - if (allocated(InData%TBDepISp)) then - call RegPackBounds(Buf, 1, lbound(InData%TBDepISp, kind=B8Ki), ubound(InData%TBDepISp, kind=B8Ki)) - call RegPack(Buf, InData%TBDepISp) - end if - call RegPack(Buf, InData%TBDrConN) - call RegPack(Buf, InData%TBDrConD) - call RegPack(Buf, InData%NumBl) - call RegPack(Buf, InData%NumBStC) - call RegPack(Buf, InData%NumNStC) - call RegPack(Buf, InData%NumTStC) - call RegPack(Buf, InData%NumSStC) - call RegPack(Buf, InData%AfCmode) - call RegPack(Buf, InData%AfC_Mean) - call RegPack(Buf, InData%AfC_Amp) - call RegPack(Buf, InData%AfC_Phase) - call RegPack(Buf, InData%CCmode) - call RegPack(Buf, InData%StCCmode) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%NumOuts_DLL) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, allocated(InData%OutParam)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%HSSBrDT) + call RegPack(RF, InData%HSSBrTqF) + call RegPack(RF, InData%SIG_POSl) + call RegPack(RF, InData%SIG_POTq) + call RegPack(RF, InData%SIG_SlPc) + call RegPack(RF, InData%SIG_Slop) + call RegPack(RF, InData%SIG_SySp) + call RegPack(RF, InData%TEC_A0) + call RegPack(RF, InData%TEC_C0) + call RegPack(RF, InData%TEC_C1) + call RegPack(RF, InData%TEC_C2) + call RegPack(RF, InData%TEC_K2) + call RegPack(RF, InData%TEC_MR) + call RegPack(RF, InData%TEC_Re1) + call RegPack(RF, InData%TEC_RLR) + call RegPack(RF, InData%TEC_RRes) + call RegPack(RF, InData%TEC_SRes) + call RegPack(RF, InData%TEC_SySp) + call RegPack(RF, InData%TEC_V1a) + call RegPack(RF, InData%TEC_VLL) + call RegPack(RF, InData%TEC_Xe1) + call RegPack(RF, InData%GenEff) + call RegPackAlloc(RF, InData%BlPitchInit) + call RegPackAlloc(RF, InData%BlPitchF) + call RegPackAlloc(RF, InData%PitManRat) + call RegPack(RF, InData%YawManRat) + call RegPack(RF, InData%NacYawF) + call RegPack(RF, InData%SpdGenOn) + call RegPack(RF, InData%THSSBrDp) + call RegPack(RF, InData%THSSBrFl) + call RegPack(RF, InData%TimGenOf) + call RegPack(RF, InData%TimGenOn) + call RegPack(RF, InData%TPCOn) + call RegPackAlloc(RF, InData%TPitManS) + call RegPack(RF, InData%TYawManS) + call RegPack(RF, InData%TYCOn) + call RegPack(RF, InData%VS_RtGnSp) + call RegPack(RF, InData%VS_RtTq) + call RegPack(RF, InData%VS_Slope) + call RegPack(RF, InData%VS_SlPc) + call RegPack(RF, InData%VS_SySp) + call RegPack(RF, InData%VS_TrGnSp) + call RegPack(RF, InData%YawPosCom) + call RegPack(RF, InData%YawRateCom) + call RegPack(RF, InData%GenModel) + call RegPack(RF, InData%HSSBrMode) + call RegPack(RF, InData%PCMode) + call RegPack(RF, InData%VSContrl) + call RegPack(RF, InData%YCMode) + call RegPack(RF, InData%GenTiStp) + call RegPack(RF, InData%GenTiStr) + call RegPack(RF, InData%VS_Rgn2K) + call RegPack(RF, InData%YawNeut) + call RegPack(RF, InData%YawSpr) + call RegPack(RF, InData%YawDamp) + call RegPack(RF, InData%TpBrDT) + call RegPackAlloc(RF, InData%TBDepISp) + call RegPack(RF, InData%TBDrConN) + call RegPack(RF, InData%TBDrConD) + call RegPack(RF, InData%NumBl) + call RegPack(RF, InData%NumBStC) + call RegPack(RF, InData%NumNStC) + call RegPack(RF, InData%NumTStC) + call RegPack(RF, InData%NumSStC) + call RegPack(RF, InData%AfCmode) + call RegPack(RF, InData%AfC_Mean) + call RegPack(RF, InData%AfC_Amp) + call RegPack(RF, InData%AfC_Phase) + call RegPack(RF, InData%CCmode) + call RegPack(RF, InData%StCCmode) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumOuts_DLL) + call RegPack(RF, InData%RootName) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) - end do - end if - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%UseBladedInterface) - call RegPack(Buf, InData%UseLegacyInterface) - call DLLTypePack(Buf, InData%DLL_Trgt) - call RegPack(Buf, InData%DLL_Ramp) - call RegPack(Buf, InData%BlAlpha) - call RegPack(Buf, InData%DLL_n) - call RegPack(Buf, InData%avcOUTNAME_LEN) - call RegPack(Buf, InData%NacYaw_North) - call RegPack(Buf, InData%AvgWindSpeed) - call RegPack(Buf, InData%AirDens) - call RegPack(Buf, InData%TrimCase) - call RegPack(Buf, InData%TrimGain) - call RegPack(Buf, InData%RotSpeedRef) - call RegPack(Buf, allocated(InData%BStC)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%UseBladedInterface) + call RegPack(RF, InData%UseLegacyInterface) + call DLLTypePack(RF, InData%DLL_Trgt) + call RegPack(RF, InData%DLL_Ramp) + call RegPack(RF, InData%BlAlpha) + call RegPack(RF, InData%DLL_n) + call RegPack(RF, InData%avcOUTNAME_LEN) + call RegPack(RF, InData%NacYaw_North) + call RegPack(RF, InData%AvgWindSpeed) + call RegPack(RF, InData%AirDens) + call RegPack(RF, InData%TrimCase) + call RegPack(RF, InData%TrimGain) + call RegPack(RF, InData%RotSpeedRef) + call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(Buf, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) LB(1:1) = lbound(InData%BStC, kind=B8Ki) UB(1:1) = ubound(InData%BStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackParam(Buf, InData%BStC(i1)) + call StC_PackParam(RF, InData%BStC(i1)) end do end if - call RegPack(Buf, allocated(InData%NStC)) + call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(Buf, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) LB(1:1) = lbound(InData%NStC, kind=B8Ki) UB(1:1) = ubound(InData%NStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackParam(Buf, InData%NStC(i1)) + call StC_PackParam(RF, InData%NStC(i1)) end do end if - call RegPack(Buf, allocated(InData%TStC)) + call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(Buf, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) LB(1:1) = lbound(InData%TStC, kind=B8Ki) UB(1:1) = ubound(InData%TStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackParam(Buf, InData%TStC(i1)) + call StC_PackParam(RF, InData%TStC(i1)) end do end if - call RegPack(Buf, allocated(InData%SStC)) + call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(Buf, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) LB(1:1) = lbound(InData%SStC, kind=B8Ki) UB(1:1) = ubound(InData%SStC, kind=B8Ki) do i1 = LB(1), UB(1) - call StC_PackParam(Buf, InData%SStC(i1)) - end do - end if - call RegPack(Buf, InData%InterpOrder) - call RegPack(Buf, InData%EXavrSWAP) - call RegPack(Buf, InData%NumCableControl) - call RegPack(Buf, InData%NumStC_Control) - call RegPack(Buf, allocated(InData%StCMeasNumPerChan)) - if (allocated(InData%StCMeasNumPerChan)) then - call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan, kind=B8Ki), ubound(InData%StCMeasNumPerChan, kind=B8Ki)) - call RegPack(Buf, InData%StCMeasNumPerChan) - end if - call RegPack(Buf, InData%UseSC) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%Jac_x_indx)) - if (allocated(InData%Jac_x_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx, kind=B8Ki), ubound(InData%Jac_x_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_x_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, allocated(InData%dx)) - if (allocated(InData%dx)) then - call RegPackBounds(Buf, 1, lbound(InData%dx, kind=B8Ki), ubound(InData%dx, kind=B8Ki)) - call RegPack(Buf, InData%dx) - end if - call RegPack(Buf, InData%Jac_nu) - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%Jac_nx) - call RegPack(Buf, allocated(InData%Jac_Idx_BStC_u)) - if (allocated(InData%Jac_Idx_BStC_u)) then - call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u, kind=B8Ki), ubound(InData%Jac_Idx_BStC_u, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_BStC_u) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_NStC_u)) - if (allocated(InData%Jac_Idx_NStC_u)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u, kind=B8Ki), ubound(InData%Jac_Idx_NStC_u, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_NStC_u) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_TStC_u)) - if (allocated(InData%Jac_Idx_TStC_u)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u, kind=B8Ki), ubound(InData%Jac_Idx_TStC_u, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_TStC_u) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_SStC_u)) - if (allocated(InData%Jac_Idx_SStC_u)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u, kind=B8Ki), ubound(InData%Jac_Idx_SStC_u, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_SStC_u) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_BStC_x)) - if (allocated(InData%Jac_Idx_BStC_x)) then - call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x, kind=B8Ki), ubound(InData%Jac_Idx_BStC_x, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_BStC_x) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_NStC_x)) - if (allocated(InData%Jac_Idx_NStC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x, kind=B8Ki), ubound(InData%Jac_Idx_NStC_x, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_NStC_x) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_TStC_x)) - if (allocated(InData%Jac_Idx_TStC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x, kind=B8Ki), ubound(InData%Jac_Idx_TStC_x, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_TStC_x) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_SStC_x)) - if (allocated(InData%Jac_Idx_SStC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x, kind=B8Ki), ubound(InData%Jac_Idx_SStC_x, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_SStC_x) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_BStC_y)) - if (allocated(InData%Jac_Idx_BStC_y)) then - call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y, kind=B8Ki), ubound(InData%Jac_Idx_BStC_y, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_BStC_y) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_NStC_y)) - if (allocated(InData%Jac_Idx_NStC_y)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y, kind=B8Ki), ubound(InData%Jac_Idx_NStC_y, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_NStC_y) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_TStC_y)) - if (allocated(InData%Jac_Idx_TStC_y)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y, kind=B8Ki), ubound(InData%Jac_Idx_TStC_y, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_TStC_y) - end if - call RegPack(Buf, allocated(InData%Jac_Idx_SStC_y)) - if (allocated(InData%Jac_Idx_SStC_y)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y, kind=B8Ki), ubound(InData%Jac_Idx_SStC_y, kind=B8Ki)) - call RegPack(Buf, InData%Jac_Idx_SStC_y) - end if - call RegPack(Buf, InData%SensorType) - call RegPack(Buf, InData%NumBeam) - call RegPack(Buf, InData%NumPulseGate) - call RegPack(Buf, InData%PulseSpacing) - call RegPack(Buf, InData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return + call StC_PackParam(RF, InData%SStC(i1)) + end do + end if + call RegPack(RF, InData%InterpOrder) + call RegPack(RF, InData%EXavrSWAP) + call RegPack(RF, InData%NumCableControl) + call RegPack(RF, InData%NumStC_Control) + call RegPackAlloc(RF, InData%StCMeasNumPerChan) + call RegPack(RF, InData%UseSC) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%Jac_x_indx) + call RegPackAlloc(RF, InData%du) + call RegPackAlloc(RF, InData%dx) + call RegPack(RF, InData%Jac_nu) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_u) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_x) + call RegPackAlloc(RF, InData%Jac_Idx_BStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_NStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_TStC_y) + call RegPackAlloc(RF, InData%Jac_Idx_SStC_y) + call RegPack(RF, InData%SensorType) + call RegPack(RF, InData%NumBeam) + call RegPack(RF, InData%NumPulseGate) + call RegPack(RF, InData%PulseSpacing) + call RegPack(RF, InData%URefLid) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackParam' integer(B8Ki) :: i1, i2, i3 integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrDT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrTqF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_POSl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_POTq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_SlPc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_Slop) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SIG_SySp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_A0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_C0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_C1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_C2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_K2) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_MR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_Re1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_RLR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_RRes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_SRes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_SySp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_V1a) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_VLL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TEC_Xe1) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenEff) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchInit(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchInit) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlPitchF)) deallocate(OutData%BlPitchF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PitManRat)) deallocate(OutData%PitManRat) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PitManRat(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PitManRat) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%YawManRat) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYawF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SpdGenOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%THSSBrDp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%THSSBrFl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimGenOf) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TimGenOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TPCOn) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TPitManS)) deallocate(OutData%TPitManS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TPitManS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TPitManS) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TYawManS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TYCOn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_RtGnSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_RtTq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_Slope) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_SlPc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_SySp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_TrGnSp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawPosCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawRateCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenModel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrMode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PCMode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VSContrl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YCMode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTiStp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTiStr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%VS_Rgn2K) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawNeut) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawSpr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawDamp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TpBrDT) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TBDepISp)) deallocate(OutData%TBDepISp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TBDepISp(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TBDepISp) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TBDrConN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TBDrConD) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBStC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumNStC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumTStC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumSStC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfCmode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfC_Mean) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfC_Amp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AfC_Phase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CCmode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StCCmode) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts_DLL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTqF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POSl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_POTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_Slop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SIG_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_A0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_C2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_K2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_MR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Re1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RLR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_RRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SRes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_V1a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_VLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TEC_Xe1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenEff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PitManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawManRat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYawF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SpdGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrDp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%THSSBrFl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOf); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TimGenOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TPCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TPitManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYawManS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TYCOn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_RtTq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Slope); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SlPc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_SySp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_TrGnSp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenModel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VSContrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YCMode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTiStr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%VS_Rgn2K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawNeut); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawSpr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TpBrDT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDepISp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TBDrConD); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumNStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumTStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumSStC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Mean); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Amp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AfC_Phase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StCCmode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts_DLL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam - end do - end if - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseBladedInterface) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UseLegacyInterface) - if (RegCheckErr(Buf, RoutineName)) return - call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt - call RegUnpack(Buf, OutData%DLL_Ramp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%BlAlpha) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DLL_n) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%avcOUTNAME_LEN) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NacYaw_North) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AvgWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimCase) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TrimGain) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeedRef) - if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseBladedInterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseLegacyInterface); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpack(RF, OutData%DLL_Ramp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlAlpha); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avcOUTNAME_LEN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacYaw_North); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AvgWindSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimCase); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TrimGain); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeedRef); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStC)) deallocate(OutData%BStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(Buf, OutData%BStC(i1)) ! BStC + call StC_UnpackParam(RF, OutData%BStC(i1)) ! BStC end do end if if (allocated(OutData%NStC)) deallocate(OutData%NStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(Buf, OutData%NStC(i1)) ! NStC + call StC_UnpackParam(RF, OutData%NStC(i1)) ! NStC end do end if if (allocated(OutData%TStC)) deallocate(OutData%TStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call StC_UnpackParam(Buf, OutData%TStC(i1)) ! TStC + call StC_UnpackParam(RF, OutData%TStC(i1)) ! TStC end do end if if (allocated(OutData%SStC)) deallocate(OutData%SStC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStC(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call StC_UnpackParam(Buf, OutData%SStC(i1)) ! SStC - end do - end if - call RegUnpack(Buf, OutData%InterpOrder) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%EXavrSWAP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumCableControl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumStC_Control) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%StCMeasNumPerChan)) deallocate(OutData%StCMeasNumPerChan) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StCMeasNumPerChan(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasNumPerChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StCMeasNumPerChan) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UseSC) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_x_indx)) deallocate(OutData%Jac_x_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_x_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_x_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dx)) deallocate(OutData%dx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dx(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Jac_nu) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_Idx_BStC_u)) deallocate(OutData%Jac_Idx_BStC_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_BStC_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_NStC_u)) deallocate(OutData%Jac_Idx_NStC_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_NStC_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_TStC_u)) deallocate(OutData%Jac_Idx_TStC_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_TStC_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_SStC_u)) deallocate(OutData%Jac_Idx_SStC_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_SStC_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_BStC_x)) deallocate(OutData%Jac_Idx_BStC_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_BStC_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_NStC_x)) deallocate(OutData%Jac_Idx_NStC_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_NStC_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_TStC_x)) deallocate(OutData%Jac_Idx_TStC_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_TStC_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_SStC_x)) deallocate(OutData%Jac_Idx_SStC_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_SStC_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_BStC_y)) deallocate(OutData%Jac_Idx_BStC_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_BStC_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_NStC_y)) deallocate(OutData%Jac_Idx_NStC_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_NStC_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_TStC_y)) deallocate(OutData%Jac_Idx_TStC_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_TStC_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Jac_Idx_SStC_y)) deallocate(OutData%Jac_Idx_SStC_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_Idx_SStC_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC + end do + end if + call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EXavrSWAP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumCableControl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumStC_Control); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCMeasNumPerChan); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_x_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_BStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_NStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_TStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_Idx_SStC_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PulseSpacing); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -7550,457 +5778,211 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%BlPitch)) - if (allocated(InData%BlPitch)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitch, kind=B8Ki), ubound(InData%BlPitch, kind=B8Ki)) - call RegPack(Buf, InData%BlPitch) - end if - call RegPack(Buf, InData%Yaw) - call RegPack(Buf, InData%YawRate) - call RegPack(Buf, InData%LSS_Spd) - call RegPack(Buf, InData%HSS_Spd) - call RegPack(Buf, InData%RotSpeed) - call RegPack(Buf, InData%ExternalYawPosCom) - call RegPack(Buf, InData%ExternalYawRateCom) - call RegPack(Buf, allocated(InData%ExternalBlPitchCom)) - if (allocated(InData%ExternalBlPitchCom)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom, kind=B8Ki), ubound(InData%ExternalBlPitchCom, kind=B8Ki)) - call RegPack(Buf, InData%ExternalBlPitchCom) - end if - call RegPack(Buf, InData%ExternalGenTrq) - call RegPack(Buf, InData%ExternalElecPwr) - call RegPack(Buf, InData%ExternalHSSBrFrac) - call RegPack(Buf, allocated(InData%ExternalBlAirfoilCom)) - if (allocated(InData%ExternalBlAirfoilCom)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom, kind=B8Ki), ubound(InData%ExternalBlAirfoilCom, kind=B8Ki)) - call RegPack(Buf, InData%ExternalBlAirfoilCom) - end if - call RegPack(Buf, allocated(InData%ExternalCableDeltaL)) - if (allocated(InData%ExternalCableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL, kind=B8Ki), ubound(InData%ExternalCableDeltaL, kind=B8Ki)) - call RegPack(Buf, InData%ExternalCableDeltaL) - end if - call RegPack(Buf, allocated(InData%ExternalCableDeltaLdot)) - if (allocated(InData%ExternalCableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot, kind=B8Ki), ubound(InData%ExternalCableDeltaLdot, kind=B8Ki)) - call RegPack(Buf, InData%ExternalCableDeltaLdot) - end if - call RegPack(Buf, InData%TwrAccel) - call RegPack(Buf, InData%YawErr) - call RegPack(Buf, InData%WindDir) - call RegPack(Buf, InData%RootMyc) - call RegPack(Buf, InData%YawBrTAxp) - call RegPack(Buf, InData%YawBrTAyp) - call RegPack(Buf, InData%LSSTipPxa) - call RegPack(Buf, InData%RootMxc) - call RegPack(Buf, InData%LSSTipMxa) - call RegPack(Buf, InData%LSSTipMya) - call RegPack(Buf, InData%LSSTipMza) - call RegPack(Buf, InData%LSSTipMys) - call RegPack(Buf, InData%LSSTipMzs) - call RegPack(Buf, InData%YawBrMyn) - call RegPack(Buf, InData%YawBrMzn) - call RegPack(Buf, InData%NcIMURAxs) - call RegPack(Buf, InData%NcIMURAys) - call RegPack(Buf, InData%NcIMURAzs) - call RegPack(Buf, InData%RotPwr) - call RegPack(Buf, InData%HorWindV) - call RegPack(Buf, InData%YawAngle) - call RegPack(Buf, InData%LSShftFxa) - call RegPack(Buf, InData%LSShftFys) - call RegPack(Buf, InData%LSShftFzs) - call RegPack(Buf, allocated(InData%fromSC)) - if (allocated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) - call RegPack(Buf, InData%fromSC) - end if - call RegPack(Buf, allocated(InData%fromSCglob)) - if (allocated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) - call RegPack(Buf, InData%fromSCglob) - end if - call RegPack(Buf, allocated(InData%Lidar)) - if (allocated(InData%Lidar)) then - call RegPackBounds(Buf, 1, lbound(InData%Lidar, kind=B8Ki), ubound(InData%Lidar, kind=B8Ki)) - call RegPack(Buf, InData%Lidar) - end if - call MeshPack(Buf, InData%PtfmMotionMesh) - call RegPack(Buf, allocated(InData%BStCMotionMesh)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%BlPitch) + call RegPack(RF, InData%Yaw) + call RegPack(RF, InData%YawRate) + call RegPack(RF, InData%LSS_Spd) + call RegPack(RF, InData%HSS_Spd) + call RegPack(RF, InData%RotSpeed) + call RegPack(RF, InData%ExternalYawPosCom) + call RegPack(RF, InData%ExternalYawRateCom) + call RegPackAlloc(RF, InData%ExternalBlPitchCom) + call RegPack(RF, InData%ExternalGenTrq) + call RegPack(RF, InData%ExternalElecPwr) + call RegPack(RF, InData%ExternalHSSBrFrac) + call RegPackAlloc(RF, InData%ExternalBlAirfoilCom) + call RegPackAlloc(RF, InData%ExternalCableDeltaL) + call RegPackAlloc(RF, InData%ExternalCableDeltaLdot) + call RegPack(RF, InData%TwrAccel) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%WindDir) + call RegPack(RF, InData%RootMyc) + call RegPack(RF, InData%YawBrTAxp) + call RegPack(RF, InData%YawBrTAyp) + call RegPack(RF, InData%LSSTipPxa) + call RegPack(RF, InData%RootMxc) + call RegPack(RF, InData%LSSTipMxa) + call RegPack(RF, InData%LSSTipMya) + call RegPack(RF, InData%LSSTipMza) + call RegPack(RF, InData%LSSTipMys) + call RegPack(RF, InData%LSSTipMzs) + call RegPack(RF, InData%YawBrMyn) + call RegPack(RF, InData%YawBrMzn) + call RegPack(RF, InData%NcIMURAxs) + call RegPack(RF, InData%NcIMURAys) + call RegPack(RF, InData%NcIMURAzs) + call RegPack(RF, InData%RotPwr) + call RegPack(RF, InData%HorWindV) + call RegPack(RF, InData%YawAngle) + call RegPack(RF, InData%LSShftFxa) + call RegPack(RF, InData%LSShftFys) + call RegPack(RF, InData%LSShftFzs) + call RegPackAlloc(RF, InData%fromSC) + call RegPackAlloc(RF, InData%fromSCglob) + call RegPackAlloc(RF, InData%Lidar) + call MeshPack(RF, InData%PtfmMotionMesh) + call RegPack(RF, allocated(InData%BStCMotionMesh)) if (allocated(InData%BStCMotionMesh)) then - call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%BStCMotionMesh, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) LB(1:2) = lbound(InData%BStCMotionMesh, kind=B8Ki) UB(1:2) = ubound(InData%BStCMotionMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BStCMotionMesh(i1,i2)) + call MeshPack(RF, InData%BStCMotionMesh(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%NStCMotionMesh)) + call RegPack(RF, allocated(InData%NStCMotionMesh)) if (allocated(InData%NStCMotionMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStCMotionMesh, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) LB(1:1) = lbound(InData%NStCMotionMesh, kind=B8Ki) UB(1:1) = ubound(InData%NStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%NStCMotionMesh(i1)) + call MeshPack(RF, InData%NStCMotionMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%TStCMotionMesh)) + call RegPack(RF, allocated(InData%TStCMotionMesh)) if (allocated(InData%TStCMotionMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStCMotionMesh, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) LB(1:1) = lbound(InData%TStCMotionMesh, kind=B8Ki) UB(1:1) = ubound(InData%TStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%TStCMotionMesh(i1)) + call MeshPack(RF, InData%TStCMotionMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%SStCMotionMesh)) + call RegPack(RF, allocated(InData%SStCMotionMesh)) if (allocated(InData%SStCMotionMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStCMotionMesh, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) LB(1:1) = lbound(InData%SStCMotionMesh, kind=B8Ki) UB(1:1) = ubound(InData%SStCMotionMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%SStCMotionMesh(i1)) + call MeshPack(RF, InData%SStCMotionMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%LidSpeed)) - if (allocated(InData%LidSpeed)) then - call RegPackBounds(Buf, 1, lbound(InData%LidSpeed, kind=B8Ki), ubound(InData%LidSpeed, kind=B8Ki)) - call RegPack(Buf, InData%LidSpeed) - end if - call RegPack(Buf, allocated(InData%MsrPositionsX)) - if (allocated(InData%MsrPositionsX)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX, kind=B8Ki), ubound(InData%MsrPositionsX, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsX) - end if - call RegPack(Buf, allocated(InData%MsrPositionsY)) - if (allocated(InData%MsrPositionsY)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY, kind=B8Ki), ubound(InData%MsrPositionsY, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsY) - end if - call RegPack(Buf, allocated(InData%MsrPositionsZ)) - if (allocated(InData%MsrPositionsZ)) then - call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ, kind=B8Ki), ubound(InData%MsrPositionsZ, kind=B8Ki)) - call RegPack(Buf, InData%MsrPositionsZ) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%LidSpeed) + call RegPackAlloc(RF, InData%MsrPositionsX) + call RegPackAlloc(RF, InData%MsrPositionsY) + call RegPackAlloc(RF, InData%MsrPositionsZ) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitch) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Yaw) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawRate) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExternalYawPosCom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExternalYawRateCom) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ExternalBlPitchCom)) deallocate(OutData%ExternalBlPitchCom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ExternalBlPitchCom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ExternalBlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%ExternalGenTrq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExternalElecPwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ExternalHSSBrFrac) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%ExternalBlAirfoilCom)) deallocate(OutData%ExternalBlAirfoilCom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ExternalBlAirfoilCom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlAirfoilCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ExternalBlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ExternalCableDeltaL)) deallocate(OutData%ExternalCableDeltaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ExternalCableDeltaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ExternalCableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ExternalCableDeltaLdot)) deallocate(OutData%ExternalCableDeltaLdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ExternalCableDeltaLdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ExternalCableDeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%TwrAccel) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WindDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMyc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrTAxp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrTAyp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipPxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootMxc) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMya) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMza) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSSTipMzs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMyn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawBrMzn) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAxs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NcIMURAzs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotPwr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HorWindV) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawAngle) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFxa) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%LSShftFzs) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fromSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%fromSCglob) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Lidar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Lidar) - if (RegCheckErr(Buf, RoutineName)) return - end if - call MeshUnpack(Buf, OutData%PtfmMotionMesh) ! PtfmMotionMesh + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%BlPitch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Yaw); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawRate); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSS_Spd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawPosCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalYawRateCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalGenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ExternalHSSBrFrac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalBlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ExternalCableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TwrAccel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WindDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMyc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAxp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrTAyp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipPxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootMxc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMya); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMza); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSSTipMzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMyn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawBrMzn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAxs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NcIMURAzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HorWindV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawAngle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFxa); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LSShftFzs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Lidar); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%PtfmMotionMesh) ! PtfmMotionMesh if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + call MeshUnpack(RF, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh end do end do end if if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh + call MeshUnpack(RF, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh end do end if if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh + call MeshUnpack(RF, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh end do end if if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh + call MeshUnpack(RF, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh end do end if - if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LidSpeed) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsY) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MsrPositionsZ) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -8259,289 +6241,141 @@ subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SrvD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SrvD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOutput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - call RegPack(Buf, allocated(InData%BlPitchCom)) - if (allocated(InData%BlPitchCom)) then - call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom, kind=B8Ki), ubound(InData%BlPitchCom, kind=B8Ki)) - call RegPack(Buf, InData%BlPitchCom) - end if - call RegPack(Buf, allocated(InData%BlAirfoilCom)) - if (allocated(InData%BlAirfoilCom)) then - call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom, kind=B8Ki), ubound(InData%BlAirfoilCom, kind=B8Ki)) - call RegPack(Buf, InData%BlAirfoilCom) - end if - call RegPack(Buf, InData%YawMom) - call RegPack(Buf, InData%GenTrq) - call RegPack(Buf, InData%HSSBrTrqC) - call RegPack(Buf, InData%ElecPwr) - call RegPack(Buf, allocated(InData%TBDrCon)) - if (allocated(InData%TBDrCon)) then - call RegPackBounds(Buf, 1, lbound(InData%TBDrCon, kind=B8Ki), ubound(InData%TBDrCon, kind=B8Ki)) - call RegPack(Buf, InData%TBDrCon) - end if - call RegPack(Buf, allocated(InData%Lidar)) - if (allocated(InData%Lidar)) then - call RegPackBounds(Buf, 1, lbound(InData%Lidar, kind=B8Ki), ubound(InData%Lidar, kind=B8Ki)) - call RegPack(Buf, InData%Lidar) - end if - call RegPack(Buf, allocated(InData%CableDeltaL)) - if (allocated(InData%CableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL, kind=B8Ki), ubound(InData%CableDeltaL, kind=B8Ki)) - call RegPack(Buf, InData%CableDeltaL) - end if - call RegPack(Buf, allocated(InData%CableDeltaLdot)) - if (allocated(InData%CableDeltaLdot)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot, kind=B8Ki), ubound(InData%CableDeltaLdot, kind=B8Ki)) - call RegPack(Buf, InData%CableDeltaLdot) - end if - call RegPack(Buf, allocated(InData%BStCLoadMesh)) + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + call RegPackAlloc(RF, InData%BlPitchCom) + call RegPackAlloc(RF, InData%BlAirfoilCom) + call RegPack(RF, InData%YawMom) + call RegPack(RF, InData%GenTrq) + call RegPack(RF, InData%HSSBrTrqC) + call RegPack(RF, InData%ElecPwr) + call RegPackAlloc(RF, InData%TBDrCon) + call RegPackAlloc(RF, InData%Lidar) + call RegPackAlloc(RF, InData%CableDeltaL) + call RegPackAlloc(RF, InData%CableDeltaLdot) + call RegPack(RF, allocated(InData%BStCLoadMesh)) if (allocated(InData%BStCLoadMesh)) then - call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(InData%BStCLoadMesh, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) LB(1:2) = lbound(InData%BStCLoadMesh, kind=B8Ki) UB(1:2) = ubound(InData%BStCLoadMesh, kind=B8Ki) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%BStCLoadMesh(i1,i2)) + call MeshPack(RF, InData%BStCLoadMesh(i1,i2)) end do end do end if - call RegPack(Buf, allocated(InData%NStCLoadMesh)) + call RegPack(RF, allocated(InData%NStCLoadMesh)) if (allocated(InData%NStCLoadMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NStCLoadMesh, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) LB(1:1) = lbound(InData%NStCLoadMesh, kind=B8Ki) UB(1:1) = ubound(InData%NStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%NStCLoadMesh(i1)) + call MeshPack(RF, InData%NStCLoadMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%TStCLoadMesh)) + call RegPack(RF, allocated(InData%TStCLoadMesh)) if (allocated(InData%TStCLoadMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) LB(1:1) = lbound(InData%TStCLoadMesh, kind=B8Ki) UB(1:1) = ubound(InData%TStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%TStCLoadMesh(i1)) + call MeshPack(RF, InData%TStCLoadMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%SStCLoadMesh)) + call RegPack(RF, allocated(InData%SStCLoadMesh)) if (allocated(InData%SStCLoadMesh)) then - call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) LB(1:1) = lbound(InData%SStCLoadMesh, kind=B8Ki) UB(1:1) = ubound(InData%SStCLoadMesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%SStCLoadMesh(i1)) + call MeshPack(RF, InData%SStCLoadMesh(i1)) end do end if - call RegPack(Buf, allocated(InData%toSC)) - if (allocated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) - call RegPack(Buf, InData%toSC) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%toSC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SrvD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SrvD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SrvD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlPitchCom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%BlAirfoilCom)) deallocate(OutData%BlAirfoilCom) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%BlAirfoilCom(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%BlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%YawMom) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%HSSBrTrqC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ElecPwr) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%TBDrCon)) deallocate(OutData%TBDrCon) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TBDrCon(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TBDrCon) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Lidar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Lidar) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableDeltaLdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableDeltaLdot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlAirfoilCom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawMom); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GenTrq); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HSSBrTrqC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ElecPwr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TBDrCon); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Lidar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableDeltaLdot); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 2, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh + call MeshUnpack(RF, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh end do end do end if if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh + call MeshUnpack(RF, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh end do end if if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh + call MeshUnpack(RF, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh end do end if if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + call MeshUnpack(RF, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh end do end if - if (allocated(OutData%toSC)) deallocate(OutData%toSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%toSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%toSC) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 61c5b1aa1c..b11f6b1805 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -380,268 +380,154 @@ subroutine StC_DestroyInputFile(InputFileData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInputFile' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%StCFileName) - call RegPack(Buf, InData%Echo) - call RegPack(Buf, InData%StC_CMODE) - call RegPack(Buf, InData%StC_SA_MODE) - call RegPack(Buf, InData%StC_DOF_MODE) - call RegPack(Buf, InData%StC_X_DOF) - call RegPack(Buf, InData%StC_Y_DOF) - call RegPack(Buf, InData%StC_Z_DOF) - call RegPack(Buf, InData%StC_X_DSP) - call RegPack(Buf, InData%StC_Y_DSP) - call RegPack(Buf, InData%StC_Z_DSP) - call RegPack(Buf, InData%StC_Z_PreLdC) - call RegPack(Buf, InData%StC_X_M) - call RegPack(Buf, InData%StC_Y_M) - call RegPack(Buf, InData%StC_Z_M) - call RegPack(Buf, InData%StC_XY_M) - call RegPack(Buf, InData%StC_X_K) - call RegPack(Buf, InData%StC_Y_K) - call RegPack(Buf, InData%StC_Z_K) - call RegPack(Buf, InData%StC_X_C) - call RegPack(Buf, InData%StC_Y_C) - call RegPack(Buf, InData%StC_Z_C) - call RegPack(Buf, InData%StC_X_PSP) - call RegPack(Buf, InData%StC_X_NSP) - call RegPack(Buf, InData%StC_Y_PSP) - call RegPack(Buf, InData%StC_Y_NSP) - call RegPack(Buf, InData%StC_Z_PSP) - call RegPack(Buf, InData%StC_Z_NSP) - call RegPack(Buf, InData%StC_X_KS) - call RegPack(Buf, InData%StC_X_CS) - call RegPack(Buf, InData%StC_Y_KS) - call RegPack(Buf, InData%StC_Y_CS) - call RegPack(Buf, InData%StC_Z_KS) - call RegPack(Buf, InData%StC_Z_CS) - call RegPack(Buf, InData%StC_P_X) - call RegPack(Buf, InData%StC_P_Y) - call RegPack(Buf, InData%StC_P_Z) - call RegPack(Buf, InData%StC_X_C_HIGH) - call RegPack(Buf, InData%StC_X_C_LOW) - call RegPack(Buf, InData%StC_Y_C_HIGH) - call RegPack(Buf, InData%StC_Y_C_LOW) - call RegPack(Buf, InData%StC_Z_C_HIGH) - call RegPack(Buf, InData%StC_Z_C_LOW) - call RegPack(Buf, InData%StC_X_C_BRAKE) - call RegPack(Buf, InData%StC_Y_C_BRAKE) - call RegPack(Buf, InData%StC_Z_C_BRAKE) - call RegPack(Buf, InData%L_X) - call RegPack(Buf, InData%B_X) - call RegPack(Buf, InData%area_X) - call RegPack(Buf, InData%area_ratio_X) - call RegPack(Buf, InData%headLossCoeff_X) - call RegPack(Buf, InData%rho_X) - call RegPack(Buf, InData%L_Y) - call RegPack(Buf, InData%B_Y) - call RegPack(Buf, InData%area_Y) - call RegPack(Buf, InData%area_ratio_Y) - call RegPack(Buf, InData%headLossCoeff_Y) - call RegPack(Buf, InData%rho_Y) - call RegPack(Buf, InData%USE_F_TBL) - call RegPack(Buf, InData%NKInpSt) - call RegPack(Buf, InData%StC_F_TBL_FILE) - call RegPack(Buf, allocated(InData%F_TBL)) - if (allocated(InData%F_TBL)) then - call RegPackBounds(Buf, 2, lbound(InData%F_TBL, kind=B8Ki), ubound(InData%F_TBL, kind=B8Ki)) - call RegPack(Buf, InData%F_TBL) - end if - call RegPack(Buf, InData%PrescribedForcesCoordSys) - call RegPack(Buf, InData%PrescribedForcesFile) - call RegPack(Buf, allocated(InData%StC_PrescribedForce)) - if (allocated(InData%StC_PrescribedForce)) then - call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce, kind=B8Ki), ubound(InData%StC_PrescribedForce, kind=B8Ki)) - call RegPack(Buf, InData%StC_PrescribedForce) - end if - call RegPack(Buf, allocated(InData%StC_CChan)) - if (allocated(InData%StC_CChan)) then - call RegPackBounds(Buf, 1, lbound(InData%StC_CChan, kind=B8Ki), ubound(InData%StC_CChan, kind=B8Ki)) - call RegPack(Buf, InData%StC_CChan) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%StCFileName) + call RegPack(RF, InData%Echo) + call RegPack(RF, InData%StC_CMODE) + call RegPack(RF, InData%StC_SA_MODE) + call RegPack(RF, InData%StC_DOF_MODE) + call RegPack(RF, InData%StC_X_DOF) + call RegPack(RF, InData%StC_Y_DOF) + call RegPack(RF, InData%StC_Z_DOF) + call RegPack(RF, InData%StC_X_DSP) + call RegPack(RF, InData%StC_Y_DSP) + call RegPack(RF, InData%StC_Z_DSP) + call RegPack(RF, InData%StC_Z_PreLdC) + call RegPack(RF, InData%StC_X_M) + call RegPack(RF, InData%StC_Y_M) + call RegPack(RF, InData%StC_Z_M) + call RegPack(RF, InData%StC_XY_M) + call RegPack(RF, InData%StC_X_K) + call RegPack(RF, InData%StC_Y_K) + call RegPack(RF, InData%StC_Z_K) + call RegPack(RF, InData%StC_X_C) + call RegPack(RF, InData%StC_Y_C) + call RegPack(RF, InData%StC_Z_C) + call RegPack(RF, InData%StC_X_PSP) + call RegPack(RF, InData%StC_X_NSP) + call RegPack(RF, InData%StC_Y_PSP) + call RegPack(RF, InData%StC_Y_NSP) + call RegPack(RF, InData%StC_Z_PSP) + call RegPack(RF, InData%StC_Z_NSP) + call RegPack(RF, InData%StC_X_KS) + call RegPack(RF, InData%StC_X_CS) + call RegPack(RF, InData%StC_Y_KS) + call RegPack(RF, InData%StC_Y_CS) + call RegPack(RF, InData%StC_Z_KS) + call RegPack(RF, InData%StC_Z_CS) + call RegPack(RF, InData%StC_P_X) + call RegPack(RF, InData%StC_P_Y) + call RegPack(RF, InData%StC_P_Z) + call RegPack(RF, InData%StC_X_C_HIGH) + call RegPack(RF, InData%StC_X_C_LOW) + call RegPack(RF, InData%StC_Y_C_HIGH) + call RegPack(RF, InData%StC_Y_C_LOW) + call RegPack(RF, InData%StC_Z_C_HIGH) + call RegPack(RF, InData%StC_Z_C_LOW) + call RegPack(RF, InData%StC_X_C_BRAKE) + call RegPack(RF, InData%StC_Y_C_BRAKE) + call RegPack(RF, InData%StC_Z_C_BRAKE) + call RegPack(RF, InData%L_X) + call RegPack(RF, InData%B_X) + call RegPack(RF, InData%area_X) + call RegPack(RF, InData%area_ratio_X) + call RegPack(RF, InData%headLossCoeff_X) + call RegPack(RF, InData%rho_X) + call RegPack(RF, InData%L_Y) + call RegPack(RF, InData%B_Y) + call RegPack(RF, InData%area_Y) + call RegPack(RF, InData%area_ratio_Y) + call RegPack(RF, InData%headLossCoeff_Y) + call RegPack(RF, InData%rho_Y) + call RegPack(RF, InData%USE_F_TBL) + call RegPack(RF, InData%NKInpSt) + call RegPack(RF, InData%StC_F_TBL_FILE) + call RegPackAlloc(RF, InData%F_TBL) + call RegPack(RF, InData%PrescribedForcesCoordSys) + call RegPack(RF, InData%PrescribedForcesFile) + call RegPackAlloc(RF, InData%StC_PrescribedForce) + call RegPackAlloc(RF, InData%StC_CChan) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackInputFile(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInputFile' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%StCFileName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_CMODE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_SA_MODE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_DOF_MODE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_DSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_DSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_DSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_PreLdC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_XY_M) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_K) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_K) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_K) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_PSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_NSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_PSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_NSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_PSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_NSP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_KS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_CS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_KS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_CS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_KS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_CS) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_P_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_P_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_P_Z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%L_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%B_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_ratio_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%headLossCoeff_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rho_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%L_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%B_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_ratio_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%headLossCoeff_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rho_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%USE_F_TBL) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NKInpSt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_F_TBL_FILE) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_TBL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_TBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrescribedForcesFile) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StC_PrescribedForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StC_CChan(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StC_CChan) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%StCFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Echo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_CMODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_SA_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_DOF_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_DSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_DSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_DSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_PreLdC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_XY_M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_PSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_NSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_PSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_NSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_PSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_NSP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_KS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_CS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_KS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_CS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_KS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_CS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_P_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_P_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_P_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%USE_F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NKInpSt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_F_TBL_FILE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedForcesCoordSys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedForcesFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_PrescribedForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_CChan); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -745,120 +631,46 @@ subroutine StC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine StC_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%InputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%NumMeshPts) - call RegPack(Buf, allocated(InData%InitRefPos)) - if (allocated(InData%InitRefPos)) then - call RegPackBounds(Buf, 2, lbound(InData%InitRefPos, kind=B8Ki), ubound(InData%InitRefPos, kind=B8Ki)) - call RegPack(Buf, InData%InitRefPos) - end if - call RegPack(Buf, allocated(InData%InitTransDisp)) - if (allocated(InData%InitTransDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp, kind=B8Ki), ubound(InData%InitTransDisp, kind=B8Ki)) - call RegPack(Buf, InData%InitTransDisp) - end if - call RegPack(Buf, allocated(InData%InitOrient)) - if (allocated(InData%InitOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%InitOrient, kind=B8Ki), ubound(InData%InitOrient, kind=B8Ki)) - call RegPack(Buf, InData%InitOrient) - end if - call RegPack(Buf, allocated(InData%InitRefOrient)) - if (allocated(InData%InitRefOrient)) then - call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient, kind=B8Ki), ubound(InData%InitRefOrient, kind=B8Ki)) - call RegPack(Buf, InData%InitRefOrient) - end if - call RegPack(Buf, InData%UseInputFile) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - call RegPack(Buf, InData%UseInputFile_PrescribeFrc) - call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrescribeFrcData) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%NumMeshPts) + call RegPackAlloc(RF, InData%InitRefPos) + call RegPackAlloc(RF, InData%InitTransDisp) + call RegPackAlloc(RF, InData%InitOrient) + call RegPackAlloc(RF, InData%InitRefOrient) + call RegPack(RF, InData%UseInputFile) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrimaryInputData) + call RegPack(RF, InData%UseInputFile_PrescribeFrc) + call NWTC_Library_PackFileInfoType(RF, InData%PassedPrescribeFrcData) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitInput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumMeshPts) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%InitRefPos)) deallocate(OutData%InitRefPos) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitRefPos) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitTransDisp)) deallocate(OutData%InitTransDisp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitTransDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitTransDisp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitOrient)) deallocate(OutData%InitOrient) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitOrient) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitRefOrient)) deallocate(OutData%InitRefOrient) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitRefOrient) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - call RegUnpack(Buf, OutData%UseInputFile_PrescribeFrc) - if (RegCheckErr(Buf, RoutineName)) return - call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrescribeFrcData) ! PassedPrescribeFrcData + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumMeshPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitRefPos); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitTransDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitRefOrient); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + call RegUnpack(RF, OutData%UseInputFile_PrescribeFrc); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackFileInfoType(RF, OutData%PassedPrescribeFrcData) ! PassedPrescribeFrcData end subroutine subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg) @@ -988,155 +800,36 @@ subroutine StC_DestroyCtrlChanInitInfoType(CtrlChanInitInfoTypeData, ErrStat, Er end if end subroutine -subroutine StC_PackCtrlChanInitInfoType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackCtrlChanInitInfoType(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_CtrlChanInitInfoType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackCtrlChanInitInfoType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Requestor)) - if (allocated(InData%Requestor)) then - call RegPackBounds(Buf, 1, lbound(InData%Requestor, kind=B8Ki), ubound(InData%Requestor, kind=B8Ki)) - call RegPack(Buf, InData%Requestor) - end if - call RegPack(Buf, allocated(InData%InitStiff)) - if (allocated(InData%InitStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%InitStiff, kind=B8Ki), ubound(InData%InitStiff, kind=B8Ki)) - call RegPack(Buf, InData%InitStiff) - end if - call RegPack(Buf, allocated(InData%InitDamp)) - if (allocated(InData%InitDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%InitDamp, kind=B8Ki), ubound(InData%InitDamp, kind=B8Ki)) - call RegPack(Buf, InData%InitDamp) - end if - call RegPack(Buf, allocated(InData%InitBrake)) - if (allocated(InData%InitBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%InitBrake, kind=B8Ki), ubound(InData%InitBrake, kind=B8Ki)) - call RegPack(Buf, InData%InitBrake) - end if - call RegPack(Buf, allocated(InData%InitForce)) - if (allocated(InData%InitForce)) then - call RegPackBounds(Buf, 2, lbound(InData%InitForce, kind=B8Ki), ubound(InData%InitForce, kind=B8Ki)) - call RegPack(Buf, InData%InitForce) - end if - call RegPack(Buf, allocated(InData%InitMeasDisp)) - if (allocated(InData%InitMeasDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp, kind=B8Ki), ubound(InData%InitMeasDisp, kind=B8Ki)) - call RegPack(Buf, InData%InitMeasDisp) - end if - call RegPack(Buf, allocated(InData%InitMeasVel)) - if (allocated(InData%InitMeasVel)) then - call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel, kind=B8Ki), ubound(InData%InitMeasVel, kind=B8Ki)) - call RegPack(Buf, InData%InitMeasVel) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%Requestor) + call RegPackAlloc(RF, InData%InitStiff) + call RegPackAlloc(RF, InData%InitDamp) + call RegPackAlloc(RF, InData%InitBrake) + call RegPackAlloc(RF, InData%InitForce) + call RegPackAlloc(RF, InData%InitMeasDisp) + call RegPackAlloc(RF, InData%InitMeasVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackCtrlChanInitInfoType(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_CtrlChanInitInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%Requestor)) deallocate(OutData%Requestor) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Requestor(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Requestor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Requestor) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitStiff)) deallocate(OutData%InitStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitDamp)) deallocate(OutData%InitDamp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitDamp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitBrake)) deallocate(OutData%InitBrake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitBrake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitForce)) deallocate(OutData%InitForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitMeasDisp)) deallocate(OutData%InitMeasDisp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitMeasDisp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%InitMeasVel)) deallocate(OutData%InitMeasVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InitMeasVel) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%Requestor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitMeasDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitMeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1176,41 +869,24 @@ subroutine StC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%RelPosition)) - if (allocated(InData%RelPosition)) then - call RegPackBounds(Buf, 2, lbound(InData%RelPosition, kind=B8Ki), ubound(InData%RelPosition, kind=B8Ki)) - call RegPack(Buf, InData%RelPosition) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%RelPosition) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%RelPosition)) deallocate(OutData%RelPosition) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RelPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RelPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RelPosition) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%RelPosition); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1250,41 +926,24 @@ subroutine StC_DestroyContState(ContStateData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%StC_x)) - if (allocated(InData%StC_x)) then - call RegPackBounds(Buf, 2, lbound(InData%StC_x, kind=B8Ki), ubound(InData%StC_x, kind=B8Ki)) - call RegPack(Buf, InData%StC_x) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%StC_x) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackContState' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%StC_x)) deallocate(OutData%StC_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StC_x) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%StC_x); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -1308,22 +967,21 @@ subroutine StC_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine StC_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1347,22 +1005,21 @@ subroutine StC_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine StC_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1386,22 +1043,21 @@ subroutine StC_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine StC_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyOtherState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1682,348 +1338,58 @@ subroutine StC_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%F_stop)) - if (allocated(InData%F_stop)) then - call RegPackBounds(Buf, 2, lbound(InData%F_stop, kind=B8Ki), ubound(InData%F_stop, kind=B8Ki)) - call RegPack(Buf, InData%F_stop) - end if - call RegPack(Buf, allocated(InData%F_ext)) - if (allocated(InData%F_ext)) then - call RegPackBounds(Buf, 2, lbound(InData%F_ext, kind=B8Ki), ubound(InData%F_ext, kind=B8Ki)) - call RegPack(Buf, InData%F_ext) - end if - call RegPack(Buf, allocated(InData%F_fr)) - if (allocated(InData%F_fr)) then - call RegPackBounds(Buf, 2, lbound(InData%F_fr, kind=B8Ki), ubound(InData%F_fr, kind=B8Ki)) - call RegPack(Buf, InData%F_fr) - end if - call RegPack(Buf, allocated(InData%K)) - if (allocated(InData%K)) then - call RegPackBounds(Buf, 2, lbound(InData%K, kind=B8Ki), ubound(InData%K, kind=B8Ki)) - call RegPack(Buf, InData%K) - end if - call RegPack(Buf, allocated(InData%C_ctrl)) - if (allocated(InData%C_ctrl)) then - call RegPackBounds(Buf, 2, lbound(InData%C_ctrl, kind=B8Ki), ubound(InData%C_ctrl, kind=B8Ki)) - call RegPack(Buf, InData%C_ctrl) - end if - call RegPack(Buf, allocated(InData%C_Brake)) - if (allocated(InData%C_Brake)) then - call RegPackBounds(Buf, 2, lbound(InData%C_Brake, kind=B8Ki), ubound(InData%C_Brake, kind=B8Ki)) - call RegPack(Buf, InData%C_Brake) - end if - call RegPack(Buf, allocated(InData%F_table)) - if (allocated(InData%F_table)) then - call RegPackBounds(Buf, 2, lbound(InData%F_table, kind=B8Ki), ubound(InData%F_table, kind=B8Ki)) - call RegPack(Buf, InData%F_table) - end if - call RegPack(Buf, allocated(InData%F_k)) - if (allocated(InData%F_k)) then - call RegPackBounds(Buf, 2, lbound(InData%F_k, kind=B8Ki), ubound(InData%F_k, kind=B8Ki)) - call RegPack(Buf, InData%F_k) - end if - call RegPack(Buf, allocated(InData%a_G)) - if (allocated(InData%a_G)) then - call RegPackBounds(Buf, 2, lbound(InData%a_G, kind=B8Ki), ubound(InData%a_G, kind=B8Ki)) - call RegPack(Buf, InData%a_G) - end if - call RegPack(Buf, allocated(InData%rdisp_P)) - if (allocated(InData%rdisp_P)) then - call RegPackBounds(Buf, 2, lbound(InData%rdisp_P, kind=B8Ki), ubound(InData%rdisp_P, kind=B8Ki)) - call RegPack(Buf, InData%rdisp_P) - end if - call RegPack(Buf, allocated(InData%rdot_P)) - if (allocated(InData%rdot_P)) then - call RegPackBounds(Buf, 2, lbound(InData%rdot_P, kind=B8Ki), ubound(InData%rdot_P, kind=B8Ki)) - call RegPack(Buf, InData%rdot_P) - end if - call RegPack(Buf, allocated(InData%rddot_P)) - if (allocated(InData%rddot_P)) then - call RegPackBounds(Buf, 2, lbound(InData%rddot_P, kind=B8Ki), ubound(InData%rddot_P, kind=B8Ki)) - call RegPack(Buf, InData%rddot_P) - end if - call RegPack(Buf, allocated(InData%omega_P)) - if (allocated(InData%omega_P)) then - call RegPackBounds(Buf, 2, lbound(InData%omega_P, kind=B8Ki), ubound(InData%omega_P, kind=B8Ki)) - call RegPack(Buf, InData%omega_P) - end if - call RegPack(Buf, allocated(InData%alpha_P)) - if (allocated(InData%alpha_P)) then - call RegPackBounds(Buf, 2, lbound(InData%alpha_P, kind=B8Ki), ubound(InData%alpha_P, kind=B8Ki)) - call RegPack(Buf, InData%alpha_P) - end if - call RegPack(Buf, allocated(InData%F_P)) - if (allocated(InData%F_P)) then - call RegPackBounds(Buf, 2, lbound(InData%F_P, kind=B8Ki), ubound(InData%F_P, kind=B8Ki)) - call RegPack(Buf, InData%F_P) - end if - call RegPack(Buf, allocated(InData%M_P)) - if (allocated(InData%M_P)) then - call RegPackBounds(Buf, 2, lbound(InData%M_P, kind=B8Ki), ubound(InData%M_P, kind=B8Ki)) - call RegPack(Buf, InData%M_P) - end if - call RegPack(Buf, allocated(InData%Acc)) - if (allocated(InData%Acc)) then - call RegPackBounds(Buf, 2, lbound(InData%Acc, kind=B8Ki), ubound(InData%Acc, kind=B8Ki)) - call RegPack(Buf, InData%Acc) - end if - call RegPack(Buf, InData%PrescribedInterpIdx) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%F_stop) + call RegPackAlloc(RF, InData%F_ext) + call RegPackAlloc(RF, InData%F_fr) + call RegPackAlloc(RF, InData%K) + call RegPackAlloc(RF, InData%C_ctrl) + call RegPackAlloc(RF, InData%C_Brake) + call RegPackAlloc(RF, InData%F_table) + call RegPackAlloc(RF, InData%F_k) + call RegPackAlloc(RF, InData%a_G) + call RegPackAlloc(RF, InData%rdisp_P) + call RegPackAlloc(RF, InData%rdot_P) + call RegPackAlloc(RF, InData%rddot_P) + call RegPackAlloc(RF, InData%omega_P) + call RegPackAlloc(RF, InData%alpha_P) + call RegPackAlloc(RF, InData%F_P) + call RegPackAlloc(RF, InData%M_P) + call RegPackAlloc(RF, InData%Acc) + call RegPack(RF, InData%PrescribedInterpIdx) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackMisc' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%F_stop)) deallocate(OutData%F_stop) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_stop(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_stop.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_stop) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_ext)) deallocate(OutData%F_ext) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_ext(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_ext.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_ext) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_fr)) deallocate(OutData%F_fr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_fr(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_fr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_fr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%K)) deallocate(OutData%K) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%K(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%K) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C_ctrl)) deallocate(OutData%C_ctrl) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C_ctrl(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_ctrl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C_ctrl) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C_Brake)) deallocate(OutData%C_Brake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C_Brake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_Brake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C_Brake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_table)) deallocate(OutData%F_table) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_table(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_table.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_table) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_k)) deallocate(OutData%F_k) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_k(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_k) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%a_G)) deallocate(OutData%a_G) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%a_G(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%a_G) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdisp_P)) deallocate(OutData%rdisp_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdisp_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdisp_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdisp_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rdot_P)) deallocate(OutData%rdot_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rdot_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdot_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rdot_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%rddot_P)) deallocate(OutData%rddot_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%rddot_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rddot_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%rddot_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%omega_P)) deallocate(OutData%omega_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%omega_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%omega_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%alpha_P)) deallocate(OutData%alpha_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%alpha_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%alpha_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_P)) deallocate(OutData%F_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M_P)) deallocate(OutData%M_P) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M_P) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Acc)) deallocate(OutData%Acc) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Acc(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Acc) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%PrescribedInterpIdx) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%F_stop); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_ext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_fr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_ctrl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C_Brake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_table); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_k); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a_G); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdisp_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rdot_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%rddot_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%omega_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%alpha_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_P); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Acc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedInterpIdx); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2141,223 +1507,124 @@ subroutine StC_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%StC_DOF_MODE) - call RegPack(Buf, InData%StC_X_DOF) - call RegPack(Buf, InData%StC_Y_DOF) - call RegPack(Buf, InData%StC_Z_DOF) - call RegPack(Buf, InData%StC_Z_PreLd) - call RegPack(Buf, InData%M_X) - call RegPack(Buf, InData%M_Y) - call RegPack(Buf, InData%M_Z) - call RegPack(Buf, InData%M_XY) - call RegPack(Buf, InData%K_X) - call RegPack(Buf, InData%K_Y) - call RegPack(Buf, InData%K_Z) - call RegPack(Buf, InData%C_X) - call RegPack(Buf, InData%C_Y) - call RegPack(Buf, InData%C_Z) - call RegPack(Buf, InData%K_S) - call RegPack(Buf, InData%C_S) - call RegPack(Buf, InData%P_SP) - call RegPack(Buf, InData%N_SP) - call RegPack(Buf, InData%Gravity) - call RegPack(Buf, InData%StC_CMODE) - call RegPack(Buf, InData%StC_SA_MODE) - call RegPack(Buf, InData%StC_X_C_HIGH) - call RegPack(Buf, InData%StC_X_C_LOW) - call RegPack(Buf, InData%StC_Y_C_HIGH) - call RegPack(Buf, InData%StC_Y_C_LOW) - call RegPack(Buf, InData%StC_Z_C_HIGH) - call RegPack(Buf, InData%StC_Z_C_LOW) - call RegPack(Buf, InData%StC_X_C_BRAKE) - call RegPack(Buf, InData%StC_Y_C_BRAKE) - call RegPack(Buf, InData%StC_Z_C_BRAKE) - call RegPack(Buf, InData%L_X) - call RegPack(Buf, InData%B_X) - call RegPack(Buf, InData%area_X) - call RegPack(Buf, InData%area_ratio_X) - call RegPack(Buf, InData%headLossCoeff_X) - call RegPack(Buf, InData%rho_X) - call RegPack(Buf, InData%L_Y) - call RegPack(Buf, InData%B_Y) - call RegPack(Buf, InData%area_Y) - call RegPack(Buf, InData%area_ratio_Y) - call RegPack(Buf, InData%headLossCoeff_Y) - call RegPack(Buf, InData%rho_Y) - call RegPack(Buf, InData%Use_F_TBL) - call RegPack(Buf, allocated(InData%F_TBL)) - if (allocated(InData%F_TBL)) then - call RegPackBounds(Buf, 2, lbound(InData%F_TBL, kind=B8Ki), ubound(InData%F_TBL, kind=B8Ki)) - call RegPack(Buf, InData%F_TBL) - end if - call RegPack(Buf, InData%NumMeshPts) - call RegPack(Buf, InData%PrescribedForcesCoordSys) - call RegPack(Buf, allocated(InData%StC_PrescribedForce)) - if (allocated(InData%StC_PrescribedForce)) then - call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce, kind=B8Ki), ubound(InData%StC_PrescribedForce, kind=B8Ki)) - call RegPack(Buf, InData%StC_PrescribedForce) - end if - call RegPack(Buf, allocated(InData%StC_CChan)) - if (allocated(InData%StC_CChan)) then - call RegPackBounds(Buf, 1, lbound(InData%StC_CChan, kind=B8Ki), ubound(InData%StC_CChan, kind=B8Ki)) - call RegPack(Buf, InData%StC_CChan) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%StC_DOF_MODE) + call RegPack(RF, InData%StC_X_DOF) + call RegPack(RF, InData%StC_Y_DOF) + call RegPack(RF, InData%StC_Z_DOF) + call RegPack(RF, InData%StC_Z_PreLd) + call RegPack(RF, InData%M_X) + call RegPack(RF, InData%M_Y) + call RegPack(RF, InData%M_Z) + call RegPack(RF, InData%M_XY) + call RegPack(RF, InData%K_X) + call RegPack(RF, InData%K_Y) + call RegPack(RF, InData%K_Z) + call RegPack(RF, InData%C_X) + call RegPack(RF, InData%C_Y) + call RegPack(RF, InData%C_Z) + call RegPack(RF, InData%K_S) + call RegPack(RF, InData%C_S) + call RegPack(RF, InData%P_SP) + call RegPack(RF, InData%N_SP) + call RegPack(RF, InData%Gravity) + call RegPack(RF, InData%StC_CMODE) + call RegPack(RF, InData%StC_SA_MODE) + call RegPack(RF, InData%StC_X_C_HIGH) + call RegPack(RF, InData%StC_X_C_LOW) + call RegPack(RF, InData%StC_Y_C_HIGH) + call RegPack(RF, InData%StC_Y_C_LOW) + call RegPack(RF, InData%StC_Z_C_HIGH) + call RegPack(RF, InData%StC_Z_C_LOW) + call RegPack(RF, InData%StC_X_C_BRAKE) + call RegPack(RF, InData%StC_Y_C_BRAKE) + call RegPack(RF, InData%StC_Z_C_BRAKE) + call RegPack(RF, InData%L_X) + call RegPack(RF, InData%B_X) + call RegPack(RF, InData%area_X) + call RegPack(RF, InData%area_ratio_X) + call RegPack(RF, InData%headLossCoeff_X) + call RegPack(RF, InData%rho_X) + call RegPack(RF, InData%L_Y) + call RegPack(RF, InData%B_Y) + call RegPack(RF, InData%area_Y) + call RegPack(RF, InData%area_ratio_Y) + call RegPack(RF, InData%headLossCoeff_Y) + call RegPack(RF, InData%rho_Y) + call RegPack(RF, InData%Use_F_TBL) + call RegPackAlloc(RF, InData%F_TBL) + call RegPack(RF, InData%NumMeshPts) + call RegPack(RF, InData%PrescribedForcesCoordSys) + call RegPackAlloc(RF, InData%StC_PrescribedForce) + call RegPackAlloc(RF, InData%StC_CChan) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackParam' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_DOF_MODE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_DOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_PreLd) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M_Z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%M_XY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%K_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%K_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%K_Z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_Z) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%K_S) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_S) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%P_SP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%N_SP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_CMODE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_SA_MODE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_X_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%L_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%B_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_ratio_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%headLossCoeff_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rho_X) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%L_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%B_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%area_ratio_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%headLossCoeff_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%rho_Y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Use_F_TBL) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_TBL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_TBL) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NumMeshPts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StC_PrescribedForce) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StC_CChan(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StC_CChan) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_DOF_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_DOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_PreLd); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%M_XY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_Z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%K_S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_S); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%P_SP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N_SP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Gravity); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_CMODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_SA_MODE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_HIGH); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_LOW); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_X_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Y_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StC_Z_C_BRAKE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_X); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%L_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%B_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%area_ratio_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%headLossCoeff_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%rho_Y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Use_F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_TBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumMeshPts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PrescribedForcesCoordSys); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_PrescribedForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StC_CChan); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -2473,125 +1740,55 @@ subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Mesh)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) LB(1:1) = lbound(InData%Mesh, kind=B8Ki) UB(1:1) = ubound(InData%Mesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%Mesh(i1)) + call MeshPack(RF, InData%Mesh(i1)) end do end if - call RegPack(Buf, allocated(InData%CmdStiff)) - if (allocated(InData%CmdStiff)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdStiff, kind=B8Ki), ubound(InData%CmdStiff, kind=B8Ki)) - call RegPack(Buf, InData%CmdStiff) - end if - call RegPack(Buf, allocated(InData%CmdDamp)) - if (allocated(InData%CmdDamp)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdDamp, kind=B8Ki), ubound(InData%CmdDamp, kind=B8Ki)) - call RegPack(Buf, InData%CmdDamp) - end if - call RegPack(Buf, allocated(InData%CmdBrake)) - if (allocated(InData%CmdBrake)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdBrake, kind=B8Ki), ubound(InData%CmdBrake, kind=B8Ki)) - call RegPack(Buf, InData%CmdBrake) - end if - call RegPack(Buf, allocated(InData%CmdForce)) - if (allocated(InData%CmdForce)) then - call RegPackBounds(Buf, 2, lbound(InData%CmdForce, kind=B8Ki), ubound(InData%CmdForce, kind=B8Ki)) - call RegPack(Buf, InData%CmdForce) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%CmdStiff) + call RegPackAlloc(RF, InData%CmdDamp) + call RegPackAlloc(RF, InData%CmdBrake) + call RegPackAlloc(RF, InData%CmdForce) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh + call MeshUnpack(RF, OutData%Mesh(i1)) ! Mesh end do end if - if (allocated(OutData%CmdStiff)) deallocate(OutData%CmdStiff) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CmdStiff) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CmdDamp)) deallocate(OutData%CmdDamp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CmdDamp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CmdBrake)) deallocate(OutData%CmdBrake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CmdBrake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CmdForce)) deallocate(OutData%CmdForce) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CmdForce) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%CmdStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdBrake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdForce); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2677,87 +1874,51 @@ subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine StC_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(StC_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackOutput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%Mesh)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(Buf, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) LB(1:1) = lbound(InData%Mesh, kind=B8Ki) UB(1:1) = ubound(InData%Mesh, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshPack(Buf, InData%Mesh(i1)) + call MeshPack(RF, InData%Mesh(i1)) end do end if - call RegPack(Buf, allocated(InData%MeasDisp)) - if (allocated(InData%MeasDisp)) then - call RegPackBounds(Buf, 2, lbound(InData%MeasDisp, kind=B8Ki), ubound(InData%MeasDisp, kind=B8Ki)) - call RegPack(Buf, InData%MeasDisp) - end if - call RegPack(Buf, allocated(InData%MeasVel)) - if (allocated(InData%MeasVel)) then - call RegPackBounds(Buf, 2, lbound(InData%MeasVel, kind=B8Ki), ubound(InData%MeasVel, kind=B8Ki)) - call RegPack(Buf, InData%MeasVel) - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackAlloc(RF, InData%MeasDisp) + call RegPackAlloc(RF, InData%MeasVel) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine StC_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine StC_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(StC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackOutput' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh + call MeshUnpack(RF, OutData%Mesh(i1)) ! Mesh end do end if - if (allocated(OutData%MeasDisp)) deallocate(OutData%MeasDisp) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MeasDisp) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MeasVel)) deallocate(OutData%MeasVel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MeasVel) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%MeasDisp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index f8f683f430..9ad5e7668a 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -380,41 +380,24 @@ subroutine SD_DestroyIList(IListData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackIList(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackIList(RF, Indata) + type(RegFile), intent(inout) :: RF type(IList), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackIList' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%List)) - if (allocated(InData%List)) then - call RegPackBounds(Buf, 1, lbound(InData%List, kind=B8Ki), ubound(InData%List, kind=B8Ki)) - call RegPack(Buf, InData%List) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%List) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackIList(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackIList(RF, OutData) + type(RegFile), intent(inout) :: RF type(IList), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackIList' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%List)) deallocate(OutData%List) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%List(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%List) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%List); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg) @@ -546,161 +529,40 @@ subroutine SD_DestroyMeshAuxDataType(MeshAuxDataTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackMeshAuxDataType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackMeshAuxDataType(RF, Indata) + type(RegFile), intent(inout) :: RF type(MeshAuxDataType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackMeshAuxDataType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%MemberID) - call RegPack(Buf, InData%NOutCnt) - call RegPack(Buf, allocated(InData%NodeCnt)) - if (allocated(InData%NodeCnt)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeCnt, kind=B8Ki), ubound(InData%NodeCnt, kind=B8Ki)) - call RegPack(Buf, InData%NodeCnt) - end if - call RegPack(Buf, allocated(InData%NodeIDs)) - if (allocated(InData%NodeIDs)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeIDs, kind=B8Ki), ubound(InData%NodeIDs, kind=B8Ki)) - call RegPack(Buf, InData%NodeIDs) - end if - call RegPack(Buf, allocated(InData%ElmIDs)) - if (allocated(InData%ElmIDs)) then - call RegPackBounds(Buf, 2, lbound(InData%ElmIDs, kind=B8Ki), ubound(InData%ElmIDs, kind=B8Ki)) - call RegPack(Buf, InData%ElmIDs) - end if - call RegPack(Buf, allocated(InData%ElmNds)) - if (allocated(InData%ElmNds)) then - call RegPackBounds(Buf, 2, lbound(InData%ElmNds, kind=B8Ki), ubound(InData%ElmNds, kind=B8Ki)) - call RegPack(Buf, InData%ElmNds) - end if - call RegPack(Buf, allocated(InData%Me)) - if (allocated(InData%Me)) then - call RegPackBounds(Buf, 4, lbound(InData%Me, kind=B8Ki), ubound(InData%Me, kind=B8Ki)) - call RegPack(Buf, InData%Me) - end if - call RegPack(Buf, allocated(InData%Ke)) - if (allocated(InData%Ke)) then - call RegPackBounds(Buf, 4, lbound(InData%Ke, kind=B8Ki), ubound(InData%Ke, kind=B8Ki)) - call RegPack(Buf, InData%Ke) - end if - call RegPack(Buf, allocated(InData%Fg)) - if (allocated(InData%Fg)) then - call RegPackBounds(Buf, 3, lbound(InData%Fg, kind=B8Ki), ubound(InData%Fg, kind=B8Ki)) - call RegPack(Buf, InData%Fg) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%MemberID) + call RegPack(RF, InData%NOutCnt) + call RegPackAlloc(RF, InData%NodeCnt) + call RegPackAlloc(RF, InData%NodeIDs) + call RegPackAlloc(RF, InData%ElmIDs) + call RegPackAlloc(RF, InData%ElmNds) + call RegPackAlloc(RF, InData%Me) + call RegPackAlloc(RF, InData%Ke) + call RegPackAlloc(RF, InData%Fg) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackMeshAuxDataType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackMeshAuxDataType(RF, OutData) + type(RegFile), intent(inout) :: RF type(MeshAuxDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' integer(B8Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NOutCnt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%NodeCnt)) deallocate(OutData%NodeCnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodeCnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodeCnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NodeIDs)) deallocate(OutData%NodeIDs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodeIDs(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodeIDs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ElmIDs)) deallocate(OutData%ElmIDs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElmIDs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElmIDs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ElmNds)) deallocate(OutData%ElmNds) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElmNds(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElmNds) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Me)) deallocate(OutData%Me) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Me) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Ke)) deallocate(OutData%Ke) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 4, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ke) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fg)) deallocate(OutData%Fg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fg) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%MemberID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NOutCnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeCnt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeIDs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElmIDs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElmNds); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Me); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ke); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fg); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg) @@ -815,136 +677,34 @@ subroutine SD_DestroyCB_MatArrays(CB_MatArraysData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackCB_MatArrays(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackCB_MatArrays(RF, Indata) + type(RegFile), intent(inout) :: RF type(CB_MatArrays), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackCB_MatArrays' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%MBB)) - if (allocated(InData%MBB)) then - call RegPackBounds(Buf, 2, lbound(InData%MBB, kind=B8Ki), ubound(InData%MBB, kind=B8Ki)) - call RegPack(Buf, InData%MBB) - end if - call RegPack(Buf, allocated(InData%MBM)) - if (allocated(InData%MBM)) then - call RegPackBounds(Buf, 2, lbound(InData%MBM, kind=B8Ki), ubound(InData%MBM, kind=B8Ki)) - call RegPack(Buf, InData%MBM) - end if - call RegPack(Buf, allocated(InData%KBB)) - if (allocated(InData%KBB)) then - call RegPackBounds(Buf, 2, lbound(InData%KBB, kind=B8Ki), ubound(InData%KBB, kind=B8Ki)) - call RegPack(Buf, InData%KBB) - end if - call RegPack(Buf, allocated(InData%PhiL)) - if (allocated(InData%PhiL)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiL, kind=B8Ki), ubound(InData%PhiL, kind=B8Ki)) - call RegPack(Buf, InData%PhiL) - end if - call RegPack(Buf, allocated(InData%PhiR)) - if (allocated(InData%PhiR)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiR, kind=B8Ki), ubound(InData%PhiR, kind=B8Ki)) - call RegPack(Buf, InData%PhiR) - end if - call RegPack(Buf, allocated(InData%OmegaL)) - if (allocated(InData%OmegaL)) then - call RegPackBounds(Buf, 1, lbound(InData%OmegaL, kind=B8Ki), ubound(InData%OmegaL, kind=B8Ki)) - call RegPack(Buf, InData%OmegaL) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%MBB) + call RegPackAlloc(RF, InData%MBM) + call RegPackAlloc(RF, InData%KBB) + call RegPackAlloc(RF, InData%PhiL) + call RegPackAlloc(RF, InData%PhiR) + call RegPackAlloc(RF, InData%OmegaL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackCB_MatArrays(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackCB_MatArrays(RF, OutData) + type(RegFile), intent(inout) :: RF type(CB_MatArrays), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%MBB)) deallocate(OutData%MBB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MBB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MBM)) deallocate(OutData%MBM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MBM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MBM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%KBB)) deallocate(OutData%KBB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%KBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%KBB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PhiL)) deallocate(OutData%PhiL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PhiL(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PhiL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PhiR)) deallocate(OutData%PhiR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PhiR(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PhiR) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%OmegaL)) deallocate(OutData%OmegaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OmegaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%OmegaL) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%MBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OmegaL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyElemPropType(SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg) @@ -982,64 +742,49 @@ subroutine SD_DestroyElemPropType(ElemPropTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SD_PackElemPropType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackElemPropType(RF, Indata) + type(RegFile), intent(inout) :: RF type(ElemPropType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackElemPropType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%eType) - call RegPack(Buf, InData%Length) - call RegPack(Buf, InData%Ixx) - call RegPack(Buf, InData%Iyy) - call RegPack(Buf, InData%Jzz) - call RegPack(Buf, InData%Shear) - call RegPack(Buf, InData%Kappa_x) - call RegPack(Buf, InData%Kappa_y) - call RegPack(Buf, InData%YoungE) - call RegPack(Buf, InData%ShearG) - call RegPack(Buf, InData%D) - call RegPack(Buf, InData%Area) - call RegPack(Buf, InData%Rho) - call RegPack(Buf, InData%T0) - call RegPack(Buf, InData%DirCos) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%eType) + call RegPack(RF, InData%Length) + call RegPack(RF, InData%Ixx) + call RegPack(RF, InData%Iyy) + call RegPack(RF, InData%Jzz) + call RegPack(RF, InData%Shear) + call RegPack(RF, InData%Kappa_x) + call RegPack(RF, InData%Kappa_y) + call RegPack(RF, InData%YoungE) + call RegPack(RF, InData%ShearG) + call RegPack(RF, InData%D) + call RegPack(RF, InData%Area) + call RegPack(RF, InData%Rho) + call RegPack(RF, InData%T0) + call RegPack(RF, InData%DirCos) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackElemPropType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackElemPropType(RF, OutData) + type(RegFile), intent(inout) :: RF type(ElemPropType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackElemPropType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%eType) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Length) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ixx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Iyy) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jzz) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Shear) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kappa_x) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Kappa_y) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YoungE) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%ShearG) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Area) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Rho) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%T0) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DirCos) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%eType); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Length); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ixx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Iyy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jzz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Shear); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kappa_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Kappa_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YoungE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ShearG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Area); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Rho); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%T0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DirCos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -1094,64 +839,40 @@ subroutine SD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%SDInputFile) - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%g) - call RegPack(Buf, InData%WtrDpth) - call RegPack(Buf, InData%TP_RefPoint) - call RegPack(Buf, InData%SubRotateZ) - call RegPack(Buf, allocated(InData%SoilStiffness)) - if (allocated(InData%SoilStiffness)) then - call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness, kind=B8Ki), ubound(InData%SoilStiffness, kind=B8Ki)) - call RegPack(Buf, InData%SoilStiffness) - end if - call MeshPack(Buf, InData%SoilMesh) - call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SDInputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%g) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%TP_RefPoint) + call RegPack(RF, InData%SubRotateZ) + call RegPackAlloc(RF, InData%SoilStiffness) + call MeshPack(RF, InData%SoilMesh) + call RegPack(RF, InData%Linearize) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitInput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%SDInputFile) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%g) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TP_RefPoint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SubRotateZ) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%SoilStiffness)) deallocate(OutData%SoilStiffness) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SoilStiffness) - if (RegCheckErr(Buf, RoutineName)) return - end if - call MeshUnpack(Buf, OutData%SoilMesh) ! SoilMesh - call RegUnpack(Buf, OutData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SDInputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TP_RefPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubRotateZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SoilStiffness); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%SoilMesh) ! SoilMesh + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1349,233 +1070,46 @@ subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, allocated(InData%LinNames_y)) - if (allocated(InData%LinNames_y)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_y, kind=B8Ki), ubound(InData%LinNames_y, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_y) - end if - call RegPack(Buf, allocated(InData%LinNames_x)) - if (allocated(InData%LinNames_x)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_x, kind=B8Ki), ubound(InData%LinNames_x, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_x) - end if - call RegPack(Buf, allocated(InData%LinNames_u)) - if (allocated(InData%LinNames_u)) then - call RegPackBounds(Buf, 1, lbound(InData%LinNames_u, kind=B8Ki), ubound(InData%LinNames_u, kind=B8Ki)) - call RegPack(Buf, InData%LinNames_u) - end if - call RegPack(Buf, allocated(InData%RotFrame_y)) - if (allocated(InData%RotFrame_y)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y, kind=B8Ki), ubound(InData%RotFrame_y, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_y) - end if - call RegPack(Buf, allocated(InData%RotFrame_x)) - if (allocated(InData%RotFrame_x)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x, kind=B8Ki), ubound(InData%RotFrame_x, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_x) - end if - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u, kind=B8Ki), ubound(InData%RotFrame_u, kind=B8Ki)) - call RegPack(Buf, InData%RotFrame_u) - end if - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u, kind=B8Ki), ubound(InData%IsLoad_u, kind=B8Ki)) - call RegPack(Buf, InData%IsLoad_u) - end if - call RegPack(Buf, allocated(InData%DerivOrder_x)) - if (allocated(InData%DerivOrder_x)) then - call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x, kind=B8Ki), ubound(InData%DerivOrder_x, kind=B8Ki)) - call RegPack(Buf, InData%DerivOrder_x) - end if - call RegPack(Buf, allocated(InData%CableCChanRqst)) - if (allocated(InData%CableCChanRqst)) then - call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst, kind=B8Ki), ubound(InData%CableCChanRqst, kind=B8Ki)) - call RegPack(Buf, InData%CableCChanRqst) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_x) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%RotFrame_x) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%IsLoad_u) + call RegPackAlloc(RF, InData%DerivOrder_x) + call RegPackAlloc(RF, InData%CableCChanRqst) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinNames_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DerivOrder_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableCChanRqst(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableCChanRqst) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DerivOrder_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CableCChanRqst); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg) @@ -2015,699 +1549,198 @@ subroutine SD_DestroyInitType(InitTypeData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackInitType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackInitType(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_InitType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%RootName) - call RegPack(Buf, InData%TP_RefPoint) - call RegPack(Buf, InData%SubRotateZ) - call RegPack(Buf, InData%g) - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%NJoints) - call RegPack(Buf, InData%NPropSetsX) - call RegPack(Buf, InData%NPropSetsB) - call RegPack(Buf, InData%NPropSetsC) - call RegPack(Buf, InData%NPropSetsR) - call RegPack(Buf, InData%NCMass) - call RegPack(Buf, InData%NCOSMs) - call RegPack(Buf, InData%FEMMod) - call RegPack(Buf, InData%NDiv) - call RegPack(Buf, InData%CBMod) - call RegPack(Buf, allocated(InData%Joints)) - if (allocated(InData%Joints)) then - call RegPackBounds(Buf, 2, lbound(InData%Joints, kind=B8Ki), ubound(InData%Joints, kind=B8Ki)) - call RegPack(Buf, InData%Joints) - end if - call RegPack(Buf, allocated(InData%PropSetsB)) - if (allocated(InData%PropSetsB)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsB, kind=B8Ki), ubound(InData%PropSetsB, kind=B8Ki)) - call RegPack(Buf, InData%PropSetsB) - end if - call RegPack(Buf, allocated(InData%PropSetsC)) - if (allocated(InData%PropSetsC)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsC, kind=B8Ki), ubound(InData%PropSetsC, kind=B8Ki)) - call RegPack(Buf, InData%PropSetsC) - end if - call RegPack(Buf, allocated(InData%PropSetsR)) - if (allocated(InData%PropSetsR)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsR, kind=B8Ki), ubound(InData%PropSetsR, kind=B8Ki)) - call RegPack(Buf, InData%PropSetsR) - end if - call RegPack(Buf, allocated(InData%PropSetsX)) - if (allocated(InData%PropSetsX)) then - call RegPackBounds(Buf, 2, lbound(InData%PropSetsX, kind=B8Ki), ubound(InData%PropSetsX, kind=B8Ki)) - call RegPack(Buf, InData%PropSetsX) - end if - call RegPack(Buf, allocated(InData%COSMs)) - if (allocated(InData%COSMs)) then - call RegPackBounds(Buf, 2, lbound(InData%COSMs, kind=B8Ki), ubound(InData%COSMs, kind=B8Ki)) - call RegPack(Buf, InData%COSMs) - end if - call RegPack(Buf, allocated(InData%CMass)) - if (allocated(InData%CMass)) then - call RegPackBounds(Buf, 2, lbound(InData%CMass, kind=B8Ki), ubound(InData%CMass, kind=B8Ki)) - call RegPack(Buf, InData%CMass) - end if - call RegPack(Buf, allocated(InData%JDampings)) - if (allocated(InData%JDampings)) then - call RegPackBounds(Buf, 1, lbound(InData%JDampings, kind=B8Ki), ubound(InData%JDampings, kind=B8Ki)) - call RegPack(Buf, InData%JDampings) - end if - call RegPack(Buf, InData%GuyanDampMod) - call RegPack(Buf, InData%RayleighDamp) - call RegPack(Buf, InData%GuyanDampMat) - call RegPack(Buf, allocated(InData%Members)) - if (allocated(InData%Members)) then - call RegPackBounds(Buf, 2, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) - call RegPack(Buf, InData%Members) - end if - call RegPack(Buf, allocated(InData%SSOutList)) - if (allocated(InData%SSOutList)) then - call RegPackBounds(Buf, 1, lbound(InData%SSOutList, kind=B8Ki), ubound(InData%SSOutList, kind=B8Ki)) - call RegPack(Buf, InData%SSOutList) - end if - call RegPack(Buf, InData%OutCOSM) - call RegPack(Buf, InData%TabDelim) - call RegPack(Buf, allocated(InData%SSIK)) - if (allocated(InData%SSIK)) then - call RegPackBounds(Buf, 2, lbound(InData%SSIK, kind=B8Ki), ubound(InData%SSIK, kind=B8Ki)) - call RegPack(Buf, InData%SSIK) - end if - call RegPack(Buf, allocated(InData%SSIM)) - if (allocated(InData%SSIM)) then - call RegPackBounds(Buf, 2, lbound(InData%SSIM, kind=B8Ki), ubound(InData%SSIM, kind=B8Ki)) - call RegPack(Buf, InData%SSIM) - end if - call RegPack(Buf, allocated(InData%SSIfile)) - if (allocated(InData%SSIfile)) then - call RegPackBounds(Buf, 1, lbound(InData%SSIfile, kind=B8Ki), ubound(InData%SSIfile, kind=B8Ki)) - call RegPack(Buf, InData%SSIfile) - end if - call RegPack(Buf, allocated(InData%Soil_K)) - if (allocated(InData%Soil_K)) then - call RegPackBounds(Buf, 3, lbound(InData%Soil_K, kind=B8Ki), ubound(InData%Soil_K, kind=B8Ki)) - call RegPack(Buf, InData%Soil_K) - end if - call RegPack(Buf, allocated(InData%Soil_Points)) - if (allocated(InData%Soil_Points)) then - call RegPackBounds(Buf, 2, lbound(InData%Soil_Points, kind=B8Ki), ubound(InData%Soil_Points, kind=B8Ki)) - call RegPack(Buf, InData%Soil_Points) - end if - call RegPack(Buf, allocated(InData%Soil_Nodes)) - if (allocated(InData%Soil_Nodes)) then - call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes, kind=B8Ki), ubound(InData%Soil_Nodes, kind=B8Ki)) - call RegPack(Buf, InData%Soil_Nodes) - end if - call RegPack(Buf, InData%NElem) - call RegPack(Buf, InData%NPropB) - call RegPack(Buf, InData%NPropC) - call RegPack(Buf, InData%NPropR) - call RegPack(Buf, allocated(InData%Nodes)) - if (allocated(InData%Nodes)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) - call RegPack(Buf, InData%Nodes) - end if - call RegPack(Buf, allocated(InData%PropsB)) - if (allocated(InData%PropsB)) then - call RegPackBounds(Buf, 2, lbound(InData%PropsB, kind=B8Ki), ubound(InData%PropsB, kind=B8Ki)) - call RegPack(Buf, InData%PropsB) - end if - call RegPack(Buf, allocated(InData%PropsC)) - if (allocated(InData%PropsC)) then - call RegPackBounds(Buf, 2, lbound(InData%PropsC, kind=B8Ki), ubound(InData%PropsC, kind=B8Ki)) - call RegPack(Buf, InData%PropsC) - end if - call RegPack(Buf, allocated(InData%PropsR)) - if (allocated(InData%PropsR)) then - call RegPackBounds(Buf, 2, lbound(InData%PropsR, kind=B8Ki), ubound(InData%PropsR, kind=B8Ki)) - call RegPack(Buf, InData%PropsR) - end if - call RegPack(Buf, allocated(InData%K)) - if (allocated(InData%K)) then - call RegPackBounds(Buf, 2, lbound(InData%K, kind=B8Ki), ubound(InData%K, kind=B8Ki)) - call RegPack(Buf, InData%K) - end if - call RegPack(Buf, allocated(InData%M)) - if (allocated(InData%M)) then - call RegPackBounds(Buf, 2, lbound(InData%M, kind=B8Ki), ubound(InData%M, kind=B8Ki)) - call RegPack(Buf, InData%M) - end if - call RegPack(Buf, allocated(InData%ElemProps)) - if (allocated(InData%ElemProps)) then - call RegPackBounds(Buf, 2, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) - call RegPack(Buf, InData%ElemProps) - end if - call RegPack(Buf, allocated(InData%MemberNodes)) - if (allocated(InData%MemberNodes)) then - call RegPackBounds(Buf, 2, lbound(InData%MemberNodes, kind=B8Ki), ubound(InData%MemberNodes, kind=B8Ki)) - call RegPack(Buf, InData%MemberNodes) - end if - call RegPack(Buf, allocated(InData%NodesConnN)) - if (allocated(InData%NodesConnN)) then - call RegPackBounds(Buf, 2, lbound(InData%NodesConnN, kind=B8Ki), ubound(InData%NodesConnN, kind=B8Ki)) - call RegPack(Buf, InData%NodesConnN) - end if - call RegPack(Buf, allocated(InData%NodesConnE)) - if (allocated(InData%NodesConnE)) then - call RegPackBounds(Buf, 2, lbound(InData%NodesConnE, kind=B8Ki), ubound(InData%NodesConnE, kind=B8Ki)) - call RegPack(Buf, InData%NodesConnE) - end if - call RegPack(Buf, InData%SSSum) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%TP_RefPoint) + call RegPack(RF, InData%SubRotateZ) + call RegPack(RF, InData%g) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%NJoints) + call RegPack(RF, InData%NPropSetsX) + call RegPack(RF, InData%NPropSetsB) + call RegPack(RF, InData%NPropSetsC) + call RegPack(RF, InData%NPropSetsR) + call RegPack(RF, InData%NCMass) + call RegPack(RF, InData%NCOSMs) + call RegPack(RF, InData%FEMMod) + call RegPack(RF, InData%NDiv) + call RegPack(RF, InData%CBMod) + call RegPackAlloc(RF, InData%Joints) + call RegPackAlloc(RF, InData%PropSetsB) + call RegPackAlloc(RF, InData%PropSetsC) + call RegPackAlloc(RF, InData%PropSetsR) + call RegPackAlloc(RF, InData%PropSetsX) + call RegPackAlloc(RF, InData%COSMs) + call RegPackAlloc(RF, InData%CMass) + call RegPackAlloc(RF, InData%JDampings) + call RegPack(RF, InData%GuyanDampMod) + call RegPack(RF, InData%RayleighDamp) + call RegPack(RF, InData%GuyanDampMat) + call RegPackAlloc(RF, InData%Members) + call RegPackAlloc(RF, InData%SSOutList) + call RegPack(RF, InData%OutCOSM) + call RegPack(RF, InData%TabDelim) + call RegPackAlloc(RF, InData%SSIK) + call RegPackAlloc(RF, InData%SSIM) + call RegPackAlloc(RF, InData%SSIfile) + call RegPackAlloc(RF, InData%Soil_K) + call RegPackAlloc(RF, InData%Soil_Points) + call RegPackAlloc(RF, InData%Soil_Nodes) + call RegPack(RF, InData%NElem) + call RegPack(RF, InData%NPropB) + call RegPack(RF, InData%NPropC) + call RegPack(RF, InData%NPropR) + call RegPackAlloc(RF, InData%Nodes) + call RegPackAlloc(RF, InData%PropsB) + call RegPackAlloc(RF, InData%PropsC) + call RegPackAlloc(RF, InData%PropsR) + call RegPackAlloc(RF, InData%K) + call RegPackAlloc(RF, InData%M) + call RegPackAlloc(RF, InData%ElemProps) + call RegPackAlloc(RF, InData%MemberNodes) + call RegPackAlloc(RF, InData%NodesConnN) + call RegPackAlloc(RF, InData%NodesConnE) + call RegPack(RF, InData%SSSum) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackInitType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackInitType(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_InitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitType' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%RootName) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TP_RefPoint) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SubRotateZ) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%g) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NJoints) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropSetsX) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropSetsB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropSetsC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropSetsR) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NCMass) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NCOSMs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FEMMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NDiv) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%CBMod) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Joints)) deallocate(OutData%Joints) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Joints(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Joints) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PropSetsB)) deallocate(OutData%PropSetsB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropSetsB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropSetsB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PropSetsC)) deallocate(OutData%PropSetsC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropSetsC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropSetsC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PropSetsR)) deallocate(OutData%PropSetsR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropSetsR(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropSetsR) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PropSetsX)) deallocate(OutData%PropSetsX) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropSetsX(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropSetsX) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%COSMs)) deallocate(OutData%COSMs) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%COSMs(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%COSMs) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CMass)) deallocate(OutData%CMass) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CMass(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CMass) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%JDampings)) deallocate(OutData%JDampings) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%JDampings(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%JDampings) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%GuyanDampMod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RayleighDamp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GuyanDampMat) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Members)) deallocate(OutData%Members) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Members(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Members) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SSOutList)) deallocate(OutData%SSOutList) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SSOutList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SSOutList) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%OutCOSM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%SSIK)) deallocate(OutData%SSIK) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SSIK(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SSIK) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SSIM)) deallocate(OutData%SSIM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SSIM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SSIM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SSIfile)) deallocate(OutData%SSIfile) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SSIfile(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TP_RefPoint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SubRotateZ); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%g); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NJoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropSetsR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NCMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NCOSMs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FEMMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NDiv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CBMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Joints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropSetsX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%COSMs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMass); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%JDampings); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GuyanDampMod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RayleighDamp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GuyanDampMat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Members); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSOutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutCOSM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TabDelim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSIK); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SSIfile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Soil_K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Soil_Points); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Soil_Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NElem); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NPropR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PropsR); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%K); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElemProps); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MemberNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodesConnN); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodesConnE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SSSum); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_ContinuousStateType), intent(in) :: SrcContStateData + type(SD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%SSIfile) - if (RegCheckErr(Buf, RoutineName)) return + DstContStateData%qm = SrcContStateData%qm end if - if (allocated(OutData%Soil_K)) deallocate(OutData%Soil_K) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) + UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%Soil_K) - if (RegCheckErr(Buf, RoutineName)) return + DstContStateData%qmdot = SrcContStateData%qmdot end if - if (allocated(OutData%Soil_Points)) deallocate(OutData%Soil_Points) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Soil_Points(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Soil_Points) - if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) end if - if (allocated(OutData%Soil_Nodes)) deallocate(OutData%Soil_Nodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Soil_Nodes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Soil_Nodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NElem) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropC) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NPropR) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nodes) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) end if - if (allocated(OutData%PropsB)) deallocate(OutData%PropsB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropsB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropsB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PropsC)) deallocate(OutData%PropsC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropsC(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropsC) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PropsR)) deallocate(OutData%PropsR) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PropsR(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PropsR) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%K)) deallocate(OutData%K) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%K(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%K) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%M)) deallocate(OutData%M) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%M(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%M) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElemProps(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElemProps) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MemberNodes)) deallocate(OutData%MemberNodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MemberNodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MemberNodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NodesConnN)) deallocate(OutData%NodesConnN) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodesConnN(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodesConnN) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NodesConnE)) deallocate(OutData%NodesConnE) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodesConnE(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodesConnE) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%SSSum) - if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) - type(SD_ContinuousStateType), intent(in) :: SrcContStateData - type(SD_ContinuousStateType), intent(inout) :: DstContStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'SD_CopyContState' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) - if (.not. allocated(DstContStateData%qm)) then - allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstContStateData%qm = SrcContStateData%qm - end if - if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) - if (.not. allocated(DstContStateData%qmdot)) then - allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstContStateData%qmdot = SrcContStateData%qmdot - end if -end subroutine - -subroutine SD_DestroyContState(ContStateData, ErrStat, ErrMsg) - type(SD_ContinuousStateType), intent(inout) :: ContStateData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SD_DestroyContState' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(ContStateData%qm)) then - deallocate(ContStateData%qm) - end if - if (allocated(ContStateData%qmdot)) then - deallocate(ContStateData%qmdot) - end if -end subroutine - -subroutine SD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%qm)) - if (allocated(InData%qm)) then - call RegPackBounds(Buf, 1, lbound(InData%qm, kind=B8Ki), ubound(InData%qm, kind=B8Ki)) - call RegPack(Buf, InData%qm) - end if - call RegPack(Buf, allocated(InData%qmdot)) - if (allocated(InData%qmdot)) then - call RegPackBounds(Buf, 1, lbound(InData%qmdot, kind=B8Ki), ubound(InData%qmdot, kind=B8Ki)) - call RegPack(Buf, InData%qmdot) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%qm) + call RegPackAlloc(RF, InData%qmdot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackContState' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%qm)) deallocate(OutData%qm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%qm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%qm) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%qmdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%qmdot) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%qm); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%qmdot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -2731,22 +1764,21 @@ subroutine SD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyDiscState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackDiscState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyDiscState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyDiscState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -2770,22 +1802,21 @@ subroutine SD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -2842,52 +1873,49 @@ subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%xdot)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(Buf, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) LB(1:1) = lbound(InData%xdot, kind=B8Ki) UB(1:1) = ubound(InData%xdot, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackContState(Buf, InData%xdot(i1)) + call SD_PackContState(RF, InData%xdot(i1)) end do end if - call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%n) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOtherState' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return + if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%xdot)) deallocate(OutData%xdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%xdot(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + call SD_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do end if - call RegUnpack(Buf, OutData%n) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -3277,493 +2305,80 @@ subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%qmdotdot)) - if (allocated(InData%qmdotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%qmdotdot, kind=B8Ki), ubound(InData%qmdotdot, kind=B8Ki)) - call RegPack(Buf, InData%qmdotdot) - end if - call RegPack(Buf, InData%u_TP) - call RegPack(Buf, InData%udot_TP) - call RegPack(Buf, InData%udotdot_TP) - call RegPack(Buf, allocated(InData%F_L)) - if (allocated(InData%F_L)) then - call RegPackBounds(Buf, 1, lbound(InData%F_L, kind=B8Ki), ubound(InData%F_L, kind=B8Ki)) - call RegPack(Buf, InData%F_L) - end if - call RegPack(Buf, allocated(InData%F_L2)) - if (allocated(InData%F_L2)) then - call RegPackBounds(Buf, 1, lbound(InData%F_L2, kind=B8Ki), ubound(InData%F_L2, kind=B8Ki)) - call RegPack(Buf, InData%F_L2) - end if - call RegPack(Buf, allocated(InData%UR_bar)) - if (allocated(InData%UR_bar)) then - call RegPackBounds(Buf, 1, lbound(InData%UR_bar, kind=B8Ki), ubound(InData%UR_bar, kind=B8Ki)) - call RegPack(Buf, InData%UR_bar) - end if - call RegPack(Buf, allocated(InData%UR_bar_dot)) - if (allocated(InData%UR_bar_dot)) then - call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot, kind=B8Ki), ubound(InData%UR_bar_dot, kind=B8Ki)) - call RegPack(Buf, InData%UR_bar_dot) - end if - call RegPack(Buf, allocated(InData%UR_bar_dotdot)) - if (allocated(InData%UR_bar_dotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot, kind=B8Ki), ubound(InData%UR_bar_dotdot, kind=B8Ki)) - call RegPack(Buf, InData%UR_bar_dotdot) - end if - call RegPack(Buf, allocated(InData%UL)) - if (allocated(InData%UL)) then - call RegPackBounds(Buf, 1, lbound(InData%UL, kind=B8Ki), ubound(InData%UL, kind=B8Ki)) - call RegPack(Buf, InData%UL) - end if - call RegPack(Buf, allocated(InData%UL_NS)) - if (allocated(InData%UL_NS)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_NS, kind=B8Ki), ubound(InData%UL_NS, kind=B8Ki)) - call RegPack(Buf, InData%UL_NS) - end if - call RegPack(Buf, allocated(InData%UL_dot)) - if (allocated(InData%UL_dot)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_dot, kind=B8Ki), ubound(InData%UL_dot, kind=B8Ki)) - call RegPack(Buf, InData%UL_dot) - end if - call RegPack(Buf, allocated(InData%UL_dotdot)) - if (allocated(InData%UL_dotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot, kind=B8Ki), ubound(InData%UL_dotdot, kind=B8Ki)) - call RegPack(Buf, InData%UL_dotdot) - end if - call RegPack(Buf, allocated(InData%DU_full)) - if (allocated(InData%DU_full)) then - call RegPackBounds(Buf, 1, lbound(InData%DU_full, kind=B8Ki), ubound(InData%DU_full, kind=B8Ki)) - call RegPack(Buf, InData%DU_full) - end if - call RegPack(Buf, allocated(InData%U_full)) - if (allocated(InData%U_full)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full, kind=B8Ki), ubound(InData%U_full, kind=B8Ki)) - call RegPack(Buf, InData%U_full) - end if - call RegPack(Buf, allocated(InData%U_full_NS)) - if (allocated(InData%U_full_NS)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_NS, kind=B8Ki), ubound(InData%U_full_NS, kind=B8Ki)) - call RegPack(Buf, InData%U_full_NS) - end if - call RegPack(Buf, allocated(InData%U_full_dot)) - if (allocated(InData%U_full_dot)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_dot, kind=B8Ki), ubound(InData%U_full_dot, kind=B8Ki)) - call RegPack(Buf, InData%U_full_dot) - end if - call RegPack(Buf, allocated(InData%U_full_dotdot)) - if (allocated(InData%U_full_dotdot)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot, kind=B8Ki), ubound(InData%U_full_dotdot, kind=B8Ki)) - call RegPack(Buf, InData%U_full_dotdot) - end if - call RegPack(Buf, allocated(InData%U_full_elast)) - if (allocated(InData%U_full_elast)) then - call RegPackBounds(Buf, 1, lbound(InData%U_full_elast, kind=B8Ki), ubound(InData%U_full_elast, kind=B8Ki)) - call RegPack(Buf, InData%U_full_elast) - end if - call RegPack(Buf, allocated(InData%U_red)) - if (allocated(InData%U_red)) then - call RegPackBounds(Buf, 1, lbound(InData%U_red, kind=B8Ki), ubound(InData%U_red, kind=B8Ki)) - call RegPack(Buf, InData%U_red) - end if - call RegPack(Buf, allocated(InData%FC_unit)) - if (allocated(InData%FC_unit)) then - call RegPackBounds(Buf, 1, lbound(InData%FC_unit, kind=B8Ki), ubound(InData%FC_unit, kind=B8Ki)) - call RegPack(Buf, InData%FC_unit) - end if - call RegPack(Buf, allocated(InData%SDWrOutput)) - if (allocated(InData%SDWrOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput, kind=B8Ki), ubound(InData%SDWrOutput, kind=B8Ki)) - call RegPack(Buf, InData%SDWrOutput) - end if - call RegPack(Buf, allocated(InData%AllOuts)) - if (allocated(InData%AllOuts)) then - call RegPackBounds(Buf, 1, lbound(InData%AllOuts, kind=B8Ki), ubound(InData%AllOuts, kind=B8Ki)) - call RegPack(Buf, InData%AllOuts) - end if - call RegPack(Buf, InData%LastOutTime) - call RegPack(Buf, InData%Decimat) - call RegPack(Buf, allocated(InData%Fext)) - if (allocated(InData%Fext)) then - call RegPackBounds(Buf, 1, lbound(InData%Fext, kind=B8Ki), ubound(InData%Fext, kind=B8Ki)) - call RegPack(Buf, InData%Fext) - end if - call RegPack(Buf, allocated(InData%Fext_red)) - if (allocated(InData%Fext_red)) then - call RegPackBounds(Buf, 1, lbound(InData%Fext_red, kind=B8Ki), ubound(InData%Fext_red, kind=B8Ki)) - call RegPack(Buf, InData%Fext_red) - end if - call RegPack(Buf, allocated(InData%UL_SIM)) - if (allocated(InData%UL_SIM)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_SIM, kind=B8Ki), ubound(InData%UL_SIM, kind=B8Ki)) - call RegPack(Buf, InData%UL_SIM) - end if - call RegPack(Buf, allocated(InData%UL_0m)) - if (allocated(InData%UL_0m)) then - call RegPackBounds(Buf, 1, lbound(InData%UL_0m, kind=B8Ki), ubound(InData%UL_0m, kind=B8Ki)) - call RegPack(Buf, InData%UL_0m) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%qmdotdot) + call RegPack(RF, InData%u_TP) + call RegPack(RF, InData%udot_TP) + call RegPack(RF, InData%udotdot_TP) + call RegPackAlloc(RF, InData%F_L) + call RegPackAlloc(RF, InData%F_L2) + call RegPackAlloc(RF, InData%UR_bar) + call RegPackAlloc(RF, InData%UR_bar_dot) + call RegPackAlloc(RF, InData%UR_bar_dotdot) + call RegPackAlloc(RF, InData%UL) + call RegPackAlloc(RF, InData%UL_NS) + call RegPackAlloc(RF, InData%UL_dot) + call RegPackAlloc(RF, InData%UL_dotdot) + call RegPackAlloc(RF, InData%DU_full) + call RegPackAlloc(RF, InData%U_full) + call RegPackAlloc(RF, InData%U_full_NS) + call RegPackAlloc(RF, InData%U_full_dot) + call RegPackAlloc(RF, InData%U_full_dotdot) + call RegPackAlloc(RF, InData%U_full_elast) + call RegPackAlloc(RF, InData%U_red) + call RegPackAlloc(RF, InData%FC_unit) + call RegPackAlloc(RF, InData%SDWrOutput) + call RegPackAlloc(RF, InData%AllOuts) + call RegPack(RF, InData%LastOutTime) + call RegPack(RF, InData%Decimat) + call RegPackAlloc(RF, InData%Fext) + call RegPackAlloc(RF, InData%Fext_red) + call RegPackAlloc(RF, InData%UL_SIM) + call RegPackAlloc(RF, InData%UL_0m) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMisc' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%qmdotdot)) deallocate(OutData%qmdotdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%qmdotdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%qmdotdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%u_TP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%udot_TP) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%udotdot_TP) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%F_L)) deallocate(OutData%F_L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_L(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_L) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%F_L2)) deallocate(OutData%F_L2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%F_L2(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%F_L2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UR_bar)) deallocate(OutData%UR_bar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UR_bar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UR_bar) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UR_bar_dot)) deallocate(OutData%UR_bar_dot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UR_bar_dot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UR_bar_dot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UR_bar_dotdot)) deallocate(OutData%UR_bar_dotdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UR_bar_dotdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UR_bar_dotdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UL)) deallocate(OutData%UL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UL) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UL_NS)) deallocate(OutData%UL_NS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UL_NS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UL_NS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UL_dot)) deallocate(OutData%UL_dot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UL_dot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UL_dot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UL_dotdot)) deallocate(OutData%UL_dotdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UL_dotdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UL_dotdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DU_full)) deallocate(OutData%DU_full) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DU_full(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DU_full) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_full)) deallocate(OutData%U_full) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_full(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_full) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_full_NS)) deallocate(OutData%U_full_NS) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_full_NS(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_full_NS) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_full_dot)) deallocate(OutData%U_full_dot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_full_dot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_full_dot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_full_dotdot)) deallocate(OutData%U_full_dotdot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_full_dotdot(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_full_dotdot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_full_elast)) deallocate(OutData%U_full_elast) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_full_elast(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_full_elast) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%U_red)) deallocate(OutData%U_red) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%U_red(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%U_red) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%FC_unit)) deallocate(OutData%FC_unit) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FC_unit(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FC_unit) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%SDWrOutput)) deallocate(OutData%SDWrOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%SDWrOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%SDWrOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AllOuts) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Decimat) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Fext)) deallocate(OutData%Fext) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fext(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fext) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Fext_red)) deallocate(OutData%Fext_red) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Fext_red(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Fext_red) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UL_SIM)) deallocate(OutData%UL_SIM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UL_SIM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UL_SIM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%UL_0m)) deallocate(OutData%UL_0m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%UL_0m(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%UL_0m) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%qmdotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%u_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%udotdot_TP); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%F_L2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UR_bar_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DU_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_NS); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_dotdot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_full_elast); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%U_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%FC_unit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SDWrOutput); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AllOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Decimat); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Fext_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_SIM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%UL_0m); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -4793,1313 +3408,371 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%SDDeltaT) - call RegPack(Buf, InData%IntMethod) - call RegPack(Buf, InData%nDOF) - call RegPack(Buf, InData%nDOF_red) - call RegPack(Buf, InData%Nmembers) - call RegPack(Buf, allocated(InData%Elems)) - if (allocated(InData%Elems)) then - call RegPackBounds(Buf, 2, lbound(InData%Elems, kind=B8Ki), ubound(InData%Elems, kind=B8Ki)) - call RegPack(Buf, InData%Elems) - end if - call RegPack(Buf, allocated(InData%ElemProps)) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%SDDeltaT) + call RegPack(RF, InData%IntMethod) + call RegPack(RF, InData%nDOF) + call RegPack(RF, InData%nDOF_red) + call RegPack(RF, InData%Nmembers) + call RegPackAlloc(RF, InData%Elems) + call RegPack(RF, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then - call RegPackBounds(Buf, 1, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) LB(1:1) = lbound(InData%ElemProps, kind=B8Ki) UB(1:1) = ubound(InData%ElemProps, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackElemPropType(Buf, InData%ElemProps(i1)) + call SD_PackElemPropType(RF, InData%ElemProps(i1)) end do end if - call RegPack(Buf, allocated(InData%FG)) - if (allocated(InData%FG)) then - call RegPackBounds(Buf, 1, lbound(InData%FG, kind=B8Ki), ubound(InData%FG, kind=B8Ki)) - call RegPack(Buf, InData%FG) - end if - call RegPack(Buf, allocated(InData%DP0)) - if (allocated(InData%DP0)) then - call RegPackBounds(Buf, 2, lbound(InData%DP0, kind=B8Ki), ubound(InData%DP0, kind=B8Ki)) - call RegPack(Buf, InData%DP0) - end if - call RegPack(Buf, allocated(InData%NodeID2JointID)) - if (allocated(InData%NodeID2JointID)) then - call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID, kind=B8Ki), ubound(InData%NodeID2JointID, kind=B8Ki)) - call RegPack(Buf, InData%NodeID2JointID) - end if - call RegPack(Buf, InData%reduced) - call RegPack(Buf, allocated(InData%T_red)) - if (allocated(InData%T_red)) then - call RegPackBounds(Buf, 2, lbound(InData%T_red, kind=B8Ki), ubound(InData%T_red, kind=B8Ki)) - call RegPack(Buf, InData%T_red) - end if - call RegPack(Buf, allocated(InData%T_red_T)) - if (allocated(InData%T_red_T)) then - call RegPackBounds(Buf, 2, lbound(InData%T_red_T, kind=B8Ki), ubound(InData%T_red_T, kind=B8Ki)) - call RegPack(Buf, InData%T_red_T) - end if - call RegPack(Buf, allocated(InData%NodesDOF)) + call RegPackAlloc(RF, InData%FG) + call RegPackAlloc(RF, InData%DP0) + call RegPackAlloc(RF, InData%NodeID2JointID) + call RegPack(RF, InData%reduced) + call RegPackAlloc(RF, InData%T_red) + call RegPackAlloc(RF, InData%T_red_T) + call RegPack(RF, allocated(InData%NodesDOF)) if (allocated(InData%NodesDOF)) then - call RegPackBounds(Buf, 1, lbound(InData%NodesDOF, kind=B8Ki), ubound(InData%NodesDOF, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NodesDOF, kind=B8Ki), ubound(InData%NodesDOF, kind=B8Ki)) LB(1:1) = lbound(InData%NodesDOF, kind=B8Ki) UB(1:1) = ubound(InData%NodesDOF, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackIList(Buf, InData%NodesDOF(i1)) + call SD_PackIList(RF, InData%NodesDOF(i1)) end do end if - call RegPack(Buf, allocated(InData%NodesDOFred)) + call RegPack(RF, allocated(InData%NodesDOFred)) if (allocated(InData%NodesDOFred)) then - call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred, kind=B8Ki), ubound(InData%NodesDOFred, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%NodesDOFred, kind=B8Ki), ubound(InData%NodesDOFred, kind=B8Ki)) LB(1:1) = lbound(InData%NodesDOFred, kind=B8Ki) UB(1:1) = ubound(InData%NodesDOFred, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackIList(Buf, InData%NodesDOFred(i1)) + call SD_PackIList(RF, InData%NodesDOFred(i1)) end do end if - call RegPack(Buf, allocated(InData%ElemsDOF)) - if (allocated(InData%ElemsDOF)) then - call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF, kind=B8Ki), ubound(InData%ElemsDOF, kind=B8Ki)) - call RegPack(Buf, InData%ElemsDOF) - end if - call RegPack(Buf, allocated(InData%DOFred2Nodes)) - if (allocated(InData%DOFred2Nodes)) then - call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes, kind=B8Ki), ubound(InData%DOFred2Nodes, kind=B8Ki)) - call RegPack(Buf, InData%DOFred2Nodes) - end if - call RegPack(Buf, allocated(InData%CtrlElem2Channel)) - if (allocated(InData%CtrlElem2Channel)) then - call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel, kind=B8Ki), ubound(InData%CtrlElem2Channel, kind=B8Ki)) - call RegPack(Buf, InData%CtrlElem2Channel) - end if - call RegPack(Buf, InData%nDOFM) - call RegPack(Buf, InData%SttcSolve) - call RegPack(Buf, InData%GuyanLoadCorrection) - call RegPack(Buf, InData%Floating) - call RegPack(Buf, allocated(InData%KMMDiag)) - if (allocated(InData%KMMDiag)) then - call RegPackBounds(Buf, 1, lbound(InData%KMMDiag, kind=B8Ki), ubound(InData%KMMDiag, kind=B8Ki)) - call RegPack(Buf, InData%KMMDiag) - end if - call RegPack(Buf, allocated(InData%CMMDiag)) - if (allocated(InData%CMMDiag)) then - call RegPackBounds(Buf, 1, lbound(InData%CMMDiag, kind=B8Ki), ubound(InData%CMMDiag, kind=B8Ki)) - call RegPack(Buf, InData%CMMDiag) - end if - call RegPack(Buf, allocated(InData%MMB)) - if (allocated(InData%MMB)) then - call RegPackBounds(Buf, 2, lbound(InData%MMB, kind=B8Ki), ubound(InData%MMB, kind=B8Ki)) - call RegPack(Buf, InData%MMB) - end if - call RegPack(Buf, allocated(InData%MBmmB)) - if (allocated(InData%MBmmB)) then - call RegPackBounds(Buf, 2, lbound(InData%MBmmB, kind=B8Ki), ubound(InData%MBmmB, kind=B8Ki)) - call RegPack(Buf, InData%MBmmB) - end if - call RegPack(Buf, allocated(InData%C1_11)) - if (allocated(InData%C1_11)) then - call RegPackBounds(Buf, 2, lbound(InData%C1_11, kind=B8Ki), ubound(InData%C1_11, kind=B8Ki)) - call RegPack(Buf, InData%C1_11) - end if - call RegPack(Buf, allocated(InData%C1_12)) - if (allocated(InData%C1_12)) then - call RegPackBounds(Buf, 2, lbound(InData%C1_12, kind=B8Ki), ubound(InData%C1_12, kind=B8Ki)) - call RegPack(Buf, InData%C1_12) - end if - call RegPack(Buf, allocated(InData%D1_141)) - if (allocated(InData%D1_141)) then - call RegPackBounds(Buf, 2, lbound(InData%D1_141, kind=B8Ki), ubound(InData%D1_141, kind=B8Ki)) - call RegPack(Buf, InData%D1_141) - end if - call RegPack(Buf, allocated(InData%D1_142)) - if (allocated(InData%D1_142)) then - call RegPackBounds(Buf, 2, lbound(InData%D1_142, kind=B8Ki), ubound(InData%D1_142, kind=B8Ki)) - call RegPack(Buf, InData%D1_142) - end if - call RegPack(Buf, allocated(InData%PhiM)) - if (allocated(InData%PhiM)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiM, kind=B8Ki), ubound(InData%PhiM, kind=B8Ki)) - call RegPack(Buf, InData%PhiM) - end if - call RegPack(Buf, allocated(InData%C2_61)) - if (allocated(InData%C2_61)) then - call RegPackBounds(Buf, 2, lbound(InData%C2_61, kind=B8Ki), ubound(InData%C2_61, kind=B8Ki)) - call RegPack(Buf, InData%C2_61) - end if - call RegPack(Buf, allocated(InData%C2_62)) - if (allocated(InData%C2_62)) then - call RegPackBounds(Buf, 2, lbound(InData%C2_62, kind=B8Ki), ubound(InData%C2_62, kind=B8Ki)) - call RegPack(Buf, InData%C2_62) - end if - call RegPack(Buf, allocated(InData%PhiRb_TI)) - if (allocated(InData%PhiRb_TI)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI, kind=B8Ki), ubound(InData%PhiRb_TI, kind=B8Ki)) - call RegPack(Buf, InData%PhiRb_TI) - end if - call RegPack(Buf, allocated(InData%D2_63)) - if (allocated(InData%D2_63)) then - call RegPackBounds(Buf, 2, lbound(InData%D2_63, kind=B8Ki), ubound(InData%D2_63, kind=B8Ki)) - call RegPack(Buf, InData%D2_63) - end if - call RegPack(Buf, allocated(InData%D2_64)) - if (allocated(InData%D2_64)) then - call RegPackBounds(Buf, 2, lbound(InData%D2_64, kind=B8Ki), ubound(InData%D2_64, kind=B8Ki)) - call RegPack(Buf, InData%D2_64) - end if - call RegPack(Buf, allocated(InData%MBB)) - if (allocated(InData%MBB)) then - call RegPackBounds(Buf, 2, lbound(InData%MBB, kind=B8Ki), ubound(InData%MBB, kind=B8Ki)) - call RegPack(Buf, InData%MBB) - end if - call RegPack(Buf, allocated(InData%KBB)) - if (allocated(InData%KBB)) then - call RegPackBounds(Buf, 2, lbound(InData%KBB, kind=B8Ki), ubound(InData%KBB, kind=B8Ki)) - call RegPack(Buf, InData%KBB) - end if - call RegPack(Buf, allocated(InData%CBB)) - if (allocated(InData%CBB)) then - call RegPackBounds(Buf, 2, lbound(InData%CBB, kind=B8Ki), ubound(InData%CBB, kind=B8Ki)) - call RegPack(Buf, InData%CBB) - end if - call RegPack(Buf, allocated(InData%CMM)) - if (allocated(InData%CMM)) then - call RegPackBounds(Buf, 2, lbound(InData%CMM, kind=B8Ki), ubound(InData%CMM, kind=B8Ki)) - call RegPack(Buf, InData%CMM) - end if - call RegPack(Buf, allocated(InData%MBM)) - if (allocated(InData%MBM)) then - call RegPackBounds(Buf, 2, lbound(InData%MBM, kind=B8Ki), ubound(InData%MBM, kind=B8Ki)) - call RegPack(Buf, InData%MBM) - end if - call RegPack(Buf, allocated(InData%PhiL_T)) - if (allocated(InData%PhiL_T)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiL_T, kind=B8Ki), ubound(InData%PhiL_T, kind=B8Ki)) - call RegPack(Buf, InData%PhiL_T) - end if - call RegPack(Buf, allocated(InData%PhiLInvOmgL2)) - if (allocated(InData%PhiLInvOmgL2)) then - call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2, kind=B8Ki), ubound(InData%PhiLInvOmgL2, kind=B8Ki)) - call RegPack(Buf, InData%PhiLInvOmgL2) - end if - call RegPack(Buf, allocated(InData%KLLm1)) - if (allocated(InData%KLLm1)) then - call RegPackBounds(Buf, 2, lbound(InData%KLLm1, kind=B8Ki), ubound(InData%KLLm1, kind=B8Ki)) - call RegPack(Buf, InData%KLLm1) - end if - call RegPack(Buf, allocated(InData%AM2Jac)) - if (allocated(InData%AM2Jac)) then - call RegPackBounds(Buf, 2, lbound(InData%AM2Jac, kind=B8Ki), ubound(InData%AM2Jac, kind=B8Ki)) - call RegPack(Buf, InData%AM2Jac) - end if - call RegPack(Buf, allocated(InData%AM2JacPiv)) - if (allocated(InData%AM2JacPiv)) then - call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv, kind=B8Ki), ubound(InData%AM2JacPiv, kind=B8Ki)) - call RegPack(Buf, InData%AM2JacPiv) - end if - call RegPack(Buf, allocated(InData%TI)) - if (allocated(InData%TI)) then - call RegPackBounds(Buf, 2, lbound(InData%TI, kind=B8Ki), ubound(InData%TI, kind=B8Ki)) - call RegPack(Buf, InData%TI) - end if - call RegPack(Buf, allocated(InData%TIreact)) - if (allocated(InData%TIreact)) then - call RegPackBounds(Buf, 2, lbound(InData%TIreact, kind=B8Ki), ubound(InData%TIreact, kind=B8Ki)) - call RegPack(Buf, InData%TIreact) - end if - call RegPack(Buf, InData%nNodes) - call RegPack(Buf, InData%nNodes_I) - call RegPack(Buf, InData%nNodes_L) - call RegPack(Buf, InData%nNodes_C) - call RegPack(Buf, allocated(InData%Nodes_I)) - if (allocated(InData%Nodes_I)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes_I, kind=B8Ki), ubound(InData%Nodes_I, kind=B8Ki)) - call RegPack(Buf, InData%Nodes_I) - end if - call RegPack(Buf, allocated(InData%Nodes_L)) - if (allocated(InData%Nodes_L)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes_L, kind=B8Ki), ubound(InData%Nodes_L, kind=B8Ki)) - call RegPack(Buf, InData%Nodes_L) - end if - call RegPack(Buf, allocated(InData%Nodes_C)) - if (allocated(InData%Nodes_C)) then - call RegPackBounds(Buf, 2, lbound(InData%Nodes_C, kind=B8Ki), ubound(InData%Nodes_C, kind=B8Ki)) - call RegPack(Buf, InData%Nodes_C) - end if - call RegPack(Buf, InData%nDOFI__) - call RegPack(Buf, InData%nDOFI_Rb) - call RegPack(Buf, InData%nDOFI_F) - call RegPack(Buf, InData%nDOFL_L) - call RegPack(Buf, InData%nDOFC__) - call RegPack(Buf, InData%nDOFC_Rb) - call RegPack(Buf, InData%nDOFC_L) - call RegPack(Buf, InData%nDOFC_F) - call RegPack(Buf, InData%nDOFR__) - call RegPack(Buf, InData%nDOF__Rb) - call RegPack(Buf, InData%nDOF__L) - call RegPack(Buf, InData%nDOF__F) - call RegPack(Buf, allocated(InData%IDI__)) - if (allocated(InData%IDI__)) then - call RegPackBounds(Buf, 1, lbound(InData%IDI__, kind=B8Ki), ubound(InData%IDI__, kind=B8Ki)) - call RegPack(Buf, InData%IDI__) - end if - call RegPack(Buf, allocated(InData%IDI_Rb)) - if (allocated(InData%IDI_Rb)) then - call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb, kind=B8Ki), ubound(InData%IDI_Rb, kind=B8Ki)) - call RegPack(Buf, InData%IDI_Rb) - end if - call RegPack(Buf, allocated(InData%IDI_F)) - if (allocated(InData%IDI_F)) then - call RegPackBounds(Buf, 1, lbound(InData%IDI_F, kind=B8Ki), ubound(InData%IDI_F, kind=B8Ki)) - call RegPack(Buf, InData%IDI_F) - end if - call RegPack(Buf, allocated(InData%IDL_L)) - if (allocated(InData%IDL_L)) then - call RegPackBounds(Buf, 1, lbound(InData%IDL_L, kind=B8Ki), ubound(InData%IDL_L, kind=B8Ki)) - call RegPack(Buf, InData%IDL_L) - end if - call RegPack(Buf, allocated(InData%IDC__)) - if (allocated(InData%IDC__)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC__, kind=B8Ki), ubound(InData%IDC__, kind=B8Ki)) - call RegPack(Buf, InData%IDC__) - end if - call RegPack(Buf, allocated(InData%IDC_Rb)) - if (allocated(InData%IDC_Rb)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb, kind=B8Ki), ubound(InData%IDC_Rb, kind=B8Ki)) - call RegPack(Buf, InData%IDC_Rb) - end if - call RegPack(Buf, allocated(InData%IDC_L)) - if (allocated(InData%IDC_L)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC_L, kind=B8Ki), ubound(InData%IDC_L, kind=B8Ki)) - call RegPack(Buf, InData%IDC_L) - end if - call RegPack(Buf, allocated(InData%IDC_F)) - if (allocated(InData%IDC_F)) then - call RegPackBounds(Buf, 1, lbound(InData%IDC_F, kind=B8Ki), ubound(InData%IDC_F, kind=B8Ki)) - call RegPack(Buf, InData%IDC_F) - end if - call RegPack(Buf, allocated(InData%IDR__)) - if (allocated(InData%IDR__)) then - call RegPackBounds(Buf, 1, lbound(InData%IDR__, kind=B8Ki), ubound(InData%IDR__, kind=B8Ki)) - call RegPack(Buf, InData%IDR__) - end if - call RegPack(Buf, allocated(InData%ID__Rb)) - if (allocated(InData%ID__Rb)) then - call RegPackBounds(Buf, 1, lbound(InData%ID__Rb, kind=B8Ki), ubound(InData%ID__Rb, kind=B8Ki)) - call RegPack(Buf, InData%ID__Rb) - end if - call RegPack(Buf, allocated(InData%ID__L)) - if (allocated(InData%ID__L)) then - call RegPackBounds(Buf, 1, lbound(InData%ID__L, kind=B8Ki), ubound(InData%ID__L, kind=B8Ki)) - call RegPack(Buf, InData%ID__L) - end if - call RegPack(Buf, allocated(InData%ID__F)) - if (allocated(InData%ID__F)) then - call RegPackBounds(Buf, 1, lbound(InData%ID__F, kind=B8Ki), ubound(InData%ID__F, kind=B8Ki)) - call RegPack(Buf, InData%ID__F) - end if - call RegPack(Buf, InData%NMOutputs) - call RegPack(Buf, InData%NumOuts) - call RegPack(Buf, InData%OutSwtch) - call RegPack(Buf, InData%UnJckF) - call RegPack(Buf, InData%Delim) - call RegPack(Buf, InData%OutFmt) - call RegPack(Buf, InData%OutSFmt) - call RegPack(Buf, allocated(InData%MoutLst)) + call RegPackAlloc(RF, InData%ElemsDOF) + call RegPackAlloc(RF, InData%DOFred2Nodes) + call RegPackAlloc(RF, InData%CtrlElem2Channel) + call RegPack(RF, InData%nDOFM) + call RegPack(RF, InData%SttcSolve) + call RegPack(RF, InData%GuyanLoadCorrection) + call RegPack(RF, InData%Floating) + call RegPackAlloc(RF, InData%KMMDiag) + call RegPackAlloc(RF, InData%CMMDiag) + call RegPackAlloc(RF, InData%MMB) + call RegPackAlloc(RF, InData%MBmmB) + call RegPackAlloc(RF, InData%C1_11) + call RegPackAlloc(RF, InData%C1_12) + call RegPackAlloc(RF, InData%D1_141) + call RegPackAlloc(RF, InData%D1_142) + call RegPackAlloc(RF, InData%PhiM) + call RegPackAlloc(RF, InData%C2_61) + call RegPackAlloc(RF, InData%C2_62) + call RegPackAlloc(RF, InData%PhiRb_TI) + call RegPackAlloc(RF, InData%D2_63) + call RegPackAlloc(RF, InData%D2_64) + call RegPackAlloc(RF, InData%MBB) + call RegPackAlloc(RF, InData%KBB) + call RegPackAlloc(RF, InData%CBB) + call RegPackAlloc(RF, InData%CMM) + call RegPackAlloc(RF, InData%MBM) + call RegPackAlloc(RF, InData%PhiL_T) + call RegPackAlloc(RF, InData%PhiLInvOmgL2) + call RegPackAlloc(RF, InData%KLLm1) + call RegPackAlloc(RF, InData%AM2Jac) + call RegPackAlloc(RF, InData%AM2JacPiv) + call RegPackAlloc(RF, InData%TI) + call RegPackAlloc(RF, InData%TIreact) + call RegPack(RF, InData%nNodes) + call RegPack(RF, InData%nNodes_I) + call RegPack(RF, InData%nNodes_L) + call RegPack(RF, InData%nNodes_C) + call RegPackAlloc(RF, InData%Nodes_I) + call RegPackAlloc(RF, InData%Nodes_L) + call RegPackAlloc(RF, InData%Nodes_C) + call RegPack(RF, InData%nDOFI__) + call RegPack(RF, InData%nDOFI_Rb) + call RegPack(RF, InData%nDOFI_F) + call RegPack(RF, InData%nDOFL_L) + call RegPack(RF, InData%nDOFC__) + call RegPack(RF, InData%nDOFC_Rb) + call RegPack(RF, InData%nDOFC_L) + call RegPack(RF, InData%nDOFC_F) + call RegPack(RF, InData%nDOFR__) + call RegPack(RF, InData%nDOF__Rb) + call RegPack(RF, InData%nDOF__L) + call RegPack(RF, InData%nDOF__F) + call RegPackAlloc(RF, InData%IDI__) + call RegPackAlloc(RF, InData%IDI_Rb) + call RegPackAlloc(RF, InData%IDI_F) + call RegPackAlloc(RF, InData%IDL_L) + call RegPackAlloc(RF, InData%IDC__) + call RegPackAlloc(RF, InData%IDC_Rb) + call RegPackAlloc(RF, InData%IDC_L) + call RegPackAlloc(RF, InData%IDC_F) + call RegPackAlloc(RF, InData%IDR__) + call RegPackAlloc(RF, InData%ID__Rb) + call RegPackAlloc(RF, InData%ID__L) + call RegPackAlloc(RF, InData%ID__F) + call RegPack(RF, InData%NMOutputs) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%OutSwtch) + call RegPack(RF, InData%UnJckF) + call RegPack(RF, InData%Delim) + call RegPack(RF, InData%OutFmt) + call RegPack(RF, InData%OutSFmt) + call RegPack(RF, allocated(InData%MoutLst)) if (allocated(InData%MoutLst)) then - call RegPackBounds(Buf, 1, lbound(InData%MoutLst, kind=B8Ki), ubound(InData%MoutLst, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MoutLst, kind=B8Ki), ubound(InData%MoutLst, kind=B8Ki)) LB(1:1) = lbound(InData%MoutLst, kind=B8Ki) UB(1:1) = ubound(InData%MoutLst, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackMeshAuxDataType(Buf, InData%MoutLst(i1)) + call SD_PackMeshAuxDataType(RF, InData%MoutLst(i1)) end do end if - call RegPack(Buf, allocated(InData%MoutLst2)) + call RegPack(RF, allocated(InData%MoutLst2)) if (allocated(InData%MoutLst2)) then - call RegPackBounds(Buf, 1, lbound(InData%MoutLst2, kind=B8Ki), ubound(InData%MoutLst2, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MoutLst2, kind=B8Ki), ubound(InData%MoutLst2, kind=B8Ki)) LB(1:1) = lbound(InData%MoutLst2, kind=B8Ki) UB(1:1) = ubound(InData%MoutLst2, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackMeshAuxDataType(Buf, InData%MoutLst2(i1)) + call SD_PackMeshAuxDataType(RF, InData%MoutLst2(i1)) end do end if - call RegPack(Buf, allocated(InData%MoutLst3)) + call RegPack(RF, allocated(InData%MoutLst3)) if (allocated(InData%MoutLst3)) then - call RegPackBounds(Buf, 1, lbound(InData%MoutLst3, kind=B8Ki), ubound(InData%MoutLst3, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%MoutLst3, kind=B8Ki), ubound(InData%MoutLst3, kind=B8Ki)) LB(1:1) = lbound(InData%MoutLst3, kind=B8Ki) UB(1:1) = ubound(InData%MoutLst3, kind=B8Ki) do i1 = LB(1), UB(1) - call SD_PackMeshAuxDataType(Buf, InData%MoutLst3(i1)) + call SD_PackMeshAuxDataType(RF, InData%MoutLst3(i1)) end do end if - call RegPack(Buf, allocated(InData%OutParam)) + call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(Buf, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) LB(1:1) = lbound(InData%OutParam, kind=B8Ki) UB(1:1) = ubound(InData%OutParam, kind=B8Ki) do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(Buf, InData%OutAll) - call RegPack(Buf, InData%OutCBModes) - call RegPack(Buf, InData%OutFEMModes) - call RegPack(Buf, InData%OutReact) - call RegPack(Buf, InData%OutAllInt) - call RegPack(Buf, InData%OutAllDims) - call RegPack(Buf, InData%OutDec) - call RegPack(Buf, allocated(InData%Jac_u_indx)) - if (allocated(InData%Jac_u_indx)) then - call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx, kind=B8Ki), ubound(InData%Jac_u_indx, kind=B8Ki)) - call RegPack(Buf, InData%Jac_u_indx) - end if - call RegPack(Buf, allocated(InData%du)) - if (allocated(InData%du)) then - call RegPackBounds(Buf, 1, lbound(InData%du, kind=B8Ki), ubound(InData%du, kind=B8Ki)) - call RegPack(Buf, InData%du) - end if - call RegPack(Buf, InData%dx) - call RegPack(Buf, InData%Jac_ny) - call RegPack(Buf, InData%Jac_nx) - call RegPack(Buf, InData%RotStates) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%OutAll) + call RegPack(RF, InData%OutCBModes) + call RegPack(RF, InData%OutFEMModes) + call RegPack(RF, InData%OutReact) + call RegPack(RF, InData%OutAllInt) + call RegPack(RF, InData%OutAllDims) + call RegPack(RF, InData%OutDec) + call RegPackAlloc(RF, InData%Jac_u_indx) + call RegPackAlloc(RF, InData%du) + call RegPack(RF, InData%dx) + call RegPack(RF, InData%Jac_ny) + call RegPack(RF, InData%Jac_nx) + call RegPack(RF, InData%RotStates) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackParam' integer(B8Ki) :: i1, i2 integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%SDDeltaT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOF_red) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Nmembers) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Elems)) deallocate(OutData%Elems) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Elems(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Elems) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%SDDeltaT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IntMethod); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nmembers); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Elems); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%ElemProps(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackElemPropType(Buf, OutData%ElemProps(i1)) ! ElemProps + call SD_UnpackElemPropType(RF, OutData%ElemProps(i1)) ! ElemProps end do end if - if (allocated(OutData%FG)) deallocate(OutData%FG) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%FG(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%FG) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DP0)) deallocate(OutData%DP0) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DP0(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DP0) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%NodeID2JointID)) deallocate(OutData%NodeID2JointID) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%NodeID2JointID(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%NodeID2JointID) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%reduced) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%T_red)) deallocate(OutData%T_red) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%T_red(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%T_red) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%T_red_T)) deallocate(OutData%T_red_T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%T_red_T(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%T_red_T) - if (RegCheckErr(Buf, RoutineName)) return - end if + call RegUnpackAlloc(RF, OutData%FG); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DP0); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%NodeID2JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%reduced); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T_red); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%T_red_T); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%NodesDOF)) deallocate(OutData%NodesDOF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NodesDOF(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackIList(Buf, OutData%NodesDOF(i1)) ! NodesDOF + call SD_UnpackIList(RF, OutData%NodesDOF(i1)) ! NodesDOF end do end if if (allocated(OutData%NodesDOFred)) deallocate(OutData%NodesDOFred) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%NodesDOFred(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackIList(Buf, OutData%NodesDOFred(i1)) ! NodesDOFred + call SD_UnpackIList(RF, OutData%NodesDOFred(i1)) ! NodesDOFred end do end if - if (allocated(OutData%ElemsDOF)) deallocate(OutData%ElemsDOF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ElemsDOF) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%DOFred2Nodes)) deallocate(OutData%DOFred2Nodes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%DOFred2Nodes) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CtrlElem2Channel)) deallocate(OutData%CtrlElem2Channel) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CtrlElem2Channel) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nDOFM) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%SttcSolve) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%GuyanLoadCorrection) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Floating) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%KMMDiag)) deallocate(OutData%KMMDiag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%KMMDiag(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%KMMDiag) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CMMDiag)) deallocate(OutData%CMMDiag) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CMMDiag(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CMMDiag) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MMB)) deallocate(OutData%MMB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MMB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MMB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MBmmB)) deallocate(OutData%MBmmB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MBmmB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MBmmB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C1_11)) deallocate(OutData%C1_11) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C1_11(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C1_11) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C1_12)) deallocate(OutData%C1_12) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C1_12(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C1_12) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D1_141)) deallocate(OutData%D1_141) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D1_141(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D1_141) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D1_142)) deallocate(OutData%D1_142) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D1_142(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D1_142) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PhiM)) deallocate(OutData%PhiM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PhiM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PhiM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C2_61)) deallocate(OutData%C2_61) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C2_61(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C2_61) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%C2_62)) deallocate(OutData%C2_62) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C2_62(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%C2_62) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PhiRb_TI)) deallocate(OutData%PhiRb_TI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PhiRb_TI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D2_63)) deallocate(OutData%D2_63) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D2_63(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D2_63) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D2_64)) deallocate(OutData%D2_64) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D2_64(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D2_64) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MBB)) deallocate(OutData%MBB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MBB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%KBB)) deallocate(OutData%KBB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%KBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%KBB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CBB)) deallocate(OutData%CBB) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CBB) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%CMM)) deallocate(OutData%CMM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CMM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CMM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%MBM)) deallocate(OutData%MBM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%MBM(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%MBM) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PhiL_T)) deallocate(OutData%PhiL_T) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PhiL_T(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PhiL_T) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%PhiLInvOmgL2)) deallocate(OutData%PhiLInvOmgL2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%PhiLInvOmgL2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%KLLm1)) deallocate(OutData%KLLm1) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%KLLm1(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%KLLm1) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AM2Jac)) deallocate(OutData%AM2Jac) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AM2Jac(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AM2Jac) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%AM2JacPiv)) deallocate(OutData%AM2JacPiv) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AM2JacPiv(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AM2JacPiv) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TI)) deallocate(OutData%TI) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TIreact)) deallocate(OutData%TIreact) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TIreact(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TIreact) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nNodes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNodes_I) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNodes_L) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nNodes_C) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Nodes_I)) deallocate(OutData%Nodes_I) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nodes_I(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nodes_I) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Nodes_L)) deallocate(OutData%Nodes_L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nodes_L(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nodes_L) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Nodes_C)) deallocate(OutData%Nodes_C) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Nodes_C(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Nodes_C) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%nDOFI__) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFI_Rb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFI_F) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFL_L) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFC__) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFC_Rb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFC_L) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFC_F) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOFR__) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOF__Rb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOF__L) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%nDOF__F) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%IDI__)) deallocate(OutData%IDI__) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDI__(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDI__) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDI_Rb)) deallocate(OutData%IDI_Rb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDI_Rb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDI_Rb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDI_F)) deallocate(OutData%IDI_F) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDI_F(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDI_F) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDL_L)) deallocate(OutData%IDL_L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDL_L(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDL_L) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDC__)) deallocate(OutData%IDC__) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDC__(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDC__) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDC_Rb)) deallocate(OutData%IDC_Rb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDC_Rb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDC_Rb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDC_L)) deallocate(OutData%IDC_L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDC_L(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDC_L) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDC_F)) deallocate(OutData%IDC_F) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDC_F(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDC_F) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%IDR__)) deallocate(OutData%IDR__) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IDR__(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IDR__) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ID__Rb)) deallocate(OutData%ID__Rb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ID__Rb(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ID__Rb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ID__L)) deallocate(OutData%ID__L) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ID__L(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ID__L) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%ID__F)) deallocate(OutData%ID__F) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ID__F(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ID__F) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%NMOutputs) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%UnJckF) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Delim) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ElemsDOF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DOFred2Nodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CtrlElem2Channel); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SttcSolve); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GuyanLoadCorrection); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Floating); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KMMDiag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMMDiag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MMB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBmmB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C1_11); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C1_12); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D1_141); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D1_142); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C2_61); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%C2_62); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiRb_TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D2_63); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D2_64); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CBB); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%MBM); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiL_T); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PhiLInvOmgL2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%KLLm1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AM2Jac); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%AM2JacPiv); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TIreact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes_I); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodes_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes_I); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Nodes_C); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFI__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFI_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFI_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFL_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFC_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOFR__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF__Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF__L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nDOF__F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDI__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDI_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDI_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDL_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC_Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC_L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDC_F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IDR__); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ID__Rb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ID__L); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%ID__F); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NMOutputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSwtch); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UnJckF); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Delim); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFmt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutSFmt); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%MoutLst)) deallocate(OutData%MoutLst) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MoutLst(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst(i1)) ! MoutLst + call SD_UnpackMeshAuxDataType(RF, OutData%MoutLst(i1)) ! MoutLst end do end if if (allocated(OutData%MoutLst2)) deallocate(OutData%MoutLst2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MoutLst2(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst2(i1)) ! MoutLst2 + call SD_UnpackMeshAuxDataType(RF, OutData%MoutLst2(i1)) ! MoutLst2 end do end if if (allocated(OutData%MoutLst3)) deallocate(OutData%MoutLst3) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%MoutLst3(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst3(i1)) ! MoutLst3 + call SD_UnpackMeshAuxDataType(RF, OutData%MoutLst3(i1)) ! MoutLst3 end do end if if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - call RegUnpack(Buf, OutData%OutAll) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutCBModes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFEMModes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutReact) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutAllInt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutAllDims) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutDec) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Jac_u_indx) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%du)) deallocate(OutData%du) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%du(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%du) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%dx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%RotStates) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%OutAll); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutCBModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFEMModes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutReact); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllInt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllDims); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutDec); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RotStates); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -6152,45 +3825,28 @@ subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%TPMesh) - call MeshPack(Buf, InData%LMesh) - call RegPack(Buf, allocated(InData%CableDeltaL)) - if (allocated(InData%CableDeltaL)) then - call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL, kind=B8Ki), ubound(InData%CableDeltaL, kind=B8Ki)) - call RegPack(Buf, InData%CableDeltaL) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%TPMesh) + call MeshPack(RF, InData%LMesh) + call RegPackAlloc(RF, InData%CableDeltaL) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%TPMesh) ! TPMesh - call MeshUnpack(Buf, OutData%LMesh) ! LMesh - if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%CableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%TPMesh) ! TPMesh + call MeshUnpack(RF, OutData%LMesh) ! LMesh + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -6248,47 +3904,30 @@ subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call MeshPack(Buf, InData%Y1Mesh) - call MeshPack(Buf, InData%Y2Mesh) - call MeshPack(Buf, InData%Y3Mesh) - call RegPack(Buf, allocated(InData%WriteOutput)) - if (allocated(InData%WriteOutput)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutput, kind=B8Ki), ubound(InData%WriteOutput, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutput) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%Y1Mesh) + call MeshPack(RF, InData%Y2Mesh) + call MeshPack(RF, InData%Y3Mesh) + call RegPackAlloc(RF, InData%WriteOutput) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call MeshUnpack(Buf, OutData%Y1Mesh) ! Y1Mesh - call MeshUnpack(Buf, OutData%Y2Mesh) ! Y2Mesh - call MeshUnpack(Buf, OutData%Y3Mesh) ! Y3Mesh - if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutput) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%Y1Mesh) ! Y1Mesh + call MeshUnpack(RF, OutData%Y2Mesh) ! Y2Mesh + call MeshUnpack(RF, OutData%Y3Mesh) ! Y3Mesh + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index fcefcf10ab..1b5fd5b28e 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -119,34 +119,31 @@ subroutine SC_DX_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_DX_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_DX_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_DX_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%NumSC2Ctrl) - call RegPack(Buf, InData%NumSC2CtrlGlob) - call RegPack(Buf, InData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumCtrl2SC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_DX_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_DX_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - call RegUnpack(Buf, OutData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - call RegUnpack(Buf, OutData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC end subroutine @@ -219,25 +216,25 @@ subroutine SC_DX_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SC_DX_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_DX_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_DX_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_DX_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_DX_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine SUBROUTINE SC_DX_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) @@ -296,26 +293,25 @@ subroutine SC_DX_DestroyParam(ParamData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_DX_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_DX_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_DX_PackParam' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%useSC) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%useSC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_DX_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_DX_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackParam' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%useSC) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%useSC); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%useSC = OutData%useSC end subroutine @@ -398,29 +394,22 @@ subroutine SC_DX_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine SC_DX_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_DX_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_DX_PackInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%toSC)) - if (associated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%toSC) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%toSC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_DX_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_DX_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' integer(B8Ki) :: LB(1), UB(1) @@ -428,33 +417,8 @@ subroutine SC_DX_UnPackInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%toSC)) deallocate(OutData%toSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%toSC, UB(1:1)-LB(1:1)) - OutData%toSC(LB(1):) => OutData%toSC - else - allocate(OutData%toSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%toSC) - OutData%C_obj%toSC_Len = size(OutData%toSC) - if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) - call RegUnpack(Buf, OutData%toSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%toSC => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE SC_DX_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) @@ -576,37 +540,23 @@ subroutine SC_DX_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SC_DX_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_DX_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_DX_PackOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%fromSC)) - if (associated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fromSC) - end if - end if - call RegPack(Buf, associated(InData%fromSCglob)) - if (associated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fromSCglob) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%fromSC) + call RegPackPtr(RF, InData%fromSCglob) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_DX_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_DX_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_DX_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) @@ -614,59 +564,9 @@ subroutine SC_DX_UnPackOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%fromSC)) deallocate(OutData%fromSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fromSC, UB(1:1)-LB(1:1)) - OutData%fromSC(LB(1):) => OutData%fromSC - else - allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fromSC) - OutData%C_obj%fromSC_Len = size(OutData%fromSC) - if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) - call RegUnpack(Buf, OutData%fromSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fromSC => null() - end if - if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fromSCglob, UB(1:1)-LB(1:1)) - OutData%fromSCglob(LB(1):) => OutData%fromSCglob - else - allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fromSCglob) - OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) - if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) - call RegUnpack(Buf, OutData%fromSCglob) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fromSCglob => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE SC_DX_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index dce6747bce..8da3781664 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -205,30 +205,28 @@ subroutine SC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%nTurbines) - call RegPack(Buf, InData%DLL_FileName) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%nTurbines) + call RegPack(RF, InData%DLL_FileName) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%nTurbines) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%nTurbines = OutData%nTurbines - call RegUnpack(Buf, OutData%DLL_FileName) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%DLL_FileName = transfer(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) end subroutine @@ -307,40 +305,36 @@ subroutine SC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SC_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - call RegPack(Buf, InData%NumCtrl2SC) - call RegPack(Buf, InData%nInpGlobal) - call RegPack(Buf, InData%NumSC2Ctrl) - call RegPack(Buf, InData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%nInpGlobal) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInitOutput' - if (Buf%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - call RegUnpack(Buf, OutData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - call RegUnpack(Buf, OutData%nInpGlobal) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%nInpGlobal); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%nInpGlobal = OutData%nInpGlobal - call RegUnpack(Buf, OutData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - call RegUnpack(Buf, OutData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob end subroutine @@ -476,48 +470,34 @@ subroutine SC_DestroyParam(ParamData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SC_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackParam' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%DT) - call RegPack(Buf, InData%nTurbines) - call RegPack(Buf, InData%NumCtrl2SC) - call RegPack(Buf, InData%nInpGlobal) - call RegPack(Buf, InData%NumSC2Ctrl) - call RegPack(Buf, InData%NumSC2CtrlGlob) - call RegPack(Buf, InData%NumStatesGlobal) - call RegPack(Buf, InData%NumStatesTurbine) - call RegPack(Buf, InData%NumParamGlobal) - call RegPack(Buf, InData%NumParamTurbine) - call RegPack(Buf, associated(InData%ParamGlobal)) - if (associated(InData%ParamGlobal)) then - call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal, kind=B8Ki), ubound(InData%ParamGlobal, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%ParamGlobal), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%ParamGlobal) - end if - end if - call RegPack(Buf, associated(InData%ParamTurbine)) - if (associated(InData%ParamTurbine)) then - call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine, kind=B8Ki), ubound(InData%ParamTurbine, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%ParamTurbine), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%ParamTurbine) - end if - end if - call DLLTypePack(Buf, InData%DLL_Trgt) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%DT) + call RegPack(RF, InData%nTurbines) + call RegPack(RF, InData%NumCtrl2SC) + call RegPack(RF, InData%nInpGlobal) + call RegPack(RF, InData%NumSC2Ctrl) + call RegPack(RF, InData%NumSC2CtrlGlob) + call RegPack(RF, InData%NumStatesGlobal) + call RegPack(RF, InData%NumStatesTurbine) + call RegPack(RF, InData%NumParamGlobal) + call RegPack(RF, InData%NumParamTurbine) + call RegPackPtr(RF, InData%ParamGlobal) + call RegPackPtr(RF, InData%ParamTurbine) + call DLLTypePack(RF, InData%DLL_Trgt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackParam' integer(B8Ki) :: LB(1), UB(1) @@ -525,90 +505,30 @@ subroutine SC_UnPackParam(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DT) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%DT = OutData%DT - call RegUnpack(Buf, OutData%nTurbines) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%nTurbines); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%nTurbines = OutData%nTurbines - call RegUnpack(Buf, OutData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumCtrl2SC); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - call RegUnpack(Buf, OutData%nInpGlobal) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%nInpGlobal); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%nInpGlobal = OutData%nInpGlobal - call RegUnpack(Buf, OutData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2Ctrl); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - call RegUnpack(Buf, OutData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumSC2CtrlGlob); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - call RegUnpack(Buf, OutData%NumStatesGlobal) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumStatesGlobal); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal - call RegUnpack(Buf, OutData%NumStatesTurbine) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumStatesTurbine); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine - call RegUnpack(Buf, OutData%NumParamGlobal) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumParamGlobal); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal - call RegUnpack(Buf, OutData%NumParamTurbine) - if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(RF, OutData%NumParamTurbine); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine - if (associated(OutData%ParamGlobal)) deallocate(OutData%ParamGlobal) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%ParamGlobal, UB(1:1)-LB(1:1)) - OutData%ParamGlobal(LB(1):) => OutData%ParamGlobal - else - allocate(OutData%ParamGlobal(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamGlobal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%ParamGlobal) - OutData%C_obj%ParamGlobal_Len = size(OutData%ParamGlobal) - if (OutData%C_obj%ParamGlobal_Len > 0) OutData%C_obj%ParamGlobal = c_loc(OutData%ParamGlobal(LB(1))) - call RegUnpack(Buf, OutData%ParamGlobal) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%ParamGlobal => null() - end if - if (associated(OutData%ParamTurbine)) deallocate(OutData%ParamTurbine) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%ParamTurbine, UB(1:1)-LB(1:1)) - OutData%ParamTurbine(LB(1):) => OutData%ParamTurbine - else - allocate(OutData%ParamTurbine(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamTurbine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%ParamTurbine) - OutData%C_obj%ParamTurbine_Len = size(OutData%ParamTurbine) - if (OutData%C_obj%ParamTurbine_Len > 0) OutData%C_obj%ParamTurbine = c_loc(OutData%ParamTurbine(LB(1))) - call RegUnpack(Buf, OutData%ParamTurbine) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%ParamTurbine => null() - end if - call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpackPtr(RF, OutData%ParamGlobal); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%ParamTurbine); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt end subroutine SUBROUTINE SC_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) @@ -771,37 +691,23 @@ subroutine SC_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine SC_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackDiscState' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%Global)) - if (associated(InData%Global)) then - call RegPackBounds(Buf, 1, lbound(InData%Global, kind=B8Ki), ubound(InData%Global, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Global), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Global) - end if - end if - call RegPack(Buf, associated(InData%Turbine)) - if (associated(InData%Turbine)) then - call RegPackBounds(Buf, 1, lbound(InData%Turbine, kind=B8Ki), ubound(InData%Turbine, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%Turbine), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%Turbine) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%Global) + call RegPackPtr(RF, InData%Turbine) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackDiscState' integer(B8Ki) :: LB(1), UB(1) @@ -809,59 +715,9 @@ subroutine SC_UnPackDiscState(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%Global)) deallocate(OutData%Global) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Global, UB(1:1)-LB(1:1)) - OutData%Global(LB(1):) => OutData%Global - else - allocate(OutData%Global(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Global.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Global) - OutData%C_obj%Global_Len = size(OutData%Global) - if (OutData%C_obj%Global_Len > 0) OutData%C_obj%Global = c_loc(OutData%Global(LB(1))) - call RegUnpack(Buf, OutData%Global) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Global => null() - end if - if (associated(OutData%Turbine)) deallocate(OutData%Turbine) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%Turbine, UB(1:1)-LB(1:1)) - OutData%Turbine(LB(1):) => OutData%Turbine - else - allocate(OutData%Turbine(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%Turbine) - OutData%C_obj%Turbine_Len = size(OutData%Turbine) - if (OutData%C_obj%Turbine_Len > 0) OutData%C_obj%Turbine = c_loc(OutData%Turbine(LB(1))) - call RegUnpack(Buf, OutData%Turbine) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%Turbine => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%Global); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%Turbine); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE SC_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) @@ -962,26 +818,25 @@ subroutine SC_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackContState' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine @@ -1043,26 +898,25 @@ subroutine SC_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine @@ -1124,26 +978,25 @@ subroutine SC_DestroyMisc(MiscData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackMisc' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine @@ -1205,26 +1058,25 @@ subroutine SC_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine SC_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(RF, InData%Dummy) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Dummy); if (RegCheckErr(RF, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine @@ -1328,37 +1180,23 @@ subroutine SC_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine SC_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackInput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%toSCglob)) - if (associated(InData%toSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%toSCglob, kind=B8Ki), ubound(InData%toSCglob, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%toSCglob), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%toSCglob) - end if - end if - call RegPack(Buf, associated(InData%toSC)) - if (associated(InData%toSC)) then - call RegPackBounds(Buf, 1, lbound(InData%toSC, kind=B8Ki), ubound(InData%toSC, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%toSC) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%toSCglob) + call RegPackPtr(RF, InData%toSC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInput' integer(B8Ki) :: LB(1), UB(1) @@ -1366,59 +1204,9 @@ subroutine SC_UnPackInput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%toSCglob)) deallocate(OutData%toSCglob) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%toSCglob, UB(1:1)-LB(1:1)) - OutData%toSCglob(LB(1):) => OutData%toSCglob - else - allocate(OutData%toSCglob(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%toSCglob) - OutData%C_obj%toSCglob_Len = size(OutData%toSCglob) - if (OutData%C_obj%toSCglob_Len > 0) OutData%C_obj%toSCglob = c_loc(OutData%toSCglob(LB(1))) - call RegUnpack(Buf, OutData%toSCglob) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%toSCglob => null() - end if - if (associated(OutData%toSC)) deallocate(OutData%toSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%toSC, UB(1:1)-LB(1:1)) - OutData%toSC(LB(1):) => OutData%toSC - else - allocate(OutData%toSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%toSC) - OutData%C_obj%toSC_Len = size(OutData%toSC) - if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) - call RegUnpack(Buf, OutData%toSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%toSC => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%toSCglob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%toSC); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE SC_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) @@ -1561,37 +1349,23 @@ subroutine SC_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine SC_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(SC_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SC_PackOutput' logical :: PtrInIndex - if (Buf%ErrStat >= AbortErrLev) return + if (RF%ErrStat >= AbortErrLev) return if (c_associated(InData%C_obj%object)) then - call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if - call RegPack(Buf, associated(InData%fromSCglob)) - if (associated(InData%fromSCglob)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSCglob, kind=B8Ki), ubound(InData%fromSCglob, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fromSCglob) - end if - end if - call RegPack(Buf, associated(InData%fromSC)) - if (associated(InData%fromSC)) then - call RegPackBounds(Buf, 1, lbound(InData%fromSC, kind=B8Ki), ubound(InData%fromSC, kind=B8Ki)) - call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) - if (.not. PtrInIndex) then - call RegPack(Buf, InData%fromSC) - end if - end if - if (RegCheckErr(Buf, RoutineName)) return + call RegPackPtr(RF, InData%fromSCglob) + call RegPackPtr(RF, InData%fromSC) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SC_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine SC_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(SC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackOutput' integer(B8Ki) :: LB(1), UB(1) @@ -1599,59 +1373,9 @@ subroutine SC_UnPackOutput(Buf, OutData) logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx type(c_ptr) :: Ptr - if (Buf%ErrStat /= ErrID_None) return - if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fromSCglob, UB(1:1)-LB(1:1)) - OutData%fromSCglob(LB(1):) => OutData%fromSCglob - else - allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fromSCglob) - OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) - if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) - call RegUnpack(Buf, OutData%fromSCglob) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fromSCglob => null() - end if - if (associated(OutData%fromSC)) deallocate(OutData%fromSC) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpackPointer(Buf, Ptr, PtrIdx) - if (RegCheckErr(Buf, RoutineName)) return - if (c_associated(Ptr)) then - call c_f_pointer(Ptr, OutData%fromSC, UB(1:1)-LB(1:1)) - OutData%fromSC(LB(1):) => OutData%fromSC - else - allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - Buf%Pointers(PtrIdx) = c_loc(OutData%fromSC) - OutData%C_obj%fromSC_Len = size(OutData%fromSC) - if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) - call RegUnpack(Buf, OutData%fromSC) - if (RegCheckErr(Buf, RoutineName)) return - end if - else - OutData%fromSC => null() - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackPtr(RF, OutData%fromSCglob); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackPtr(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return end subroutine SUBROUTINE SC_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index ea0d0bd9b8..54046decbb 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -282,115 +282,83 @@ subroutine WD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine WD_PackInputFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackInputFileType(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_InputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInputFileType' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dr) - call RegPack(Buf, InData%NumRadii) - call RegPack(Buf, InData%NumPlanes) - call RegPack(Buf, InData%Mod_Wake) - call RegPack(Buf, InData%f_c) - call RegPack(Buf, InData%C_HWkDfl_O) - call RegPack(Buf, InData%C_HWkDfl_OY) - call RegPack(Buf, InData%C_HWkDfl_x) - call RegPack(Buf, InData%C_HWkDfl_xY) - call RegPack(Buf, InData%C_NearWake) - call RegPack(Buf, InData%k_vAmb) - call RegPack(Buf, InData%k_vShr) - call RegPack(Buf, InData%C_vAmb_DMin) - call RegPack(Buf, InData%C_vAmb_DMax) - call RegPack(Buf, InData%C_vAmb_FMin) - call RegPack(Buf, InData%C_vAmb_Exp) - call RegPack(Buf, InData%C_vShr_DMin) - call RegPack(Buf, InData%C_vShr_DMax) - call RegPack(Buf, InData%C_vShr_FMin) - call RegPack(Buf, InData%C_vShr_Exp) - call RegPack(Buf, InData%Mod_WakeDiam) - call RegPack(Buf, InData%C_WakeDiam) - call RegPack(Buf, InData%Swirl) - call RegPack(Buf, InData%k_VortexDecay) - call RegPack(Buf, InData%sigma_D) - call RegPack(Buf, InData%NumVortices) - call RegPack(Buf, InData%FilterInit) - call RegPack(Buf, InData%k_vCurl) - call RegPack(Buf, InData%OutAllPlanes) - call RegPack(Buf, InData%WAT) - call RegPack(Buf, InData%WAT_k_Def) - call RegPack(Buf, InData%WAT_k_Grad) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dr) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%NumPlanes) + call RegPack(RF, InData%Mod_Wake) + call RegPack(RF, InData%f_c) + call RegPack(RF, InData%C_HWkDfl_O) + call RegPack(RF, InData%C_HWkDfl_OY) + call RegPack(RF, InData%C_HWkDfl_x) + call RegPack(RF, InData%C_HWkDfl_xY) + call RegPack(RF, InData%C_NearWake) + call RegPack(RF, InData%k_vAmb) + call RegPack(RF, InData%k_vShr) + call RegPack(RF, InData%C_vAmb_DMin) + call RegPack(RF, InData%C_vAmb_DMax) + call RegPack(RF, InData%C_vAmb_FMin) + call RegPack(RF, InData%C_vAmb_Exp) + call RegPack(RF, InData%C_vShr_DMin) + call RegPack(RF, InData%C_vShr_DMax) + call RegPack(RF, InData%C_vShr_FMin) + call RegPack(RF, InData%C_vShr_Exp) + call RegPack(RF, InData%Mod_WakeDiam) + call RegPack(RF, InData%C_WakeDiam) + call RegPack(RF, InData%Swirl) + call RegPack(RF, InData%k_VortexDecay) + call RegPack(RF, InData%sigma_D) + call RegPack(RF, InData%NumVortices) + call RegPack(RF, InData%FilterInit) + call RegPack(RF, InData%k_vCurl) + call RegPack(RF, InData%OutAllPlanes) + call RegPack(RF, InData%WAT) + call RegPack(RF, InData%WAT_k_Def) + call RegPack(RF, InData%WAT_k_Grad) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackInputFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackInputFileType(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInputFileType' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_Wake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%f_c) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_O) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_OY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_x) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_xY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_NearWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_vAmb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_vShr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_DMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_DMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_FMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_Exp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_DMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_DMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_FMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_Exp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Swirl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_VortexDecay) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%sigma_D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumVortices) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FilterInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_vCurl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutAllPlanes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAT_k_Def) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAT_k_Grad) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%f_c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_O); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_OY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_xY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_NearWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vAmb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Swirl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_VortexDecay); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sigma_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumVortices); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FilterInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vCurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) @@ -424,27 +392,25 @@ subroutine WD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WD_PackInitInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInitInput' - if (Buf%ErrStat >= AbortErrLev) return - call WD_PackInputFileType(Buf, InData%InputFileData) - call RegPack(Buf, InData%TurbNum) - call RegPack(Buf, InData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call WD_PackInputFileType(RF, InData%InputFileData) + call RegPack(RF, InData%TurbNum) + call RegPack(RF, InData%OutFileRoot) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackInitInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInitInput' - if (Buf%ErrStat /= ErrID_None) return - call WD_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData - call RegUnpack(Buf, OutData%TurbNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call WD_UnpackInputFileType(RF, OutData%InputFileData) ! InputFileData + call RegUnpack(RF, OutData%TurbNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -507,62 +473,28 @@ subroutine WD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine WD_PackInitOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInitOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%WriteOutputHdr)) - if (allocated(InData%WriteOutputHdr)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr, kind=B8Ki), ubound(InData%WriteOutputHdr, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputHdr) - end if - call RegPack(Buf, allocated(InData%WriteOutputUnt)) - if (allocated(InData%WriteOutputUnt)) then - call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt, kind=B8Ki), ubound(InData%WriteOutputUnt, kind=B8Ki)) - call RegPack(Buf, InData%WriteOutputUnt) - end if - call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackInitOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputHdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WriteOutputUnt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver end subroutine subroutine WD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -586,22 +518,21 @@ subroutine WD_DestroyContState(ContStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine WD_PackContState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackContState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackContState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackContState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) @@ -854,316 +785,58 @@ subroutine WD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end if end subroutine -subroutine WD_PackDiscState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackDiscState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%xhat_plane)) - if (allocated(InData%xhat_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%xhat_plane, kind=B8Ki), ubound(InData%xhat_plane, kind=B8Ki)) - call RegPack(Buf, InData%xhat_plane) - end if - call RegPack(Buf, allocated(InData%YawErr_filt)) - if (allocated(InData%YawErr_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt, kind=B8Ki), ubound(InData%YawErr_filt, kind=B8Ki)) - call RegPack(Buf, InData%YawErr_filt) - end if - call RegPack(Buf, InData%psi_skew_filt) - call RegPack(Buf, InData%chi_skew_filt) - call RegPack(Buf, allocated(InData%V_plane_filt)) - if (allocated(InData%V_plane_filt)) then - call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt, kind=B8Ki), ubound(InData%V_plane_filt, kind=B8Ki)) - call RegPack(Buf, InData%V_plane_filt) - end if - call RegPack(Buf, allocated(InData%p_plane)) - if (allocated(InData%p_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%p_plane, kind=B8Ki), ubound(InData%p_plane, kind=B8Ki)) - call RegPack(Buf, InData%p_plane) - end if - call RegPack(Buf, allocated(InData%x_plane)) - if (allocated(InData%x_plane)) then - call RegPackBounds(Buf, 1, lbound(InData%x_plane, kind=B8Ki), ubound(InData%x_plane, kind=B8Ki)) - call RegPack(Buf, InData%x_plane) - end if - call RegPack(Buf, allocated(InData%Vx_wake)) - if (allocated(InData%Vx_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vx_wake, kind=B8Ki), ubound(InData%Vx_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wake) - end if - call RegPack(Buf, allocated(InData%Vr_wake)) - if (allocated(InData%Vr_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vr_wake, kind=B8Ki), ubound(InData%Vr_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vr_wake) - end if - call RegPack(Buf, allocated(InData%Vx_wake2)) - if (allocated(InData%Vx_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2, kind=B8Ki), ubound(InData%Vx_wake2, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wake2) - end if - call RegPack(Buf, allocated(InData%Vy_wake2)) - if (allocated(InData%Vy_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2, kind=B8Ki), ubound(InData%Vy_wake2, kind=B8Ki)) - call RegPack(Buf, InData%Vy_wake2) - end if - call RegPack(Buf, allocated(InData%Vz_wake2)) - if (allocated(InData%Vz_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2, kind=B8Ki), ubound(InData%Vz_wake2, kind=B8Ki)) - call RegPack(Buf, InData%Vz_wake2) - end if - call RegPack(Buf, allocated(InData%Vx_wind_disk_filt)) - if (allocated(InData%Vx_wind_disk_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt, kind=B8Ki), ubound(InData%Vx_wind_disk_filt, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wind_disk_filt) - end if - call RegPack(Buf, allocated(InData%TI_amb_filt)) - if (allocated(InData%TI_amb_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt, kind=B8Ki), ubound(InData%TI_amb_filt, kind=B8Ki)) - call RegPack(Buf, InData%TI_amb_filt) - end if - call RegPack(Buf, allocated(InData%D_rotor_filt)) - if (allocated(InData%D_rotor_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt, kind=B8Ki), ubound(InData%D_rotor_filt, kind=B8Ki)) - call RegPack(Buf, InData%D_rotor_filt) - end if - call RegPack(Buf, InData%Vx_rel_disk_filt) - call RegPack(Buf, allocated(InData%Ct_azavg_filt)) - if (allocated(InData%Ct_azavg_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt, kind=B8Ki), ubound(InData%Ct_azavg_filt, kind=B8Ki)) - call RegPack(Buf, InData%Ct_azavg_filt) - end if - call RegPack(Buf, allocated(InData%Cq_azavg_filt)) - if (allocated(InData%Cq_azavg_filt)) then - call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt, kind=B8Ki), ubound(InData%Cq_azavg_filt, kind=B8Ki)) - call RegPack(Buf, InData%Cq_azavg_filt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xhat_plane) + call RegPackAlloc(RF, InData%YawErr_filt) + call RegPack(RF, InData%psi_skew_filt) + call RegPack(RF, InData%chi_skew_filt) + call RegPackAlloc(RF, InData%V_plane_filt) + call RegPackAlloc(RF, InData%p_plane) + call RegPackAlloc(RF, InData%x_plane) + call RegPackAlloc(RF, InData%Vx_wake) + call RegPackAlloc(RF, InData%Vr_wake) + call RegPackAlloc(RF, InData%Vx_wake2) + call RegPackAlloc(RF, InData%Vy_wake2) + call RegPackAlloc(RF, InData%Vz_wake2) + call RegPackAlloc(RF, InData%Vx_wind_disk_filt) + call RegPackAlloc(RF, InData%TI_amb_filt) + call RegPackAlloc(RF, InData%D_rotor_filt) + call RegPack(RF, InData%Vx_rel_disk_filt) + call RegPackAlloc(RF, InData%Ct_azavg_filt) + call RegPackAlloc(RF, InData%Cq_azavg_filt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackDiscState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackDiscState' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xhat_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%YawErr_filt)) deallocate(OutData%YawErr_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%YawErr_filt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%YawErr_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%YawErr_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%psi_skew_filt) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%chi_skew_filt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%V_plane_filt)) deallocate(OutData%V_plane_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_plane_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%p_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_plane(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%x_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vr_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vr_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wake2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vy_wake2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vz_wake2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wind_disk_filt)) deallocate(OutData%Vx_wind_disk_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wind_disk_filt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wind_disk_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%TI_amb_filt)) deallocate(OutData%TI_amb_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TI_amb_filt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%TI_amb_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D_rotor_filt)) deallocate(OutData%D_rotor_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D_rotor_filt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_rotor_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D_rotor_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Vx_rel_disk_filt) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Ct_azavg_filt)) deallocate(OutData%Ct_azavg_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ct_azavg_filt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ct_azavg_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cq_azavg_filt)) deallocate(OutData%Cq_azavg_filt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cq_azavg_filt(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cq_azavg_filt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xhat_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%YawErr_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psi_skew_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi_skew_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_plane_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vr_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wind_disk_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%TI_amb_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D_rotor_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vx_rel_disk_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ct_azavg_filt); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cq_azavg_filt); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) @@ -1187,22 +860,21 @@ subroutine WD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine WD_PackConstrState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackConstrState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackConstrState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackConstrState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1226,22 +898,21 @@ subroutine WD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) ErrMsg = '' end subroutine -subroutine WD_PackOtherState(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackOtherState' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%firstPass) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%firstPass) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackOtherState(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackOtherState' - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%firstPass) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%firstPass); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) @@ -1583,427 +1254,68 @@ subroutine WD_DestroyMisc(MiscData, ErrStat, ErrMsg) end if end subroutine -subroutine WD_PackMisc(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackMisc' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%dvtdr)) - if (allocated(InData%dvtdr)) then - call RegPackBounds(Buf, 1, lbound(InData%dvtdr, kind=B8Ki), ubound(InData%dvtdr, kind=B8Ki)) - call RegPack(Buf, InData%dvtdr) - end if - call RegPack(Buf, allocated(InData%vt_tot)) - if (allocated(InData%vt_tot)) then - call RegPackBounds(Buf, 2, lbound(InData%vt_tot, kind=B8Ki), ubound(InData%vt_tot, kind=B8Ki)) - call RegPack(Buf, InData%vt_tot) - end if - call RegPack(Buf, allocated(InData%vt_amb)) - if (allocated(InData%vt_amb)) then - call RegPackBounds(Buf, 2, lbound(InData%vt_amb, kind=B8Ki), ubound(InData%vt_amb, kind=B8Ki)) - call RegPack(Buf, InData%vt_amb) - end if - call RegPack(Buf, allocated(InData%vt_shr)) - if (allocated(InData%vt_shr)) then - call RegPackBounds(Buf, 2, lbound(InData%vt_shr, kind=B8Ki), ubound(InData%vt_shr, kind=B8Ki)) - call RegPack(Buf, InData%vt_shr) - end if - call RegPack(Buf, allocated(InData%vt_tot2)) - if (allocated(InData%vt_tot2)) then - call RegPackBounds(Buf, 3, lbound(InData%vt_tot2, kind=B8Ki), ubound(InData%vt_tot2, kind=B8Ki)) - call RegPack(Buf, InData%vt_tot2) - end if - call RegPack(Buf, allocated(InData%vt_amb2)) - if (allocated(InData%vt_amb2)) then - call RegPackBounds(Buf, 3, lbound(InData%vt_amb2, kind=B8Ki), ubound(InData%vt_amb2, kind=B8Ki)) - call RegPack(Buf, InData%vt_amb2) - end if - call RegPack(Buf, allocated(InData%vt_shr2)) - if (allocated(InData%vt_shr2)) then - call RegPackBounds(Buf, 3, lbound(InData%vt_shr2, kind=B8Ki), ubound(InData%vt_shr2, kind=B8Ki)) - call RegPack(Buf, InData%vt_shr2) - end if - call RegPack(Buf, allocated(InData%dvx_dy)) - if (allocated(InData%dvx_dy)) then - call RegPackBounds(Buf, 3, lbound(InData%dvx_dy, kind=B8Ki), ubound(InData%dvx_dy, kind=B8Ki)) - call RegPack(Buf, InData%dvx_dy) - end if - call RegPack(Buf, allocated(InData%dvx_dz)) - if (allocated(InData%dvx_dz)) then - call RegPackBounds(Buf, 3, lbound(InData%dvx_dz, kind=B8Ki), ubound(InData%dvx_dz, kind=B8Ki)) - call RegPack(Buf, InData%dvx_dz) - end if - call RegPack(Buf, allocated(InData%nu_dvx_dy)) - if (allocated(InData%nu_dvx_dy)) then - call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy, kind=B8Ki), ubound(InData%nu_dvx_dy, kind=B8Ki)) - call RegPack(Buf, InData%nu_dvx_dy) - end if - call RegPack(Buf, allocated(InData%nu_dvx_dz)) - if (allocated(InData%nu_dvx_dz)) then - call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz, kind=B8Ki), ubound(InData%nu_dvx_dz, kind=B8Ki)) - call RegPack(Buf, InData%nu_dvx_dz) - end if - call RegPack(Buf, allocated(InData%dnuvx_dy)) - if (allocated(InData%dnuvx_dy)) then - call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy, kind=B8Ki), ubound(InData%dnuvx_dy, kind=B8Ki)) - call RegPack(Buf, InData%dnuvx_dy) - end if - call RegPack(Buf, allocated(InData%dnuvx_dz)) - if (allocated(InData%dnuvx_dz)) then - call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz, kind=B8Ki), ubound(InData%dnuvx_dz, kind=B8Ki)) - call RegPack(Buf, InData%dnuvx_dz) - end if - call RegPack(Buf, allocated(InData%a)) - if (allocated(InData%a)) then - call RegPackBounds(Buf, 1, lbound(InData%a, kind=B8Ki), ubound(InData%a, kind=B8Ki)) - call RegPack(Buf, InData%a) - end if - call RegPack(Buf, allocated(InData%b)) - if (allocated(InData%b)) then - call RegPackBounds(Buf, 1, lbound(InData%b, kind=B8Ki), ubound(InData%b, kind=B8Ki)) - call RegPack(Buf, InData%b) - end if - call RegPack(Buf, allocated(InData%c)) - if (allocated(InData%c)) then - call RegPackBounds(Buf, 1, lbound(InData%c, kind=B8Ki), ubound(InData%c, kind=B8Ki)) - call RegPack(Buf, InData%c) - end if - call RegPack(Buf, allocated(InData%d)) - if (allocated(InData%d)) then - call RegPackBounds(Buf, 1, lbound(InData%d, kind=B8Ki), ubound(InData%d, kind=B8Ki)) - call RegPack(Buf, InData%d) - end if - call RegPack(Buf, allocated(InData%r_wake)) - if (allocated(InData%r_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%r_wake, kind=B8Ki), ubound(InData%r_wake, kind=B8Ki)) - call RegPack(Buf, InData%r_wake) - end if - call RegPack(Buf, allocated(InData%Vx_high)) - if (allocated(InData%Vx_high)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_high, kind=B8Ki), ubound(InData%Vx_high, kind=B8Ki)) - call RegPack(Buf, InData%Vx_high) - end if - call RegPack(Buf, allocated(InData%Vx_polar)) - if (allocated(InData%Vx_polar)) then - call RegPackBounds(Buf, 1, lbound(InData%Vx_polar, kind=B8Ki), ubound(InData%Vx_polar, kind=B8Ki)) - call RegPack(Buf, InData%Vx_polar) - end if - call RegPack(Buf, allocated(InData%Vt_wake)) - if (allocated(InData%Vt_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%Vt_wake, kind=B8Ki), ubound(InData%Vt_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vt_wake) - end if - call RegPack(Buf, InData%GammaCurl) - call RegPack(Buf, InData%Ct_avg) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%dvtdr) + call RegPackAlloc(RF, InData%vt_tot) + call RegPackAlloc(RF, InData%vt_amb) + call RegPackAlloc(RF, InData%vt_shr) + call RegPackAlloc(RF, InData%vt_tot2) + call RegPackAlloc(RF, InData%vt_amb2) + call RegPackAlloc(RF, InData%vt_shr2) + call RegPackAlloc(RF, InData%dvx_dy) + call RegPackAlloc(RF, InData%dvx_dz) + call RegPackAlloc(RF, InData%nu_dvx_dy) + call RegPackAlloc(RF, InData%nu_dvx_dz) + call RegPackAlloc(RF, InData%dnuvx_dy) + call RegPackAlloc(RF, InData%dnuvx_dz) + call RegPackAlloc(RF, InData%a) + call RegPackAlloc(RF, InData%b) + call RegPackAlloc(RF, InData%c) + call RegPackAlloc(RF, InData%d) + call RegPackAlloc(RF, InData%r_wake) + call RegPackAlloc(RF, InData%Vx_high) + call RegPackAlloc(RF, InData%Vx_polar) + call RegPackAlloc(RF, InData%Vt_wake) + call RegPack(RF, InData%GammaCurl) + call RegPack(RF, InData%Ct_avg) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackMisc(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackMisc' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%dvtdr)) deallocate(OutData%dvtdr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dvtdr(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvtdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dvtdr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vt_tot)) deallocate(OutData%vt_tot) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vt_tot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vt_tot) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vt_amb)) deallocate(OutData%vt_amb) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vt_amb(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vt_amb) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vt_shr)) deallocate(OutData%vt_shr) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vt_shr(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vt_shr) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vt_tot2)) deallocate(OutData%vt_tot2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vt_tot2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vt_amb2)) deallocate(OutData%vt_amb2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vt_amb2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%vt_shr2)) deallocate(OutData%vt_shr2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%vt_shr2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dvx_dy)) deallocate(OutData%dvx_dy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dvx_dy) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dvx_dz)) deallocate(OutData%dvx_dz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dvx_dz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%nu_dvx_dy)) deallocate(OutData%nu_dvx_dy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%nu_dvx_dy) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%nu_dvx_dz)) deallocate(OutData%nu_dvx_dz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%nu_dvx_dz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dnuvx_dy)) deallocate(OutData%dnuvx_dy) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dnuvx_dy) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%dnuvx_dz)) deallocate(OutData%dnuvx_dz) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%dnuvx_dz) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%a)) deallocate(OutData%a) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%a(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%a) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%b)) deallocate(OutData%b) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%b(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%b.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%b) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%c)) deallocate(OutData%c) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%c(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%c) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%d)) deallocate(OutData%d) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%d(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%d) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%r_wake)) deallocate(OutData%r_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r_wake(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_high)) deallocate(OutData%Vx_high) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_high(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_high) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_polar)) deallocate(OutData%Vx_polar) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_polar(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_polar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_polar) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vt_wake)) deallocate(OutData%Vt_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vt_wake(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vt_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vt_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%GammaCurl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Ct_avg) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%dvtdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_tot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_shr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_tot2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_amb2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%vt_shr2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dvx_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dvx_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nu_dvx_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%nu_dvx_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dnuvx_dy); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%dnuvx_dz); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%a); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%b); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%c); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_high); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_polar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vt_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%GammaCurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Ct_avg); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) @@ -2110,190 +1422,102 @@ subroutine WD_DestroyParam(ParamData, ErrStat, ErrMsg) end if end subroutine -subroutine WD_PackParam(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackParam' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%dt_low) - call RegPack(Buf, InData%NumPlanes) - call RegPack(Buf, InData%NumRadii) - call RegPack(Buf, InData%dr) - call RegPack(Buf, allocated(InData%r)) - if (allocated(InData%r)) then - call RegPackBounds(Buf, 1, lbound(InData%r, kind=B8Ki), ubound(InData%r, kind=B8Ki)) - call RegPack(Buf, InData%r) - end if - call RegPack(Buf, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - call RegPack(Buf, InData%y) - end if - call RegPack(Buf, allocated(InData%z)) - if (allocated(InData%z)) then - call RegPackBounds(Buf, 1, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - call RegPack(Buf, InData%z) - end if - call RegPack(Buf, InData%Mod_Wake) - call RegPack(Buf, InData%Swirl) - call RegPack(Buf, InData%k_VortexDecay) - call RegPack(Buf, InData%sigma_D) - call RegPack(Buf, InData%NumVortices) - call RegPack(Buf, InData%filtParam) - call RegPack(Buf, InData%oneMinusFiltParam) - call RegPack(Buf, InData%C_HWkDfl_O) - call RegPack(Buf, InData%C_HWkDfl_OY) - call RegPack(Buf, InData%C_HWkDfl_x) - call RegPack(Buf, InData%C_HWkDfl_xY) - call RegPack(Buf, InData%C_NearWake) - call RegPack(Buf, InData%C_vAmb_DMin) - call RegPack(Buf, InData%C_vAmb_DMax) - call RegPack(Buf, InData%C_vAmb_FMin) - call RegPack(Buf, InData%C_vAmb_Exp) - call RegPack(Buf, InData%C_vShr_DMin) - call RegPack(Buf, InData%C_vShr_DMax) - call RegPack(Buf, InData%C_vShr_FMin) - call RegPack(Buf, InData%C_vShr_Exp) - call RegPack(Buf, InData%k_vAmb) - call RegPack(Buf, InData%k_vShr) - call RegPack(Buf, InData%Mod_WakeDiam) - call RegPack(Buf, InData%C_WakeDiam) - call RegPack(Buf, InData%FilterInit) - call RegPack(Buf, InData%k_vCurl) - call RegPack(Buf, InData%OutAllPlanes) - call RegPack(Buf, InData%OutFileRoot) - call RegPack(Buf, InData%OutFileVTKDir) - call RegPack(Buf, InData%TurbNum) - call RegPack(Buf, InData%WAT) - call RegPack(Buf, InData%WAT_k_Def) - call RegPack(Buf, InData%WAT_k_Grad) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%dt_low) + call RegPack(RF, InData%NumPlanes) + call RegPack(RF, InData%NumRadii) + call RegPack(RF, InData%dr) + call RegPackAlloc(RF, InData%r) + call RegPackAlloc(RF, InData%y) + call RegPackAlloc(RF, InData%z) + call RegPack(RF, InData%Mod_Wake) + call RegPack(RF, InData%Swirl) + call RegPack(RF, InData%k_VortexDecay) + call RegPack(RF, InData%sigma_D) + call RegPack(RF, InData%NumVortices) + call RegPack(RF, InData%filtParam) + call RegPack(RF, InData%oneMinusFiltParam) + call RegPack(RF, InData%C_HWkDfl_O) + call RegPack(RF, InData%C_HWkDfl_OY) + call RegPack(RF, InData%C_HWkDfl_x) + call RegPack(RF, InData%C_HWkDfl_xY) + call RegPack(RF, InData%C_NearWake) + call RegPack(RF, InData%C_vAmb_DMin) + call RegPack(RF, InData%C_vAmb_DMax) + call RegPack(RF, InData%C_vAmb_FMin) + call RegPack(RF, InData%C_vAmb_Exp) + call RegPack(RF, InData%C_vShr_DMin) + call RegPack(RF, InData%C_vShr_DMax) + call RegPack(RF, InData%C_vShr_FMin) + call RegPack(RF, InData%C_vShr_Exp) + call RegPack(RF, InData%k_vAmb) + call RegPack(RF, InData%k_vShr) + call RegPack(RF, InData%Mod_WakeDiam) + call RegPack(RF, InData%C_WakeDiam) + call RegPack(RF, InData%FilterInit) + call RegPack(RF, InData%k_vCurl) + call RegPack(RF, InData%OutAllPlanes) + call RegPack(RF, InData%OutFileRoot) + call RegPack(RF, InData%OutFileVTKDir) + call RegPack(RF, InData%TurbNum) + call RegPack(RF, InData%WAT) + call RegPack(RF, InData%WAT_k_Def) + call RegPack(RF, InData%WAT_k_Grad) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackParam(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackParam' integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%dt_low) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%dr) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%r)) deallocate(OutData%r) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%r(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%r) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%y) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%z)) deallocate(OutData%z) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%z) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Mod_Wake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Swirl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_VortexDecay) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%sigma_D) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%NumVortices) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%filtParam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%oneMinusFiltParam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_O) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_OY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_x) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_HWkDfl_xY) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_NearWake) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_DMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_DMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_FMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vAmb_Exp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_DMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_DMax) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_FMin) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_vShr_Exp) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_vAmb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_vShr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Mod_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%C_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%FilterInit) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%k_vCurl) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutAllPlanes) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%OutFileVTKDir) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TurbNum) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAT) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAT_k_Def) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%WAT_k_Grad) - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%dt_low); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRadii); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%r); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%z); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_Wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Swirl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_VortexDecay); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%sigma_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumVortices); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%filtParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%oneMinusFiltParam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_O); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_OY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_x); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_HWkDfl_xY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_NearWake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vAmb_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_DMax); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_FMin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_vShr_Exp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vAmb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vShr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Mod_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%C_WakeDiam); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FilterInit); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%k_vCurl); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutAllPlanes); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%OutFileVTKDir); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TurbNum); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Def); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WAT_k_Grad); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -2372,106 +1596,46 @@ subroutine WD_DestroyInput(InputData, ErrStat, ErrMsg) end if end subroutine -subroutine WD_PackInput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, InData%xhat_disk) - call RegPack(Buf, InData%YawErr) - call RegPack(Buf, InData%psi_skew) - call RegPack(Buf, InData%chi_skew) - call RegPack(Buf, InData%p_hub) - call RegPack(Buf, allocated(InData%V_plane)) - if (allocated(InData%V_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%V_plane, kind=B8Ki), ubound(InData%V_plane, kind=B8Ki)) - call RegPack(Buf, InData%V_plane) - end if - call RegPack(Buf, InData%Vx_wind_disk) - call RegPack(Buf, InData%TI_amb) - call RegPack(Buf, InData%D_rotor) - call RegPack(Buf, InData%Vx_rel_disk) - call RegPack(Buf, allocated(InData%Ct_azavg)) - if (allocated(InData%Ct_azavg)) then - call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg, kind=B8Ki), ubound(InData%Ct_azavg, kind=B8Ki)) - call RegPack(Buf, InData%Ct_azavg) - end if - call RegPack(Buf, allocated(InData%Cq_azavg)) - if (allocated(InData%Cq_azavg)) then - call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg, kind=B8Ki), ubound(InData%Cq_azavg, kind=B8Ki)) - call RegPack(Buf, InData%Cq_azavg) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%xhat_disk) + call RegPack(RF, InData%YawErr) + call RegPack(RF, InData%psi_skew) + call RegPack(RF, InData%chi_skew) + call RegPack(RF, InData%p_hub) + call RegPackAlloc(RF, InData%V_plane) + call RegPack(RF, InData%Vx_wind_disk) + call RegPack(RF, InData%TI_amb) + call RegPack(RF, InData%D_rotor) + call RegPack(RF, InData%Vx_rel_disk) + call RegPackAlloc(RF, InData%Ct_azavg) + call RegPackAlloc(RF, InData%Cq_azavg) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackInput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInput' integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - call RegUnpack(Buf, OutData%xhat_disk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%psi_skew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%chi_skew) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%p_hub) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%V_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%V_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - call RegUnpack(Buf, OutData%Vx_wind_disk) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%TI_amb) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%D_rotor) - if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Vx_rel_disk) - if (RegCheckErr(Buf, RoutineName)) return - if (allocated(OutData%Ct_azavg)) deallocate(OutData%Ct_azavg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Ct_azavg(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Ct_azavg) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Cq_azavg)) deallocate(OutData%Cq_azavg) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Cq_azavg(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Cq_azavg) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%xhat_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%YawErr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%psi_skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%chi_skew); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%p_hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%V_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vx_wind_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI_amb); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%D_rotor); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Vx_rel_disk); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Ct_azavg); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Cq_azavg); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2646,212 +1810,42 @@ subroutine WD_DestroyOutput(OutputData, ErrStat, ErrMsg) end if end subroutine -subroutine WD_PackOutput(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF type(WD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackOutput' - if (Buf%ErrStat >= AbortErrLev) return - call RegPack(Buf, allocated(InData%xhat_plane)) - if (allocated(InData%xhat_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%xhat_plane, kind=B8Ki), ubound(InData%xhat_plane, kind=B8Ki)) - call RegPack(Buf, InData%xhat_plane) - end if - call RegPack(Buf, allocated(InData%p_plane)) - if (allocated(InData%p_plane)) then - call RegPackBounds(Buf, 2, lbound(InData%p_plane, kind=B8Ki), ubound(InData%p_plane, kind=B8Ki)) - call RegPack(Buf, InData%p_plane) - end if - call RegPack(Buf, allocated(InData%Vx_wake)) - if (allocated(InData%Vx_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vx_wake, kind=B8Ki), ubound(InData%Vx_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wake) - end if - call RegPack(Buf, allocated(InData%Vr_wake)) - if (allocated(InData%Vr_wake)) then - call RegPackBounds(Buf, 2, lbound(InData%Vr_wake, kind=B8Ki), ubound(InData%Vr_wake, kind=B8Ki)) - call RegPack(Buf, InData%Vr_wake) - end if - call RegPack(Buf, allocated(InData%Vx_wake2)) - if (allocated(InData%Vx_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2, kind=B8Ki), ubound(InData%Vx_wake2, kind=B8Ki)) - call RegPack(Buf, InData%Vx_wake2) - end if - call RegPack(Buf, allocated(InData%Vy_wake2)) - if (allocated(InData%Vy_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2, kind=B8Ki), ubound(InData%Vy_wake2, kind=B8Ki)) - call RegPack(Buf, InData%Vy_wake2) - end if - call RegPack(Buf, allocated(InData%Vz_wake2)) - if (allocated(InData%Vz_wake2)) then - call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2, kind=B8Ki), ubound(InData%Vz_wake2, kind=B8Ki)) - call RegPack(Buf, InData%Vz_wake2) - end if - call RegPack(Buf, allocated(InData%D_wake)) - if (allocated(InData%D_wake)) then - call RegPackBounds(Buf, 1, lbound(InData%D_wake, kind=B8Ki), ubound(InData%D_wake, kind=B8Ki)) - call RegPack(Buf, InData%D_wake) - end if - call RegPack(Buf, allocated(InData%x_plane)) - if (allocated(InData%x_plane)) then - call RegPackBounds(Buf, 1, lbound(InData%x_plane, kind=B8Ki), ubound(InData%x_plane, kind=B8Ki)) - call RegPack(Buf, InData%x_plane) - end if - call RegPack(Buf, allocated(InData%WAT_k_mt)) - if (allocated(InData%WAT_k_mt)) then - call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt, kind=B8Ki), ubound(InData%WAT_k_mt, kind=B8Ki)) - call RegPack(Buf, InData%WAT_k_mt) - end if - if (RegCheckErr(Buf, RoutineName)) return + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%xhat_plane) + call RegPackAlloc(RF, InData%p_plane) + call RegPackAlloc(RF, InData%Vx_wake) + call RegPackAlloc(RF, InData%Vr_wake) + call RegPackAlloc(RF, InData%Vx_wake2) + call RegPackAlloc(RF, InData%Vy_wake2) + call RegPackAlloc(RF, InData%Vz_wake2) + call RegPackAlloc(RF, InData%D_wake) + call RegPackAlloc(RF, InData%x_plane) + call RegPackAlloc(RF, InData%WAT_k_mt) + if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine WD_UnPackOutput(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf +subroutine WD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF type(WD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackOutput' integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%xhat_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%p_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vr_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vr_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vx_wake2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vy_wake2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%Vz_wake2) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D_wake(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%D_wake) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_plane(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%x_plane) - if (RegCheckErr(Buf, RoutineName)) return - end if - if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 3, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%WAT_k_mt) - if (RegCheckErr(Buf, RoutineName)) return - end if + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%xhat_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%p_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vr_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vx_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vy_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Vz_wake2); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%D_wake); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%x_plane); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WAT_k_mt); if (RegCheckErr(RF, RoutineName)) return end subroutine END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE From d99345909aabcf49bad62833fb49dd1f1cd44502 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 16 Jan 2024 13:41:52 +0000 Subject: [PATCH 169/232] Update Generate_NWTC_Library_types.bat to match CMakeLists.txt The CMakeLists.txt now automatically generates modules based on the Registry_NWTC_Library_mesh.txt and Registry_NWTC_Library_base.txt files. It also concatenates these files to create the full Registry_NWTC_Library.txt which is included by other modules. The changes to Generate_NWTC_Library_types.bat replicate this behavior. --- modules/nwtc-library/src/Generate_NWTC_Library_Types.bat | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat index 020b426a71..a55760e8bc 100644 --- a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat +++ b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat @@ -13,11 +13,13 @@ REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- ECHO on :mesh -%REGISTRY% Registry_NWTC_Library_mesh.txt -noextrap +%REGISTRY% Registry_NWTC_Library_mesh.txt -noextrap -subs +type Registry_NWTC_Library_base.txt Registry_NWTC_Library_mesh.txt > Registry_NWTC_Library.txt goto end :nomesh %REGISTRY% Registry_NWTC_Library_base.txt -noextrap +type Registry_NWTC_Library_base.txt Registry_NWTC_Library_mesh.txt > Registry_NWTC_Library.txt :end From 7337f5a6bba4871f5500edb917c126a565032217 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 16 Jan 2024 18:06:02 +0000 Subject: [PATCH 170/232] Fix openfast-registry documentation for -subs option --- modules/openfast-registry/src/main.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/openfast-registry/src/main.cpp b/modules/openfast-registry/src/main.cpp index 445fcc4700..fd5005e89d 100644 --- a/modules/openfast-registry/src/main.cpp +++ b/modules/openfast-registry/src/main.cpp @@ -13,7 +13,7 @@ Usage: openfast_registry registryfile [options] -or- -h this summary -I look for usefrom files in directory "dir" -O generate types files in directory "dir" - -inc generate types file to be included in another file + -subs generate only subroutines (to be included in another file) -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines -D define symbol for conditional evaluation inside registry file -ccode generate additional code for interfacing with C/C++ From 6f53520e487424899b8b28b5b078a57fe08571bb Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 16 Jan 2024 18:06:33 +0000 Subject: [PATCH 171/232] Add ModVar.f90 to projects in vs-build --- vs-build/AeroDyn/AeroDyn_Driver.vfproj | 1 + .../AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj | 1 + vs-build/BeamDyn/BeamDyn.vfproj | 1 + vs-build/FASTlib/FASTlib.vfproj | 1 + vs-build/HydroDyn/HydroDynDriver.vfproj | 1 + vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj | 1 + vs-build/InflowWind/InflowWind_driver.vfproj | 1 + vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj | 1 + vs-build/MoorDyn/MoorDynDriver.vfproj | 1 + vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj | 1 + vs-build/SeaState/SeaStateDriver.vfproj | 1 + vs-build/SubDyn/SubDyn.vfproj | 1 + vs-build/TurbSim/TurbSim.vfproj | 1 + vs-build/UnsteadyAero/UnsteadyAero.vfproj | 1 + 14 files changed, 14 insertions(+) diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index 98a04e0a8b..fc5edafe0d 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -930,6 +930,7 @@ + diff --git a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj index e1b544cdf7..4f5a544cf0 100644 --- a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj +++ b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj @@ -1011,6 +1011,7 @@ + diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index e5a72c25eb..1e516287f6 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -201,6 +201,7 @@ + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 983b157bf4..854272c9bc 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -1975,6 +1975,7 @@ + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 961854b6bb..82488ba7a2 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -368,6 +368,7 @@ + diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 7bcec48d49..4481a2cde7 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -257,6 +257,7 @@ + diff --git a/vs-build/InflowWind/InflowWind_driver.vfproj b/vs-build/InflowWind/InflowWind_driver.vfproj index 35ec74eefc..61993f00be 100644 --- a/vs-build/InflowWind/InflowWind_driver.vfproj +++ b/vs-build/InflowWind/InflowWind_driver.vfproj @@ -258,6 +258,7 @@ + diff --git a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj index 49bd328500..28e5fcef81 100644 --- a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj +++ b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj @@ -218,6 +218,7 @@ + diff --git a/vs-build/MoorDyn/MoorDynDriver.vfproj b/vs-build/MoorDyn/MoorDynDriver.vfproj index 42279628c3..473ae204fa 100644 --- a/vs-build/MoorDyn/MoorDynDriver.vfproj +++ b/vs-build/MoorDyn/MoorDynDriver.vfproj @@ -171,6 +171,7 @@ + diff --git a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj index 6d2f237551..8216ac5dd4 100644 --- a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj +++ b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj @@ -193,6 +193,7 @@ + diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index c9a4786e34..208b6ce568 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -147,6 +147,7 @@ + diff --git a/vs-build/SubDyn/SubDyn.vfproj b/vs-build/SubDyn/SubDyn.vfproj index 188f4cca03..b4d5eaf9c5 100644 --- a/vs-build/SubDyn/SubDyn.vfproj +++ b/vs-build/SubDyn/SubDyn.vfproj @@ -160,6 +160,7 @@ + diff --git a/vs-build/TurbSim/TurbSim.vfproj b/vs-build/TurbSim/TurbSim.vfproj index 1f07d1efd5..cbe8def283 100644 --- a/vs-build/TurbSim/TurbSim.vfproj +++ b/vs-build/TurbSim/TurbSim.vfproj @@ -55,6 +55,7 @@ + diff --git a/vs-build/UnsteadyAero/UnsteadyAero.vfproj b/vs-build/UnsteadyAero/UnsteadyAero.vfproj index afc6eb7f96..4cb89b2f83 100644 --- a/vs-build/UnsteadyAero/UnsteadyAero.vfproj +++ b/vs-build/UnsteadyAero/UnsteadyAero.vfproj @@ -186,6 +186,7 @@ + From f48f325f8977dc9ff92a32fc4198d50b256dd237 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 16 Jan 2024 18:17:14 +0000 Subject: [PATCH 172/232] Use _IncSubs.90 for registry generated subroutines file --- modules/nwtc-library/CMakeLists.txt | 4 ++-- modules/nwtc-library/src/Generate_NWTC_Library_Types.bat | 2 +- modules/nwtc-library/src/ModMesh_Mapping.f90 | 2 +- .../src/{NWTC_Library_Subs.f90 => NWTC_Library_IncSubs.f90} | 0 modules/openfast-registry/src/main.cpp | 6 +++--- modules/openfast-registry/src/registry.hpp | 2 +- modules/openfast-registry/src/registry_gen_fortran.cpp | 6 +++--- 7 files changed, 11 insertions(+), 11 deletions(-) rename modules/nwtc-library/src/{NWTC_Library_Subs.f90 => NWTC_Library_IncSubs.f90} (100%) diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index dc0e51e50d..bad52c35ee 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -16,7 +16,7 @@ if (GENERATE_TYPES) generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Types.f90 -noextrap) - generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Subs.f90 -subs -noextrap) + generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Subs.f90 -incsubs -noextrap) # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS src/Registry_NWTC_Library_mesh.txt @@ -149,7 +149,7 @@ if (CMAKE_BUILD_TYPE MATCHES Debug) endif() endif() -add_custom_target(nwtc_library_subs DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Subs.f90) +add_custom_target(nwtc_library_subs DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90) # Create NWTC Library add_library(nwtclibs STATIC diff --git a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat index a55760e8bc..772880fca3 100644 --- a/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat +++ b/modules/nwtc-library/src/Generate_NWTC_Library_Types.bat @@ -13,7 +13,7 @@ REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- ECHO on :mesh -%REGISTRY% Registry_NWTC_Library_mesh.txt -noextrap -subs +%REGISTRY% Registry_NWTC_Library_mesh.txt -noextrap -incsubs type Registry_NWTC_Library_base.txt Registry_NWTC_Library_mesh.txt > Registry_NWTC_Library.txt goto end diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index c0ef92fbd9..69cec3db98 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -5761,7 +5761,7 @@ END SUBROUTINE WriteMappingTransferToFile !---------------------------------------------------------------------------------------------------------------------------------- ! Include the registry generated subroutines for mesh types -include "NWTC_Library_Subs.f90" +include "NWTC_Library_IncSubs.f90" !---------------------------------------------------------------------------------------------------------------------------------- END MODULE ModMesh_Mapping diff --git a/modules/nwtc-library/src/NWTC_Library_Subs.f90 b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 similarity index 100% rename from modules/nwtc-library/src/NWTC_Library_Subs.f90 rename to modules/nwtc-library/src/NWTC_Library_IncSubs.f90 diff --git a/modules/openfast-registry/src/main.cpp b/modules/openfast-registry/src/main.cpp index fd5005e89d..7f7250ae1b 100644 --- a/modules/openfast-registry/src/main.cpp +++ b/modules/openfast-registry/src/main.cpp @@ -13,7 +13,7 @@ Usage: openfast_registry registryfile [options] -or- -h this summary -I look for usefrom files in directory "dir" -O generate types files in directory "dir" - -subs generate only subroutines (to be included in another file) + -incsubs generate the pack/unpack/copy/destroy subroutines to be included in another file -noextrap do not generate ModName_Input_ExtrapInterp or ModName_Output_ExtrapInterp routines -D define symbol for conditional evaluation inside registry file -ccode generate additional code for interfacing with C/C++ @@ -86,9 +86,9 @@ int main(int argc, char *argv[]) reg.include_dirs.push_back(*it); } } - else if ((arg.compare("-subs")) == 0 || (arg.compare("/subs")) == 0) + else if ((arg.compare("-incsubs")) == 0 || (arg.compare("/incsubs")) == 0) { - reg.gen_subs = true; + reg.gen_inc_subs = true; } else if ((arg.compare("-template")) == 0 || (arg.compare("-registry")) == 0 || (arg.compare("/template")) == 0 || (arg.compare("/registry")) == 0) diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index 696f411c40..f615fb7a15 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -440,7 +440,7 @@ struct Registry std::map, ci_less> data_types; bool gen_c_code = false; bool no_extrap_interp = false; - bool gen_subs = false; + bool gen_inc_subs = false; Registry() { diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 9a407c184d..221448dada 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -63,9 +63,9 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) { // Create file name and path auto file_name = mod.name + "_Types.f90"; - if (this->gen_subs) + if (this->gen_inc_subs) { - file_name = mod.name + "_Subs.f90"; + file_name = mod.name + "_IncSubs.f90"; } auto file_path = out_dir + "/" + file_name; std::cerr << "generating " << file_name << std::endl; @@ -81,7 +81,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // If flag set to generate subroutines only (e.g. for inclusing in ModMesh_Mappings.f90) // write header, subs, and footer to file, then return - if (this->gen_subs) + if (this->gen_inc_subs) { w << std::regex_replace("!STARTOFREGISTRYGENERATEDFILE 'ModuleName_Subs.f90'\n", std::regex("ModuleName"), mod.name); w << "!\n! WARNING This file is generated automatically by the FAST registry.\n"; From 25fb3b098d201265fba4c08c22553cdac9c6c6c3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 16 Jan 2024 19:08:48 +0000 Subject: [PATCH 173/232] Fix bug in openfast-cpp CMakeLists.txt runtime install destination The install runtime destination was set to lib, this commit changes it to bin --- glue-codes/openfast-cpp/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/glue-codes/openfast-cpp/CMakeLists.txt b/glue-codes/openfast-cpp/CMakeLists.txt index 55823e0465..658d502a01 100644 --- a/glue-codes/openfast-cpp/CMakeLists.txt +++ b/glue-codes/openfast-cpp/CMakeLists.txt @@ -72,7 +72,7 @@ endif(MPI_LINK_FLAGS) install(TARGETS openfastcpp openfastcpplib EXPORT "${CMAKE_PROJECT_NAME}Libraries" - RUNTIME DESTINATION lib + RUNTIME DESTINATION bin ARCHIVE DESTINATION lib LIBRARY DESTINATION lib PUBLIC_HEADER DESTINATION include From bbcbf89cc3dada3ee09dcf7eacc464e05e3a0913 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 16 Jan 2024 19:24:00 +0000 Subject: [PATCH 174/232] Fix name of output file in generate_f90_types for Registry_NWTC_Library_mesh.txt and change custom target name --- modules/nwtc-library/CMakeLists.txt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index bad52c35ee..de91776fea 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -16,7 +16,7 @@ if (GENERATE_TYPES) generate_f90_types(src/Registry_NWTC_Library_base.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Types.f90 -noextrap) - generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_Subs.f90 -incsubs -noextrap) + generate_f90_types(src/Registry_NWTC_Library_mesh.txt ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90 -incsubs -noextrap) # Generate Registry_NWTC_Library.txt by concatenating _base.txt and _mesh.txt set_property(DIRECTORY APPEND PROPERTY CMAKE_CONFIGURE_DEPENDS src/Registry_NWTC_Library_mesh.txt @@ -149,14 +149,14 @@ if (CMAKE_BUILD_TYPE MATCHES Debug) endif() endif() -add_custom_target(nwtc_library_subs DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90) +add_custom_target(nwtc_library_inc_subs DEPENDS ${CMAKE_CURRENT_SOURCE_DIR}/src/NWTC_Library_IncSubs.f90) # Create NWTC Library add_library(nwtclibs STATIC ${NWTC_SYS_FILE} ${NWTCLIBS_SOURCES} ) -add_dependencies(nwtclibs nwtc_library_subs) +add_dependencies(nwtclibs nwtc_library_inc_subs) target_link_libraries(nwtclibs PUBLIC ${LAPACK_LIBRARIES} ${CMAKE_DL_LIBS} From 4dd1b9c96c4a32e84d26ae281c8dc62af221c598 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 16 Jan 2024 12:53:40 -0700 Subject: [PATCH 175/232] AWAE: Mod_AmbWind=3 modify checks from GH PR suggestions --- modules/awae/src/AWAE.f90 | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index 7ba865997a..4710c2dcf9 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -1278,8 +1278,8 @@ subroutine CheckModAmb3Boundaries() ff => p%IfW(nt)%FlowField wfi => IfW_InitOut%WindFileInfo - tmpMsg = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the InflowWind high-res grid '// & - 'is entirely contained within the high-res flow-field from InflowWind. '//NewLine//' Try setting:'//NewLine + tmpMsg = NewLine//NewLine//'Turbine '//trim(Num2LStr(nt))//' -- Mod_AmbWind=3 requires the FAST.Farm high-res grid '// & + 'is entirely contained within the flow-field from InflowWind. '//NewLine//' Try setting:'//NewLine ! check Z limits, if ZRange is limited (we don't care what kind of wind) if (wfi%ZRange_Limited) then @@ -1299,17 +1299,17 @@ subroutine CheckModAmb3Boundaries() ErrMsg2=trim(ErrMsg2)//NewLine//' dZ_High = '//trim(Num2LStr(Dxyz)) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) endif + ErrMsg2=NewLine//' for Turbine '//trim(Num2LStr(nt)) endif endif - ! check X/Y limits if range limited. Depends on orientation of winds. + ! check FlowField Y limits if range limited. Depends on orientation of winds. if (wfi%YRange_Limited) then - ! flow field limits (with grid tolerance) - ff_lim(1) = p%WT_Position(2,nt) + wfi%YRange(1) - GridTol - ff_lim(2) = p%WT_Position(2,nt) + wfi%YRange(2) + GridTol - ! wind X aligned with high-res X - if (.not. ff%RotateWindBox) then + if ((.not. ff%RotateWindBox) .or. EqualRealNos(abs(ff%PropagationDir),Pi)) then + ! flow field limits (with grid tolerance) + ff_lim(1) = p%WT_Position(2,nt) + wfi%YRange(1) - GridTol + ff_lim(2) = p%WT_Position(2,nt) + wfi%YRange(2) + GridTol ! high-res Y limits hr_lim(1) = p%Y0_High(nt) hr_lim(2) = p%Y0_High(nt) + (real(p%nY_high,ReKi)-1.0_ReKi)*p%dY_high(nt) @@ -1323,10 +1323,14 @@ subroutine CheckModAmb3Boundaries() ErrMsg2=trim(ErrMsg2)//NewLine//' dY_High = '//trim(Num2LStr(Dxyz)) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) endif + ErrMsg2=NewLine//' for Turbine '//trim(Num2LStr(nt)) endif ! wind X aligned with high-res Y elseif (EqualRealNos(abs(ff%PropagationDir),PiBy2)) then + ! flow field limits (with grid tolerance) + ff_lim(1) = p%WT_Position(1,nt) + wfi%YRange(1) - GridTol + ff_lim(2) = p%WT_Position(1,nt) + wfi%YRange(2) + GridTol ! high-res X limits hr_lim(1) = p%X0_High(nt) hr_lim(2) = p%X0_High(nt) + (real(p%nX_high,ReKi)-1.0_ReKi)*p%dX_high(nt) @@ -1340,6 +1344,7 @@ subroutine CheckModAmb3Boundaries() ErrMsg2=trim(ErrMsg2)//NewLine//' dX_High = '//trim(Num2LStr(Dxyz)) call SetErrStat ( errStat2, errMsg2, errStat, errMsg, RoutineName ) endif + ErrMsg2=NewLine//' for Turbine '//trim(Num2LStr(nt)) endif elseif (.not. EqualRealNos(ff%PropagationDir,0.0_ReKi)) then ! wind not aligned with X or Y. This is not allowed at present ErrStat2 = ErrID_Fatal From 66a7547437882756a407f9ae9c4c1e984f39a3aa Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 16 Jan 2024 14:00:14 -0700 Subject: [PATCH 176/232] update changelog --- docs/changelogs/v3.5.2.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/docs/changelogs/v3.5.2.md b/docs/changelogs/v3.5.2.md index bae421240d..e28b4dbed0 100644 --- a/docs/changelogs/v3.5.2.md +++ b/docs/changelogs/v3.5.2.md @@ -44,6 +44,10 @@ See GitHub Actions #1913 ADI: memory leak in ADI_UpdateStates +### AWAE + +#1963 FAST.Farm, Mod_AmbWind=3: add error if HR grid not centered on turbine in Y dimension + ### HydroDyn #1872 Fix segfault in HD when no outputs specified From 2acce08433fe1a7ee34067ddf33d3f051cc2e2e8 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Tue, 16 Jan 2024 16:24:04 -0700 Subject: [PATCH 177/232] MD version update --- modules/moordyn/src/MoorDyn.f90 | 4 ++-- modules/moordyn/src/MoorDyn_Driver.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index ebde8cf519..54d8f1420f 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -34,7 +34,7 @@ MODULE MoorDyn PRIVATE - TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', 'v2.0.0', '2023-09-18' ) + TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', 'v2.2.2', '2024-01-16' ) INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output @@ -163,7 +163,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er InitOut%Ver = MD_ProgDesc CALL WrScr(' This is MoorDyn v2, with significant input file changes from v1.') - CALL WrScr(' Copyright: (C) 2023 National Renewable Energy Laboratory, (C) 2019 Matt Hall') + CALL WrScr(' Copyright: (C) 2024 National Renewable Energy Laboratory, (C) 2019 Matt Hall') !--------------------------------------------------------------------------------------------- diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 3fbe8b580a..26628b1634 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -132,7 +132,7 @@ PROGRAM MoorDyn_Driver IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() ! Display the copyright notice - CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2021 NREL, 2019 Matt Hall' ) + CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2024 NREL, 2019 Matt Hall' ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running @@ -144,7 +144,7 @@ PROGRAM MoorDyn_Driver CALL CPU_TIME ( ProgStrtCPU ) ! Initial time (this zeros the start time when used as a MATLAB function) - CALL WrScr( ' MD Driver updated 2022-01-12') + CALL WrScr( ' MD Driver updated 2024-01-16') ! Parse the driver input file and run the simulation based on that file CALL get_command_argument(1, drvrFilename) From 672b29f9270d7ea8b3015fc76cc78ef6c4cab811 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 17 Jan 2024 13:59:31 -0700 Subject: [PATCH 178/232] SeaState: fix grid size in wave surface visualization --- .../openfast-library/src/FAST_Registry.txt | 5 +- modules/openfast-library/src/FAST_Subs.f90 | 192 ++++++------------ modules/openfast-library/src/FAST_Types.f90 | 82 +++++--- modules/seastate/src/SeaState.f90 | 116 ++++++++--- modules/seastate/src/SeaState.txt | 9 +- modules/seastate/src/SeaState_DriverCode.f90 | 84 ++++---- modules/seastate/src/SeaState_Types.f90 | 98 +++++---- 7 files changed, 316 insertions(+), 270 deletions(-) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index e11ad319c4..08822a8140 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -76,8 +76,9 @@ typedef ^ FAST_VTK_SurfaceType SiKi GroundRad - - - "radius for plotting circle typedef ^ FAST_VTK_SurfaceType SiKi NacelleBox {3}{8} - - "X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position" m typedef ^ FAST_VTK_SurfaceType SiKi TowerRad {:} - - "radius of each ED tower node" m typedef ^ FAST_VTK_SurfaceType IntKi NWaveElevPts {2} - - "number of points for wave elevation visualization" - -typedef ^ FAST_VTK_SurfaceType SiKi WaveElevXY {:}{:} - - "X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" -typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveElevXY; first dimension is time step; second dimension is point number" "m,-" +typedef ^ FAST_VTK_SurfaceType SiKi WaveElevVisX {:} - - "X locations for WaveElev output (for visualization)." "m,-" +typedef ^ FAST_VTK_SurfaceType SiKi WaveElevVisY {:} - - "Y locations for WaveElev output (for visualization)." "m,-" +typedef ^ FAST_VTK_SurfaceType SiKi WaveElevVisGrid {:}{:}{:} - - "wave elevation at WaveElevVis{XY}; first dimension is time step; second/third dimensions are grid of elevations" "m,-" typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m typedef ^ FAST_VTK_SurfaceType SiKi MorisonVisRad {:} - - "radius of each Morison node" m diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 1732086c5f..0954c7b2e6 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -776,20 +776,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF - ! ........................ - ! set some VTK parameters required before SeaState init (so we can get wave elevations for visualization) - ! ........................ - - ! get wave elevation data for visualization - if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters_B4SeaSt(p_FAST, Init%OutData_ED, Init%InData_SeaSt, BD, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - end if - ! ........................ ! initialize SeaStates ! ........................ @@ -816,9 +802,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_SeaSt%WaveFieldMod = p_FAST%WaveFieldMod Init%InData_SeaSt%PtfmLocationX = p_FAST%TurbinePos(1) Init%InData_SeaSt%PtfmLocationY = p_FAST%TurbinePos(2) - + Init%InData_SeaSt%TMax = p_FAST%TMax + ! wave field visualization + if (p_FAST%WrVTK == VTK_Animate .and. p_FAST%VTK_Type == VTK_Surf) Init%InData_SeaSt%SurfaceVis = .true. + CALL SeaSt_Init( Init%InData_SeaSt, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, p_FAST%dt_module( MODULE_SeaSt ), Init%OutData_SeaSt, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -826,7 +815,15 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%ModuleInitialized(Module_SeaSt) = .TRUE. CALL SetModuleSubstepTime(Module_SeaSt, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + + if (allocated(Init%OutData_SeaSt%WaveElevVisGrid)) then + p_FAST%VTK_surface%NWaveElevPts(1) = size(Init%OutData_SeaSt%WaveElevVisX) + p_FAST%VTK_surface%NWaveElevPts(2) = size(Init%OutData_SeaSt%WaveElevVisX) + else + p_FAST%VTK_surface%NWaveElevPts(1) = 0 + p_FAST%VTK_surface%NWaveElevPts(2) = 0 + endif + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -3795,75 +3792,6 @@ end subroutine cleanup !............................................................................................................................... END SUBROUTINE FAST_ReadSteadyStateFile !---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets up some of the information needed for plotting VTK surfaces. It initializes only the data needed before -!! SeaState initialization. (SeaSt needs some of this data so it can return the wave elevation data we want.) -SUBROUTINE SetVTKParameters_B4SeaSt(p_FAST, InitOutData_ED, InitInData_SeaSt, BD, ErrStat, ErrMsg) - - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code - TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module - TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInData_SeaSt !< The initialization input to SeaState - TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - REAL(SiKi) :: BladeLength, HubRad, Width, WidthBy2 - REAL(SiKi) :: dx, dy - INTEGER(IntKi) :: i, j, n - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters_B4SeaSt' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! Get radius for ground (blade length + hub radius): - if ( p_FAST%CompElast == Module_BD ) then - BladeLength = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) - HubRad = InitOutData_ED%HubRad - else - BladeLength = InitOutData_ED%BladeLength - HubRad = InitOutData_ED%HubRad - end if - p_FAST%VTK_Surface%HubRad = HubRad - p_FAST%VTK_Surface%GroundRad = BladeLength + HubRad - - !........................................................................................................ - ! We don't use the rest of this routine for stick-figure output - if (p_FAST%VTK_Type /= VTK_Surf) return - !........................................................................................................ - - ! initialize wave elevation data: - if ( p_FAST%CompSeaSt == Module_SeaSt ) then - - p_FAST%VTK_surface%NWaveElevPts(1) = 25 - p_FAST%VTK_surface%NWaveElevPts(2) = 25 - - call allocAry( InitInData_SeaSt%WaveElevXY, 2, p_FAST%VTK_surface%NWaveElevPts(1)*p_FAST%VTK_surface%NWaveElevPts(2), 'WaveElevXY', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - Width = p_FAST%VTK_Surface%GroundRad * VTK_GroundFactor - if (p_FAST%MHK /= MHK_None) Width = Width * 5.0_SiKi - dx = Width / (p_FAST%VTK_surface%NWaveElevPts(1) - 1) - dy = Width / (p_FAST%VTK_surface%NWaveElevPts(2) - 1) - - WidthBy2 = Width / 2.0_SiKi - n = 1 - do i=1,p_FAST%VTK_surface%NWaveElevPts(1) - do j=1,p_FAST%VTK_surface%NWaveElevPts(2) - InitInData_SeaSt%WaveElevXY(1,n) = dx*(i-1) - WidthBy2 ! SeaSt takes p_FAST%TurbinePos into account already - InitInData_SeaSt%WaveElevXY(2,n) = dy*(j-1) - WidthBy2 - n = n+1 - end do - end do - - end if - - -END SUBROUTINE SetVTKParameters_B4SeaSt -!---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the information needed for plotting VTK surfaces. SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_SeaSt, InitOutData_SeaSt, InitOutData_HD, ED, BD, AD, HD, ErrStat, ErrMsg) @@ -3883,6 +3811,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S REAL(SiKi) :: RefPoint(3), RefLengths(2) REAL(SiKi) :: x, y REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength + REAL(SiKi) :: BladeLength, HubRad INTEGER(IntKi) :: topNode, baseNode INTEGER(IntKi) :: NumBl, k, Indx LOGICAL :: UseADtwr @@ -3921,10 +3850,18 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S NumBl = InitOutData_ED%NumBl ! initialize the vtk data - p_FAST%VTK_Surface%NumSectors = 25 - ! NOTE: we set p_FAST%VTK_Surface%GroundRad and p_FAST%VTK_Surface%HubRad in SetVTKParameters_B4SeaSt + ! Get radius for ground (blade length + hub radius): + if ( p_FAST%CompElast == Module_BD ) then + BladeLength = TwoNorm(BD%y(1)%BldMotion%Position(:,1) - BD%y(1)%BldMotion%Position(:,BD%y(1)%BldMotion%Nnodes)) + HubRad = InitOutData_ED%HubRad + else + BladeLength = InitOutData_ED%BladeLength + HubRad = InitOutData_ED%HubRad + end if + p_FAST%VTK_Surface%HubRad = HubRad + p_FAST%VTK_Surface%GroundRad = BladeLength + HubRad ! write the ground or seabed reference polygon: RefPoint = p_FAST%TurbinePos @@ -4070,13 +4007,18 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S !....................... !bjj: interpolate here instead of each time step? - if ( allocated(InitOutData_SeaSt%WaveElevSeries) ) then - call move_alloc( InitInData_SeaSt%WaveElevXY, p_FAST%VTK_Surface%WaveElevXY ) - call move_alloc( InitOutData_SeaSt%WaveElevSeries, p_FAST%VTK_Surface%WaveElev ) + if ( allocated(InitOutData_SeaSt%WaveElevVisGrid) ) then +print*,'Storing Wave surface visualization' + call move_alloc( InitOutData_SeaSt%WaveElevVisX, p_FAST%VTK_Surface%WaveElevVisX ) + call move_alloc( InitOutData_SeaSt%WaveElevVisY, p_FAST%VTK_Surface%WaveElevVisY ) + call move_alloc( InitOutData_SeaSt%WaveElevVisGrid,p_FAST%VTK_Surface%WaveElevVisGrid ) ! put the following lines in loops to avoid stack-size issues: - do k=1,size(p_FAST%VTK_Surface%WaveElevXY,2) - p_FAST%VTK_Surface%WaveElevXY(:,k) = p_FAST%VTK_Surface%WaveElevXY(:,k) + p_FAST%TurbinePos(1:2) + do k=1,size(p_FAST%VTK_Surface%WaveElevVisX) + p_FAST%VTK_Surface%WaveElevVisX(k) = p_FAST%VTK_Surface%WaveElevVisX(k) + p_FAST%TurbinePos(1) + end do + do k=1,size(p_FAST%VTK_Surface%WaveElevVisY) + p_FAST%VTK_Surface%WaveElevVisY(k) = p_FAST%VTK_Surface%WaveElevVisY(k) + p_FAST%TurbinePos(2) end do end if @@ -6375,7 +6317,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! Ground (written at initialization) ! Wave elevation - if ( allocated( p_FAST%VTK_Surface%WaveElev ) ) call WrVTK_WaveElev( t_global, p_FAST, y_FAST, SeaSt) + if ( allocated( p_FAST%VTK_Surface%WaveElevVisGrid ) ) call WrVTK_WaveElevVisGrid( t_global, p_FAST, y_FAST, SeaSt) if (allocated(ED%Input)) then ! Nacelle @@ -6480,7 +6422,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW END SUBROUTINE WrVTK_Surfaces !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine writes the wave elevation data for a given time step -SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, SeaSt) +SUBROUTINE WrVTK_WaveElevVisGrid(t_global, p_FAST, y_FAST, SeaSt) REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -6499,10 +6441,10 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, SeaSt) CHARACTER(1024) :: Tstr INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElev' + CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElevVisGrid' - NumberOfPoints = size(p_FAST%VTK_surface%WaveElevXY,2) + NumberOfPoints = p_FAST%VTK_surface%NWaveElevPts(1) * p_FAST%VTK_surface%NWaveElevPts(2) ! I'm going to make triangles for now. we should probably just make this a structured file at some point NumberOfPolys = ( p_FAST%VTK_surface%NWaveElevPts(1) - 1 ) * & ( p_FAST%VTK_surface%NWaveElevPts(2) - 1 ) * 2 @@ -6520,49 +6462,47 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, SeaSt) if (ErrStat2 >= AbortErrLev) return ! points (nodes, augmented with NumSegments): - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value - t = REAL(t_global,SiKi) - call GetWaveElevIndx( t, SeaSt%p%WaveField%WaveTime, y_FAST%VTK_LastWaveIndx ) + ! I'm not going to interpolate in time; I'm just going to get the index of the closest wave time value + t = REAL(t_global,SiKi) + call GetWaveElevIndx( t, SeaSt%p%WaveField%WaveTime, y_FAST%VTK_LastWaveIndx ) - n = 1 - do ix=1,p_FAST%VTK_surface%NWaveElevPts(1) - do iy=1,p_FAST%VTK_surface%NWaveElevPts(2) - WRITE(Un,VTK_AryFmt) p_FAST%VTK_surface%WaveElevXY(:,n), p_FAST%VTK_surface%WaveElev(y_FAST%VTK_LastWaveIndx,n) - n = n+1 - end do + do ix=1,p_FAST%VTK_surface%NWaveElevPts(1) + do iy=1,p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,VTK_AryFmt) p_FAST%VTK_surface%WaveElevVisX(ix), p_FAST%VTK_surface%WaveElevVisX(iy), p_FAST%VTK_surface%WaveElevVisGrid(y_FAST%VTK_LastWaveIndx,ix,iy) end do + end do - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - do ix=1,p_FAST%VTK_surface%NWaveElevPts(1)-1 - do iy=1,p_FAST%VTK_surface%NWaveElevPts(2)-1 - n = p_FAST%VTK_surface%NWaveElevPts(1)*(ix-1)+iy - 1 ! points start at 0 + do ix=1,p_FAST%VTK_surface%NWaveElevPts(1)-1 + do iy=1,p_FAST%VTK_surface%NWaveElevPts(2)-1 + n = p_FAST%VTK_surface%NWaveElevPts(1)*(ix-1)+iy - 1 ! points start at 0 - WRITE(Un,'(3(i7))') n, n+1, n+p_FAST%VTK_surface%NWaveElevPts(2) - WRITE(Un,'(3(i7))') n+1, n+1+p_FAST%VTK_surface%NWaveElevPts(2), n+p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,'(3(i7))') n, n+1, n+p_FAST%VTK_surface%NWaveElevPts(2) + WRITE(Un,'(3(i7))') n+1, n+1+p_FAST%VTK_surface%NWaveElevPts(2), n+p_FAST%VTK_surface%NWaveElevPts(2) - end do end do - WRITE(Un,'(A)') ' ' + end do + WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' - do n=1,NumberOfPolys - WRITE(Un,'(i7)') 3*n - end do - WRITE(Un,'(A)') ' ' - WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' + do n=1,NumberOfPolys + WRITE(Un,'(i7)') 3*n + end do + WRITE(Un,'(A)') ' ' + WRITE(Un,'(A)') ' ' - call WrVTK_footer( Un ) + call WrVTK_footer( Un ) -END SUBROUTINE WrVTK_WaveElev +END SUBROUTINE WrVTK_WaveElevVisGrid !---------------------------------------------------------------------------------------------------------------------------------- !> This function returns the index, Ind, of the XAry closest to XValIn, where XAry is assumed to be periodic. It starts !! searching at the value of Ind from a previous step. diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 8c5b43ef30..69cf370a60 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -92,8 +92,9 @@ MODULE FAST_Types REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TowerRad !< radius of each ED tower node [m] INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts = 0_IntKi !< number of points for wave elevation visualization [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< wave elevation at WaveElevXY; first dimension is time step; second dimension is point number [m,-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisX !< X locations for WaveElev output (for visualization). [m,-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations for WaveElev output (for visualization). [m,-] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< wave elevation at WaveElevVis{XY}; first dimension is time step; second/third dimensions are grid of elevations [m,-] TYPE(FAST_VTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonVisRad !< radius of each Morison node [m] END TYPE FAST_VTK_SurfaceType @@ -896,8 +897,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' @@ -920,29 +921,41 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad end if DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts - if (allocated(SrcVTK_SurfaceTypeData%WaveElevXY)) then - LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElevXY, kind=B8Ki) - UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElevXY, kind=B8Ki) - if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevXY)) then - allocate(DstVTK_SurfaceTypeData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisX)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisX, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisX, kind=B8Ki) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisX)) then + allocate(DstVTK_SurfaceTypeData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevXY.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevVisX.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY + DstVTK_SurfaceTypeData%WaveElevVisX = SrcVTK_SurfaceTypeData%WaveElevVisX end if - if (allocated(SrcVTK_SurfaceTypeData%WaveElev)) then - LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElev, kind=B8Ki) - UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElev, kind=B8Ki) - if (.not. allocated(DstVTK_SurfaceTypeData%WaveElev)) then - allocate(DstVTK_SurfaceTypeData%WaveElev(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisY)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisY, kind=B8Ki) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisY, kind=B8Ki) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisY)) then + allocate(DstVTK_SurfaceTypeData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElev.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevVisY.', ErrStat, ErrMsg, RoutineName) return end if end if - DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev + DstVTK_SurfaceTypeData%WaveElevVisY = SrcVTK_SurfaceTypeData%WaveElevVisY + end if + if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisGrid)) then + LB(1:3) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisGrid, kind=B8Ki) + UB(1:3) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisGrid, kind=B8Ki) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisGrid)) then + allocate(DstVTK_SurfaceTypeData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevVisGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElevVisGrid = SrcVTK_SurfaceTypeData%WaveElevVisGrid end if if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) @@ -978,8 +991,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) type(FAST_VTK_SurfaceType), intent(inout) :: VTK_SurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' @@ -988,11 +1001,14 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) if (allocated(VTK_SurfaceTypeData%TowerRad)) then deallocate(VTK_SurfaceTypeData%TowerRad) end if - if (allocated(VTK_SurfaceTypeData%WaveElevXY)) then - deallocate(VTK_SurfaceTypeData%WaveElevXY) + if (allocated(VTK_SurfaceTypeData%WaveElevVisX)) then + deallocate(VTK_SurfaceTypeData%WaveElevVisX) + end if + if (allocated(VTK_SurfaceTypeData%WaveElevVisY)) then + deallocate(VTK_SurfaceTypeData%WaveElevVisY) end if - if (allocated(VTK_SurfaceTypeData%WaveElev)) then - deallocate(VTK_SurfaceTypeData%WaveElev) + if (allocated(VTK_SurfaceTypeData%WaveElevVisGrid)) then + deallocate(VTK_SurfaceTypeData%WaveElevVisGrid) end if if (allocated(VTK_SurfaceTypeData%BladeShape)) then LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) @@ -1012,8 +1028,8 @@ subroutine FAST_PackVTK_SurfaceType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%NumSectors) call RegPack(RF, InData%HubRad) @@ -1021,8 +1037,9 @@ subroutine FAST_PackVTK_SurfaceType(RF, Indata) call RegPack(RF, InData%NacelleBox) call RegPackAlloc(RF, InData%TowerRad) call RegPack(RF, InData%NWaveElevPts) - call RegPackAlloc(RF, InData%WaveElevXY) - call RegPackAlloc(RF, InData%WaveElev) + call RegPackAlloc(RF, InData%WaveElevVisX) + call RegPackAlloc(RF, InData%WaveElevVisY) + call RegPackAlloc(RF, InData%WaveElevVisGrid) call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) @@ -1040,8 +1057,8 @@ subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: i1, i2, i3 + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1051,8 +1068,9 @@ subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) call RegUnpack(RF, OutData%NacelleBox); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TowerRad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NWaveElevPts); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveElevXY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveElev); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisGrid); if (RegCheckErr(RF, RoutineName)) return if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 9d56069af5..0e3e27033d 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -381,35 +381,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! If requested, output wave elevation data for VTK visualization - - IF (ALLOCATED(InitInp%WaveElevXY)) THEN - ! maybe instead of getting these requested points, we just output the grid that SeaState is generated on? - ALLOCATE(InitOut%WaveElevSeries( 0:p%WaveField%NStepWave, 1:SIZE(InitInp%WaveElevXY, DIM=2)),STAT=ErrStat2) - if (ErrStat2 /= 0) then - CALL SetErrStat(ErrID_Fatal,"Error allocating InitOut%WaveElevSeries.",ErrStat,ErrMsg,RoutineName) - CALL CleanUp() - RETURN - end if - - do it = 1,size(p%WaveField%WaveTime) - do i = 1, size(InitOut%WaveElevSeries,DIM=2) - InitOut%WaveElevSeries(it,i) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev1, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end do - end do - - if (allocated(p%WaveField%WaveElev2)) then - do it = 1,size(p%WaveField%WaveTime) - do i = 1, size(InitOut%WaveElevSeries,DIM=2) - TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(InitInp%WaveElevXY(:,i),ReKi), p%WaveField%WaveElev2, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - InitOut%WaveElevSeries(it,i) = InitOut%WaveElevSeries(it,i) + TmpElev - end do - end do - end if - - - ENDIF + if (InitInp%SurfaceVis) then + call SurfaceVisGenerate(ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + endif IF ( InitInp%hasIce ) THEN @@ -468,6 +444,88 @@ SUBROUTINE CleanUp() END SUBROUTINE CleanUp !................................ + subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen),intent( out) :: ErrMsg3 + integer(IntKi) :: Nx,Ny,i1,i2 + real(SiKi) :: HWidX, HWidY, dx, dy, TmpElev + real(ReKi) :: loc(2) ! location (x,y) + integer(IntKi) :: ErrStat4 + character(ErrMsgLen) :: ErrMsg4 + character(*), parameter :: RtnName="SurfaceVisGenerate" + + ErrStat3 = ErrID_None + ErrMsg3 = "" + + ! Grid half width from the WaveField + HWidX = (real(p%WaveField%SeaSt_Interp_p%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%SeaSt_Interp_p%delta(2) + HWidY = (real(p%WaveField%SeaSt_Interp_p%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%SeaSt_Interp_p%delta(3) + + if ((InitInp%SurfaceVisNx <= 0) .or. (InitInp%SurfaceVisNy <= 0))then ! use the SeaState points exactly + ! Set number of points to the number of seastate grid points in each direction + Nx = p%WaveField%SeaSt_Interp_p%n(2) + Ny = p%WaveField%SeaSt_Interp_p%n(3) + dx = p%WaveField%SeaSt_Interp_p%delta(2) + dy = p%WaveField%SeaSt_Interp_p%delta(3) + call SetErrStat(ErrID_Info,"Setting wavefield visualization grid to "//trim(Num2LStr(Nx))//" x "//trim(Num2LStr(Ny))//"points",ErrStat3,ErrMsg3,RoutineName) + elseif ((InitInp%SurfaceVisNx < 3) .or. (InitInp%SurfaceVisNx < 3)) then ! Set to 3 for minimum + Nx = 3 + Ny = 3 + dx = HWidX + dy = HWidY + call SetErrStat(ErrID_Warn,"Setting wavefield visualization grid to 3 points in each direction",ErrStat3,ErrMsg3,RoutineName) + else ! Specified number of points + Nx = InitInp%SurfaceVisNx + Ny = InitInp%SurfaceVisNy + dx = 2.0_SiKi * HWidX / (real(Nx,SiKi)-1) + dy = 2.0_SiKi * HWidY / (real(Ny,SiKi)-1) + endif + + ! allocate arrays + call AllocAry(InitOut%WaveElevVisX,Nx,"InitOut%NWaveElevVisX",ErrStat4,ErrMsg4) + call SetErrStat(ErrStat4,ErrMsg4,ErrStat3,ErrMsg3,RtnName) + call AllocAry(InitOut%WaveElevVisY,Ny,"InitOut%NWaveElevVisY",ErrStat4,ErrMsg4) + call SetErrStat(ErrStat4,ErrMsg4,ErrStat3,ErrMsg3,RtnName) + allocate(InitOut%WaveElevVisGrid( 0:size(p%WaveField%WaveTime),Nx,Ny ),STAT=ErrStat4) + if (ErrStat4 /= 0) then + CALL SetErrStat(ErrID_Fatal,"Error allocating InitOut%WaveElevVisGrid.",ErrStat3,ErrMsg3,RoutineName) + return + end if + + ! Populate the arrays + do i1=1,Nx + InitOut%WaveElevVisX(i1) = -HWidX + real(i1-1,SiKi)*dx + enddo + do i2=1,Ny + InitOut%WaveElevVisY(i2) = -HWidY + real(i2-1,SiKi)*dy + enddo + +!FIXME: calculate from the FFT of the data. + do it = 0,size(p%WaveField%WaveTime)-1 + do i1 = 1, nx + loc(1) = InitOut%WaveElevVisX(i1) + do i2 = 1, ny + loc(2) = InitOut%WaveElevVisX(i2) + InitOut%WaveElevVisGrid(it,i1,i2) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), p%WaveField%WaveElev1, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat4, ErrMsg4 ) + call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) + enddo + end do + end do + + if (allocated(p%WaveField%WaveElev2)) then + do it = 0,size(p%WaveField%WaveTime)-1 + do i1 = 1, nx + loc(1) = InitOut%WaveElevVisX(i1) + do i2 = 1, ny + loc(2) = InitOut%WaveElevVisX(i2) + TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), p%WaveField%WaveElev2, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat4, ErrMsg4 ) + call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) + InitOut%WaveElevVisGrid(it,i1,i2) = InitOut%WaveElevVisGrid(it,i1,i2) + TmpElev + end do + end do + end do + end if + end subroutine SurfaceVisGenerate END SUBROUTINE SeaSt_Init !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 03e659fac1..1ef0d93440 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -73,13 +73,15 @@ typedef ^ ^ ReKi def typedef ^ ^ ReKi defWtrDpth - - - "Default water depth from the driver; may be overwritten " "m" typedef ^ ^ ReKi defMSL2SWL - - - "Default mean sea level to still water level from the driver; may be overwritten" "m" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" -typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" typedef ^ ^ IntKi WrWvKinMod - 0 - "0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname]" - typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical SurfaceVis - .FALSE. - "Turn on grid surface visualization outputs" - +typedef ^ ^ IntKi SurfaceVisNx - 0 - "Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution." - +typedef ^ ^ IntKi SurfaceVisNy - 0 - "Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution." - # # @@ -89,8 +91,11 @@ typedef ^ InitOutputType CHARACTER(ChanLen) Wri typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "The is the list of all HD-related output channel unit strings (includes all sub-module channels)" - typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) -typedef ^ ^ SiKi 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 ^ ^ SiKi WaveElevVisX {:} - - "X locations of grid output" "m,-" +typedef ^ ^ SiKi WaveElevVisY {:} - - "X locations of grid output" "m,-" +typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" + # # # ..... States .................................................................................................................... diff --git a/modules/seastate/src/SeaState_DriverCode.f90 b/modules/seastate/src/SeaState_DriverCode.f90 index 276352fbd3..885a1f50e7 100644 --- a/modules/seastate/src/SeaState_DriverCode.f90 +++ b/modules/seastate/src/SeaState_DriverCode.f90 @@ -42,11 +42,9 @@ program SeaStateDriver integer :: WrWvKinMod integer :: NSteps real(DbKi) :: TimeInterval - logical :: WaveElevSeriesFlag !< Should we put together a wave elevation series and save it to file? - real(ReKi) :: WaveElevdX !< Spacing in the X direction for wave elevation series (m) - real(ReKi) :: WaveElevdY !< Spacing in the Y direction for the wave elevation series (m) - integer(IntKi) :: WaveElevNX !< Number of points in the X direction for the wave elevation series (-) - integer(IntKi) :: WaveElevNY !< Number of points in the X direction for the wave elevation series (-) + logical :: WaveElevVis !< Should we put together a wave elevation series and save it to file? + integer(IntKi) :: WaveElevVisNx !< Number of points in the X direction for the wave elevation series (-) + integer(IntKi) :: WaveElevVisNy !< Number of points in the X direction for the wave elevation series (-) end type SeaSt_Drvr_InitInput ! ----------------------------------------------------------------------------------- @@ -178,28 +176,14 @@ program SeaStateDriver !------------------------------------------------------------------------------------- ! Setup the arrays for the wave elevation timeseries if requested by the driver input file - !if ( drvrInitInp%WaveElevSeriesFlag ) then - ! ALLOCATE ( InitInData%WaveElevXY(2,drvrInitInp%WaveElevNX*drvrInitInp%WaveElevNY), STAT=ErrStat ) - ! if ( ErrStat >= ErrID_Fatal ) then - ! call SeaSt_End( u(1), p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - ! if ( ErrStat /= ErrID_None ) then - ! call WrScr( ErrMsg ) - ! end if - ! stop - ! end if - ! - ! ! Set the values - ! n = 0 ! Dummy counter we are using to get the current point number - ! do I = 0,drvrInitInp%WaveElevNX-1 - ! do J = 0, drvrInitInp%WaveElevNY-1 - ! n = n+1 - ! ! X dimension - ! InitInData%WaveElevXY(1,n) = drvrInitInp%WaveElevDX*(I - 0.5*(drvrInitInp%WaveElevNX-1)) - ! ! Y dimension - ! InitInData%WaveElevXY(2,n) = drvrInitInp%WaveElevDY*(J - 0.5*(drvrInitInp%WaveElevNY-1)) - ! ENDDO - ! ENDDO - !endif + if ( drvrInitInp%WaveElevVis ) then + InitInData%SurfaceVis = .true. +!FIXME: enable this when we can use an arbitrary number of points from the FFT of the data. + !InitInData%SurfaceVisNx = drvrInitInp%WaveElevVisNx ! Number of points in X + !InitInData%SurfaceVisNy = drvrInitInp%WaveElevVisNy ! Number of points in Y + InitInData%SurfaceVisNx = 0 ! use the WaveField grid resolution + InitInData%SurfaceVisNy = 0 ! use the WaveField grid resolution + endif ! Initialize the module Interval = drvrInitInp%TimeInterval @@ -217,7 +201,7 @@ program SeaStateDriver ! Write the gridded wave elevation data to a file - if ( drvrInitInp%WaveElevSeriesFlag ) call WaveElevGrid_Output (drvrInitInp, InitInData, InitOutData, p, ErrStat, ErrMsg) + if ( drvrInitInp%WaveElevVis ) call WaveElevGrid_Output (drvrInitInp, InitInData, InitOutData, p, ErrStat, ErrMsg) if (errStat >= AbortErrLev) then ! Clean up and exit call SeaSt_DvrCleanup() @@ -434,13 +418,13 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) close( UnIn ) return - end if + end if end if !------------------------------------------------------------------------------------------------- ! Environmental conditions section !------------------------------------------------------------------------------------------------- - + ! Header call ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat, ErrMsg, UnEchoLocal ) @@ -499,7 +483,7 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) ! Header call ReadCom( UnIn, FileName, 'SeaState header', ErrStat, ErrMsg, UnEchoLocal ) - + if ( ErrStat >= AbortErrLev ) then if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) close( UnIn ) @@ -580,21 +564,39 @@ SUBROUTINE ReadDriverInputFile( inputFile, InitInp, ErrStat, ErrMsg ) !> Header call ReadCom( UnIn, FileName, 'Waves multipoint elevation output header', ErrStat, ErrMsg, UnEchoLocal ) - + if ( ErrStat >= AbortErrLev ) then - if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) - close( UnIn ) + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) + close( UnIn ) return end if !> WaveElevSeriesFlag -- are we doing multipoint wave elevation output? - call ReadVar ( UnIn, FileName, InitInp%WaveElevSeriesFlag, 'WaveElevSeriesFlag', 'WaveElevSeriesFlag', ErrStat, ErrMsg ) + call ReadVar ( UnIn, FileName, InitInp%WaveElevVis, 'WaveElevVis', 'WaveElevVis', ErrStat, ErrMsg ) if ( ErrStat >= AbortErrLev ) then if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) close( UnIn ) return end if +!FIXME: enable this when we can use an arbitrary number of points from the FFT of the data. +! !> WaveElevVisNx -- number of points in X if visualizing +! call ReadVar ( UnIn, FileName, InitInp%WaveElevVisNx, 'WaveElevVisNX', 'WaveElevVisNx', ErrStat, ErrMsg ) +! if ( ErrStat >= AbortErrLev ) then +! if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) +! close( UnIn ) +! return +! end if +! +! !> WaveElevVisNy -- number of points in Y if visualizing +! call ReadVar ( UnIn, FileName, InitInp%WaveElevVisNy, 'WaveElevVisNy', 'WaveElevVisNy', ErrStat, ErrMsg ) +! if ( ErrStat >= AbortErrLev ) then +! if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) +! close( UnIn ) +! return +! end if + + if (InitInp%Echo .and. UnEchoLocal>0) close(UnEchoLocal) close( UnIn ) @@ -667,15 +669,11 @@ SUBROUTINE WaveElevGrid_Output (drvrInitInp, SeaStateInitInp, SeaStateInitOut, S write (WaveElevFileUn,'(A)', IOSTAT=ErrStatTmp ) NewLine write (WaveElevFileUn,'(A8,F10.3)', IOSTAT=ErrStatTmp ) '# Time: ',SeaState_p%WaveField%WaveTime(I) ! Now output the X,Y, Elev info for this timestep - do j=1,SeaState_p%NGrid(1) - xpos = -SeaState_p%deltaGrid(1)*(SeaState_p%NGrid(1)-1)/2.0 + (J-1)*SeaState_p%deltaGrid(1) + do j=1,size(SeaStateInitOut%WaveElevVisX) + xpos = SeaStateInitOut%WaveElevVisX(j) do k=1, SeaState_p%NGrid(2) - ypos = -SeaState_p%deltaGrid(2)*(SeaState_p%NGrid(2)-1)/2.0 + (K-1)*SeaState_p%deltaGrid(2) - if (allocated(SeaState_p%WaveField%WaveElev2)) then - WaveElev = SeaState_p%WaveField%WaveElev1(I,J,K) + SeaState_p%WaveField%WaveElev2(I,J,K) - else - WaveElev = SeaState_p%WaveField%WaveElev1(I,J,K) - end if + ypos = SeaStateInitOut%WaveElevVisY(k) + WaveElev = SeaStateInitOut%WaveElevVisGrid(i,j,k) write (WaveElevFileUn,WaveElevFmt, IOSTAT=ErrStatTmp ) xpos, ypos, WaveElev end do end do diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index ff4581d486..f2807fdb04 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -94,13 +94,15 @@ MODULE SeaState_Types REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] INTEGER(IntKi) :: WrWvKinMod = 0 !< 0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname] [-] LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + LOGICAL :: SurfaceVis = .FALSE. !< Turn on grid surface visualization outputs [-] + INTEGER(IntKi) :: SurfaceVisNx = 0 !< Number of points in X direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] + INTEGER(IntKi) :: SurfaceVisNy = 0 !< Number of points in Y direction to output for visualization grid. Use 0 or negative to set to SeaState resolution. [-] END TYPE SeaSt_InitInputType ! ======================= ! ========= SeaSt_InitOutputType ======= @@ -109,7 +111,9 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: 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)] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisX !< X locations of grid output [m,-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< X locations of grid output [m,-] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType ! ======================= @@ -445,7 +449,6 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitInput' @@ -462,24 +465,15 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL DstInitInputData%TMax = SrcInitInputData%TMax - if (allocated(SrcInitInputData%WaveElevXY)) then - LB(1:2) = lbound(SrcInitInputData%WaveElevXY, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%WaveElevXY, kind=B8Ki) - if (.not. allocated(DstInitInputData%WaveElevXY)) then - allocate(DstInitInputData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY - end if DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod DstInitInputData%HasIce = SrcInitInputData%HasIce DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%SurfaceVis = SrcInitInputData%SurfaceVis + DstInitInputData%SurfaceVisNx = SrcInitInputData%SurfaceVisNx + DstInitInputData%SurfaceVisNy = SrcInitInputData%SurfaceVisNy end subroutine subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -493,9 +487,6 @@ subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) ErrMsg = '' call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InitInputData%WaveElevXY)) then - deallocate(InitInputData%WaveElevXY) - end if end subroutine subroutine SeaSt_PackInitInput(RF, Indata) @@ -512,13 +503,15 @@ subroutine SeaSt_PackInitInput(RF, Indata) call RegPack(RF, InData%defWtrDpth) call RegPack(RF, InData%defMSL2SWL) call RegPack(RF, InData%TMax) - call RegPackAlloc(RF, InData%WaveElevXY) call RegPack(RF, InData%WaveFieldMod) call RegPack(RF, InData%PtfmLocationX) call RegPack(RF, InData%PtfmLocationY) call RegPack(RF, InData%WrWvKinMod) call RegPack(RF, InData%HasIce) call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%SurfaceVis) + call RegPack(RF, InData%SurfaceVisNx) + call RegPack(RF, InData%SurfaceVisNy) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -526,9 +519,6 @@ subroutine SeaSt_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UseInputFile); if (RegCheckErr(RF, RoutineName)) return @@ -539,13 +529,15 @@ subroutine SeaSt_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%defWtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%defMSL2SWL); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TMax); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveElevXY); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WaveFieldMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmLocationX); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmLocationY); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WrWvKinMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HasIce); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SurfaceVis); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SurfaceVisNx); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SurfaceVisNy); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -554,7 +546,7 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' @@ -588,17 +580,41 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn - if (allocated(SrcInitOutputData%WaveElevSeries)) then - LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries, kind=B8Ki) - UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries, kind=B8Ki) - if (.not. allocated(DstInitOutputData%WaveElevSeries)) then - allocate(DstInitOutputData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (allocated(SrcInitOutputData%WaveElevVisX)) then + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisX, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisX, kind=B8Ki) + if (.not. allocated(DstInitOutputData%WaveElevVisX)) then + allocate(DstInitOutputData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevVisX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevVisX = SrcInitOutputData%WaveElevVisX + end if + if (allocated(SrcInitOutputData%WaveElevVisY)) then + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisY, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisY, kind=B8Ki) + if (.not. allocated(DstInitOutputData%WaveElevVisY)) then + allocate(DstInitOutputData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevVisY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevVisY = SrcInitOutputData%WaveElevVisY + end if + if (allocated(SrcInitOutputData%WaveElevVisGrid)) then + LB(1:3) = lbound(SrcInitOutputData%WaveElevVisGrid, kind=B8Ki) + UB(1:3) = ubound(SrcInitOutputData%WaveElevVisGrid, kind=B8Ki) + if (.not. allocated(DstInitOutputData%WaveElevVisGrid)) then + allocate(DstInitOutputData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevVisGrid.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries + DstInitOutputData%WaveElevVisGrid = SrcInitOutputData%WaveElevVisGrid end if DstInitOutputData%WaveField => SrcInitOutputData%WaveField end subroutine @@ -620,8 +636,14 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(InitOutputData%WaveElevSeries)) then - deallocate(InitOutputData%WaveElevSeries) + if (allocated(InitOutputData%WaveElevVisX)) then + deallocate(InitOutputData%WaveElevVisX) + end if + if (allocated(InitOutputData%WaveElevVisY)) then + deallocate(InitOutputData%WaveElevVisY) + end if + if (allocated(InitOutputData%WaveElevVisGrid)) then + deallocate(InitOutputData%WaveElevVisGrid) end if nullify(InitOutputData%WaveField) end subroutine @@ -636,7 +658,9 @@ subroutine SeaSt_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPack(RF, InData%InvalidWithSSExctn) - call RegPackAlloc(RF, InData%WaveElevSeries) + call RegPackAlloc(RF, InData%WaveElevVisX) + call RegPackAlloc(RF, InData%WaveElevVisY) + call RegPackAlloc(RF, InData%WaveElevVisGrid) call RegPack(RF, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(RF, c_loc(InData%WaveField), PtrInIndex) @@ -651,7 +675,7 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B8Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -661,7 +685,9 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpack(RF, OutData%InvalidWithSSExctn); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%WaveElevSeries); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisX); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WaveElevVisGrid); if (RegCheckErr(RF, RoutineName)) return if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then From 208c806ad17256a6595b31025546574c4bdbca3f Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Thu, 18 Jan 2024 10:27:09 -0700 Subject: [PATCH 179/232] MD: change copyright display --- modules/moordyn/src/MoorDyn.f90 | 2 +- modules/moordyn/src/MoorDyn_Driver.f90 | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 54d8f1420f..fc6f47db6e 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -163,7 +163,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er InitOut%Ver = MD_ProgDesc CALL WrScr(' This is MoorDyn v2, with significant input file changes from v1.') - CALL WrScr(' Copyright: (C) 2024 National Renewable Energy Laboratory, (C) 2019 Matt Hall') + CALL DispCopyrightLicense( MD_ProgDesc%Name, 'Copyright (C) 2019 Matt Hall' ) !--------------------------------------------------------------------------------------------- diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 26628b1634..de826a52b1 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -114,7 +114,7 @@ PROGRAM MoorDyn_Driver CHARACTER(20) :: FlagArg ! flag argument from command line CHARACTER(200) :: git_commit ! String containing the current git commit hash - TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'MoorDyn Driver', '', '' ) + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'MoorDyn Driver', '', '2024-01-18' ) @@ -131,8 +131,8 @@ PROGRAM MoorDyn_Driver CALL CheckArgs( MD_InitInp%FileName, Arg2=drvrInitInp%InputsFile, Flag=FlagArg ) IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() - ! Display the copyright notice - CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2024 NREL, 2019 Matt Hall' ) + ! ! Display the copyright notice + ! CALL DispCopyrightLicense( version%Name, ' Copyright (C) 2019 Matt Hall' ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running @@ -144,7 +144,7 @@ PROGRAM MoorDyn_Driver CALL CPU_TIME ( ProgStrtCPU ) ! Initial time (this zeros the start time when used as a MATLAB function) - CALL WrScr( ' MD Driver updated 2024-01-16') + CALL WrScr('MD Driver updated '//TRIM( version%Date )) ! Parse the driver input file and run the simulation based on that file CALL get_command_argument(1, drvrFilename) From da0ad544c19abc07ca30f3e5c97e44d7672ceb14 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 18 Jan 2024 15:04:19 -0700 Subject: [PATCH 180/232] Update pointer to r-test/main for 3.5.2 release --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 58ced27ad1..b63e928023 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 58ced27ad1e6ca167ba174046891c63185b18901 +Subproject commit b63e9280234c2fb5695a37931d2329f3011e97ec From 418db34a0476e66fbc81ae5a8568ea02b1cc028c Mon Sep 17 00:00:00 2001 From: Garrett Barter Date: Fri, 19 Jan 2024 13:57:49 -0700 Subject: [PATCH 181/232] switch from -fpic to -fPIC for all gfortran builds --- cmake/OpenfastFortranOptions.cmake | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index 0efa0aed55..f09837fbcf 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -109,9 +109,9 @@ endmacro(check_f2008_features) # macro(set_fast_gfortran) if(NOT WIN32) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic ") - set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fpic") - set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fpic") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fPIC ") + set(CMAKE_CXX_FLAGS "${CMAKE_CXX_FLAGS} -fPIC") + set(CMAKE_C_FLAGS "${CMAKE_C_FLAGS} -fPIC") endif(NOT WIN32) # Fix free-form compilation for OpenFAST From 939674e4d83cb935f6115f110166f45ecbaa949b Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 22 Jan 2024 11:47:38 -0700 Subject: [PATCH 182/232] ExtLoads: move integers from DX_u to DX_p --- glue-codes/openfast-cpp/src/OpenFAST.H | 2 + glue-codes/openfast-cpp/src/OpenFAST.cpp | 11 +- modules/extloads/src/ExtLoads.f90 | 20 +- modules/extloads/src/ExtLoadsDX_Registry.txt | 7 +- modules/extloads/src/ExtLoadsDX_Types.f90 | 813 +++++++++++------- modules/extloads/src/ExtLoadsDX_Types.h | 10 +- modules/extloads/src/ExtLoads_Registry.txt | 1 + modules/extloads/src/ExtLoads_Types.f90 | 92 ++ modules/openfast-library/src/FAST_Library.f90 | 42 +- modules/openfast-library/src/FAST_Library.h | 4 +- 10 files changed, 637 insertions(+), 365 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.H b/glue-codes/openfast-cpp/src/OpenFAST.H index 8635f373dc..9915d7bbb3 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.H +++ b/glue-codes/openfast-cpp/src/OpenFAST.H @@ -333,6 +333,8 @@ class OpenFAST { //! Data structure to get deflections from ExternalLoads module in OpenFAST std::vector extld_i_f_FAST; // Input from OpenFAST + //! Data structure to get deflections from ExternalLoads module in OpenFAST + std::vector extld_p_f_FAST; // Parameter from OpenFAST //! Data structure to send force information to ExternalLoads module in OpenFAST std::vector extld_o_t_FAST; // Output to OpenFAST diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 58e2549a54..8afc735825 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -674,6 +674,7 @@ void fast::OpenFAST::init() { &turbineData[iTurb].numBlades, &ntStart, &extld_i_f_FAST[iTurb], + &extld_p_f_FAST[iTurb], &extld_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], @@ -778,6 +779,7 @@ void fast::OpenFAST::init() { &turbineData[iTurb].zRef, &turbineData[iTurb].shearExp, &extld_i_f_FAST[iTurb], + &extld_p_f_FAST[iTurb], &extld_o_t_FAST[iTurb], &sc->ip_from_FAST[iTurb], &sc->op_to_FAST[iTurb], @@ -2090,8 +2092,9 @@ void fast::OpenFAST::allocateMemory_preInit() { extinfw_i_f_FAST.resize(nTurbinesProc) ; extinfw_o_t_FAST.resize(nTurbinesProc) ; - // Allocate memory for ExtLd Input types in FAST + // Allocate memory for ExtLd Input/Parameter/Output types in FAST extld_i_f_FAST.resize(nTurbinesProc) ; + extld_p_f_FAST.resize(nTurbinesProc) ; extld_o_t_FAST.resize(nTurbinesProc) ; if(scStatus) { @@ -2150,11 +2153,11 @@ void fast::OpenFAST::allocateMemory_postInit(int iTurbLoc) { turbineData[iTurbLoc].nBRfsiPtsBlade.resize(turbineData[iTurbLoc].numBlades); int nTotBldNds = 0; for(int i=0; i < turbineData[iTurbLoc].numBlades; i++) { - nTotBldNds += extld_i_f_FAST[iTurbLoc].nBladeNodes[i]; - turbineData[iTurbLoc].nBRfsiPtsBlade[i] = extld_i_f_FAST[iTurbLoc].nBladeNodes[i]; + nTotBldNds += extld_p_f_FAST[iTurbLoc].nBladeNodes[i]; + turbineData[iTurbLoc].nBRfsiPtsBlade[i] = extld_p_f_FAST[iTurbLoc].nBladeNodes[i]; turbineData[iTurbLoc].nTotBRfsiPtsBlade += turbineData[iTurbLoc].nBRfsiPtsBlade[i]; } - turbineData[iTurbLoc].nBRfsiPtsTwr = extld_i_f_FAST[iTurbLoc].nTowerNodes[0]; + turbineData[iTurbLoc].nBRfsiPtsTwr = extld_p_f_FAST[iTurbLoc].nTowerNodes[0]; // Allocate memory for reference position only for 1 time step - np1 for(int k=0; k<4; k++) { diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index 84f034f13b..11f2ce86dc 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -299,7 +299,7 @@ subroutine Init_u( u, p, InitInp, errStat, errMsg ) USE BeamDyn_IO, ONLY: BD_CrvExtractCrv type(ExtLd_InputType), intent( out) :: u !< Input data - type(ExtLd_ParameterType), intent(in ) :: p !< Parameters + type(ExtLd_ParameterType), intent(inout) :: p !< Parameters (inout so can update DX_p) type(ExtLd_InitInputType), intent(in ) :: InitInp !< Input data for ExtLd initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None @@ -542,15 +542,15 @@ subroutine Init_u( u, p, InitInp, errStat, errMsg ) end do !k=numBlades ! Set the parameters first - CALL AllocPAry( u%DX_u%nTowerNodes, 1, 'nTowerNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - u%DX_u%c_obj%nTowerNodes_Len = 1; u%DX_u%c_obj%nTowerNodes = C_LOC( u%DX_u%nTowerNodes(1) ) - u%DX_u%nTowerNodes(1) = p%NumTwrNds - CALL AllocPAry( u%DX_u%nBlades, 1, 'nBlades', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - u%DX_u%c_obj%nBlades_Len = 1; u%DX_u%c_obj%nBlades = C_LOC( u%DX_u%nBlades(1) ) - u%DX_u%nBlades(1) = p%NumBlds - CALL AllocPAry( u%DX_u%nBladeNodes, p%NumBlds, 'nBladeNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - u%DX_u%c_obj%nBladeNodes_Len = p%NumBlds; u%DX_u%c_obj%nBladeNodes = C_LOC( u%DX_u%nBladeNodes(1) ) - u%DX_u%nBladeNodes(:) = p%NumBldNds(:) + CALL AllocPAry( p%DX_p%nTowerNodes, 1, 'nTowerNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + p%DX_p%c_obj%nTowerNodes_Len = 1; p%DX_p%c_obj%nTowerNodes = C_LOC( p%DX_p%nTowerNodes(1) ) + p%DX_p%nTowerNodes(1) = p%NumTwrNds + CALL AllocPAry( p%DX_p%nBlades, 1, 'nBlades', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + p%DX_p%c_obj%nBlades_Len = 1; p%DX_p%c_obj%nBlades = C_LOC( p%DX_p%nBlades(1) ) + p%DX_p%nBlades(1) = p%NumBlds + CALL AllocPAry( p%DX_p%nBladeNodes, p%NumBlds, 'nBladeNodes', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + p%DX_p%c_obj%nBladeNodes_Len = p%NumBlds; p%DX_p%c_obj%nBladeNodes = C_LOC( p%DX_p%nBladeNodes(1) ) + p%DX_p%nBladeNodes(:) = p%NumBldNds(:) ! Set the reference positions next CALL AllocPAry( u%DX_u%twrRefPos, p%NumTwrNds*6, 'twrRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) diff --git a/modules/extloads/src/ExtLoadsDX_Registry.txt b/modules/extloads/src/ExtLoadsDX_Registry.txt index 7f09fae1ca..042033a4a0 100644 --- a/modules/extloads/src/ExtLoadsDX_Registry.txt +++ b/modules/extloads/src/ExtLoadsDX_Registry.txt @@ -28,15 +28,16 @@ typedef ^ InputType R8Ki bldRefPos {:} - - typedef ^ InputType R8Ki hubRefPos {:} - - "Reference position of the tower nodes - to send to external driver" typedef ^ InputType R8Ki nacRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" typedef ^ InputType R8Ki bldRootRefPos {:} - - "Reference position of the blade root nodes - to send to external driver" -typedef ^ InputType IntKi nBlades {:} - - "Number of blades" -typedef ^ InputType IntKi nBladeNodes {:} - - "Number of blade nodes for each blade" - -typedef ^ InputType IntKi nTowerNodes {:} - - "Number of tower nodes for each blade" - typedef ^ InputType R8Ki bldChord {:} - - "Blade chord" m typedef ^ InputType R8Ki bldRloc {:} - - "Radial location along the blade" m typedef ^ InputType R8Ki twrDia {:} - - "Tower diameter" m typedef ^ InputType R8Ki twrHloc {:} - - "Height location along the tower" m typedef ^ InputType R8Ki bldPitch {:} - - "Pitch angle of blade" +# ..... Parameters ................................................................................................................ +typedef ^ ParameterType IntKi nBlades {:} - - "Number of blades" +typedef ^ ParameterType IntKi nBladeNodes {:} - - "Number of blade nodes for each blade" - +typedef ^ ParameterType IntKi nTowerNodes {:} - - "Number of tower nodes for each blade" - # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index 6fd8494e49..f989cb6ac9 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -57,12 +57,6 @@ MODULE ExtLoadsDX_Types INTEGER(C_int) :: nacRefPos_Len = 0 TYPE(C_ptr) :: bldRootRefPos = C_NULL_PTR INTEGER(C_int) :: bldRootRefPos_Len = 0 - TYPE(C_ptr) :: nBlades = C_NULL_PTR - INTEGER(C_int) :: nBlades_Len = 0 - TYPE(C_ptr) :: nBladeNodes = C_NULL_PTR - INTEGER(C_int) :: nBladeNodes_Len = 0 - TYPE(C_ptr) :: nTowerNodes = C_NULL_PTR - INTEGER(C_int) :: nTowerNodes_Len = 0 TYPE(C_ptr) :: bldChord = C_NULL_PTR INTEGER(C_int) :: bldChord_Len = 0 TYPE(C_ptr) :: bldRloc = C_NULL_PTR @@ -86,9 +80,6 @@ MODULE ExtLoadsDX_Types REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootRefPos => NULL() !< Reference position of the blade root nodes - to send to external driver [-] - INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBlades => NULL() !< Number of blades [-] - INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBladeNodes => NULL() !< Number of blade nodes for each blade [-] - INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nTowerNodes => NULL() !< Number of tower nodes for each blade [-] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldChord => NULL() !< Blade chord [m] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRloc => NULL() !< Radial location along the blade [m] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDia => NULL() !< Tower diameter [m] @@ -96,6 +87,23 @@ MODULE ExtLoadsDX_Types REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldPitch => NULL() !< Pitch angle of blade [-] END TYPE ExtLdDX_InputType ! ======================= +! ========= ExtLdDX_ParameterType_C ======= + TYPE, BIND(C) :: ExtLdDX_ParameterType_C + TYPE(C_PTR) :: object = C_NULL_PTR + TYPE(C_ptr) :: nBlades = C_NULL_PTR + INTEGER(C_int) :: nBlades_Len = 0 + TYPE(C_ptr) :: nBladeNodes = C_NULL_PTR + INTEGER(C_int) :: nBladeNodes_Len = 0 + TYPE(C_ptr) :: nTowerNodes = C_NULL_PTR + INTEGER(C_int) :: nTowerNodes_Len = 0 + END TYPE ExtLdDX_ParameterType_C + TYPE, PUBLIC :: ExtLdDX_ParameterType + TYPE( ExtLdDX_ParameterType_C ) :: C_obj + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBlades => NULL() !< Number of blades [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBladeNodes => NULL() !< Number of blade nodes for each blade [-] + INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nTowerNodes => NULL() !< Number of tower nodes for each blade [-] + END TYPE ExtLdDX_ParameterType +! ======================= ! ========= ExtLdDX_OutputType_C ======= TYPE, BIND(C) :: ExtLdDX_OutputType_C TYPE(C_PTR) :: object = C_NULL_PTR @@ -276,51 +284,6 @@ SUBROUTINE ExtLdDX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err END IF DstInputData%bldRootRefPos = SrcInputData%bldRootRefPos ENDIF -IF (ASSOCIATED(SrcInputData%nBlades)) THEN - i1_l = LBOUND(SrcInputData%nBlades,1) - i1_u = UBOUND(SrcInputData%nBlades,1) - IF (.NOT. ASSOCIATED(DstInputData%nBlades)) THEN - ALLOCATE(DstInputData%nBlades(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nBlades.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%nBlades_Len = SIZE(DstInputData%nBlades) - IF (DstInputData%c_obj%nBlades_Len > 0) & - DstInputData%c_obj%nBlades = C_LOC( DstInputData%nBlades( i1_l ) ) - END IF - DstInputData%nBlades = SrcInputData%nBlades -ENDIF -IF (ASSOCIATED(SrcInputData%nBladeNodes)) THEN - i1_l = LBOUND(SrcInputData%nBladeNodes,1) - i1_u = UBOUND(SrcInputData%nBladeNodes,1) - IF (.NOT. ASSOCIATED(DstInputData%nBladeNodes)) THEN - ALLOCATE(DstInputData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%nBladeNodes_Len = SIZE(DstInputData%nBladeNodes) - IF (DstInputData%c_obj%nBladeNodes_Len > 0) & - DstInputData%c_obj%nBladeNodes = C_LOC( DstInputData%nBladeNodes( i1_l ) ) - END IF - DstInputData%nBladeNodes = SrcInputData%nBladeNodes -ENDIF -IF (ASSOCIATED(SrcInputData%nTowerNodes)) THEN - i1_l = LBOUND(SrcInputData%nTowerNodes,1) - i1_u = UBOUND(SrcInputData%nTowerNodes,1) - IF (.NOT. ASSOCIATED(DstInputData%nTowerNodes)) THEN - ALLOCATE(DstInputData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%nTowerNodes_Len = SIZE(DstInputData%nTowerNodes) - IF (DstInputData%c_obj%nTowerNodes_Len > 0) & - DstInputData%c_obj%nTowerNodes = C_LOC( DstInputData%nTowerNodes( i1_l ) ) - END IF - DstInputData%nTowerNodes = SrcInputData%nTowerNodes -ENDIF IF (ASSOCIATED(SrcInputData%bldChord)) THEN i1_l = LBOUND(SrcInputData%bldChord,1) i1_u = UBOUND(SrcInputData%bldChord,1) @@ -489,27 +452,6 @@ SUBROUTINE ExtLdDX_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers InputData%C_obj%bldRootRefPos = C_NULL_PTR InputData%C_obj%bldRootRefPos_Len = 0 ENDIF -IF (ASSOCIATED(InputData%nBlades)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%nBlades) - InputData%nBlades => NULL() - InputData%C_obj%nBlades = C_NULL_PTR - InputData%C_obj%nBlades_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%nBladeNodes)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%nBladeNodes) - InputData%nBladeNodes => NULL() - InputData%C_obj%nBladeNodes = C_NULL_PTR - InputData%C_obj%nBladeNodes_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%nTowerNodes)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%nTowerNodes) - InputData%nTowerNodes => NULL() - InputData%C_obj%nTowerNodes = C_NULL_PTR - InputData%C_obj%nTowerNodes_Len = 0 -ENDIF IF (ASSOCIATED(InputData%bldChord)) THEN IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%bldChord) @@ -632,21 +574,6 @@ SUBROUTINE ExtLdDX_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! bldRootRefPos upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%bldRootRefPos) ! bldRootRefPos END IF - Int_BufSz = Int_BufSz + 1 ! nBlades allocated yes/no - IF ( ASSOCIATED(InData%nBlades) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nBlades upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nBlades) ! nBlades - END IF - Int_BufSz = Int_BufSz + 1 ! nBladeNodes allocated yes/no - IF ( ASSOCIATED(InData%nBladeNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nBladeNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nBladeNodes) ! nBladeNodes - END IF - Int_BufSz = Int_BufSz + 1 ! nTowerNodes allocated yes/no - IF ( ASSOCIATED(InData%nTowerNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nTowerNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nTowerNodes) ! nTowerNodes - END IF Int_BufSz = Int_BufSz + 1 ! bldChord allocated yes/no IF ( ASSOCIATED(InData%bldChord) ) THEN Int_BufSz = Int_BufSz + 2*1 ! bldChord upper/lower bounds for each dimension @@ -851,51 +778,6 @@ SUBROUTINE ExtLdDX_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%nBlades) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nBlades,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBlades,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nBlades,1), UBOUND(InData%nBlades,1) - IntKiBuf(Int_Xferred) = InData%nBlades(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%nBladeNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nBladeNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBladeNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nBladeNodes,1), UBOUND(InData%nBladeNodes,1) - IntKiBuf(Int_Xferred) = InData%nBladeNodes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%nTowerNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nTowerNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nTowerNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nTowerNodes,1), UBOUND(InData%nTowerNodes,1) - IntKiBuf(Int_Xferred) = InData%nTowerNodes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF IF ( .NOT. ASSOCIATED(InData%bldChord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1210,69 +1092,6 @@ SUBROUTINE ExtLdDX_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBlades not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nBlades)) DEALLOCATE(OutData%nBlades) - ALLOCATE(OutData%nBlades(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBlades.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%nBlades_Len = SIZE(OutData%nBlades) - IF (OutData%c_obj%nBlades_Len > 0) & - OutData%c_obj%nBlades = C_LOC( OutData%nBlades( i1_l ) ) - DO i1 = LBOUND(OutData%nBlades,1), UBOUND(OutData%nBlades,1) - OutData%nBlades(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBladeNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nBladeNodes)) DEALLOCATE(OutData%nBladeNodes) - ALLOCATE(OutData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%nBladeNodes_Len = SIZE(OutData%nBladeNodes) - IF (OutData%c_obj%nBladeNodes_Len > 0) & - OutData%c_obj%nBladeNodes = C_LOC( OutData%nBladeNodes( i1_l ) ) - DO i1 = LBOUND(OutData%nBladeNodes,1), UBOUND(OutData%nBladeNodes,1) - OutData%nBladeNodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nTowerNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nTowerNodes)) DEALLOCATE(OutData%nTowerNodes) - ALLOCATE(OutData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%nTowerNodes_Len = SIZE(OutData%nTowerNodes) - IF (OutData%c_obj%nTowerNodes_Len > 0) & - OutData%c_obj%nTowerNodes = C_LOC( OutData%nTowerNodes( i1_l ) ) - DO i1 = LBOUND(OutData%nTowerNodes,1), UBOUND(OutData%nTowerNodes,1) - OutData%nTowerNodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldChord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1486,33 +1305,6 @@ SUBROUTINE ExtLdDX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF - ! -- nBlades Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nBlades ) ) THEN - NULLIFY( InputData%nBlades ) - ELSE - CALL C_F_POINTER(InputData%C_obj%nBlades, InputData%nBlades, (/InputData%C_obj%nBlades_Len/)) - END IF - END IF - - ! -- nBladeNodes Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nBladeNodes ) ) THEN - NULLIFY( InputData%nBladeNodes ) - ELSE - CALL C_F_POINTER(InputData%C_obj%nBladeNodes, InputData%nBladeNodes, (/InputData%C_obj%nBladeNodes_Len/)) - END IF - END IF - - ! -- nTowerNodes Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nTowerNodes ) ) THEN - NULLIFY( InputData%nTowerNodes ) - ELSE - CALL C_F_POINTER(InputData%C_obj%nTowerNodes, InputData%nTowerNodes, (/InputData%C_obj%nTowerNodes_Len/)) - END IF - END IF - ! -- bldChord Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldChord ) ) THEN @@ -1695,42 +1487,6 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF - ! -- nBlades Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%nBlades)) THEN - InputData%c_obj%nBlades_Len = 0 - InputData%c_obj%nBlades = C_NULL_PTR - ELSE - InputData%c_obj%nBlades_Len = SIZE(InputData%nBlades) - IF (InputData%c_obj%nBlades_Len > 0) & - InputData%c_obj%nBlades = C_LOC( InputData%nBlades( LBOUND(InputData%nBlades,1) ) ) - END IF - END IF - - ! -- nBladeNodes Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%nBladeNodes)) THEN - InputData%c_obj%nBladeNodes_Len = 0 - InputData%c_obj%nBladeNodes = C_NULL_PTR - ELSE - InputData%c_obj%nBladeNodes_Len = SIZE(InputData%nBladeNodes) - IF (InputData%c_obj%nBladeNodes_Len > 0) & - InputData%c_obj%nBladeNodes = C_LOC( InputData%nBladeNodes( LBOUND(InputData%nBladeNodes,1) ) ) - END IF - END IF - - ! -- nTowerNodes Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%nTowerNodes)) THEN - InputData%c_obj%nTowerNodes_Len = 0 - InputData%c_obj%nTowerNodes = C_NULL_PTR - ELSE - InputData%c_obj%nTowerNodes_Len = SIZE(InputData%nTowerNodes) - IF (InputData%c_obj%nTowerNodes_Len > 0) & - InputData%c_obj%nTowerNodes = C_LOC( InputData%nTowerNodes( LBOUND(InputData%nTowerNodes,1) ) ) - END IF - END IF - ! -- bldChord Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. ASSOCIATED(InputData%bldChord)) THEN @@ -1792,9 +1548,9 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE ExtLdDX_F2C_CopyInput - SUBROUTINE ExtLdDX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtLdDX_OutputType), INTENT(IN) :: SrcOutputData - TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: DstOutputData + SUBROUTINE ExtLdDX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLdDX_ParameterType), INTENT(IN) :: SrcParamData + TYPE(ExtLdDX_ParameterType), INTENT(INOUT) :: DstParamData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -1803,44 +1559,59 @@ SUBROUTINE ExtLdDX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyParam' ! ErrStat = ErrID_None ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%twrLd)) THEN - i1_l = LBOUND(SrcOutputData%twrLd,1) - i1_u = UBOUND(SrcOutputData%twrLd,1) - IF (.NOT. ASSOCIATED(DstOutputData%twrLd)) THEN - ALLOCATE(DstOutputData%twrLd(i1_l:i1_u),STAT=ErrStat2) +IF (ASSOCIATED(SrcParamData%nBlades)) THEN + i1_l = LBOUND(SrcParamData%nBlades,1) + i1_u = UBOUND(SrcParamData%nBlades,1) + IF (.NOT. ASSOCIATED(DstParamData%nBlades)) THEN + ALLOCATE(DstParamData%nBlades(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%twrLd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nBlades.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%twrLd_Len = SIZE(DstOutputData%twrLd) - IF (DstOutputData%c_obj%twrLd_Len > 0) & - DstOutputData%c_obj%twrLd = C_LOC( DstOutputData%twrLd( i1_l ) ) + DstParamData%c_obj%nBlades_Len = SIZE(DstParamData%nBlades) + IF (DstParamData%c_obj%nBlades_Len > 0) & + DstParamData%c_obj%nBlades = C_LOC( DstParamData%nBlades( i1_l ) ) END IF - DstOutputData%twrLd = SrcOutputData%twrLd + DstParamData%nBlades = SrcParamData%nBlades ENDIF -IF (ASSOCIATED(SrcOutputData%bldLd)) THEN - i1_l = LBOUND(SrcOutputData%bldLd,1) - i1_u = UBOUND(SrcOutputData%bldLd,1) - IF (.NOT. ASSOCIATED(DstOutputData%bldLd)) THEN - ALLOCATE(DstOutputData%bldLd(i1_l:i1_u),STAT=ErrStat2) +IF (ASSOCIATED(SrcParamData%nBladeNodes)) THEN + i1_l = LBOUND(SrcParamData%nBladeNodes,1) + i1_u = UBOUND(SrcParamData%nBladeNodes,1) + IF (.NOT. ASSOCIATED(DstParamData%nBladeNodes)) THEN + ALLOCATE(DstParamData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%bldLd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DstOutputData%c_obj%bldLd_Len = SIZE(DstOutputData%bldLd) - IF (DstOutputData%c_obj%bldLd_Len > 0) & - DstOutputData%c_obj%bldLd = C_LOC( DstOutputData%bldLd( i1_l ) ) + DstParamData%c_obj%nBladeNodes_Len = SIZE(DstParamData%nBladeNodes) + IF (DstParamData%c_obj%nBladeNodes_Len > 0) & + DstParamData%c_obj%nBladeNodes = C_LOC( DstParamData%nBladeNodes( i1_l ) ) END IF - DstOutputData%bldLd = SrcOutputData%bldLd + DstParamData%nBladeNodes = SrcParamData%nBladeNodes ENDIF - END SUBROUTINE ExtLdDX_CopyOutput +IF (ASSOCIATED(SrcParamData%nTowerNodes)) THEN + i1_l = LBOUND(SrcParamData%nTowerNodes,1) + i1_u = UBOUND(SrcParamData%nTowerNodes,1) + IF (.NOT. ASSOCIATED(DstParamData%nTowerNodes)) THEN + ALLOCATE(DstParamData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%nTowerNodes_Len = SIZE(DstParamData%nTowerNodes) + IF (DstParamData%c_obj%nTowerNodes_Len > 0) & + DstParamData%c_obj%nTowerNodes = C_LOC( DstParamData%nTowerNodes( i1_l ) ) + END IF + DstParamData%nTowerNodes = SrcParamData%nTowerNodes +ENDIF + END SUBROUTINE ExtLdDX_CopyParam - SUBROUTINE ExtLdDX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) - TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: OutputData + SUBROUTINE ExtLdDX_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLdDX_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers @@ -1849,7 +1620,7 @@ SUBROUTINE ExtLdDX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointer LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_DestroyOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_DestroyParam' ErrStat = ErrID_None ErrMsg = "" @@ -1860,27 +1631,34 @@ SUBROUTINE ExtLdDX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointer DEALLOCATEpointers_local = .true. END IF -IF (ASSOCIATED(OutputData%twrLd)) THEN +IF (ASSOCIATED(ParamData%nBlades)) THEN IF (DEALLOCATEpointers_local) & - DEALLOCATE(OutputData%twrLd) - OutputData%twrLd => NULL() - OutputData%C_obj%twrLd = C_NULL_PTR - OutputData%C_obj%twrLd_Len = 0 + DEALLOCATE(ParamData%nBlades) + ParamData%nBlades => NULL() + ParamData%C_obj%nBlades = C_NULL_PTR + ParamData%C_obj%nBlades_Len = 0 ENDIF -IF (ASSOCIATED(OutputData%bldLd)) THEN +IF (ASSOCIATED(ParamData%nBladeNodes)) THEN IF (DEALLOCATEpointers_local) & - DEALLOCATE(OutputData%bldLd) - OutputData%bldLd => NULL() - OutputData%C_obj%bldLd = C_NULL_PTR - OutputData%C_obj%bldLd_Len = 0 + DEALLOCATE(ParamData%nBladeNodes) + ParamData%nBladeNodes => NULL() + ParamData%C_obj%nBladeNodes = C_NULL_PTR + ParamData%C_obj%nBladeNodes_Len = 0 ENDIF - END SUBROUTINE ExtLdDX_DestroyOutput +IF (ASSOCIATED(ParamData%nTowerNodes)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%nTowerNodes) + ParamData%nTowerNodes => NULL() + ParamData%C_obj%nTowerNodes = C_NULL_PTR + ParamData%C_obj%nTowerNodes_Len = 0 +ENDIF + END SUBROUTINE ExtLdDX_DestroyParam - SUBROUTINE ExtLdDX_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE ExtLdDX_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(ExtLdDX_OutputType), INTENT(IN) :: InData + TYPE(ExtLdDX_ParameterType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1895,7 +1673,7 @@ SUBROUTINE ExtLdDX_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_PackOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_PackParam' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1911,15 +1689,414 @@ SUBROUTINE ExtLdDX_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! twrLd allocated yes/no - IF ( ASSOCIATED(InData%twrLd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! twrLd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%twrLd) ! twrLd - END IF - Int_BufSz = Int_BufSz + 1 ! bldLd allocated yes/no - IF ( ASSOCIATED(InData%bldLd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bldLd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%bldLd) ! bldLd + Int_BufSz = Int_BufSz + 1 ! nBlades allocated yes/no + IF ( ASSOCIATED(InData%nBlades) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nBlades upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nBlades) ! nBlades + END IF + Int_BufSz = Int_BufSz + 1 ! nBladeNodes allocated yes/no + IF ( ASSOCIATED(InData%nBladeNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nBladeNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nBladeNodes) ! nBladeNodes + END IF + Int_BufSz = Int_BufSz + 1 ! nTowerNodes allocated yes/no + IF ( ASSOCIATED(InData%nTowerNodes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nTowerNodes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nTowerNodes) ! nTowerNodes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ASSOCIATED(InData%nBlades) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nBlades,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBlades,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nBlades,1), UBOUND(InData%nBlades,1) + IntKiBuf(Int_Xferred) = InData%nBlades(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nBladeNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nBladeNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBladeNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nBladeNodes,1), UBOUND(InData%nBladeNodes,1) + IntKiBuf(Int_Xferred) = InData%nBladeNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nTowerNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nTowerNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nTowerNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nTowerNodes,1), UBOUND(InData%nTowerNodes,1) + IntKiBuf(Int_Xferred) = InData%nTowerNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_PackParam + + SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBlades not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nBlades)) DEALLOCATE(OutData%nBlades) + ALLOCATE(OutData%nBlades(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBlades.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nBlades_Len = SIZE(OutData%nBlades) + IF (OutData%c_obj%nBlades_Len > 0) & + OutData%c_obj%nBlades = C_LOC( OutData%nBlades( i1_l ) ) + DO i1 = LBOUND(OutData%nBlades,1), UBOUND(OutData%nBlades,1) + OutData%nBlades(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBladeNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nBladeNodes)) DEALLOCATE(OutData%nBladeNodes) + ALLOCATE(OutData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nBladeNodes_Len = SIZE(OutData%nBladeNodes) + IF (OutData%c_obj%nBladeNodes_Len > 0) & + OutData%c_obj%nBladeNodes = C_LOC( OutData%nBladeNodes( i1_l ) ) + DO i1 = LBOUND(OutData%nBladeNodes,1), UBOUND(OutData%nBladeNodes,1) + OutData%nBladeNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nTowerNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nTowerNodes)) DEALLOCATE(OutData%nTowerNodes) + ALLOCATE(OutData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nTowerNodes_Len = SIZE(OutData%nTowerNodes) + IF (OutData%c_obj%nTowerNodes_Len > 0) & + OutData%c_obj%nTowerNodes = C_LOC( OutData%nTowerNodes( i1_l ) ) + DO i1 = LBOUND(OutData%nTowerNodes,1), UBOUND(OutData%nTowerNodes,1) + OutData%nTowerNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_UnPackParam + + SUBROUTINE ExtLdDX_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- nBlades Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nBlades ) ) THEN + NULLIFY( ParamData%nBlades ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nBlades, ParamData%nBlades, (/ParamData%C_obj%nBlades_Len/)) + END IF + END IF + + ! -- nBladeNodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nBladeNodes ) ) THEN + NULLIFY( ParamData%nBladeNodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nBladeNodes, ParamData%nBladeNodes, (/ParamData%C_obj%nBladeNodes_Len/)) + END IF + END IF + + ! -- nTowerNodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nTowerNodes ) ) THEN + NULLIFY( ParamData%nTowerNodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nTowerNodes, ParamData%nTowerNodes, (/ParamData%C_obj%nTowerNodes_Len/)) + END IF + END IF + END SUBROUTINE ExtLdDX_C2Fary_CopyParam + + SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- nBlades Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%nBlades)) THEN + ParamData%c_obj%nBlades_Len = 0 + ParamData%c_obj%nBlades = C_NULL_PTR + ELSE + ParamData%c_obj%nBlades_Len = SIZE(ParamData%nBlades) + IF (ParamData%c_obj%nBlades_Len > 0) & + ParamData%c_obj%nBlades = C_LOC( ParamData%nBlades( LBOUND(ParamData%nBlades,1) ) ) + END IF + END IF + + ! -- nBladeNodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%nBladeNodes)) THEN + ParamData%c_obj%nBladeNodes_Len = 0 + ParamData%c_obj%nBladeNodes = C_NULL_PTR + ELSE + ParamData%c_obj%nBladeNodes_Len = SIZE(ParamData%nBladeNodes) + IF (ParamData%c_obj%nBladeNodes_Len > 0) & + ParamData%c_obj%nBladeNodes = C_LOC( ParamData%nBladeNodes( LBOUND(ParamData%nBladeNodes,1) ) ) + END IF + END IF + + ! -- nTowerNodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%nTowerNodes)) THEN + ParamData%c_obj%nTowerNodes_Len = 0 + ParamData%c_obj%nTowerNodes = C_NULL_PTR + ELSE + ParamData%c_obj%nTowerNodes_Len = SIZE(ParamData%nTowerNodes) + IF (ParamData%c_obj%nTowerNodes_Len > 0) & + ParamData%c_obj%nTowerNodes = C_LOC( ParamData%nTowerNodes( LBOUND(ParamData%nTowerNodes,1) ) ) + END IF + END IF + END SUBROUTINE ExtLdDX_F2C_CopyParam + + SUBROUTINE ExtLdDX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLdDX_OutputType), INTENT(IN) :: SrcOutputData + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ASSOCIATED(SrcOutputData%twrLd)) THEN + i1_l = LBOUND(SrcOutputData%twrLd,1) + i1_u = UBOUND(SrcOutputData%twrLd,1) + IF (.NOT. ASSOCIATED(DstOutputData%twrLd)) THEN + ALLOCATE(DstOutputData%twrLd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%twrLd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstOutputData%c_obj%twrLd_Len = SIZE(DstOutputData%twrLd) + IF (DstOutputData%c_obj%twrLd_Len > 0) & + DstOutputData%c_obj%twrLd = C_LOC( DstOutputData%twrLd( i1_l ) ) + END IF + DstOutputData%twrLd = SrcOutputData%twrLd +ENDIF +IF (ASSOCIATED(SrcOutputData%bldLd)) THEN + i1_l = LBOUND(SrcOutputData%bldLd,1) + i1_u = UBOUND(SrcOutputData%bldLd,1) + IF (.NOT. ASSOCIATED(DstOutputData%bldLd)) THEN + ALLOCATE(DstOutputData%bldLd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%bldLd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstOutputData%c_obj%bldLd_Len = SIZE(DstOutputData%bldLd) + IF (DstOutputData%c_obj%bldLd_Len > 0) & + DstOutputData%c_obj%bldLd = C_LOC( DstOutputData%bldLd( i1_l ) ) + END IF + DstOutputData%bldLd = SrcOutputData%bldLd +ENDIF + END SUBROUTINE ExtLdDX_CopyOutput + + SUBROUTINE ExtLdDX_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(ExtLdDX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_DestroyOutput' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + +IF (ASSOCIATED(OutputData%twrLd)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(OutputData%twrLd) + OutputData%twrLd => NULL() + OutputData%C_obj%twrLd = C_NULL_PTR + OutputData%C_obj%twrLd_Len = 0 +ENDIF +IF (ASSOCIATED(OutputData%bldLd)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(OutputData%bldLd) + OutputData%bldLd => NULL() + OutputData%C_obj%bldLd = C_NULL_PTR + OutputData%C_obj%bldLd_Len = 0 +ENDIF + END SUBROUTINE ExtLdDX_DestroyOutput + + SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_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 ! twrLd allocated yes/no + IF ( ASSOCIATED(InData%twrLd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrLd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrLd) ! twrLd + END IF + Int_BufSz = Int_BufSz + 1 ! bldLd allocated yes/no + IF ( ASSOCIATED(InData%bldLd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldLd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldLd) ! bldLd END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -2284,12 +2461,6 @@ SUBROUTINE ExtLdDX_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err u_out%bldRootRefPos(i1) = u1%bldRootRefPos(i1) + b * ScaleFactor END DO END IF ! check if allocated -IF (ASSOCIATED(u_out%nBlades) .AND. ASSOCIATED(u1%nBlades)) THEN -END IF ! check if allocated -IF (ASSOCIATED(u_out%nBladeNodes) .AND. ASSOCIATED(u1%nBladeNodes)) THEN -END IF ! check if allocated -IF (ASSOCIATED(u_out%nTowerNodes) .AND. ASSOCIATED(u1%nTowerNodes)) THEN -END IF ! check if allocated IF (ASSOCIATED(u_out%bldChord) .AND. ASSOCIATED(u1%bldChord)) THEN DO i1 = LBOUND(u_out%bldChord,1),UBOUND(u_out%bldChord,1) b = -(u1%bldChord(i1) - u2%bldChord(i1)) @@ -2447,12 +2618,6 @@ SUBROUTINE ExtLdDX_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, u_out%bldRootRefPos(i1) = u1%bldRootRefPos(i1) + b + c * t_out END DO END IF ! check if allocated -IF (ASSOCIATED(u_out%nBlades) .AND. ASSOCIATED(u1%nBlades)) THEN -END IF ! check if allocated -IF (ASSOCIATED(u_out%nBladeNodes) .AND. ASSOCIATED(u1%nBladeNodes)) THEN -END IF ! check if allocated -IF (ASSOCIATED(u_out%nTowerNodes) .AND. ASSOCIATED(u1%nTowerNodes)) THEN -END IF ! check if allocated IF (ASSOCIATED(u_out%bldChord) .AND. ASSOCIATED(u1%bldChord)) THEN DO i1 = LBOUND(u_out%bldChord,1),UBOUND(u_out%bldChord,1) b = (t(3)**2*(u1%bldChord(i1) - u2%bldChord(i1)) + t(2)**2*(-u1%bldChord(i1) + u3%bldChord(i1)))* scaleFactor diff --git a/modules/extloads/src/ExtLoadsDX_Types.h b/modules/extloads/src/ExtLoadsDX_Types.h index 23d47a3a35..6a818f498c 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.h +++ b/modules/extloads/src/ExtLoadsDX_Types.h @@ -32,15 +32,18 @@ double * hubRefPos ; int hubRefPos_Len ; double * nacRefPos ; int nacRefPos_Len ; double * bldRootRefPos ; int bldRootRefPos_Len ; - int * nBlades ; int nBlades_Len ; - int * nBladeNodes ; int nBladeNodes_Len ; - int * nTowerNodes ; int nTowerNodes_Len ; double * bldChord ; int bldChord_Len ; double * bldRloc ; int bldRloc_Len ; double * twrDia ; int twrDia_Len ; double * twrHloc ; int twrHloc_Len ; double * bldPitch ; int bldPitch_Len ; } ExtLdDX_InputType_t ; + typedef struct ExtLdDX_ParameterType { + void * object ; + int * nBlades ; int nBlades_Len ; + int * nBladeNodes ; int nBladeNodes_Len ; + int * nTowerNodes ; int nTowerNodes_Len ; + } ExtLdDX_ParameterType_t ; typedef struct ExtLdDX_OutputType { void * object ; double * twrLd ; int twrLd_Len ; @@ -48,6 +51,7 @@ } ExtLdDX_OutputType_t ; typedef struct ExtLdDX_UserData { ExtLdDX_InputType_t ExtLdDX_Input ; + ExtLdDX_ParameterType_t ExtLdDX_Param ; ExtLdDX_OutputType_t ExtLdDX_Output ; } ExtLdDX_t ; diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt index 66f457ee8a..d70ba74433 100644 --- a/modules/extloads/src/ExtLoads_Registry.txt +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -72,6 +72,7 @@ typedef ^ OtherStateType ReKi blah - - - "Som # ..... Parameters ................................................................................................................ # Define parameters here: +typedef ^ ParameterType ExtLdDX_ParameterType DX_p - - - "Data to send to external driver" typedef ^ ParameterType IntKi NumBlds - - - "Number of blades on the turbine" - typedef ^ ParameterType IntKi NumBldNds {:} - - "Number of blade nodes for each blade" - typedef ^ ParameterType IntKi nTotBldNds - - - "Total number of blade nodes" - diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 8b6debb03f..c093db875d 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -98,6 +98,7 @@ MODULE ExtLoads_Types ! ======================= ! ========= ExtLd_ParameterType ======= TYPE, PUBLIC :: ExtLd_ParameterType + TYPE(ExtLdDX_ParameterType) :: DX_p !< Data to send to external driver [-] INTEGER(IntKi) :: NumBlds !< Number of blades on the turbine [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NumBldNds !< Number of blade nodes for each blade [-] INTEGER(IntKi) :: nTotBldNds !< Total number of blade nodes [-] @@ -2174,6 +2175,9 @@ SUBROUTINE ExtLd_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs ! ErrStat = ErrID_None ErrMsg = "" + CALL ExtLdDX_CopyParam( SrcParamData%DX_p, DstParamData%DX_p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN DstParamData%NumBlds = SrcParamData%NumBlds IF (ALLOCATED(SrcParamData%NumBldNds)) THEN i1_l = LBOUND(SrcParamData%NumBldNds,1) @@ -2219,6 +2223,8 @@ SUBROUTINE ExtLd_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) DEALLOCATEpointers_local = .true. END IF + CALL ExtLdDX_DestroyParam( ParamData%DX_p, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%NumBldNds)) THEN DEALLOCATE(ParamData%NumBldNds) ENDIF @@ -2259,6 +2265,24 @@ SUBROUTINE ExtLd_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 ! DX_p: size of buffers for each call to pack subtype + CALL ExtLdDX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DX_p, ErrStat2, ErrMsg2, .TRUE. ) ! DX_p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! DX_p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! DX_p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! DX_p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! NumBlds Int_BufSz = Int_BufSz + 1 ! NumBldNds allocated yes/no IF ( ALLOCATED(InData%NumBldNds) ) THEN @@ -2301,6 +2325,34 @@ SUBROUTINE ExtLd_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 + CALL ExtLdDX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DX_p, ErrStat2, ErrMsg2, OnlySize ) ! DX_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 IntKiBuf(Int_Xferred) = InData%NumBlds Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NumBldNds) ) THEN @@ -2365,6 +2417,46 @@ SUBROUTINE ExtLd_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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 ExtLdDX_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DX_p, ErrStat2, ErrMsg2 ) ! DX_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) OutData%NumBlds = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NumBldNds not allocated diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 7da7bd732b..3d818c2fe9 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -510,7 +510,7 @@ end subroutine FAST_Restart !================================================================================================================================== subroutine FAST_ExtLoads_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_c, TurbPosn, AbortErrLev_c, dtDriver_c, dt_c, NumBl_c, & az_blend_mean_c, az_blend_delta_c, vel_mean_c, wind_dir_c, z_ref_c, shear_exp_c, & - ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Init') + ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST, SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Init') !DEC$ ATTRIBUTES DLLEXPORT::FAST_ExtLoads_Init IMPLICIT NONE #ifndef IMPLICIT_DLLEXPORT @@ -533,10 +533,11 @@ subroutine FAST_ExtLoads_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_ REAL(C_DOUBLE), INTENT( OUT) :: dt_c INTEGER(C_INT), INTENT( OUT) :: AbortErrLev_c INTEGER(C_INT), INTENT( OUT) :: NumBl_c - TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST - TYPE(ExtLdDX_OutputType_C),INTENT( OUT) :: ExtLd_Output_to_FAST - TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST - TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST + TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST + TYPE(ExtLdDX_ParameterType_C), INTENT( OUT) :: ExtLd_Parameter_from_FAST + TYPE(ExtLdDX_OutputType_C), INTENT( OUT) :: ExtLd_Output_to_FAST + TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST + TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST INTEGER(C_INT), INTENT( OUT) :: ErrStat_c CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) @@ -597,7 +598,7 @@ subroutine FAST_ExtLoads_Init(iTurb, TMax, InputFileName_c, TurbID, OutFileRoot_ return end if - call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST) + call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST) OutFileRoot_c = TRANSFER( trim(Turbine(iTurb)%p_FAST%OutFileRoot)//C_NULL_CHAR, OutFileRoot_c ) @@ -901,7 +902,7 @@ subroutine FAST_ExtInfw_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c end subroutine FAST_ExtInfw_Restart !================================================================================================================================== subroutine FAST_ExtLoads_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_c, numblades_c, & - n_t_global_c, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST, & + n_t_global_c, ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST, & SC_DX_Input_from_FAST, SC_DX_Output_to_FAST, ErrStat_c, ErrMsg_c) BIND (C, NAME='FAST_ExtLoads_Restart') !DEC$ ATTRIBUTES DLLEXPORT::FAST_ExtLoads_Restart IMPLICIT NONE @@ -915,10 +916,11 @@ subroutine FAST_ExtLoads_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_ INTEGER(C_INT), INTENT( OUT) :: numblades_c REAL(C_DOUBLE), INTENT( OUT) :: dt_c INTEGER(C_INT), INTENT( OUT) :: n_t_global_c - TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST - TYPE(ExtLdDX_OutputType_C),INTENT( OUT) :: ExtLd_Output_to_FAST - TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST - TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST + TYPE(ExtLdDX_InputType_C), INTENT( OUT) :: ExtLd_Input_from_FAST + TYPE(ExtLdDX_ParameterType_C), INTENT( OUT) :: ExtLd_Parameter_from_FAST + TYPE(ExtLdDX_OutputType_C), INTENT( OUT) :: ExtLd_Output_to_FAST + TYPE(SC_DX_InputType_C), INTENT(INOUT) :: SC_DX_Input_from_FAST + TYPE(SC_DX_OutputType_C), INTENT(INOUT) :: SC_DX_Output_to_FAST INTEGER(C_INT), INTENT( OUT) :: ErrStat_c CHARACTER(KIND=C_CHAR), INTENT( OUT) :: ErrMsg_c(IntfStrLen) @@ -972,19 +974,20 @@ subroutine FAST_ExtLoads_Restart(iTurb, CheckpointRootName_c, AbortErrLev_c, dt_ end if write(*,*) 'Finished restoring OpenFAST from checkpoint' - call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Output_to_FAST) + call SetExtLoads_pointers(iTurb, ExtLd_Input_from_FAST, ExtLd_Parameter_from_FAST, ExtLd_Output_to_FAST) ErrStat_c = ErrStat ErrMsg_c = TRANSFER( trim(ErrMsg)//C_NULL_CHAR, ErrMsg_c ) end subroutine FAST_ExtLoads_Restart !================================================================================================================================== -subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_oToOF) +subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_pFromOF, ExtLd_oToOF) IMPLICIT NONE - INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number - TYPE(ExtLdDX_InputType_C), INTENT(INOUT) :: ExtLd_iFromOF - TYPE(ExtLdDX_OutputType_C),INTENT(INOUT) :: ExtLd_oToOF + INTEGER(C_INT), INTENT(IN ) :: iTurb ! Turbine number + TYPE(ExtLdDX_InputType_C), INTENT(INOUT) :: ExtLd_iFromOF + TYPE(ExtLdDX_ParameterType_C), INTENT(INOUT) :: ExtLd_pFromOF + TYPE(ExtLdDX_OutputType_C), INTENT(INOUT) :: ExtLd_oToOF ExtLd_iFromOF%bldPitch_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch_Len; ExtLd_iFromOF%bldPitch = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch ExtLd_iFromOF%twrHloc_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrHloc_Len; ExtLd_iFromOF%twrHloc = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrHloc @@ -996,9 +999,6 @@ subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_oToOF) ExtLd_iFromOF%bldRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRefPos_Len; ExtLd_iFromOF%bldRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRefPos ExtLd_iFromOF%bldRootRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootRefPos_Len; ExtLd_iFromOF%bldRootRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootRefPos ExtLd_iFromOF%bldDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef_Len; ExtLd_iFromOF%bldDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef - ExtLd_iFromOF%nBlades_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBlades_Len; ExtLd_iFromOF%nBlades = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBlades - ExtLd_iFromOF%nBladeNodes_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBladeNodes_Len; ExtLd_iFromOF%nBladeNodes = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nBladeNodes - ExtLd_iFromOF%nTowerNodes_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nTowerNodes_Len; ExtLd_iFromOF%nTowerNodes = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nTowerNodes ExtLd_iFromOF%bldRootDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef_Len; ExtLd_iFromOF%bldRootDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef @@ -1008,6 +1008,10 @@ subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_oToOF) ExtLd_iFromOF%nacRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacRefPos_Len; ExtLd_iFromOF%nacRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacRefPos ExtLd_iFromOF%nacDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef_Len; ExtLd_iFromOF%nacDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef + ExtLd_pFromOF%nBlades_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades_Len; ExtLd_pFromOF%nBlades = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades + ExtLd_pFromOF%nBladeNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes_Len; ExtLd_pFromOF%nBladeNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes + ExtLd_pFromOF%nTowerNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes_Len; ExtLd_pFromOF%nTowerNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes + ExtLd_oToOF%twrLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd_Len; ExtLd_oToOF%twrLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd ExtLd_oToOF%bldLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd_Len; ExtLd_oToOF%bldLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 5427cdbacf..89fbd014d2 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -27,8 +27,8 @@ EXTERNAL_ROUTINE void FAST_ExtInfw_Init(int * iTurb, double *TMax, const char *I ExtInfw_InputType_t* ExtInfw_Input, ExtInfw_OutputType_t* ExtInfw_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_ExtLoads_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); -EXTERNAL_ROUTINE void FAST_ExtLoads_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, double * vel_mean, double * wind_dir, double * z_ref, double * shear_exp, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtLoads_Restart(int * iTurb, const char *CheckpointRootName, int *AbortErrLev, double * dt, int * NumBl, int * n_t_global, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_ParameterType_t* ExtLdDX_Parameter, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); +EXTERNAL_ROUTINE void FAST_ExtLoads_Init(int * iTurb, double *TMax, const char *InputFileName, int * TurbineID, char *OutFileRoot, float * TurbinePosition, int *AbortErrLev, double * dtDriver, double * dt, int * NumBl, double * az_blend_mean, double * az_blend_delta, double * vel_mean, double * wind_dir, double * z_ref, double * shear_exp, ExtLdDX_InputType_t* ExtLdDX_Input, ExtLdDX_ParameterType_t* ExtLdDX_Parameter, ExtLdDX_OutputType_t* ExtLdDX_Output, SC_DX_InputType_t* SC_DX_Input, SC_DX_OutputType_t* SC_DX_Output, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Solution0(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_InitIOarrays_SubStep(int * iTurb, int *ErrStat, char *ErrMsg); EXTERNAL_ROUTINE void FAST_CFD_Prework(int * iTurb, int *ErrStat, char *ErrMsg); From bffd751d0a3b91a773170cc30b6d5f63472ef2cc Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 23 Jan 2024 13:44:30 -0700 Subject: [PATCH 183/232] ExtLoads: move additional inputs to parameters where they belong --- glue-codes/openfast-cpp/src/OpenFAST.cpp | 24 +- modules/extloads/src/ExtLoads.f90 | 64 +- modules/extloads/src/ExtLoadsDX_Registry.txt | 18 +- modules/extloads/src/ExtLoadsDX_Types.f90 | 2085 ++++++++--------- modules/extloads/src/ExtLoadsDX_Types.h | 14 +- modules/openfast-library/src/FAST_Library.f90 | 51 +- 6 files changed, 1070 insertions(+), 1186 deletions(-) diff --git a/glue-codes/openfast-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 8afc735825..6049368eb0 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -2984,10 +2984,10 @@ void fast::OpenFAST::get_ref_positions_from_openfast(int iTurb) { if(turbineData[iTurb].sType == EXTLOADS) { for (int i=0; i < 3; i++) { - brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i] = extld_i_f_FAST[iTurb].hubRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; - brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i] = extld_i_f_FAST[iTurb].nacRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; - brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i+3] = extld_i_f_FAST[iTurb].hubRefPos[i+3]; - brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i+3] = extld_i_f_FAST[iTurb].nacRefPos[i+3]; + brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i] = extld_p_f_FAST[iTurb].hubRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i] = extld_p_f_FAST[iTurb].nacRefPos[i] + turbineData[iTurb].TurbineBasePos[i]; + brFSIData[iTurb][fast::STATE_NP1].hub_ref_pos[i+3] = extld_p_f_FAST[iTurb].hubRefPos[i+3]; + brFSIData[iTurb][fast::STATE_NP1].nac_ref_pos[i+3] = extld_p_f_FAST[iTurb].nacRefPos[i+3]; } int nBlades = turbineData[iTurb].numBlades; @@ -2996,17 +2996,17 @@ void fast::OpenFAST::get_ref_positions_from_openfast(int iTurb) { int nPtsBlade = turbineData[iTurb].nBRfsiPtsBlade[i]; for (int j=0; j < nPtsBlade; j++) { for (int k=0; k < 3; k++) { - brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k] = extld_i_f_FAST[iTurb].bldRefPos[iRunTot*6+k] + turbineData[iTurb].TurbineBasePos[k]; - brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k+3] = extld_i_f_FAST[iTurb].bldRefPos[iRunTot*6+k+3]; + brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k] = extld_p_f_FAST[iTurb].bldRefPos[iRunTot*6+k] + turbineData[iTurb].TurbineBasePos[k]; + brFSIData[iTurb][fast::STATE_NP1].bld_ref_pos[iRunTot*6+k+3] = extld_p_f_FAST[iTurb].bldRefPos[iRunTot*6+k+3]; } - brFSIData[iTurb][fast::STATE_NP1].bld_chord[iRunTot] = extld_i_f_FAST[iTurb].bldChord[iRunTot]; - brFSIData[iTurb][fast::STATE_NP1].bld_rloc[iRunTot] = extld_i_f_FAST[iTurb].bldRloc[iRunTot]; + brFSIData[iTurb][fast::STATE_NP1].bld_chord[iRunTot] = extld_p_f_FAST[iTurb].bldChord[iRunTot]; + brFSIData[iTurb][fast::STATE_NP1].bld_rloc[iRunTot] = extld_p_f_FAST[iTurb].bldRloc[iRunTot]; iRunTot++; } for (int k=0; k < 3; k++) { - brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k] = extld_i_f_FAST[iTurb].bldRootRefPos[i*6+k] + turbineData[iTurb].TurbineBasePos[k]; - brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k+3] = extld_i_f_FAST[iTurb].bldRootRefPos[i*6+k+3]; + brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k] = extld_p_f_FAST[iTurb].bldRootRefPos[i*6+k] + turbineData[iTurb].TurbineBasePos[k]; + brFSIData[iTurb][fast::STATE_NP1].bld_root_ref_pos[i*6+k+3] = extld_p_f_FAST[iTurb].bldRootRefPos[i*6+k+3]; } } @@ -3014,8 +3014,8 @@ void fast::OpenFAST::get_ref_positions_from_openfast(int iTurb) { int nPtsTwr = turbineData[iTurb].nBRfsiPtsTwr; for (int i=0; i < nPtsTwr; i++) { for (int j = 0; j < 3; j++) { - brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j] = extld_i_f_FAST[iTurb].twrRefPos[i*6+j] + turbineData[iTurb].TurbineBasePos[j]; - brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j+3] = extld_i_f_FAST[iTurb].twrRefPos[i*6+j+3]; + brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j] = extld_p_f_FAST[iTurb].twrRefPos[i*6+j] + turbineData[iTurb].TurbineBasePos[j]; + brFSIData[iTurb][fast::STATE_NP1].twr_ref_pos[i*6+j+3] = extld_p_f_FAST[iTurb].twrRefPos[i*6+j+3]; } } diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index 11f2ce86dc..86ae0c85d3 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -553,26 +553,26 @@ subroutine Init_u( u, p, InitInp, errStat, errMsg ) p%DX_p%nBladeNodes(:) = p%NumBldNds(:) ! Set the reference positions next - CALL AllocPAry( u%DX_u%twrRefPos, p%NumTwrNds*6, 'twrRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%bldRefPos, p%nTotBldNds*6, 'bldRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%hubRefPos, 6, 'hubRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%nacRefPos, 6, 'nacRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry (u%DX_u%bldRootRefPos, p%NumBlds*6, 'bldRootRefPos', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%twrRefPos, p%NumTwrNds*6, 'twrRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%bldRefPos, p%nTotBldNds*6, 'bldRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%hubRefPos, 6, 'hubRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%nacRefPos, 6, 'nacRefPos', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry (p%DX_p%bldRootRefPos, p%NumBlds*6, 'bldRootRefPos', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! make sure the C versions are synced with these arrays - u%DX_u%c_obj%twrRefPos_Len = p%NumTwrNds*6; u%DX_u%c_obj%twrRefPos = C_LOC( u%DX_u%twrRefPos(1) ) - u%DX_u%c_obj%bldRefPos_Len = p%nTotBldNds*6; u%DX_u%c_obj%bldRefPos = C_LOC( u%DX_u%bldRefPos(1) ) - u%DX_u%c_obj%hubRefPos_Len = 6; u%DX_u%c_obj%hubRefPos = C_LOC( u%DX_u%hubRefPos(1) ) - u%DX_u%c_obj%nacRefPos_Len = 6; u%DX_u%c_obj%nacRefPos = C_LOC( u%DX_u%nacRefPos(1) ) - u%DX_u%c_obj%bldRootRefPos_Len = p%NumBlds*6; u%DX_u%c_obj%bldRootRefPos = C_LOC( u%DX_u%bldRootRefPos(1) ) + p%DX_p%c_obj%twrRefPos_Len = p%NumTwrNds*6; p%DX_p%c_obj%twrRefPos = C_LOC( p%DX_p%twrRefPos(1) ) + p%DX_p%c_obj%bldRefPos_Len = p%nTotBldNds*6; p%DX_p%c_obj%bldRefPos = C_LOC( p%DX_p%bldRefPos(1) ) + p%DX_p%c_obj%hubRefPos_Len = 6; p%DX_p%c_obj%hubRefPos = C_LOC( p%DX_p%hubRefPos(1) ) + p%DX_p%c_obj%nacRefPos_Len = 6; p%DX_p%c_obj%nacRefPos = C_LOC( p%DX_p%nacRefPos(1) ) + p%DX_p%c_obj%bldRootRefPos_Len = p%NumBlds*6; p%DX_p%c_obj%bldRootRefPos = C_LOC( p%DX_p%bldRootRefPos(1) ) if (p%TwrAero) then do j=1,p%NumTwrNds call BD_CrvExtractCrv(u%TowerMotion%RefOrientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - u%DX_u%twrRefPos((j-1)*6+1:(j-1)*6+3) = u%TowerMotion%Position(:,j) - u%DX_u%twrRefPos((j-1)*6+4:(j-1)*6+6) = wm_crv + p%DX_p%twrRefPos((j-1)*6+1:(j-1)*6+3) = u%TowerMotion%Position(:,j) + p%DX_p%twrRefPos((j-1)*6+4:(j-1)*6+6) = wm_crv end do end if @@ -581,27 +581,27 @@ subroutine Init_u( u, p, InitInp, errStat, errMsg ) do j=1,p%NumBldNds(k) call BD_CrvExtractCrv(u%BladeMotion(k)%RefOrientation(:,:,j), wm_crv, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - u%DX_u%bldRefPos((jTot-1)*6+1:(jTot-1)*6+3) = u%BladeMotion(k)%Position(:,j) - u%DX_u%bldRefPos((jTot-1)*6+4:(jTot-1)*6+6) = wm_crv + p%DX_p%bldRefPos((jTot-1)*6+1:(jTot-1)*6+3) = u%BladeMotion(k)%Position(:,j) + p%DX_p%bldRefPos((jTot-1)*6+4:(jTot-1)*6+6) = wm_crv jTot = jTot+1 end do end do call BD_CrvExtractCrv(u%HubMotion%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - u%DX_u%hubRefPos(1:3) = u%HubMotion%Position(:,1) - u%DX_u%hubRefPos(4:6) = wm_crv + p%DX_p%hubRefPos(1:3) = u%HubMotion%Position(:,1) + p%DX_p%hubRefPos(4:6) = wm_crv call BD_CrvExtractCrv(u%NacelleMotion%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - u%DX_u%nacRefPos(1:3) = u%NacelleMotion%Position(:,1) - u%DX_u%nacRefPos(4:6) = wm_crv + p%DX_p%nacRefPos(1:3) = u%NacelleMotion%Position(:,1) + p%DX_p%nacRefPos(4:6) = wm_crv do k=1,p%NumBlds call BD_CrvExtractCrv(u%BladeRootMotion(k)%RefOrientation(:,:,1), wm_crv, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - u%DX_u%bldRootRefPos((k-1)*6+1:(k-1)*6+3) = u%BladeRootMotion(k)%Position(:,1) - u%DX_u%bldRootRefPos((k-1)*6+4:(k-1)*6+6) = wm_crv + p%DX_p%bldRootRefPos((k-1)*6+1:(k-1)*6+3) = u%BladeRootMotion(k)%Position(:,1) + p%DX_p%bldRootRefPos((k-1)*6+4:(k-1)*6+6) = wm_crv end do @@ -621,31 +621,31 @@ subroutine Init_u( u, p, InitInp, errStat, errMsg ) call ExtLd_ConvertInpDataForExtProg(u, p, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%bldChord, p%nTotBldNds, 'bldChord', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%bldRloc, p%nTotBldNds, 'bldRloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%twrdia, p%NumTwrNds, 'twrDia', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocPAry( u%DX_u%twrHloc, p%NumTwrNds, 'twrHloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%bldChord, p%nTotBldNds, 'bldChord', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%bldRloc, p%nTotBldNds, 'bldRloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%twrdia, p%NumTwrNds, 'twrDia', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocPAry( p%DX_p%twrHloc, p%NumTwrNds, 'twrHloc', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocPAry( u%DX_u%bldPitch, p%NumBlds, 'bldPitch', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! make sure the C versions are synced with these arrays - u%DX_u%c_obj%bldChord_Len = p%nTotBldNds; u%DX_u%c_obj%bldChord = C_LOC( u%DX_u%bldChord(1) ) - u%DX_u%c_obj%bldRloc_Len = p%nTotBldNds; u%DX_u%c_obj%bldRloc = C_LOC( u%DX_u%bldRloc(1) ) - u%DX_u%c_obj%twrDia_Len = p%NumTwrNds; u%DX_u%c_obj%twrDia = C_LOC( u%DX_u%twrDia(1) ) - u%DX_u%c_obj%twrHloc_Len = p%NumTwrNds; u%DX_u%c_obj%twrHloc = C_LOC( u%DX_u%twrHloc(1) ) + p%DX_p%c_obj%bldChord_Len = p%nTotBldNds; p%DX_p%c_obj%bldChord = C_LOC( p%DX_p%bldChord(1) ) + p%DX_p%c_obj%bldRloc_Len = p%nTotBldNds; p%DX_p%c_obj%bldRloc = C_LOC( p%DX_p%bldRloc(1) ) + p%DX_p%c_obj%twrDia_Len = p%NumTwrNds; p%DX_p%c_obj%twrDia = C_LOC( p%DX_p%twrDia(1) ) + p%DX_p%c_obj%twrHloc_Len = p%NumTwrNds; p%DX_p%c_obj%twrHloc = C_LOC( p%DX_p%twrHloc(1) ) u%DX_u%c_obj%bldPitch_Len = p%NumBlds; u%DX_u%c_obj%bldPitch = C_LOC( u%DX_u%bldPitch(1) ) jTot = 1 do k=1,p%NumBlds do j=1,p%NumBldNds(k) - u%DX_u%bldChord(jTot) = InitInp%bldChord(j,k) - u%DX_u%bldRloc(jTot) = InitInp%bldRloc(j,k) + p%DX_p%bldChord(jTot) = InitInp%bldChord(j,k) + p%DX_p%bldRloc(jTot) = InitInp%bldRloc(j,k) jTot = jTot+1 end do end do do j=1,p%NumTwrNds - u%DX_u%twrDia(j) = InitInp%twrDia(j) - u%DX_u%twrHloc(j) = InitInp%twrHloc(j) + p%DX_p%twrDia(j) = InitInp%twrDia(j) + p%DX_p%twrHloc(j) = InitInp%twrHloc(j) end do end subroutine Init_u diff --git a/modules/extloads/src/ExtLoadsDX_Registry.txt b/modules/extloads/src/ExtLoadsDX_Registry.txt index 042033a4a0..f7b87c44eb 100644 --- a/modules/extloads/src/ExtLoadsDX_Registry.txt +++ b/modules/extloads/src/ExtLoadsDX_Registry.txt @@ -23,21 +23,21 @@ typedef ^ InputType R8Ki bldDef {:} - - typedef ^ InputType R8Ki hubDef {:} - - "Deformations on the hub - to send to external driver" typedef ^ InputType R8Ki nacDef {:} - - "Deformations the nacelle - to send to external driver" typedef ^ InputType R8Ki bldRootDef {:} - - "Deformations of the blade root nodes - to send to external driver" -typedef ^ InputType R8Ki twrRefPos {:} - - "Reference position of the tower nodes - to send to external driver" -typedef ^ InputType R8Ki bldRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" -typedef ^ InputType R8Ki hubRefPos {:} - - "Reference position of the tower nodes - to send to external driver" -typedef ^ InputType R8Ki nacRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" -typedef ^ InputType R8Ki bldRootRefPos {:} - - "Reference position of the blade root nodes - to send to external driver" -typedef ^ InputType R8Ki bldChord {:} - - "Blade chord" m -typedef ^ InputType R8Ki bldRloc {:} - - "Radial location along the blade" m -typedef ^ InputType R8Ki twrDia {:} - - "Tower diameter" m -typedef ^ InputType R8Ki twrHloc {:} - - "Height location along the tower" m typedef ^ InputType R8Ki bldPitch {:} - - "Pitch angle of blade" # ..... Parameters ................................................................................................................ typedef ^ ParameterType IntKi nBlades {:} - - "Number of blades" typedef ^ ParameterType IntKi nBladeNodes {:} - - "Number of blade nodes for each blade" - typedef ^ ParameterType IntKi nTowerNodes {:} - - "Number of tower nodes for each blade" - +typedef ^ ParameterType R8Ki twrRefPos {:} - - "Reference position of the tower nodes - to send to external driver" +typedef ^ ParameterType R8Ki bldRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" +typedef ^ ParameterType R8Ki hubRefPos {:} - - "Reference position of the tower nodes - to send to external driver" +typedef ^ ParameterType R8Ki nacRefPos {:} - - "Reference position of the all blade nodes - to send to external driver" +typedef ^ ParameterType R8Ki bldRootRefPos {:} - - "Reference position of the blade root nodes - to send to external driver" +typedef ^ ParameterType R8Ki bldChord {:} - - "Blade chord" m +typedef ^ ParameterType R8Ki bldRloc {:} - - "Radial location along the blade" m +typedef ^ ParameterType R8Ki twrDia {:} - - "Tower diameter" m +typedef ^ ParameterType R8Ki twrHloc {:} - - "Height location along the tower" m # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/extloads/src/ExtLoadsDX_Types.f90 b/modules/extloads/src/ExtLoadsDX_Types.f90 index f989cb6ac9..ba13696190 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.f90 +++ b/modules/extloads/src/ExtLoadsDX_Types.f90 @@ -47,24 +47,6 @@ MODULE ExtLoadsDX_Types INTEGER(C_int) :: nacDef_Len = 0 TYPE(C_ptr) :: bldRootDef = C_NULL_PTR INTEGER(C_int) :: bldRootDef_Len = 0 - TYPE(C_ptr) :: twrRefPos = C_NULL_PTR - INTEGER(C_int) :: twrRefPos_Len = 0 - TYPE(C_ptr) :: bldRefPos = C_NULL_PTR - INTEGER(C_int) :: bldRefPos_Len = 0 - TYPE(C_ptr) :: hubRefPos = C_NULL_PTR - INTEGER(C_int) :: hubRefPos_Len = 0 - TYPE(C_ptr) :: nacRefPos = C_NULL_PTR - INTEGER(C_int) :: nacRefPos_Len = 0 - TYPE(C_ptr) :: bldRootRefPos = C_NULL_PTR - INTEGER(C_int) :: bldRootRefPos_Len = 0 - TYPE(C_ptr) :: bldChord = C_NULL_PTR - INTEGER(C_int) :: bldChord_Len = 0 - TYPE(C_ptr) :: bldRloc = C_NULL_PTR - INTEGER(C_int) :: bldRloc_Len = 0 - TYPE(C_ptr) :: twrDia = C_NULL_PTR - INTEGER(C_int) :: twrDia_Len = 0 - TYPE(C_ptr) :: twrHloc = C_NULL_PTR - INTEGER(C_int) :: twrHloc_Len = 0 TYPE(C_ptr) :: bldPitch = C_NULL_PTR INTEGER(C_int) :: bldPitch_Len = 0 END TYPE ExtLdDX_InputType_C @@ -75,15 +57,6 @@ MODULE ExtLoadsDX_Types REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubDef => NULL() !< Deformations on the hub - to send to external driver [-] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacDef => NULL() !< Deformations the nacelle - to send to external driver [-] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootDef => NULL() !< Deformations of the blade root nodes - to send to external driver [-] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootRefPos => NULL() !< Reference position of the blade root nodes - to send to external driver [-] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldChord => NULL() !< Blade chord [m] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRloc => NULL() !< Radial location along the blade [m] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDia => NULL() !< Tower diameter [m] - REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrHloc => NULL() !< Height location along the tower [m] REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldPitch => NULL() !< Pitch angle of blade [-] END TYPE ExtLdDX_InputType ! ======================= @@ -96,12 +69,39 @@ MODULE ExtLoadsDX_Types INTEGER(C_int) :: nBladeNodes_Len = 0 TYPE(C_ptr) :: nTowerNodes = C_NULL_PTR INTEGER(C_int) :: nTowerNodes_Len = 0 + TYPE(C_ptr) :: twrRefPos = C_NULL_PTR + INTEGER(C_int) :: twrRefPos_Len = 0 + TYPE(C_ptr) :: bldRefPos = C_NULL_PTR + INTEGER(C_int) :: bldRefPos_Len = 0 + TYPE(C_ptr) :: hubRefPos = C_NULL_PTR + INTEGER(C_int) :: hubRefPos_Len = 0 + TYPE(C_ptr) :: nacRefPos = C_NULL_PTR + INTEGER(C_int) :: nacRefPos_Len = 0 + TYPE(C_ptr) :: bldRootRefPos = C_NULL_PTR + INTEGER(C_int) :: bldRootRefPos_Len = 0 + TYPE(C_ptr) :: bldChord = C_NULL_PTR + INTEGER(C_int) :: bldChord_Len = 0 + TYPE(C_ptr) :: bldRloc = C_NULL_PTR + INTEGER(C_int) :: bldRloc_Len = 0 + TYPE(C_ptr) :: twrDia = C_NULL_PTR + INTEGER(C_int) :: twrDia_Len = 0 + TYPE(C_ptr) :: twrHloc = C_NULL_PTR + INTEGER(C_int) :: twrHloc_Len = 0 END TYPE ExtLdDX_ParameterType_C TYPE, PUBLIC :: ExtLdDX_ParameterType TYPE( ExtLdDX_ParameterType_C ) :: C_obj INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBlades => NULL() !< Number of blades [-] INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nBladeNodes => NULL() !< Number of blade nodes for each blade [-] INTEGER(KIND=C_INT) , DIMENSION(:), POINTER :: nTowerNodes => NULL() !< Number of tower nodes for each blade [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: hubRefPos => NULL() !< Reference position of the tower nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: nacRefPos => NULL() !< Reference position of the all blade nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRootRefPos => NULL() !< Reference position of the blade root nodes - to send to external driver [-] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldChord => NULL() !< Blade chord [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: bldRloc => NULL() !< Radial location along the blade [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrDia => NULL() !< Tower diameter [m] + REAL(KIND=C_DOUBLE) , DIMENSION(:), POINTER :: twrHloc => NULL() !< Height location along the tower [m] END TYPE ExtLdDX_ParameterType ! ======================= ! ========= ExtLdDX_OutputType_C ======= @@ -209,141 +209,6 @@ SUBROUTINE ExtLdDX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, Err END IF DstInputData%bldRootDef = SrcInputData%bldRootDef ENDIF -IF (ASSOCIATED(SrcInputData%twrRefPos)) THEN - i1_l = LBOUND(SrcInputData%twrRefPos,1) - i1_u = UBOUND(SrcInputData%twrRefPos,1) - IF (.NOT. ASSOCIATED(DstInputData%twrRefPos)) THEN - ALLOCATE(DstInputData%twrRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%twrRefPos_Len = SIZE(DstInputData%twrRefPos) - IF (DstInputData%c_obj%twrRefPos_Len > 0) & - DstInputData%c_obj%twrRefPos = C_LOC( DstInputData%twrRefPos( i1_l ) ) - END IF - DstInputData%twrRefPos = SrcInputData%twrRefPos -ENDIF -IF (ASSOCIATED(SrcInputData%bldRefPos)) THEN - i1_l = LBOUND(SrcInputData%bldRefPos,1) - i1_u = UBOUND(SrcInputData%bldRefPos,1) - IF (.NOT. ASSOCIATED(DstInputData%bldRefPos)) THEN - ALLOCATE(DstInputData%bldRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%bldRefPos_Len = SIZE(DstInputData%bldRefPos) - IF (DstInputData%c_obj%bldRefPos_Len > 0) & - DstInputData%c_obj%bldRefPos = C_LOC( DstInputData%bldRefPos( i1_l ) ) - END IF - DstInputData%bldRefPos = SrcInputData%bldRefPos -ENDIF -IF (ASSOCIATED(SrcInputData%hubRefPos)) THEN - i1_l = LBOUND(SrcInputData%hubRefPos,1) - i1_u = UBOUND(SrcInputData%hubRefPos,1) - IF (.NOT. ASSOCIATED(DstInputData%hubRefPos)) THEN - ALLOCATE(DstInputData%hubRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%hubRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%hubRefPos_Len = SIZE(DstInputData%hubRefPos) - IF (DstInputData%c_obj%hubRefPos_Len > 0) & - DstInputData%c_obj%hubRefPos = C_LOC( DstInputData%hubRefPos( i1_l ) ) - END IF - DstInputData%hubRefPos = SrcInputData%hubRefPos -ENDIF -IF (ASSOCIATED(SrcInputData%nacRefPos)) THEN - i1_l = LBOUND(SrcInputData%nacRefPos,1) - i1_u = UBOUND(SrcInputData%nacRefPos,1) - IF (.NOT. ASSOCIATED(DstInputData%nacRefPos)) THEN - ALLOCATE(DstInputData%nacRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%nacRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%nacRefPos_Len = SIZE(DstInputData%nacRefPos) - IF (DstInputData%c_obj%nacRefPos_Len > 0) & - DstInputData%c_obj%nacRefPos = C_LOC( DstInputData%nacRefPos( i1_l ) ) - END IF - DstInputData%nacRefPos = SrcInputData%nacRefPos -ENDIF -IF (ASSOCIATED(SrcInputData%bldRootRefPos)) THEN - i1_l = LBOUND(SrcInputData%bldRootRefPos,1) - i1_u = UBOUND(SrcInputData%bldRootRefPos,1) - IF (.NOT. ASSOCIATED(DstInputData%bldRootRefPos)) THEN - ALLOCATE(DstInputData%bldRootRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%bldRootRefPos_Len = SIZE(DstInputData%bldRootRefPos) - IF (DstInputData%c_obj%bldRootRefPos_Len > 0) & - DstInputData%c_obj%bldRootRefPos = C_LOC( DstInputData%bldRootRefPos( i1_l ) ) - END IF - DstInputData%bldRootRefPos = SrcInputData%bldRootRefPos -ENDIF -IF (ASSOCIATED(SrcInputData%bldChord)) THEN - i1_l = LBOUND(SrcInputData%bldChord,1) - i1_u = UBOUND(SrcInputData%bldChord,1) - IF (.NOT. ASSOCIATED(DstInputData%bldChord)) THEN - ALLOCATE(DstInputData%bldChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%bldChord_Len = SIZE(DstInputData%bldChord) - IF (DstInputData%c_obj%bldChord_Len > 0) & - DstInputData%c_obj%bldChord = C_LOC( DstInputData%bldChord( i1_l ) ) - END IF - DstInputData%bldChord = SrcInputData%bldChord -ENDIF -IF (ASSOCIATED(SrcInputData%bldRloc)) THEN - i1_l = LBOUND(SrcInputData%bldRloc,1) - i1_u = UBOUND(SrcInputData%bldRloc,1) - IF (.NOT. ASSOCIATED(DstInputData%bldRloc)) THEN - ALLOCATE(DstInputData%bldRloc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%bldRloc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%bldRloc_Len = SIZE(DstInputData%bldRloc) - IF (DstInputData%c_obj%bldRloc_Len > 0) & - DstInputData%c_obj%bldRloc = C_LOC( DstInputData%bldRloc( i1_l ) ) - END IF - DstInputData%bldRloc = SrcInputData%bldRloc -ENDIF -IF (ASSOCIATED(SrcInputData%twrDia)) THEN - i1_l = LBOUND(SrcInputData%twrDia,1) - i1_u = UBOUND(SrcInputData%twrDia,1) - IF (.NOT. ASSOCIATED(DstInputData%twrDia)) THEN - ALLOCATE(DstInputData%twrDia(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrDia.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%twrDia_Len = SIZE(DstInputData%twrDia) - IF (DstInputData%c_obj%twrDia_Len > 0) & - DstInputData%c_obj%twrDia = C_LOC( DstInputData%twrDia( i1_l ) ) - END IF - DstInputData%twrDia = SrcInputData%twrDia -ENDIF -IF (ASSOCIATED(SrcInputData%twrHloc)) THEN - i1_l = LBOUND(SrcInputData%twrHloc,1) - i1_u = UBOUND(SrcInputData%twrHloc,1) - IF (.NOT. ASSOCIATED(DstInputData%twrHloc)) THEN - ALLOCATE(DstInputData%twrHloc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%twrHloc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%c_obj%twrHloc_Len = SIZE(DstInputData%twrHloc) - IF (DstInputData%c_obj%twrHloc_Len > 0) & - DstInputData%c_obj%twrHloc = C_LOC( DstInputData%twrHloc( i1_l ) ) - END IF - DstInputData%twrHloc = SrcInputData%twrHloc -ENDIF IF (ASSOCIATED(SrcInputData%bldPitch)) THEN i1_l = LBOUND(SrcInputData%bldPitch,1) i1_u = UBOUND(SrcInputData%bldPitch,1) @@ -417,69 +282,6 @@ SUBROUTINE ExtLdDX_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers InputData%C_obj%bldRootDef = C_NULL_PTR InputData%C_obj%bldRootDef_Len = 0 ENDIF -IF (ASSOCIATED(InputData%twrRefPos)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%twrRefPos) - InputData%twrRefPos => NULL() - InputData%C_obj%twrRefPos = C_NULL_PTR - InputData%C_obj%twrRefPos_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%bldRefPos)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%bldRefPos) - InputData%bldRefPos => NULL() - InputData%C_obj%bldRefPos = C_NULL_PTR - InputData%C_obj%bldRefPos_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%hubRefPos)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%hubRefPos) - InputData%hubRefPos => NULL() - InputData%C_obj%hubRefPos = C_NULL_PTR - InputData%C_obj%hubRefPos_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%nacRefPos)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%nacRefPos) - InputData%nacRefPos => NULL() - InputData%C_obj%nacRefPos = C_NULL_PTR - InputData%C_obj%nacRefPos_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%bldRootRefPos)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%bldRootRefPos) - InputData%bldRootRefPos => NULL() - InputData%C_obj%bldRootRefPos = C_NULL_PTR - InputData%C_obj%bldRootRefPos_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%bldChord)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%bldChord) - InputData%bldChord => NULL() - InputData%C_obj%bldChord = C_NULL_PTR - InputData%C_obj%bldChord_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%bldRloc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%bldRloc) - InputData%bldRloc => NULL() - InputData%C_obj%bldRloc = C_NULL_PTR - InputData%C_obj%bldRloc_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%twrDia)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%twrDia) - InputData%twrDia => NULL() - InputData%C_obj%twrDia = C_NULL_PTR - InputData%C_obj%twrDia_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%twrHloc)) THEN - IF (DEALLOCATEpointers_local) & - DEALLOCATE(InputData%twrHloc) - InputData%twrHloc => NULL() - InputData%C_obj%twrHloc = C_NULL_PTR - InputData%C_obj%twrHloc_Len = 0 -ENDIF IF (ASSOCIATED(InputData%bldPitch)) THEN IF (DEALLOCATEpointers_local) & DEALLOCATE(InputData%bldPitch) @@ -549,51 +351,6 @@ SUBROUTINE ExtLdDX_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! bldRootDef upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%bldRootDef) ! bldRootDef END IF - Int_BufSz = Int_BufSz + 1 ! twrRefPos allocated yes/no - IF ( ASSOCIATED(InData%twrRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! twrRefPos upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%twrRefPos) ! twrRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! bldRefPos allocated yes/no - IF ( ASSOCIATED(InData%bldRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bldRefPos upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%bldRefPos) ! bldRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! hubRefPos allocated yes/no - IF ( ASSOCIATED(InData%hubRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! hubRefPos upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%hubRefPos) ! hubRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! nacRefPos allocated yes/no - IF ( ASSOCIATED(InData%nacRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nacRefPos upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%nacRefPos) ! nacRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! bldRootRefPos allocated yes/no - IF ( ASSOCIATED(InData%bldRootRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bldRootRefPos upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%bldRootRefPos) ! bldRootRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! bldChord allocated yes/no - IF ( ASSOCIATED(InData%bldChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bldChord upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%bldChord) ! bldChord - END IF - Int_BufSz = Int_BufSz + 1 ! bldRloc allocated yes/no - IF ( ASSOCIATED(InData%bldRloc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bldRloc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%bldRloc) ! bldRloc - END IF - Int_BufSz = Int_BufSz + 1 ! twrDia allocated yes/no - IF ( ASSOCIATED(InData%twrDia) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! twrDia upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%twrDia) ! twrDia - END IF - Int_BufSz = Int_BufSz + 1 ! twrHloc allocated yes/no - IF ( ASSOCIATED(InData%twrHloc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! twrHloc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%twrHloc) ! twrHloc - END IF Int_BufSz = Int_BufSz + 1 ! bldPitch allocated yes/no IF ( ASSOCIATED(InData%bldPitch) ) THEN Int_BufSz = Int_BufSz + 2*1 ! bldPitch upper/lower bounds for each dimension @@ -703,233 +460,98 @@ SUBROUTINE ExtLdDX_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%twrRefPos) ) THEN + IF ( .NOT. ASSOCIATED(InData%bldPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%twrRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrRefPos,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldPitch,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldPitch,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%twrRefPos,1), UBOUND(InData%twrRefPos,1) - DbKiBuf(Db_Xferred) = InData%twrRefPos(i1) + DO i1 = LBOUND(InData%bldPitch,1), UBOUND(InData%bldPitch,1) + DbKiBuf(Db_Xferred) = InData%bldPitch(i1) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%bldRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 + END SUBROUTINE ExtLdDX_PackInput + + SUBROUTINE ExtLdDX_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(ExtLdDX_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_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 ! twrDef not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRefPos,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bldRefPos,1), UBOUND(InData%bldRefPos,1) - DbKiBuf(Db_Xferred) = InData%bldRefPos(i1) + IF (ASSOCIATED(OutData%twrDef)) DEALLOCATE(OutData%twrDef) + ALLOCATE(OutData%twrDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrDef_Len = SIZE(OutData%twrDef) + IF (OutData%c_obj%twrDef_Len > 0) & + OutData%c_obj%twrDef = C_LOC( OutData%twrDef( i1_l ) ) + DO i1 = LBOUND(OutData%twrDef,1), UBOUND(OutData%twrDef,1) + OutData%twrDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%hubRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldDef not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hubRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubRefPos,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%hubRefPos,1), UBOUND(InData%hubRefPos,1) - DbKiBuf(Db_Xferred) = InData%hubRefPos(i1) + IF (ASSOCIATED(OutData%bldDef)) DEALLOCATE(OutData%bldDef) + ALLOCATE(OutData%bldDef(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldDef.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldDef_Len = SIZE(OutData%bldDef) + IF (OutData%c_obj%bldDef_Len > 0) & + OutData%c_obj%bldDef = C_LOC( OutData%bldDef( i1_l ) ) + DO i1 = LBOUND(OutData%bldDef,1), UBOUND(OutData%bldDef,1) + OutData%bldDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%nacRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubDef not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nacRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nacRefPos,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nacRefPos,1), UBOUND(InData%nacRefPos,1) - DbKiBuf(Db_Xferred) = InData%nacRefPos(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%bldRootRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRootRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRootRefPos,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bldRootRefPos,1), UBOUND(InData%bldRootRefPos,1) - DbKiBuf(Db_Xferred) = InData%bldRootRefPos(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%bldChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bldChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldChord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bldChord,1), UBOUND(InData%bldChord,1) - DbKiBuf(Db_Xferred) = InData%bldChord(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%bldRloc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRloc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRloc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bldRloc,1), UBOUND(InData%bldRloc,1) - DbKiBuf(Db_Xferred) = InData%bldRloc(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%twrDia) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%twrDia,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrDia,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%twrDia,1), UBOUND(InData%twrDia,1) - DbKiBuf(Db_Xferred) = InData%twrDia(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%twrHloc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%twrHloc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrHloc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%twrHloc,1), UBOUND(InData%twrHloc,1) - DbKiBuf(Db_Xferred) = InData%twrHloc(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%bldPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bldPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bldPitch,1), UBOUND(InData%bldPitch,1) - DbKiBuf(Db_Xferred) = InData%bldPitch(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtLdDX_PackInput - - SUBROUTINE ExtLdDX_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(ExtLdDX_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_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 ! twrDef not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%twrDef)) DEALLOCATE(OutData%twrDef) - ALLOCATE(OutData%twrDef(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrDef.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%twrDef_Len = SIZE(OutData%twrDef) - IF (OutData%c_obj%twrDef_Len > 0) & - OutData%c_obj%twrDef = C_LOC( OutData%twrDef( i1_l ) ) - DO i1 = LBOUND(OutData%twrDef,1), UBOUND(OutData%twrDef,1) - OutData%twrDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldDef not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%bldDef)) DEALLOCATE(OutData%bldDef) - ALLOCATE(OutData%bldDef(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldDef.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%bldDef_Len = SIZE(OutData%bldDef) - IF (OutData%c_obj%bldDef_Len > 0) & - OutData%c_obj%bldDef = C_LOC( OutData%bldDef( i1_l ) ) - DO i1 = LBOUND(OutData%bldDef,1), UBOUND(OutData%bldDef,1) - OutData%bldDef(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubDef not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 IF (ASSOCIATED(OutData%hubDef)) DEALLOCATE(OutData%hubDef) ALLOCATE(OutData%hubDef(i1_l:i1_u),STAT=ErrStat2) @@ -987,241 +609,52 @@ SUBROUTINE ExtLdDX_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrRefPos not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%twrRefPos)) DEALLOCATE(OutData%twrRefPos) - ALLOCATE(OutData%twrRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ASSOCIATED(OutData%bldPitch)) DEALLOCATE(OutData%bldPitch) + ALLOCATE(OutData%bldPitch(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrRefPos.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%twrRefPos_Len = SIZE(OutData%twrRefPos) - IF (OutData%c_obj%twrRefPos_Len > 0) & - OutData%c_obj%twrRefPos = C_LOC( OutData%twrRefPos( i1_l ) ) - DO i1 = LBOUND(OutData%twrRefPos,1), UBOUND(OutData%twrRefPos,1) - OutData%twrRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + OutData%c_obj%bldPitch_Len = SIZE(OutData%bldPitch) + IF (OutData%c_obj%bldPitch_Len > 0) & + OutData%c_obj%bldPitch = C_LOC( OutData%bldPitch( i1_l ) ) + DO i1 = LBOUND(OutData%bldPitch,1), UBOUND(OutData%bldPitch,1) + OutData%bldPitch(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%bldRefPos)) DEALLOCATE(OutData%bldRefPos) - ALLOCATE(OutData%bldRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN + END SUBROUTINE ExtLdDX_UnPackInput + + SUBROUTINE ExtLdDX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(ExtLdDX_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. END IF - OutData%c_obj%bldRefPos_Len = SIZE(OutData%bldRefPos) - IF (OutData%c_obj%bldRefPos_Len > 0) & - OutData%c_obj%bldRefPos = C_LOC( OutData%bldRefPos( i1_l ) ) - DO i1 = LBOUND(OutData%bldRefPos,1), UBOUND(OutData%bldRefPos,1) - OutData%bldRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%hubRefPos)) DEALLOCATE(OutData%hubRefPos) - ALLOCATE(OutData%hubRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%hubRefPos_Len = SIZE(OutData%hubRefPos) - IF (OutData%c_obj%hubRefPos_Len > 0) & - OutData%c_obj%hubRefPos = C_LOC( OutData%hubRefPos( i1_l ) ) - DO i1 = LBOUND(OutData%hubRefPos,1), UBOUND(OutData%hubRefPos,1) - OutData%hubRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nacRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nacRefPos)) DEALLOCATE(OutData%nacRefPos) - ALLOCATE(OutData%nacRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nacRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%nacRefPos_Len = SIZE(OutData%nacRefPos) - IF (OutData%c_obj%nacRefPos_Len > 0) & - OutData%c_obj%nacRefPos = C_LOC( OutData%nacRefPos( i1_l ) ) - DO i1 = LBOUND(OutData%nacRefPos,1), UBOUND(OutData%nacRefPos,1) - OutData%nacRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRootRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%bldRootRefPos)) DEALLOCATE(OutData%bldRootRefPos) - ALLOCATE(OutData%bldRootRefPos(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%bldRootRefPos_Len = SIZE(OutData%bldRootRefPos) - IF (OutData%c_obj%bldRootRefPos_Len > 0) & - OutData%c_obj%bldRootRefPos = C_LOC( OutData%bldRootRefPos( i1_l ) ) - DO i1 = LBOUND(OutData%bldRootRefPos,1), UBOUND(OutData%bldRootRefPos,1) - OutData%bldRootRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldChord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%bldChord)) DEALLOCATE(OutData%bldChord) - ALLOCATE(OutData%bldChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%bldChord_Len = SIZE(OutData%bldChord) - IF (OutData%c_obj%bldChord_Len > 0) & - OutData%c_obj%bldChord = C_LOC( OutData%bldChord( i1_l ) ) - DO i1 = LBOUND(OutData%bldChord,1), UBOUND(OutData%bldChord,1) - OutData%bldChord(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRloc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%bldRloc)) DEALLOCATE(OutData%bldRloc) - ALLOCATE(OutData%bldRloc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRloc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%bldRloc_Len = SIZE(OutData%bldRloc) - IF (OutData%c_obj%bldRloc_Len > 0) & - OutData%c_obj%bldRloc = C_LOC( OutData%bldRloc( i1_l ) ) - DO i1 = LBOUND(OutData%bldRloc,1), UBOUND(OutData%bldRloc,1) - OutData%bldRloc(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrDia not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%twrDia)) DEALLOCATE(OutData%twrDia) - ALLOCATE(OutData%twrDia(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrDia.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%twrDia_Len = SIZE(OutData%twrDia) - IF (OutData%c_obj%twrDia_Len > 0) & - OutData%c_obj%twrDia = C_LOC( OutData%twrDia( i1_l ) ) - DO i1 = LBOUND(OutData%twrDia,1), UBOUND(OutData%twrDia,1) - OutData%twrDia(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrHloc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%twrHloc)) DEALLOCATE(OutData%twrHloc) - ALLOCATE(OutData%twrHloc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrHloc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%twrHloc_Len = SIZE(OutData%twrHloc) - IF (OutData%c_obj%twrHloc_Len > 0) & - OutData%c_obj%twrHloc = C_LOC( OutData%twrHloc( i1_l ) ) - DO i1 = LBOUND(OutData%twrHloc,1), UBOUND(OutData%twrHloc,1) - OutData%twrHloc(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldPitch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%bldPitch)) DEALLOCATE(OutData%bldPitch) - ALLOCATE(OutData%bldPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%c_obj%bldPitch_Len = SIZE(OutData%bldPitch) - IF (OutData%c_obj%bldPitch_Len > 0) & - OutData%c_obj%bldPitch = C_LOC( OutData%bldPitch( i1_l ) ) - DO i1 = LBOUND(OutData%bldPitch,1), UBOUND(OutData%bldPitch,1) - OutData%bldPitch(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtLdDX_UnPackInput - - SUBROUTINE ExtLdDX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(ExtLdDX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- twrDef Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrDef ) ) THEN - NULLIFY( InputData%twrDef ) - ELSE - CALL C_F_POINTER(InputData%C_obj%twrDef, InputData%twrDef, (/InputData%C_obj%twrDef_Len/)) - END IF + + ! -- twrDef Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrDef ) ) THEN + NULLIFY( InputData%twrDef ) + ELSE + CALL C_F_POINTER(InputData%C_obj%twrDef, InputData%twrDef, (/InputData%C_obj%twrDef_Len/)) + END IF END IF ! -- bldDef Input Data fields @@ -1260,87 +693,6 @@ SUBROUTINE ExtLdDX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF - ! -- twrRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrRefPos ) ) THEN - NULLIFY( InputData%twrRefPos ) - ELSE - CALL C_F_POINTER(InputData%C_obj%twrRefPos, InputData%twrRefPos, (/InputData%C_obj%twrRefPos_Len/)) - END IF - END IF - - ! -- bldRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRefPos ) ) THEN - NULLIFY( InputData%bldRefPos ) - ELSE - CALL C_F_POINTER(InputData%C_obj%bldRefPos, InputData%bldRefPos, (/InputData%C_obj%bldRefPos_Len/)) - END IF - END IF - - ! -- hubRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%hubRefPos ) ) THEN - NULLIFY( InputData%hubRefPos ) - ELSE - CALL C_F_POINTER(InputData%C_obj%hubRefPos, InputData%hubRefPos, (/InputData%C_obj%hubRefPos_Len/)) - END IF - END IF - - ! -- nacRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%nacRefPos ) ) THEN - NULLIFY( InputData%nacRefPos ) - ELSE - CALL C_F_POINTER(InputData%C_obj%nacRefPos, InputData%nacRefPos, (/InputData%C_obj%nacRefPos_Len/)) - END IF - END IF - - ! -- bldRootRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRootRefPos ) ) THEN - NULLIFY( InputData%bldRootRefPos ) - ELSE - CALL C_F_POINTER(InputData%C_obj%bldRootRefPos, InputData%bldRootRefPos, (/InputData%C_obj%bldRootRefPos_Len/)) - END IF - END IF - - ! -- bldChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldChord ) ) THEN - NULLIFY( InputData%bldChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%bldChord, InputData%bldChord, (/InputData%C_obj%bldChord_Len/)) - END IF - END IF - - ! -- bldRloc Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldRloc ) ) THEN - NULLIFY( InputData%bldRloc ) - ELSE - CALL C_F_POINTER(InputData%C_obj%bldRloc, InputData%bldRloc, (/InputData%C_obj%bldRloc_Len/)) - END IF - END IF - - ! -- twrDia Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrDia ) ) THEN - NULLIFY( InputData%twrDia ) - ELSE - CALL C_F_POINTER(InputData%C_obj%twrDia, InputData%twrDia, (/InputData%C_obj%twrDia_Len/)) - END IF - END IF - - ! -- twrHloc Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%twrHloc ) ) THEN - NULLIFY( InputData%twrHloc ) - ELSE - CALL C_F_POINTER(InputData%C_obj%twrHloc, InputData%twrHloc, (/InputData%C_obj%twrHloc_Len/)) - END IF - END IF - ! -- bldPitch Input Data fields IF ( .NOT. SkipPointers_local ) THEN IF ( .NOT. C_ASSOCIATED( InputData%C_obj%bldPitch ) ) THEN @@ -1427,150 +779,42 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END IF - ! -- twrRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%twrRefPos)) THEN - InputData%c_obj%twrRefPos_Len = 0 - InputData%c_obj%twrRefPos = C_NULL_PTR - ELSE - InputData%c_obj%twrRefPos_Len = SIZE(InputData%twrRefPos) - IF (InputData%c_obj%twrRefPos_Len > 0) & - InputData%c_obj%twrRefPos = C_LOC( InputData%twrRefPos( LBOUND(InputData%twrRefPos,1) ) ) - END IF - END IF - - ! -- bldRefPos Input Data fields + ! -- bldPitch Input Data fields IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%bldRefPos)) THEN - InputData%c_obj%bldRefPos_Len = 0 - InputData%c_obj%bldRefPos = C_NULL_PTR + IF ( .NOT. ASSOCIATED(InputData%bldPitch)) THEN + InputData%c_obj%bldPitch_Len = 0 + InputData%c_obj%bldPitch = C_NULL_PTR ELSE - InputData%c_obj%bldRefPos_Len = SIZE(InputData%bldRefPos) - IF (InputData%c_obj%bldRefPos_Len > 0) & - InputData%c_obj%bldRefPos = C_LOC( InputData%bldRefPos( LBOUND(InputData%bldRefPos,1) ) ) + InputData%c_obj%bldPitch_Len = SIZE(InputData%bldPitch) + IF (InputData%c_obj%bldPitch_Len > 0) & + InputData%c_obj%bldPitch = C_LOC( InputData%bldPitch( LBOUND(InputData%bldPitch,1) ) ) END IF END IF + END SUBROUTINE ExtLdDX_F2C_CopyInput - ! -- hubRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%hubRefPos)) THEN - InputData%c_obj%hubRefPos_Len = 0 - InputData%c_obj%hubRefPos = C_NULL_PTR - ELSE - InputData%c_obj%hubRefPos_Len = SIZE(InputData%hubRefPos) - IF (InputData%c_obj%hubRefPos_Len > 0) & - InputData%c_obj%hubRefPos = C_LOC( InputData%hubRefPos( LBOUND(InputData%hubRefPos,1) ) ) - END IF - END IF - - ! -- nacRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%nacRefPos)) THEN - InputData%c_obj%nacRefPos_Len = 0 - InputData%c_obj%nacRefPos = C_NULL_PTR - ELSE - InputData%c_obj%nacRefPos_Len = SIZE(InputData%nacRefPos) - IF (InputData%c_obj%nacRefPos_Len > 0) & - InputData%c_obj%nacRefPos = C_LOC( InputData%nacRefPos( LBOUND(InputData%nacRefPos,1) ) ) - END IF - END IF - - ! -- bldRootRefPos Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%bldRootRefPos)) THEN - InputData%c_obj%bldRootRefPos_Len = 0 - InputData%c_obj%bldRootRefPos = C_NULL_PTR - ELSE - InputData%c_obj%bldRootRefPos_Len = SIZE(InputData%bldRootRefPos) - IF (InputData%c_obj%bldRootRefPos_Len > 0) & - InputData%c_obj%bldRootRefPos = C_LOC( InputData%bldRootRefPos( LBOUND(InputData%bldRootRefPos,1) ) ) - END IF - END IF - - ! -- bldChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%bldChord)) THEN - InputData%c_obj%bldChord_Len = 0 - InputData%c_obj%bldChord = C_NULL_PTR - ELSE - InputData%c_obj%bldChord_Len = SIZE(InputData%bldChord) - IF (InputData%c_obj%bldChord_Len > 0) & - InputData%c_obj%bldChord = C_LOC( InputData%bldChord( LBOUND(InputData%bldChord,1) ) ) - END IF - END IF - - ! -- bldRloc Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%bldRloc)) THEN - InputData%c_obj%bldRloc_Len = 0 - InputData%c_obj%bldRloc = C_NULL_PTR - ELSE - InputData%c_obj%bldRloc_Len = SIZE(InputData%bldRloc) - IF (InputData%c_obj%bldRloc_Len > 0) & - InputData%c_obj%bldRloc = C_LOC( InputData%bldRloc( LBOUND(InputData%bldRloc,1) ) ) - END IF - END IF - - ! -- twrDia Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%twrDia)) THEN - InputData%c_obj%twrDia_Len = 0 - InputData%c_obj%twrDia = C_NULL_PTR - ELSE - InputData%c_obj%twrDia_Len = SIZE(InputData%twrDia) - IF (InputData%c_obj%twrDia_Len > 0) & - InputData%c_obj%twrDia = C_LOC( InputData%twrDia( LBOUND(InputData%twrDia,1) ) ) - END IF - END IF - - ! -- twrHloc Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%twrHloc)) THEN - InputData%c_obj%twrHloc_Len = 0 - InputData%c_obj%twrHloc = C_NULL_PTR - ELSE - InputData%c_obj%twrHloc_Len = SIZE(InputData%twrHloc) - IF (InputData%c_obj%twrHloc_Len > 0) & - InputData%c_obj%twrHloc = C_LOC( InputData%twrHloc( LBOUND(InputData%twrHloc,1) ) ) - END IF - END IF - - ! -- bldPitch Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%bldPitch)) THEN - InputData%c_obj%bldPitch_Len = 0 - InputData%c_obj%bldPitch = C_NULL_PTR - ELSE - InputData%c_obj%bldPitch_Len = SIZE(InputData%bldPitch) - IF (InputData%c_obj%bldPitch_Len > 0) & - InputData%c_obj%bldPitch = C_LOC( InputData%bldPitch( LBOUND(InputData%bldPitch,1) ) ) - END IF - END IF - END SUBROUTINE ExtLdDX_F2C_CopyInput - - SUBROUTINE ExtLdDX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtLdDX_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ExtLdDX_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcParamData%nBlades)) THEN - i1_l = LBOUND(SrcParamData%nBlades,1) - i1_u = UBOUND(SrcParamData%nBlades,1) - IF (.NOT. ASSOCIATED(DstParamData%nBlades)) THEN - ALLOCATE(DstParamData%nBlades(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nBlades.', ErrStat, ErrMsg,RoutineName) - RETURN + SUBROUTINE ExtLdDX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtLdDX_ParameterType), INTENT(IN) :: SrcParamData + TYPE(ExtLdDX_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ExtLdDX_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ASSOCIATED(SrcParamData%nBlades)) THEN + i1_l = LBOUND(SrcParamData%nBlades,1) + i1_u = UBOUND(SrcParamData%nBlades,1) + IF (.NOT. ASSOCIATED(DstParamData%nBlades)) THEN + ALLOCATE(DstParamData%nBlades(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nBlades.', ErrStat, ErrMsg,RoutineName) + RETURN END IF DstParamData%c_obj%nBlades_Len = SIZE(DstParamData%nBlades) IF (DstParamData%c_obj%nBlades_Len > 0) & @@ -1607,6 +851,141 @@ SUBROUTINE ExtLdDX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%c_obj%nTowerNodes = C_LOC( DstParamData%nTowerNodes( i1_l ) ) END IF DstParamData%nTowerNodes = SrcParamData%nTowerNodes +ENDIF +IF (ASSOCIATED(SrcParamData%twrRefPos)) THEN + i1_l = LBOUND(SrcParamData%twrRefPos,1) + i1_u = UBOUND(SrcParamData%twrRefPos,1) + IF (.NOT. ASSOCIATED(DstParamData%twrRefPos)) THEN + ALLOCATE(DstParamData%twrRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twrRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%twrRefPos_Len = SIZE(DstParamData%twrRefPos) + IF (DstParamData%c_obj%twrRefPos_Len > 0) & + DstParamData%c_obj%twrRefPos = C_LOC( DstParamData%twrRefPos( i1_l ) ) + END IF + DstParamData%twrRefPos = SrcParamData%twrRefPos +ENDIF +IF (ASSOCIATED(SrcParamData%bldRefPos)) THEN + i1_l = LBOUND(SrcParamData%bldRefPos,1) + i1_u = UBOUND(SrcParamData%bldRefPos,1) + IF (.NOT. ASSOCIATED(DstParamData%bldRefPos)) THEN + ALLOCATE(DstParamData%bldRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%bldRefPos_Len = SIZE(DstParamData%bldRefPos) + IF (DstParamData%c_obj%bldRefPos_Len > 0) & + DstParamData%c_obj%bldRefPos = C_LOC( DstParamData%bldRefPos( i1_l ) ) + END IF + DstParamData%bldRefPos = SrcParamData%bldRefPos +ENDIF +IF (ASSOCIATED(SrcParamData%hubRefPos)) THEN + i1_l = LBOUND(SrcParamData%hubRefPos,1) + i1_u = UBOUND(SrcParamData%hubRefPos,1) + IF (.NOT. ASSOCIATED(DstParamData%hubRefPos)) THEN + ALLOCATE(DstParamData%hubRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%hubRefPos_Len = SIZE(DstParamData%hubRefPos) + IF (DstParamData%c_obj%hubRefPos_Len > 0) & + DstParamData%c_obj%hubRefPos = C_LOC( DstParamData%hubRefPos( i1_l ) ) + END IF + DstParamData%hubRefPos = SrcParamData%hubRefPos +ENDIF +IF (ASSOCIATED(SrcParamData%nacRefPos)) THEN + i1_l = LBOUND(SrcParamData%nacRefPos,1) + i1_u = UBOUND(SrcParamData%nacRefPos,1) + IF (.NOT. ASSOCIATED(DstParamData%nacRefPos)) THEN + ALLOCATE(DstParamData%nacRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nacRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%nacRefPos_Len = SIZE(DstParamData%nacRefPos) + IF (DstParamData%c_obj%nacRefPos_Len > 0) & + DstParamData%c_obj%nacRefPos = C_LOC( DstParamData%nacRefPos( i1_l ) ) + END IF + DstParamData%nacRefPos = SrcParamData%nacRefPos +ENDIF +IF (ASSOCIATED(SrcParamData%bldRootRefPos)) THEN + i1_l = LBOUND(SrcParamData%bldRootRefPos,1) + i1_u = UBOUND(SrcParamData%bldRootRefPos,1) + IF (.NOT. ASSOCIATED(DstParamData%bldRootRefPos)) THEN + ALLOCATE(DstParamData%bldRootRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldRootRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%bldRootRefPos_Len = SIZE(DstParamData%bldRootRefPos) + IF (DstParamData%c_obj%bldRootRefPos_Len > 0) & + DstParamData%c_obj%bldRootRefPos = C_LOC( DstParamData%bldRootRefPos( i1_l ) ) + END IF + DstParamData%bldRootRefPos = SrcParamData%bldRootRefPos +ENDIF +IF (ASSOCIATED(SrcParamData%bldChord)) THEN + i1_l = LBOUND(SrcParamData%bldChord,1) + i1_u = UBOUND(SrcParamData%bldChord,1) + IF (.NOT. ASSOCIATED(DstParamData%bldChord)) THEN + ALLOCATE(DstParamData%bldChord(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%bldChord_Len = SIZE(DstParamData%bldChord) + IF (DstParamData%c_obj%bldChord_Len > 0) & + DstParamData%c_obj%bldChord = C_LOC( DstParamData%bldChord( i1_l ) ) + END IF + DstParamData%bldChord = SrcParamData%bldChord +ENDIF +IF (ASSOCIATED(SrcParamData%bldRloc)) THEN + i1_l = LBOUND(SrcParamData%bldRloc,1) + i1_u = UBOUND(SrcParamData%bldRloc,1) + IF (.NOT. ASSOCIATED(DstParamData%bldRloc)) THEN + ALLOCATE(DstParamData%bldRloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%bldRloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%bldRloc_Len = SIZE(DstParamData%bldRloc) + IF (DstParamData%c_obj%bldRloc_Len > 0) & + DstParamData%c_obj%bldRloc = C_LOC( DstParamData%bldRloc( i1_l ) ) + END IF + DstParamData%bldRloc = SrcParamData%bldRloc +ENDIF +IF (ASSOCIATED(SrcParamData%twrDia)) THEN + i1_l = LBOUND(SrcParamData%twrDia,1) + i1_u = UBOUND(SrcParamData%twrDia,1) + IF (.NOT. ASSOCIATED(DstParamData%twrDia)) THEN + ALLOCATE(DstParamData%twrDia(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twrDia.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%twrDia_Len = SIZE(DstParamData%twrDia) + IF (DstParamData%c_obj%twrDia_Len > 0) & + DstParamData%c_obj%twrDia = C_LOC( DstParamData%twrDia( i1_l ) ) + END IF + DstParamData%twrDia = SrcParamData%twrDia +ENDIF +IF (ASSOCIATED(SrcParamData%twrHloc)) THEN + i1_l = LBOUND(SrcParamData%twrHloc,1) + i1_u = UBOUND(SrcParamData%twrHloc,1) + IF (.NOT. ASSOCIATED(DstParamData%twrHloc)) THEN + ALLOCATE(DstParamData%twrHloc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%twrHloc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DstParamData%c_obj%twrHloc_Len = SIZE(DstParamData%twrHloc) + IF (DstParamData%c_obj%twrHloc_Len > 0) & + DstParamData%c_obj%twrHloc = C_LOC( DstParamData%twrHloc( i1_l ) ) + END IF + DstParamData%twrHloc = SrcParamData%twrHloc ENDIF END SUBROUTINE ExtLdDX_CopyParam @@ -1651,6 +1030,69 @@ SUBROUTINE ExtLdDX_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ParamData%nTowerNodes => NULL() ParamData%C_obj%nTowerNodes = C_NULL_PTR ParamData%C_obj%nTowerNodes_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%twrRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%twrRefPos) + ParamData%twrRefPos => NULL() + ParamData%C_obj%twrRefPos = C_NULL_PTR + ParamData%C_obj%twrRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%bldRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%bldRefPos) + ParamData%bldRefPos => NULL() + ParamData%C_obj%bldRefPos = C_NULL_PTR + ParamData%C_obj%bldRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%hubRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%hubRefPos) + ParamData%hubRefPos => NULL() + ParamData%C_obj%hubRefPos = C_NULL_PTR + ParamData%C_obj%hubRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%nacRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%nacRefPos) + ParamData%nacRefPos => NULL() + ParamData%C_obj%nacRefPos = C_NULL_PTR + ParamData%C_obj%nacRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%bldRootRefPos)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%bldRootRefPos) + ParamData%bldRootRefPos => NULL() + ParamData%C_obj%bldRootRefPos = C_NULL_PTR + ParamData%C_obj%bldRootRefPos_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%bldChord)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%bldChord) + ParamData%bldChord => NULL() + ParamData%C_obj%bldChord = C_NULL_PTR + ParamData%C_obj%bldChord_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%bldRloc)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%bldRloc) + ParamData%bldRloc => NULL() + ParamData%C_obj%bldRloc = C_NULL_PTR + ParamData%C_obj%bldRloc_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%twrDia)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%twrDia) + ParamData%twrDia => NULL() + ParamData%C_obj%twrDia = C_NULL_PTR + ParamData%C_obj%twrDia_Len = 0 +ENDIF +IF (ASSOCIATED(ParamData%twrHloc)) THEN + IF (DEALLOCATEpointers_local) & + DEALLOCATE(ParamData%twrHloc) + ParamData%twrHloc => NULL() + ParamData%C_obj%twrHloc = C_NULL_PTR + ParamData%C_obj%twrHloc_Len = 0 ENDIF END SUBROUTINE ExtLdDX_DestroyParam @@ -1704,6 +1146,51 @@ SUBROUTINE ExtLdDX_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! nTowerNodes upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%nTowerNodes) ! nTowerNodes END IF + Int_BufSz = Int_BufSz + 1 ! twrRefPos allocated yes/no + IF ( ASSOCIATED(InData%twrRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrRefPos) ! twrRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! bldRefPos allocated yes/no + IF ( ASSOCIATED(InData%bldRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRefPos) ! bldRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! hubRefPos allocated yes/no + IF ( ASSOCIATED(InData%hubRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! hubRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%hubRefPos) ! hubRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! nacRefPos allocated yes/no + IF ( ASSOCIATED(InData%nacRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nacRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%nacRefPos) ! nacRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! bldRootRefPos allocated yes/no + IF ( ASSOCIATED(InData%bldRootRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRootRefPos upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRootRefPos) ! bldRootRefPos + END IF + Int_BufSz = Int_BufSz + 1 ! bldChord allocated yes/no + IF ( ASSOCIATED(InData%bldChord) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldChord upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldChord) ! bldChord + END IF + Int_BufSz = Int_BufSz + 1 ! bldRloc allocated yes/no + IF ( ASSOCIATED(InData%bldRloc) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! bldRloc upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%bldRloc) ! bldRloc + END IF + Int_BufSz = Int_BufSz + 1 ! twrDia allocated yes/no + IF ( ASSOCIATED(InData%twrDia) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrDia upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrDia) ! twrDia + END IF + Int_BufSz = Int_BufSz + 1 ! twrHloc allocated yes/no + IF ( ASSOCIATED(InData%twrHloc) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! twrHloc upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%twrHloc) ! twrHloc + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1757,117 +1244,441 @@ SUBROUTINE ExtLdDX_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred ) = LBOUND(InData%nBladeNodes,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nBladeNodes,1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nBladeNodes,1), UBOUND(InData%nBladeNodes,1) - IntKiBuf(Int_Xferred) = InData%nBladeNodes(i1) - Int_Xferred = Int_Xferred + 1 + + DO i1 = LBOUND(InData%nBladeNodes,1), UBOUND(InData%nBladeNodes,1) + IntKiBuf(Int_Xferred) = InData%nBladeNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nTowerNodes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nTowerNodes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nTowerNodes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nTowerNodes,1), UBOUND(InData%nTowerNodes,1) + IntKiBuf(Int_Xferred) = InData%nTowerNodes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%twrRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrRefPos,1), UBOUND(InData%twrRefPos,1) + DbKiBuf(Db_Xferred) = InData%twrRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRefPos,1), UBOUND(InData%bldRefPos,1) + DbKiBuf(Db_Xferred) = InData%bldRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%hubRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%hubRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%hubRefPos,1), UBOUND(InData%hubRefPos,1) + DbKiBuf(Db_Xferred) = InData%hubRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%nacRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nacRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nacRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nacRefPos,1), UBOUND(InData%nacRefPos,1) + DbKiBuf(Db_Xferred) = InData%nacRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRootRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRootRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRootRefPos,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRootRefPos,1), UBOUND(InData%bldRootRefPos,1) + DbKiBuf(Db_Xferred) = InData%bldRootRefPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldChord) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldChord,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldChord,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldChord,1), UBOUND(InData%bldChord,1) + DbKiBuf(Db_Xferred) = InData%bldChord(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%bldRloc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%bldRloc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bldRloc,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%bldRloc,1), UBOUND(InData%bldRloc,1) + DbKiBuf(Db_Xferred) = InData%bldRloc(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%twrDia) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrDia,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrDia,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrDia,1), UBOUND(InData%twrDia,1) + DbKiBuf(Db_Xferred) = InData%twrDia(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ASSOCIATED(InData%twrHloc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%twrHloc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%twrHloc,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%twrHloc,1), UBOUND(InData%twrHloc,1) + DbKiBuf(Db_Xferred) = InData%twrHloc(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE ExtLdDX_PackParam + + SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBlades not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nBlades)) DEALLOCATE(OutData%nBlades) + ALLOCATE(OutData%nBlades(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBlades.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nBlades_Len = SIZE(OutData%nBlades) + IF (OutData%c_obj%nBlades_Len > 0) & + OutData%c_obj%nBlades = C_LOC( OutData%nBlades( i1_l ) ) + DO i1 = LBOUND(OutData%nBlades,1), UBOUND(OutData%nBlades,1) + OutData%nBlades(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBladeNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nBladeNodes)) DEALLOCATE(OutData%nBladeNodes) + ALLOCATE(OutData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nBladeNodes_Len = SIZE(OutData%nBladeNodes) + IF (OutData%c_obj%nBladeNodes_Len > 0) & + OutData%c_obj%nBladeNodes = C_LOC( OutData%nBladeNodes( i1_l ) ) + DO i1 = LBOUND(OutData%nBladeNodes,1), UBOUND(OutData%nBladeNodes,1) + OutData%nBladeNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nTowerNodes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nTowerNodes)) DEALLOCATE(OutData%nTowerNodes) + ALLOCATE(OutData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nTowerNodes_Len = SIZE(OutData%nTowerNodes) + IF (OutData%c_obj%nTowerNodes_Len > 0) & + OutData%c_obj%nTowerNodes = C_LOC( OutData%nTowerNodes( i1_l ) ) + DO i1 = LBOUND(OutData%nTowerNodes,1), UBOUND(OutData%nTowerNodes,1) + OutData%nTowerNodes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%twrRefPos)) DEALLOCATE(OutData%twrRefPos) + ALLOCATE(OutData%twrRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%twrRefPos_Len = SIZE(OutData%twrRefPos) + IF (OutData%c_obj%twrRefPos_Len > 0) & + OutData%c_obj%twrRefPos = C_LOC( OutData%twrRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%twrRefPos,1), UBOUND(OutData%twrRefPos,1) + OutData%twrRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldRefPos)) DEALLOCATE(OutData%bldRefPos) + ALLOCATE(OutData%bldRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldRefPos_Len = SIZE(OutData%bldRefPos) + IF (OutData%c_obj%bldRefPos_Len > 0) & + OutData%c_obj%bldRefPos = C_LOC( OutData%bldRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%bldRefPos,1), UBOUND(OutData%bldRefPos,1) + OutData%bldRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%hubRefPos)) DEALLOCATE(OutData%hubRefPos) + ALLOCATE(OutData%hubRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%hubRefPos_Len = SIZE(OutData%hubRefPos) + IF (OutData%c_obj%hubRefPos_Len > 0) & + OutData%c_obj%hubRefPos = C_LOC( OutData%hubRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%hubRefPos,1), UBOUND(OutData%hubRefPos,1) + OutData%hubRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nacRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%nacRefPos)) DEALLOCATE(OutData%nacRefPos) + ALLOCATE(OutData%nacRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nacRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%nacRefPos_Len = SIZE(OutData%nacRefPos) + IF (OutData%c_obj%nacRefPos_Len > 0) & + OutData%c_obj%nacRefPos = C_LOC( OutData%nacRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%nacRefPos,1), UBOUND(OutData%nacRefPos,1) + OutData%nacRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRootRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ASSOCIATED(OutData%bldRootRefPos)) DEALLOCATE(OutData%bldRootRefPos) + ALLOCATE(OutData%bldRootRefPos(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRootRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldRootRefPos_Len = SIZE(OutData%bldRootRefPos) + IF (OutData%c_obj%bldRootRefPos_Len > 0) & + OutData%c_obj%bldRootRefPos = C_LOC( OutData%bldRootRefPos( i1_l ) ) + DO i1 = LBOUND(OutData%bldRootRefPos,1), UBOUND(OutData%bldRootRefPos,1) + OutData%bldRootRefPos(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ASSOCIATED(InData%nTowerNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldChord not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nTowerNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nTowerNodes,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nTowerNodes,1), UBOUND(InData%nTowerNodes,1) - IntKiBuf(Int_Xferred) = InData%nTowerNodes(i1) - Int_Xferred = Int_Xferred + 1 + IF (ASSOCIATED(OutData%bldChord)) DEALLOCATE(OutData%bldChord) + ALLOCATE(OutData%bldChord(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldChord.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + OutData%c_obj%bldChord_Len = SIZE(OutData%bldChord) + IF (OutData%c_obj%bldChord_Len > 0) & + OutData%c_obj%bldChord = C_LOC( OutData%bldChord( i1_l ) ) + DO i1 = LBOUND(OutData%bldChord,1), UBOUND(OutData%bldChord,1) + OutData%bldChord(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 END DO END IF - END SUBROUTINE ExtLdDX_PackParam - - SUBROUTINE ExtLdDX_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(ExtLdDX_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 = 'ExtLdDX_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBlades not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bldRloc not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nBlades)) DEALLOCATE(OutData%nBlades) - ALLOCATE(OutData%nBlades(i1_l:i1_u),STAT=ErrStat2) + IF (ASSOCIATED(OutData%bldRloc)) DEALLOCATE(OutData%bldRloc) + ALLOCATE(OutData%bldRloc(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBlades.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bldRloc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%nBlades_Len = SIZE(OutData%nBlades) - IF (OutData%c_obj%nBlades_Len > 0) & - OutData%c_obj%nBlades = C_LOC( OutData%nBlades( i1_l ) ) - DO i1 = LBOUND(OutData%nBlades,1), UBOUND(OutData%nBlades,1) - OutData%nBlades(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + OutData%c_obj%bldRloc_Len = SIZE(OutData%bldRloc) + IF (OutData%c_obj%bldRloc_Len > 0) & + OutData%c_obj%bldRloc = C_LOC( OutData%bldRloc( i1_l ) ) + DO i1 = LBOUND(OutData%bldRloc,1), UBOUND(OutData%bldRloc,1) + OutData%bldRloc(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nBladeNodes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrDia not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nBladeNodes)) DEALLOCATE(OutData%nBladeNodes) - ALLOCATE(OutData%nBladeNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ASSOCIATED(OutData%twrDia)) DEALLOCATE(OutData%twrDia) + ALLOCATE(OutData%twrDia(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nBladeNodes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrDia.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%nBladeNodes_Len = SIZE(OutData%nBladeNodes) - IF (OutData%c_obj%nBladeNodes_Len > 0) & - OutData%c_obj%nBladeNodes = C_LOC( OutData%nBladeNodes( i1_l ) ) - DO i1 = LBOUND(OutData%nBladeNodes,1), UBOUND(OutData%nBladeNodes,1) - OutData%nBladeNodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + OutData%c_obj%twrDia_Len = SIZE(OutData%twrDia) + IF (OutData%c_obj%twrDia_Len > 0) & + OutData%c_obj%twrDia = C_LOC( OutData%twrDia( i1_l ) ) + DO i1 = LBOUND(OutData%twrDia,1), UBOUND(OutData%twrDia,1) + OutData%twrDia(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nTowerNodes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! twrHloc not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%nTowerNodes)) DEALLOCATE(OutData%nTowerNodes) - ALLOCATE(OutData%nTowerNodes(i1_l:i1_u),STAT=ErrStat2) + IF (ASSOCIATED(OutData%twrHloc)) DEALLOCATE(OutData%twrHloc) + ALLOCATE(OutData%twrHloc(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nTowerNodes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%twrHloc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - OutData%c_obj%nTowerNodes_Len = SIZE(OutData%nTowerNodes) - IF (OutData%c_obj%nTowerNodes_Len > 0) & - OutData%c_obj%nTowerNodes = C_LOC( OutData%nTowerNodes( i1_l ) ) - DO i1 = LBOUND(OutData%nTowerNodes,1), UBOUND(OutData%nTowerNodes,1) - OutData%nTowerNodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + OutData%c_obj%twrHloc_Len = SIZE(OutData%twrHloc) + IF (OutData%c_obj%twrHloc_Len > 0) & + OutData%c_obj%twrHloc = C_LOC( OutData%twrHloc( i1_l ) ) + DO i1 = LBOUND(OutData%twrHloc,1), UBOUND(OutData%twrHloc,1) + OutData%twrHloc(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 END DO END IF END SUBROUTINE ExtLdDX_UnPackParam @@ -1914,6 +1725,87 @@ SUBROUTINE ExtLdDX_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) CALL C_F_POINTER(ParamData%C_obj%nTowerNodes, ParamData%nTowerNodes, (/ParamData%C_obj%nTowerNodes_Len/)) END IF END IF + + ! -- twrRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%twrRefPos ) ) THEN + NULLIFY( ParamData%twrRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%twrRefPos, ParamData%twrRefPos, (/ParamData%C_obj%twrRefPos_Len/)) + END IF + END IF + + ! -- bldRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldRefPos ) ) THEN + NULLIFY( ParamData%bldRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldRefPos, ParamData%bldRefPos, (/ParamData%C_obj%bldRefPos_Len/)) + END IF + END IF + + ! -- hubRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%hubRefPos ) ) THEN + NULLIFY( ParamData%hubRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%hubRefPos, ParamData%hubRefPos, (/ParamData%C_obj%hubRefPos_Len/)) + END IF + END IF + + ! -- nacRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%nacRefPos ) ) THEN + NULLIFY( ParamData%nacRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%nacRefPos, ParamData%nacRefPos, (/ParamData%C_obj%nacRefPos_Len/)) + END IF + END IF + + ! -- bldRootRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldRootRefPos ) ) THEN + NULLIFY( ParamData%bldRootRefPos ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldRootRefPos, ParamData%bldRootRefPos, (/ParamData%C_obj%bldRootRefPos_Len/)) + END IF + END IF + + ! -- bldChord Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldChord ) ) THEN + NULLIFY( ParamData%bldChord ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldChord, ParamData%bldChord, (/ParamData%C_obj%bldChord_Len/)) + END IF + END IF + + ! -- bldRloc Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%bldRloc ) ) THEN + NULLIFY( ParamData%bldRloc ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%bldRloc, ParamData%bldRloc, (/ParamData%C_obj%bldRloc_Len/)) + END IF + END IF + + ! -- twrDia Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%twrDia ) ) THEN + NULLIFY( ParamData%twrDia ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%twrDia, ParamData%twrDia, (/ParamData%C_obj%twrDia_Len/)) + END IF + END IF + + ! -- twrHloc Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%twrHloc ) ) THEN + NULLIFY( ParamData%twrHloc ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%twrHloc, ParamData%twrHloc, (/ParamData%C_obj%twrHloc_Len/)) + END IF + END IF END SUBROUTINE ExtLdDX_C2Fary_CopyParam SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) @@ -1967,6 +1859,114 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ParamData%c_obj%nTowerNodes = C_LOC( ParamData%nTowerNodes( LBOUND(ParamData%nTowerNodes,1) ) ) END IF END IF + + ! -- twrRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%twrRefPos)) THEN + ParamData%c_obj%twrRefPos_Len = 0 + ParamData%c_obj%twrRefPos = C_NULL_PTR + ELSE + ParamData%c_obj%twrRefPos_Len = SIZE(ParamData%twrRefPos) + IF (ParamData%c_obj%twrRefPos_Len > 0) & + ParamData%c_obj%twrRefPos = C_LOC( ParamData%twrRefPos( LBOUND(ParamData%twrRefPos,1) ) ) + END IF + END IF + + ! -- bldRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%bldRefPos)) THEN + ParamData%c_obj%bldRefPos_Len = 0 + ParamData%c_obj%bldRefPos = C_NULL_PTR + ELSE + ParamData%c_obj%bldRefPos_Len = SIZE(ParamData%bldRefPos) + IF (ParamData%c_obj%bldRefPos_Len > 0) & + ParamData%c_obj%bldRefPos = C_LOC( ParamData%bldRefPos( LBOUND(ParamData%bldRefPos,1) ) ) + END IF + END IF + + ! -- hubRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%hubRefPos)) THEN + ParamData%c_obj%hubRefPos_Len = 0 + ParamData%c_obj%hubRefPos = C_NULL_PTR + ELSE + ParamData%c_obj%hubRefPos_Len = SIZE(ParamData%hubRefPos) + IF (ParamData%c_obj%hubRefPos_Len > 0) & + ParamData%c_obj%hubRefPos = C_LOC( ParamData%hubRefPos( LBOUND(ParamData%hubRefPos,1) ) ) + END IF + END IF + + ! -- nacRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%nacRefPos)) THEN + ParamData%c_obj%nacRefPos_Len = 0 + ParamData%c_obj%nacRefPos = C_NULL_PTR + ELSE + ParamData%c_obj%nacRefPos_Len = SIZE(ParamData%nacRefPos) + IF (ParamData%c_obj%nacRefPos_Len > 0) & + ParamData%c_obj%nacRefPos = C_LOC( ParamData%nacRefPos( LBOUND(ParamData%nacRefPos,1) ) ) + END IF + END IF + + ! -- bldRootRefPos Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%bldRootRefPos)) THEN + ParamData%c_obj%bldRootRefPos_Len = 0 + ParamData%c_obj%bldRootRefPos = C_NULL_PTR + ELSE + ParamData%c_obj%bldRootRefPos_Len = SIZE(ParamData%bldRootRefPos) + IF (ParamData%c_obj%bldRootRefPos_Len > 0) & + ParamData%c_obj%bldRootRefPos = C_LOC( ParamData%bldRootRefPos( LBOUND(ParamData%bldRootRefPos,1) ) ) + END IF + END IF + + ! -- bldChord Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%bldChord)) THEN + ParamData%c_obj%bldChord_Len = 0 + ParamData%c_obj%bldChord = C_NULL_PTR + ELSE + ParamData%c_obj%bldChord_Len = SIZE(ParamData%bldChord) + IF (ParamData%c_obj%bldChord_Len > 0) & + ParamData%c_obj%bldChord = C_LOC( ParamData%bldChord( LBOUND(ParamData%bldChord,1) ) ) + END IF + END IF + + ! -- bldRloc Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%bldRloc)) THEN + ParamData%c_obj%bldRloc_Len = 0 + ParamData%c_obj%bldRloc = C_NULL_PTR + ELSE + ParamData%c_obj%bldRloc_Len = SIZE(ParamData%bldRloc) + IF (ParamData%c_obj%bldRloc_Len > 0) & + ParamData%c_obj%bldRloc = C_LOC( ParamData%bldRloc( LBOUND(ParamData%bldRloc,1) ) ) + END IF + END IF + + ! -- twrDia Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%twrDia)) THEN + ParamData%c_obj%twrDia_Len = 0 + ParamData%c_obj%twrDia = C_NULL_PTR + ELSE + ParamData%c_obj%twrDia_Len = SIZE(ParamData%twrDia) + IF (ParamData%c_obj%twrDia_Len > 0) & + ParamData%c_obj%twrDia = C_LOC( ParamData%twrDia( LBOUND(ParamData%twrDia,1) ) ) + END IF + END IF + + ! -- twrHloc Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%twrHloc)) THEN + ParamData%c_obj%twrHloc_Len = 0 + ParamData%c_obj%twrHloc = C_NULL_PTR + ELSE + ParamData%c_obj%twrHloc_Len = SIZE(ParamData%twrHloc) + IF (ParamData%c_obj%twrHloc_Len > 0) & + ParamData%c_obj%twrHloc = C_LOC( ParamData%twrHloc( LBOUND(ParamData%twrHloc,1) ) ) + END IF + END IF END SUBROUTINE ExtLdDX_F2C_CopyParam SUBROUTINE ExtLdDX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2431,60 +2431,6 @@ SUBROUTINE ExtLdDX_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err u_out%bldRootDef(i1) = u1%bldRootDef(i1) + b * ScaleFactor END DO END IF ! check if allocated -IF (ASSOCIATED(u_out%twrRefPos) .AND. ASSOCIATED(u1%twrRefPos)) THEN - DO i1 = LBOUND(u_out%twrRefPos,1),UBOUND(u_out%twrRefPos,1) - b = -(u1%twrRefPos(i1) - u2%twrRefPos(i1)) - u_out%twrRefPos(i1) = u1%twrRefPos(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldRefPos) .AND. ASSOCIATED(u1%bldRefPos)) THEN - DO i1 = LBOUND(u_out%bldRefPos,1),UBOUND(u_out%bldRefPos,1) - b = -(u1%bldRefPos(i1) - u2%bldRefPos(i1)) - u_out%bldRefPos(i1) = u1%bldRefPos(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%hubRefPos) .AND. ASSOCIATED(u1%hubRefPos)) THEN - DO i1 = LBOUND(u_out%hubRefPos,1),UBOUND(u_out%hubRefPos,1) - b = -(u1%hubRefPos(i1) - u2%hubRefPos(i1)) - u_out%hubRefPos(i1) = u1%hubRefPos(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%nacRefPos) .AND. ASSOCIATED(u1%nacRefPos)) THEN - DO i1 = LBOUND(u_out%nacRefPos,1),UBOUND(u_out%nacRefPos,1) - b = -(u1%nacRefPos(i1) - u2%nacRefPos(i1)) - u_out%nacRefPos(i1) = u1%nacRefPos(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldRootRefPos) .AND. ASSOCIATED(u1%bldRootRefPos)) THEN - DO i1 = LBOUND(u_out%bldRootRefPos,1),UBOUND(u_out%bldRootRefPos,1) - b = -(u1%bldRootRefPos(i1) - u2%bldRootRefPos(i1)) - u_out%bldRootRefPos(i1) = u1%bldRootRefPos(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldChord) .AND. ASSOCIATED(u1%bldChord)) THEN - DO i1 = LBOUND(u_out%bldChord,1),UBOUND(u_out%bldChord,1) - b = -(u1%bldChord(i1) - u2%bldChord(i1)) - u_out%bldChord(i1) = u1%bldChord(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldRloc) .AND. ASSOCIATED(u1%bldRloc)) THEN - DO i1 = LBOUND(u_out%bldRloc,1),UBOUND(u_out%bldRloc,1) - b = -(u1%bldRloc(i1) - u2%bldRloc(i1)) - u_out%bldRloc(i1) = u1%bldRloc(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%twrDia) .AND. ASSOCIATED(u1%twrDia)) THEN - DO i1 = LBOUND(u_out%twrDia,1),UBOUND(u_out%twrDia,1) - b = -(u1%twrDia(i1) - u2%twrDia(i1)) - u_out%twrDia(i1) = u1%twrDia(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%twrHloc) .AND. ASSOCIATED(u1%twrHloc)) THEN - DO i1 = LBOUND(u_out%twrHloc,1),UBOUND(u_out%twrHloc,1) - b = -(u1%twrHloc(i1) - u2%twrHloc(i1)) - u_out%twrHloc(i1) = u1%twrHloc(i1) + b * ScaleFactor - END DO -END IF ! check if allocated IF (ASSOCIATED(u_out%bldPitch) .AND. ASSOCIATED(u1%bldPitch)) THEN DO i1 = LBOUND(u_out%bldPitch,1),UBOUND(u_out%bldPitch,1) b = -(u1%bldPitch(i1) - u2%bldPitch(i1)) @@ -2583,69 +2529,6 @@ SUBROUTINE ExtLdDX_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, u_out%bldRootDef(i1) = u1%bldRootDef(i1) + b + c * t_out END DO END IF ! check if allocated -IF (ASSOCIATED(u_out%twrRefPos) .AND. ASSOCIATED(u1%twrRefPos)) THEN - DO i1 = LBOUND(u_out%twrRefPos,1),UBOUND(u_out%twrRefPos,1) - b = (t(3)**2*(u1%twrRefPos(i1) - u2%twrRefPos(i1)) + t(2)**2*(-u1%twrRefPos(i1) + u3%twrRefPos(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%twrRefPos(i1) + t(3)*u2%twrRefPos(i1) - t(2)*u3%twrRefPos(i1) ) * scaleFactor - u_out%twrRefPos(i1) = u1%twrRefPos(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldRefPos) .AND. ASSOCIATED(u1%bldRefPos)) THEN - DO i1 = LBOUND(u_out%bldRefPos,1),UBOUND(u_out%bldRefPos,1) - b = (t(3)**2*(u1%bldRefPos(i1) - u2%bldRefPos(i1)) + t(2)**2*(-u1%bldRefPos(i1) + u3%bldRefPos(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%bldRefPos(i1) + t(3)*u2%bldRefPos(i1) - t(2)*u3%bldRefPos(i1) ) * scaleFactor - u_out%bldRefPos(i1) = u1%bldRefPos(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%hubRefPos) .AND. ASSOCIATED(u1%hubRefPos)) THEN - DO i1 = LBOUND(u_out%hubRefPos,1),UBOUND(u_out%hubRefPos,1) - b = (t(3)**2*(u1%hubRefPos(i1) - u2%hubRefPos(i1)) + t(2)**2*(-u1%hubRefPos(i1) + u3%hubRefPos(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%hubRefPos(i1) + t(3)*u2%hubRefPos(i1) - t(2)*u3%hubRefPos(i1) ) * scaleFactor - u_out%hubRefPos(i1) = u1%hubRefPos(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%nacRefPos) .AND. ASSOCIATED(u1%nacRefPos)) THEN - DO i1 = LBOUND(u_out%nacRefPos,1),UBOUND(u_out%nacRefPos,1) - b = (t(3)**2*(u1%nacRefPos(i1) - u2%nacRefPos(i1)) + t(2)**2*(-u1%nacRefPos(i1) + u3%nacRefPos(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%nacRefPos(i1) + t(3)*u2%nacRefPos(i1) - t(2)*u3%nacRefPos(i1) ) * scaleFactor - u_out%nacRefPos(i1) = u1%nacRefPos(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldRootRefPos) .AND. ASSOCIATED(u1%bldRootRefPos)) THEN - DO i1 = LBOUND(u_out%bldRootRefPos,1),UBOUND(u_out%bldRootRefPos,1) - b = (t(3)**2*(u1%bldRootRefPos(i1) - u2%bldRootRefPos(i1)) + t(2)**2*(-u1%bldRootRefPos(i1) + u3%bldRootRefPos(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%bldRootRefPos(i1) + t(3)*u2%bldRootRefPos(i1) - t(2)*u3%bldRootRefPos(i1) ) * scaleFactor - u_out%bldRootRefPos(i1) = u1%bldRootRefPos(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldChord) .AND. ASSOCIATED(u1%bldChord)) THEN - DO i1 = LBOUND(u_out%bldChord,1),UBOUND(u_out%bldChord,1) - b = (t(3)**2*(u1%bldChord(i1) - u2%bldChord(i1)) + t(2)**2*(-u1%bldChord(i1) + u3%bldChord(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%bldChord(i1) + t(3)*u2%bldChord(i1) - t(2)*u3%bldChord(i1) ) * scaleFactor - u_out%bldChord(i1) = u1%bldChord(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%bldRloc) .AND. ASSOCIATED(u1%bldRloc)) THEN - DO i1 = LBOUND(u_out%bldRloc,1),UBOUND(u_out%bldRloc,1) - b = (t(3)**2*(u1%bldRloc(i1) - u2%bldRloc(i1)) + t(2)**2*(-u1%bldRloc(i1) + u3%bldRloc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%bldRloc(i1) + t(3)*u2%bldRloc(i1) - t(2)*u3%bldRloc(i1) ) * scaleFactor - u_out%bldRloc(i1) = u1%bldRloc(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%twrDia) .AND. ASSOCIATED(u1%twrDia)) THEN - DO i1 = LBOUND(u_out%twrDia,1),UBOUND(u_out%twrDia,1) - b = (t(3)**2*(u1%twrDia(i1) - u2%twrDia(i1)) + t(2)**2*(-u1%twrDia(i1) + u3%twrDia(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%twrDia(i1) + t(3)*u2%twrDia(i1) - t(2)*u3%twrDia(i1) ) * scaleFactor - u_out%twrDia(i1) = u1%twrDia(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%twrHloc) .AND. ASSOCIATED(u1%twrHloc)) THEN - DO i1 = LBOUND(u_out%twrHloc,1),UBOUND(u_out%twrHloc,1) - b = (t(3)**2*(u1%twrHloc(i1) - u2%twrHloc(i1)) + t(2)**2*(-u1%twrHloc(i1) + u3%twrHloc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%twrHloc(i1) + t(3)*u2%twrHloc(i1) - t(2)*u3%twrHloc(i1) ) * scaleFactor - u_out%twrHloc(i1) = u1%twrHloc(i1) + b + c * t_out - END DO -END IF ! check if allocated IF (ASSOCIATED(u_out%bldPitch) .AND. ASSOCIATED(u1%bldPitch)) THEN DO i1 = LBOUND(u_out%bldPitch,1),UBOUND(u_out%bldPitch,1) b = (t(3)**2*(u1%bldPitch(i1) - u2%bldPitch(i1)) + t(2)**2*(-u1%bldPitch(i1) + u3%bldPitch(i1)))* scaleFactor diff --git a/modules/extloads/src/ExtLoadsDX_Types.h b/modules/extloads/src/ExtLoadsDX_Types.h index 6a818f498c..da9ebc41b7 100644 --- a/modules/extloads/src/ExtLoadsDX_Types.h +++ b/modules/extloads/src/ExtLoadsDX_Types.h @@ -27,6 +27,13 @@ double * hubDef ; int hubDef_Len ; double * nacDef ; int nacDef_Len ; double * bldRootDef ; int bldRootDef_Len ; + double * bldPitch ; int bldPitch_Len ; + } ExtLdDX_InputType_t ; + typedef struct ExtLdDX_ParameterType { + void * object ; + int * nBlades ; int nBlades_Len ; + int * nBladeNodes ; int nBladeNodes_Len ; + int * nTowerNodes ; int nTowerNodes_Len ; double * twrRefPos ; int twrRefPos_Len ; double * bldRefPos ; int bldRefPos_Len ; double * hubRefPos ; int hubRefPos_Len ; @@ -36,13 +43,6 @@ double * bldRloc ; int bldRloc_Len ; double * twrDia ; int twrDia_Len ; double * twrHloc ; int twrHloc_Len ; - double * bldPitch ; int bldPitch_Len ; - } ExtLdDX_InputType_t ; - typedef struct ExtLdDX_ParameterType { - void * object ; - int * nBlades ; int nBlades_Len ; - int * nBladeNodes ; int nBladeNodes_Len ; - int * nTowerNodes ; int nTowerNodes_Len ; } ExtLdDX_ParameterType_t ; typedef struct ExtLdDX_OutputType { void * object ; diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 3d818c2fe9..82a5d9d96c 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -989,31 +989,32 @@ subroutine SetExtLoads_pointers(iTurb, ExtLd_iFromOF, ExtLd_pFromOF, ExtLd_oToOF TYPE(ExtLdDX_ParameterType_C), INTENT(INOUT) :: ExtLd_pFromOF TYPE(ExtLdDX_OutputType_C), INTENT(INOUT) :: ExtLd_oToOF - ExtLd_iFromOF%bldPitch_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch_Len; ExtLd_iFromOF%bldPitch = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch - ExtLd_iFromOF%twrHloc_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrHloc_Len; ExtLd_iFromOF%twrHloc = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrHloc - ExtLd_iFromOF%twrDia_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDia_Len; ExtLd_iFromOF%twrDia = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDia - ExtLd_iFromOF%twrRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrRefPos_Len; ExtLd_iFromOF%twrRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrRefPos - ExtLd_iFromOF%twrDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef_Len; ExtLd_iFromOF%twrDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef - ExtLd_iFromOF%bldRloc_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRloc_Len; ExtLd_iFromOF%bldRloc = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRloc - ExtLd_iFromOF%bldChord_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldChord_Len; ExtLd_iFromOF%bldChord = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldChord - ExtLd_iFromOF%bldRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRefPos_Len; ExtLd_iFromOF%bldRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRefPos - ExtLd_iFromOF%bldRootRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootRefPos_Len; ExtLd_iFromOF%bldRootRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootRefPos - ExtLd_iFromOF%bldDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef_Len; ExtLd_iFromOF%bldDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef - - ExtLd_iFromOF%bldRootDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef_Len; ExtLd_iFromOF%bldRootDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef - - ExtLd_iFromOF%hubRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubRefPos_Len; ExtLd_iFromOF%hubRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubRefPos - ExtLd_iFromOF%hubDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef_Len; ExtLd_iFromOF%hubDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef - - ExtLd_iFromOF%nacRefPos_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacRefPos_Len; ExtLd_iFromOF%nacRefPos = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacRefPos - ExtLd_iFromOF%nacDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef_Len; ExtLd_iFromOF%nacDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef - - ExtLd_pFromOF%nBlades_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades_Len; ExtLd_pFromOF%nBlades = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades - ExtLd_pFromOF%nBladeNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes_Len; ExtLd_pFromOF%nBladeNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes - ExtLd_pFromOF%nTowerNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes_Len; ExtLd_pFromOF%nTowerNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes - - ExtLd_oToOF%twrLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd_Len; ExtLd_oToOF%twrLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd - ExtLd_oToOF%bldLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd_Len; ExtLd_oToOF%bldLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd + ! Inputs + ExtLd_iFromOF%bldPitch_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch_Len; ExtLd_iFromOF%bldPitch = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldPitch + ExtLd_iFromOF%twrDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef_Len; ExtLd_iFromOF%twrDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%twrDef + ExtLd_iFromOF%bldDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef_Len; ExtLd_iFromOF%bldDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldDef + ExtLd_iFromOF%bldRootDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef_Len; ExtLd_iFromOF%bldRootDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%bldRootDef + ExtLd_iFromOF%hubDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef_Len; ExtLd_iFromOF%hubDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%hubDef + ExtLd_iFromOF%nacDef_Len = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef_Len; ExtLd_iFromOF%nacDef = Turbine(iTurb)%ExtLd%u%DX_u%c_obj%nacDef + + ! Parameters + ExtLd_pFromOF%nBlades_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades_Len; ExtLd_pFromOF%nBlades = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBlades + ExtLd_pFromOF%nBladeNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes_Len; ExtLd_pFromOF%nBladeNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nBladeNodes + ExtLd_pFromOF%nTowerNodes_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes_Len; ExtLd_pFromOF%nTowerNodes = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nTowerNodes + + ExtLd_pFromOF%twrHloc_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrHloc_Len; ExtLd_pFromOF%twrHloc = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrHloc + ExtLd_pFromOF%twrDia_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrDia_Len; ExtLd_pFromOF%twrDia = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrDia + ExtLd_pFromOF%twrRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrRefPos_Len; ExtLd_pFromOF%twrRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%twrRefPos + ExtLd_pFromOF%bldRloc_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRloc_Len; ExtLd_pFromOF%bldRloc = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRloc + ExtLd_pFromOF%bldChord_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldChord_Len; ExtLd_pFromOF%bldChord = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldChord + ExtLd_pFromOF%bldRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRefPos_Len; ExtLd_pFromOF%bldRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRefPos + ExtLd_pFromOF%bldRootRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRootRefPos_Len; ExtLd_pFromOF%bldRootRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%bldRootRefPos + ExtLd_pFromOF%hubRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%hubRefPos_Len; ExtLd_pFromOF%hubRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%hubRefPos + ExtLd_pFromOF%nacRefPos_Len = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nacRefPos_Len; ExtLd_pFromOF%nacRefPos = Turbine(iTurb)%ExtLd%p%DX_p%c_obj%nacRefPos + + ! Outputs + ExtLd_oToOF%twrLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd_Len; ExtLd_oToOF%twrLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%twrLd + ExtLd_oToOF%bldLd_Len = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd_Len; ExtLd_oToOF%bldLd = Turbine(iTurb)%ExtLd%y%DX_y%c_obj%bldLd end subroutine SetExtLoads_pointers From d6f4061bfdecad4102973ab480bd5e41b1c7a7e0 Mon Sep 17 00:00:00 2001 From: Matt Hall <5151457+mattEhall@users.noreply.github.com> Date: Wed, 17 Jan 2024 13:45:16 -0700 Subject: [PATCH 184/232] MoorDyn body initial condition adjustment - Edited Body position/orientation used for input mesh setup and initial positions before dynamic relaxation, to hopefully solve that coupled bodies were previously being initialized at 0,0,0. - Coupled bodies should now initialize with position and orientation that is a combination of the relative values in the input file, plus any PtfmInit value passed from the glue code. - With this change, it's possible the p%Standalone flag is not needed - TBD. --- modules/moordyn/src/MoorDyn.f90 | 31 +++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index fc6f47db6e..b0e6c07063 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1868,27 +1868,34 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - ! note: in MoorDyn-F v2, the points in the mesh correspond in order to all the coupled bodies, then rods, then points - ! >>> make sure all coupled objects have been offset correctly by the PtfmInit values, including if it's a farm situation -- below or where the objects are first created <<<< + ! Note: in MoorDyn-F v2, the points in the mesh correspond in order to + ! all the coupled bodies, then rods, then points. The below code makes + ! sure all coupled objects have been offset correctly by the PtfmInit + ! values (initial platform pose), including if using FAST.Farm. + ! rRef and OrMatRef or the position and orientation matrix of the + ! coupled object relative to the platform, based on the input file. + ! They are used to set the "reference" pose of each coupled mesh + ! entry before the intial offsets from PtfmInit are applied. J = 0 ! this is the counter through the mesh points for each turbine DO l = 1,p%nCpldBodies(iTurb) J = J + 1 - rRef = m%BodyList(m%CpldBodyIs(l,iTurb))%r6 ! for now set reference position as per input file <<< - - CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) ! defaults to identity orientation matrix + rRef = m%BodyList(m%CpldBodyIs(l,iTurb))%r6 ! set reference position as per input file + OrMatRef = ( m%RodList(m%CpldBodyIs(l,iTurb))%OrMat ) ! set reference orientation as per input file + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! set absolute initial positions in MoorDyn IF (p%Standalone /= 1) THEN - !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< - OrMat2 = MATMUL(OrMat, ( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< + OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Body's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body - ! calculate initial point relative position, adjusted due to initial platform translations - u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) + ! calculate initial body relative position, adjusted due to initial platform translations + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(OrMat2) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation ENDIF @@ -1907,12 +1914,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! set absolute initial positions in MoorDyn IF (p%Standalone /= 1) THEN - OrMatRef = ( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< + OrMatRef = ( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! set reference orientation as per input file CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Rod's relative orientation with the turbine's initial orientation u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< - ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + ! calculate initial rod relative position, adjusted due to initial platform rotations and translations <<< could convert to array math u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) From 68d162ee7283c2a6166aa192642eeec3ab3e0a6e Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Wed, 24 Jan 2024 18:04:25 -0700 Subject: [PATCH 185/232] Removes standalone driver option --- modules/moordyn/src/MoorDyn.f90 | 63 ++++++++++-------------- modules/moordyn/src/MoorDyn_Driver.f90 | 9 +--- modules/moordyn/src/MoorDyn_Registry.txt | 3 +- modules/moordyn/src/MoorDyn_Types.f90 | 9 +--- 4 files changed, 30 insertions(+), 54 deletions(-) diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index b0e6c07063..e3304fdd48 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -205,9 +205,6 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL WrScr(' >>> MoorDyn is running in array mode <<< ') ! could make sure the size of this is right: SIZE(InitInp%FarmCoupledKinematics) p%nTurbines = InitInp%FarmSize - else if (InitInp%FarmSize < 0) then ! Farmsize==-1 indicates standlone, run MoorDyn as a standalone code with no openfast coupling - p%Standalone = 1 - p%nTurbines = 1 else ! FarmSize==0 indicates normal, FAST module mode p%nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case END IF @@ -1887,18 +1884,16 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er OrMatRef = ( m%RodList(m%CpldBodyIs(l,iTurb))%OrMat ) ! set reference orientation as per input file CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) - ! set absolute initial positions in MoorDyn - IF (p%Standalone /= 1) THEN - OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Body's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body - - ! calculate initial body relative position, adjusted due to initial platform translations - u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) - u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) - u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(OrMat2) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation - ENDIF + ! set absolute initial positions in MoorDyn + OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Body's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body + + ! calculate initial body relative position, adjusted due to initial platform translations + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(OrMat2) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element @@ -1913,19 +1908,17 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er rRef = m%RodList(m%CpldRodIs(l,iTurb))%r6 ! for now set reference position as per input file <<< ! set absolute initial positions in MoorDyn - IF (p%Standalone /= 1) THEN - OrMatRef = ( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! set reference orientation as per input file - CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation - OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Rod's relative orientation with the turbine's initial orientation - u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< - - ! calculate initial rod relative position, adjusted due to initial platform rotations and translations <<< could convert to array math - u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) - u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) - u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = MATMUL(OrMat2 , (/0.0, 0.0, 1.0/) ) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation - ENDIF + OrMatRef = ( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! set reference orientation as per input file + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation + OrMat2 = MATMUL(OrMat, OrMatRef) ! combine the Rod's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< + + ! calculate initial rod relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = MATMUL(OrMat2 , (/0.0, 0.0, 1.0/) ) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation ! >>> still need to set Rod initial orientations accounting for PtfmInit rotation <<< @@ -1942,14 +1935,12 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er rRef(1:3) = m%PointList(m%CpldPointIs(l,iTurb))%r ! set absolute initial positions in MoorDyn - IF (p%Standalone /= 1) THEN - CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) - ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math - u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) - u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) - u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) - m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) - ENDIF + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) + ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + m%PointList(m%CpldPointIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! lastly, do this to set the attached line endpoint positions: diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index de826a52b1..b0522c9326 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -175,7 +175,7 @@ PROGRAM MoorDyn_Driver if (drvrInitInp%FarmSize > 0) then ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) nTurbines = drvrInitInp%FarmSize - else ! FarmSize==0 indicates normal, FAST module mode; FarmSize<0 indicates standalone mode + else ! FarmSize==0 indicates normal, FAST module mode nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case end if @@ -491,10 +491,6 @@ PROGRAM MoorDyn_Driver K = 1 ! the index of the coupling points in the input mesh CoupledKinematics J = 1 ! the starting index of the relevant DOFs in the input array - IF (MD_InitInp%FarmSize < 0) THEN - MD_p%TurbineRefPos(:,iTurb) = 0.0 - ENDIF - ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) @@ -582,9 +578,6 @@ PROGRAM MoorDyn_Driver K = 1 ! the index of the coupling points in the input mesh CoupledKinematics J = 1 ! the starting index of the relevant DOFs in the input array - IF (MD_InitInp%FarmSize < 0) THEN - MD_p%TurbineRefPos(:,iTurb) = 0.0 - ENDIF ! any coupled bodies (type -1) DO l = 1,MD_p%nCpldBodies(iTurb) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index d4df4982c8..283fca0bed 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -24,7 +24,7 @@ typedef MoorDyn/MD InitInputType ReKi g - -99 typedef ^ ^ ReKi rhoW - -999.9 - "sea density" "[kg/m^3]" typedef ^ ^ ReKi WtrDepth - -999.9 - "depth of water" "[m]" typedef ^ ^ ReKi PtfmInit {:}{:} - - "initial position of platform(s) shape: 6, nTurbines" - -typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0, standalone mode if -1" - +typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0" - typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - typedef ^ ^ ReKi Tmax - - - "simulation duration" "[s]" typedef ^ ^ CHARACTER(1024) FileName - "" - "MoorDyn input file" @@ -390,7 +390,6 @@ typedef ^ ^ DbKi mu_kT - typedef ^ ^ DbKi mu_kA - - - "axial kinetic friction coefficient" "(-)" typedef ^ ^ DbKi mc - - - "ratio of the static friction coefficient to the kinetic friction coefficient" "(-)" typedef ^ ^ DbKi cv - - - "saturated damping coefficient" "(-)" -typedef ^ ^ IntKi Standalone - - - "Indicates MoorDyn run as standalone code if 1, coupled if 0" - typedef ^ ^ IntKi inertialF - 0 - "Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no" - # --- parameters for wave and current --- typedef ^ ^ IntKi nxWave - - - "number of x wave grid points" - diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 2c8071eefe..6f94451de3 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -47,7 +47,7 @@ MODULE MoorDyn_Types REAL(ReKi) :: rhoW = -999.9 !< sea density [[kg/m^3]] REAL(ReKi) :: WtrDepth = -999.9 !< depth of water [[m]] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmInit !< initial position of platform(s) shape: 6, nTurbines [-] - INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0, standalone mode if -1 [-] + INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] REAL(ReKi) :: Tmax !< simulation duration [[s]] CHARACTER(1024) :: FileName !< MoorDyn input file [-] @@ -425,7 +425,6 @@ MODULE MoorDyn_Types REAL(DbKi) :: mu_kA !< axial kinetic friction coefficient [(-)] REAL(DbKi) :: mc !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] REAL(DbKi) :: cv !< saturated damping coefficient [(-)] - INTEGER(IntKi) :: Standalone !< Indicates MoorDyn run as standalone code if 1, coupled if 0 [-] INTEGER(IntKi) :: inertialF = 0 !< Indicates MoorDyn returning inertial moments for coupled 6DOF objects. 1 if yes, 0 if no [-] INTEGER(IntKi) :: nxWave !< number of x wave grid points [-] INTEGER(IntKi) :: nyWave !< number of y wave grid points [-] @@ -10787,7 +10786,6 @@ SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%mu_kA = SrcParamData%mu_kA DstParamData%mc = SrcParamData%mc DstParamData%cv = SrcParamData%cv - DstParamData%Standalone = SrcParamData%Standalone DstParamData%inertialF = SrcParamData%inertialF DstParamData%nxWave = SrcParamData%nxWave DstParamData%nyWave = SrcParamData%nyWave @@ -11300,7 +11298,6 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_BufSz = Db_BufSz + 1 ! mu_kA Db_BufSz = Db_BufSz + 1 ! mc Db_BufSz = Db_BufSz + 1 ! cv - Int_BufSz = Int_BufSz + 1 ! Standalone Int_BufSz = Int_BufSz + 1 ! inertialF Int_BufSz = Int_BufSz + 1 ! nxWave Int_BufSz = Int_BufSz + 1 ! nyWave @@ -11638,8 +11635,6 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%cv Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Standalone - Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%inertialF Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%nxWave @@ -12338,8 +12333,6 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Db_Xferred = Db_Xferred + 1 OutData%cv = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%Standalone = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 OutData%inertialF = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%nxWave = IntKiBuf(Int_Xferred) From 9d46ce01d26ecd45817be01912b188f8af9728c1 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 25 Jan 2024 21:00:40 -0700 Subject: [PATCH 186/232] Tmp commit --- modules/aerodyn/src/AeroDyn.f90 | 15 +- modules/aerodyn/src/AeroDyn_Registry.txt | 1 + modules/aerodyn/src/AeroDyn_Types.f90 | 4 + modules/extloads/CMakeLists.txt | 2 +- modules/extloads/src/ExtLoads.f90 | 71 ++++++---- modules/extloads/src/ExtLoads_Registry.txt | 8 +- modules/extloads/src/ExtLoads_Types.f90 | 91 ++++++++++++ modules/openfast-library/src/FAST_Solver.f90 | 137 +++++++++++-------- modules/openfast-library/src/FAST_Subs.f90 | 14 +- 9 files changed, 249 insertions(+), 94 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 00e1d954c4..a7cca28d9d 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -227,8 +227,9 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Local variables - integer(IntKi) :: i ! loop counter + integer(IntKi) :: i,k ! loop counter integer(IntKi) :: iR ! loop on rotors + integer(IntKi) :: nNodesVelRot ! number of nodes associated with the rotor that need wind velocity (for CFD coupling) integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message @@ -500,6 +501,18 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut end do end if + ! number of nodes velocity is required at (for coupling to cfd) + InitOut%nNodesVel = 0 + do iR = 1, nRotors + if (u%rotors(iR)%HubMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%HubMotion%nNodes + do k = 1,size(u%rotors(iR)%BladeMotion) + if (u%rotors(iR)%BladeMotion(k)%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%BladeMotion(k)%nNodes + enddo + if (u%rotors(iR)%TowerMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%TowerMotion%nNodes + if (u%rotors(iR)%NacelleMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%NacelleMotion%nNodes + if (u%rotors(iR)%TFinMotion%committed) InitOut%nNodesVel = InitOut%nNodesVel + u%rotors(iR)%TFinMotion%nNodes + enddo + !............................................................................................ ! Initialize Jacobian: !............................................................................................ diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 618b6540d6..8a615e8b4e 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -141,6 +141,7 @@ typedef ^ RotInitOutputType ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ InitOutputType RotInitOutputType rotors {:} - - "Rotor init output type" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ InitOutputType IntKi nNodesVel - - - "number of nodes velocity values are needed at (for ExtLoads coupling)" - # ..... Input file data ........................................................................................................... # ..... Primary Input file data ................................................................................................... diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index fa691fffed..f8ab54496e 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -169,6 +169,7 @@ MODULE AeroDyn_Types TYPE, PUBLIC :: AD_InitOutputType TYPE(RotInitOutputType) , DIMENSION(:), ALLOCATABLE :: rotors !< Rotor init output type [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + INTEGER(IntKi) :: nNodesVel = 0_IntKi !< number of nodes velocity values are needed at (for ExtLoads coupling) [-] END TYPE AD_InitOutputType ! ======================= ! ========= RotInputFile ======= @@ -1673,6 +1674,7 @@ subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + DstInitOutputData%nNodesVel = SrcInitOutputData%nNodesVel end subroutine subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -1716,6 +1718,7 @@ subroutine AD_PackInitOutput(RF, Indata) end do end if call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPack(RF, InData%nNodesVel) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1742,6 +1745,7 @@ subroutine AD_UnPackInitOutput(RF, OutData) end do end if call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpack(RF, OutData%nNodesVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/extloads/CMakeLists.txt b/modules/extloads/CMakeLists.txt index b649f69557..43baa634f6 100644 --- a/modules/extloads/CMakeLists.txt +++ b/modules/extloads/CMakeLists.txt @@ -27,7 +27,7 @@ add_library(extloadslib STATIC target_include_directories(extloadslib PUBLIC $ ) -target_link_libraries(extloadslib beamdynlib nwtclibs versioninfolib) +target_link_libraries(extloadslib beamdynlib nwtclibs versioninfolib ifwlib) set_target_properties(extloadslib PROPERTIES PUBLIC_HEADER "src/ExtLoadsDX_Types.h") install(TARGETS extloadslib diff --git a/modules/extloads/src/ExtLoads.f90 b/modules/extloads/src/ExtLoads.f90 index 86ae0c85d3..03b4404407 100644 --- a/modules/extloads/src/ExtLoads.f90 +++ b/modules/extloads/src/ExtLoads.f90 @@ -26,7 +26,10 @@ module ExtLoads use NWTC_Library use ExtLoads_Types - + use IfW_FlowField + use InflowWind_IO_Types + use InflowWind_IO + implicit none private @@ -40,7 +43,7 @@ module ExtLoads public :: ExtLd_CalcOutput ! Routine for computing outputs public :: ExtLd_ConvertOpDataForOpenFAST ! Routine to convert Output data for OpenFAST public :: ExtLd_ConvertInpDataForExtProg ! Routine to convert Input data for external programs - + contains !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., @@ -86,21 +89,21 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM type(ExtLd_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; type(ExtLd_MiscVarType), intent( out) :: m !< Miscellaneous variables type(ExtLd_ParameterType), intent( out) :: p !< Parameter variables - !! only the output mesh is initialized) - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that - !! (1) ExtLd_UpdateStates() is called in loose coupling & - !! (2) ExtLd_UpdateDiscState() is called in tight coupling. - !! Input is the suggested time from the glue code; - !! Output is the actual coupling interval that will be used - !! by the glue code. + !! only the output mesh is initialized) + real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + !! (1) ExtLd_UpdateStates() is called in loose coupling & + !! (2) ExtLd_UpdateDiscState() is called in tight coupling. + !! Input is the suggested time from the glue code; + !! Output is the actual coupling interval that will be used + !! by the glue code. type(ExtLd_InitOutputType), intent( out) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! Local variables integer(IntKi) :: i ! loop counter - + type(Points_InitInputType) :: Points_InitInput integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message @@ -118,10 +121,7 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM p%NumBlds = InitInp%NumBlades call AllocAry(p%NumBldNds, p%NumBlds, 'NumBldNds', ErrStat2,ErrMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + if (ErrStat >= AbortErrLev) return p%NumBldNds(:) = InitInp%NumBldNodes(:) p%nTotBldNds = sum(p%NumBldNds(:)) p%NumTwrNds = InitInp%NumTwrNds @@ -142,10 +142,7 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM call Init_u( u, p, InitInp, errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + if (ErrStat >= AbortErrLev) return ! Initialize discrete states @@ -159,11 +156,27 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM !............................................................................................ call Init_y(y, u, m, p, errStat2, errMsg2) ! do this after input meshes have been initialized call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if + if (ErrStat >= AbortErrLev) return + !............................................................................................ + ! Initialize InflowWind FlowField + !............................................................................................ + if (associated(m%FlowField)) deallocate(m%FlowField) + allocate(m%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal, 'Error allocating m%FlowField', ErrStat, ErrMsg, RoutineName ) + return + end if + + ! Initialize flowfield points type + m%FlowField%FieldType = Point_FieldType + Points_InitInput%NumWindPoints = InitInp%nNodesVel + call IfW_Points_Init(Points_InitInput, m%FlowField%Points, ErrStat2, ErrMsg2); if (Failed()) return + + ! Set pointer to flow field in InitOut + InitOut%FlowField => m%FlowField + + write(*,*) 'Initializing InitOut ' !............................................................................................ @@ -172,13 +185,13 @@ subroutine ExtLd_Init( InitInp, u, xd, p, y, m, interval, InitOut, ErrStat, ErrM call ExtLd_SetInitOut(p, InitOut, errStat2, errMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call Cleanup() contains - subroutine Cleanup() - - end subroutine Cleanup - + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed + end subroutine ExtLd_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes ExtLoads meshes and output array variables for use during the simulation. diff --git a/modules/extloads/src/ExtLoads_Registry.txt b/modules/extloads/src/ExtLoads_Registry.txt index d70ba74433..5f3af5384d 100644 --- a/modules/extloads/src/ExtLoads_Registry.txt +++ b/modules/extloads/src/ExtLoads_Registry.txt @@ -15,6 +15,7 @@ ################################################################################################################################### # ...... Include files (definitions from NWTC Library) ............................................................................ include Registry_NWTC_Library.txt +include IfW_FlowField.txt usefrom ExtLoadsDX_Registry.txt # ..... Initialization data ....................................................................................................... @@ -43,12 +44,14 @@ typedef ^ InitInputType ReKi BldChord {:}{:} typedef ^ InitInputType ReKi BldRloc {:}{:} - - "Radial location of each node along the blade" m typedef ^ InitInputType ReKi TwrDia {:} - - "Tower diameter (NumTwrNodes)" m typedef ^ InitInputType ReKi TwrHloc {:} - - "Height location of each node along the tower" m +typedef ^ InitInputType IntKi nNodesVel - - - "Number of nodes velocity data is needed from (for sizing array)" - # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 +typedef ^ InitOutputType FlowFieldType *FlowField - - - "Pointer of flow field data type" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -58,8 +61,9 @@ typedef ^ ContinuousStateType ReKi blah - - - "Someth typedef ^ DiscreteStateType ReKi blah - - - "Something" - #Defin misc variables here -typedef ^ MiscVarType ReKi az - - - "Current azimuth" - -typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - +typedef ^ MiscVarType ReKi az - - - "Current azimuth" - +typedef ^ MiscVarType ReKi phi_cfd - - - "Blending ratio of load from external driver [0-1]" - +typedef ^ MiscVarType FlowFieldType &FlowField - - - "Flow field data type" - # Define constraint states here: typedef ^ ConstraintStateType ReKi blah - - - "Something" - diff --git a/modules/extloads/src/ExtLoads_Types.f90 b/modules/extloads/src/ExtLoads_Types.f90 index 1a7e775232..dcb14a5afe 100644 --- a/modules/extloads/src/ExtLoads_Types.f90 +++ b/modules/extloads/src/ExtLoads_Types.f90 @@ -31,6 +31,7 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE ExtLoads_Types !--------------------------------------------------------------------------------------------------------------------------------- +USE IfW_FlowField_Types USE ExtLoadsDX_Types USE NWTC_Library IMPLICIT NONE @@ -60,6 +61,7 @@ MODULE ExtLoads_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldRloc !< Radial location of each node along the blade [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDia !< Tower diameter (NumTwrNodes) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHloc !< Height location of each node along the tower [m] + INTEGER(IntKi) :: nNodesVel = 0_IntKi !< Number of nodes velocity data is needed from (for sizing array) [-] END TYPE ExtLd_InitInputType ! ======================= ! ========= ExtLd_InitOutputType ======= @@ -68,6 +70,7 @@ MODULE ExtLoads_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of flow field data type [-] END TYPE ExtLd_InitOutputType ! ======================= ! ========= ExtLd_ContinuousStateType ======= @@ -84,6 +87,7 @@ MODULE ExtLoads_Types TYPE, PUBLIC :: ExtLd_MiscVarType REAL(ReKi) :: az = 0.0_ReKi !< Current azimuth [-] REAL(ReKi) :: phi_cfd = 0.0_ReKi !< Blending ratio of load from external driver [0-1] [-] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data type [-] END TYPE ExtLd_MiscVarType ! ======================= ! ========= ExtLd_ConstraintStateType ======= @@ -290,6 +294,7 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if DstInitInputData%TwrHloc = SrcInitInputData%TwrHloc end if + DstInitInputData%nNodesVel = SrcInitInputData%nNodesVel end subroutine subroutine ExtLd_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -363,6 +368,7 @@ subroutine ExtLd_PackInitInput(RF, Indata) call RegPackAlloc(RF, InData%BldRloc) call RegPackAlloc(RF, InData%TwrDia) call RegPackAlloc(RF, InData%TwrHloc) + call RegPack(RF, InData%nNodesVel) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -398,6 +404,7 @@ subroutine ExtLd_UnPackInitInput(RF, OutData) call RegUnpackAlloc(RF, OutData%BldRloc); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TwrDia); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%TwrHloc); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nNodesVel); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -440,6 +447,7 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstInitOutputData%AirDens = SrcInitOutputData%AirDens + DstInitOutputData%FlowField => SrcInitOutputData%FlowField end subroutine subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -459,17 +467,26 @@ subroutine ExtLd_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitOutputData%FlowField) end subroutine subroutine ExtLd_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackInitOutput' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%WriteOutputHdr) call RegPackAlloc(RF, InData%WriteOutputUnt) call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPack(RF, InData%AirDens) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -480,11 +497,31 @@ subroutine ExtLd_UnPackInitOutput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver call RegUnpack(RF, OutData%AirDens); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if end subroutine subroutine ExtLd_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -569,29 +606,60 @@ subroutine ExtLd_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(0), UB(0) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyMisc' ErrStat = ErrID_None ErrMsg = '' DstMiscData%az = SrcMiscData%az DstMiscData%phi_cfd = SrcMiscData%phi_cfd + if (associated(SrcMiscData%FlowField)) then + if (.not. associated(DstMiscData%FlowField)) then + allocate(DstMiscData%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FlowField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call IfW_FlowField_CopyFlowFieldType(SrcMiscData%FlowField, DstMiscData%FlowField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end if end subroutine subroutine ExtLd_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ExtLd_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + if (associated(MiscData%FlowField)) then + call IfW_FlowField_DestroyFlowFieldType(MiscData%FlowField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(MiscData%FlowField) + MiscData%FlowField => null() + end if end subroutine subroutine ExtLd_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLd_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackMisc' + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%az) call RegPack(RF, InData%phi_cfd) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -599,9 +667,32 @@ subroutine ExtLd_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackMisc' + integer(B8Ki) :: LB(0), UB(0) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%az); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%phi_cfd); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if end subroutine subroutine ExtLd_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 60c51e1a08..78e7340ff3 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -531,9 +531,6 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_A Node = Node + 1 u_IfW%PositionXYZ(:,Node) = u_AD14%Twr_InputMarkers%TranslationDisp(:,J) + u_AD14%Twr_InputMarkers%Position(:,J) END DO - - ELSEIF (p_FAST%CompAero == MODULE_AD) THEN - END IF @@ -551,55 +548,81 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_A END SUBROUTINE IfW_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!FIXME: ExtLoads does needs to use the new method for setting the values in the IfW pointers -SUBROUTINE AD_InputSolve_IfW_ExtLoads( p_FAST, u_AD, p_ExtLd, ErrStat, ErrMsg ) - - type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameter data - type(AD_InputType), intent(inout) :: u_AD !< The inputs to AeroDyn - type(ExtLd_ParameterType), intent(in) :: p_ExtLd !< Parameters of ExtLoads - integer(IntKi) :: ErrStat !< Error status of the operation - character(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - !local variables - real(ReKi) :: z !< Local 'z' coordinate - real(ReKi) :: mean_vel !< Local mean velocity - real(ReKi) :: pi !< Our favorite number - integer(IntKi) :: j,k !< Local counter variables - integer(IntKi) :: NumBl !< Number of blades - integer(IntKi) :: Nnodes !< Number of nodes - - ErrStat = ErrID_None - ErrMsg = '' - -! pi = acos(-1.0) -! NumBl = size(u_AD%rotors(1)%InflowOnBlade,3) -! Nnodes = size(u_AD%rotors(1)%InflowOnBlade,2) -! -! do k=1,NumBl -! do j=1,Nnodes -! !Get position first -! z = u_AD%rotors(1)%BladeMotion(k)%Position(3,j) + u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) -! mean_vel = p_ExtLd%vel_mean * ( (z/p_ExtLd%z_ref) ** p_ExtLd%shear_exp) -! u_AD%rotors(1)%InflowOnBlade(1,j,k) = -mean_vel * sin(p_ExtLd%wind_dir * pi / 180.0) -! u_AD%rotors(1)%InflowOnBlade(2,j,k) = -mean_vel * cos(p_ExtLd%wind_dir * pi / 180.0) -! u_AD%rotors(1)%InflowOnBlade(3,j,k) = 0.0 -! end do -! end do -! -! if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then -! Nnodes = size(u_AD%rotors(1)%InflowOnTower,2) -! do j=1,Nnodes -! !Get position first -! z = u_AD%rotors(1)%TowerMotion%Position(3,j) + u_AD%rotors(1)%TowerMotion%TranslationDisp(3,j) -! mean_vel = p_ExtLd%vel_mean * ( (z/p_ExtLd%z_ref) ** p_ExtLd%shear_exp) -! u_AD%rotors(1)%InflowOnTower(1,j) = -mean_vel * sin(p_ExtLd%wind_dir * pi / 180.0) -! u_AD%rotors(1)%InflowOnTower(2,j) = -mean_vel * cos(p_ExtLd%wind_dir * pi / 180.0) -! u_AD%rotors(1)%InflowOnTower(3,j) = 0.0 -! end do -! end if +SUBROUTINE ExtLd_UpdateFlowField( p_FAST, u_AD, ExtLd, ErrStat, ErrMsg ) + type(FAST_ParameterType), intent(in) :: p_FAST !< FAST parameter data + type(AD_InputType), intent(in ) :: u_AD !< The inputs to AeroDyn + type(ExtLoads_Data), intent(in ) :: ExtLd !< ExtLoads data + integer(IntKi) :: ErrStat !< Error status of the operation + character(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + !local variables + real(ReKi) :: z !< Local 'z' coordinate + real(ReKi) :: pi !< Our favorite number + integer(IntKi) :: j,k !< Local counter variables + integer(IntKi) :: NumBl !< Number of blades + integer(IntKi) :: iPt !< Point in the flow field array. Make sure this order corresponds to what AD15 uses!!!!!! + -END SUBROUTINE AD_InputSolve_IfW_ExtLoads + ErrStat = ErrID_None + ErrMsg = '' + + NumBl = size(u_AD%rotors(1)%BladeMotion) + + iPt=1 + + ! Hub + if (u_AD%rotors(1)%HubMotion%committed) then + ! height + z = u_AD%rotors(1)%HubMotion%Position(3,1) + u_AD%rotors(1)%HubMotion%TranslationDisp(3,1) + call SetWind(iPt,z); iPt = iPt + 1 + endif + + ! Blades + do k=1,NumBl + do j=1,u_AD%rotors(1)%BladeMotion(k)%nNodes + ! height + z = u_AD%rotors(1)%BladeMotion(k)%Position(3,j) + u_AD%rotors(1)%BladeMotion(k)%TranslationDisp(3,j) + call SetWind(iPt,z); iPt = iPt + 1 + end do + end do + + ! Tower + if ( allocated(u_AD%rotors(1)%InflowOnTower) ) then + do j=1,u_AD%rotors(1)%TowerMotion%nNodes + ! height + z = u_AD%rotors(1)%TowerMotion%Position(3,j) + u_AD%rotors(1)%TowerMotion%TranslationDisp(3,j) + call SetWind(iPt,z); iPt = iPt + 1 + end do + end if + + ! Nacelle + if (u_AD%rotors(1)%NacelleMotion%committed) then + ! height + z = u_AD%rotors(1)%NacelleMotion%Position(3,1) + u_AD%rotors(1)%NacelleMotion%TranslationDisp(3,1) + call SetWind(iPt,z); iPt = iPt + 1 + endif + + ! Tailfin + if (u_AD%rotors(1)%TFinMotion%committed) then + ! height + z = u_AD%rotors(1)%TFinMotion%Position(3,1) + u_AD%rotors(1)%TFinMotion%TranslationDisp(3,1) + call SetWind(iPt,z); iPt = iPt + 1 + endif + +contains + function mean_vel(z_h) + real(ReKi) :: z_h !< height + real(ReKi) :: mean_vel !< mean velocity at height z_h + mean_vel = ExtLd%p%vel_mean * ( (z_h/ExtLd%p%z_ref) ** ExtLd%p%shear_exp) + end function + subroutine SetWind(i,z_h) + integer(IntKi) :: i ! point num + real(ReKi) :: z_h !< height + ExtLd%m%FlowField%Points%Vel(iPt,1) = -mean_vel(z_h) * sin(ExtLd%p%wind_dir * pi / 180.0) + ExtLd%m%FlowField%Points%Vel(iPt,2) = -mean_vel(z_h) * cos(ExtLd%p%wind_dir * pi / 180.0) + ExtLd%m%FlowField%Points%Vel(iPt,3) = 0.0 + end subroutine +END SUBROUTINE ExtLd_UpdateFlowField @@ -5143,7 +5166,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AD_InputSolve_IfW_ExtLoads( p_FAST, AD%Input(1), ExtLd%p, ErrStat2, ErrMsg2 ) + CALL ExtLd_UpdateFlowField( p_FAST, AD%Input(1), ExtLd, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL ExtLd_InputSolve_NoIfW( p_FAST, ExtLd%u, ExtLd%p, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) @@ -5518,7 +5541,7 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLD !< ExtLoads data + TYPE(ExtLoads_Data), INTENT(INOUT) :: ExtLd !< ExtLoads data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5569,6 +5592,12 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, CALL AD14_InputSolve_IfW( p_FAST, AD14%Input(1), IfW%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE IF (p_FAST%CompAero == Module_ExtLd ) THEN + + ! The outputs from ExternalInflow need to be transfered to the FlowField for use by AeroDyn, this seems like the right place + call ExtLd_UpdateFlowField( p_FAST, AD%Input(1), ExtLd, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF @@ -5655,7 +5684,7 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, CALL SetErrStat(ErrID_Fatal,'p_FAST%CompInflow option not setup to work with ExtLoads module.',ErrStat,ErrMsg,RoutineName) ENDIF - CALL AD_InputSolve_IfW_ExtLoads( p_FAST, AD%Input(1), ExtLd%p, ErrStat2, ErrMsg2 ) + CALL ExtLd_UpdateFlowField( p_FAST, AD%Input(1), ExtLd, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2248343b26..90ea20cd53 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -613,6 +613,9 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AirDens = Init%OutData_ExtLd%AirDens + ! Set pointer to flowfield + IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtLd%FlowField + END IF END IF @@ -654,13 +657,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes - ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - ! Number of Wind points from AeroDyn, see AeroDyn.f90 - Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints - ! Wake -- we allow the wake positions to exceed the wind box - if (allocated(AD%OtherSt(STATE_CURR)%WakeLocationPoints)) then - Init%InData_IfW%BoxExceedAllow = .true. - endif END IF ! lidar @@ -4665,6 +4661,10 @@ SUBROUTINE ExtLd_SetInitInput(InitInData_ExtLd, InitOutData_ED, y_ED, InitOutDat deallocate(AD_etaNodes) end if + ! Total number of nodes velocity is needed at + InitInData_ExtLd%nNodesVel = InitOutData_AD%nNodesVel + + RETURN END SUBROUTINE ExtLd_SetInitInput From 8a1fb562a73c3312da096b37a15993a8da5119ef Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 6 Feb 2024 15:32:43 -0700 Subject: [PATCH 187/232] RegTest: add output files for linearization frequencies --- .../executeOpenfastLinearRegressionCase.py | 90 +++++++++++++++++-- 1 file changed, 83 insertions(+), 7 deletions(-) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 9a721acab4..bd740f8741 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -98,6 +98,10 @@ def isclose(a, b, rtol=1e-09, atol=0.0): rtol_d=1e-2 atol_d=1e-1 +# --- Filenames for frequency info +fileNameFreqRef="frequencies_ref.txt" +fileNameFreqNew="frequencies_new.txt" + CasePrefix=' Case: {}: '.format(caseName) def exitWithError(msg): @@ -120,6 +124,8 @@ def indent(msg, sindent='\t'): inputsDirectory = os.path.join(moduleDirectory, caseName) targetOutputDirectory = os.path.join(inputsDirectory) testBuildDirectory = os.path.join(buildDirectory, caseName) +fNameFreqRef = os.path.join(testBuildDirectory, fileNameFreqRef) +fNameFreqNew = os.path.join(testBuildDirectory, fileNameFreqNew) # verify all the required directories exist if not os.path.isdir(rtest): @@ -183,7 +189,7 @@ def indent(msg, sindent='\t'): ### test for regression (compare lin files only) -def compareLin(f): +def compareLin(f,file_freq_ref,file_freq_new): Errors = [] ElemErrors = [] @@ -261,12 +267,44 @@ def newError(msg): Err='Failed to compare A-matrix frequencies\n\tLinfile: {}.\n\tException: {}'.format(local_file2, indent(e.args[0])) newError(Err) else: - #if verbose: - print(errPrefix+'freq_ref:', np.around(freq_bas[:8] ,5), '[Hz]') - print(errPrefix+'freq_new:', np.around(freq_loc[:8] ,5),'[Hz]') - print(errPrefix+'damp_ref:', np.around(zeta_bas[:8]*100,5), '[%]') - print(errPrefix+'damp_new:', np.around(zeta_loc[:8]*100,5), '[%]') + print('\n'+errPrefix+':') + print(' Frequency (Hz) Damping (%)') + print(' ---------------------------- ----------------------------') + print(' Ref New Ref New') + + #write frequencies to file + try: + file_freq_ref.write('\n'+errPrefix+':\n') + file_freq_ref.write(' Freq (Hz) Damp (%)\n') + file_freq_new.write('\n'+errPrefix+':\n') + file_freq_new.write(' Freq (Hz) Damp (%)\n') + except Exception: + pass # ignore all writing errors + + + for j in range(min(10,max(len(freq_bas),len(freq_loc)))): + if j0: Errors += ElemErrorsLoc[:3] # Just a couple of them +freqFileClose(ff1,ff2) + + if len(Errors)>0: exitWithError('See errors below: \n'+'\n'.join(Errors)) From 6d7762bf668cd6299a6abfe6cfa1ee7a811e8fe5 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 6 Feb 2024 17:09:35 -0700 Subject: [PATCH 188/232] Lin testing: add optional lowpass filtering on linearization frequency comparisons. --- reg_tests/CTestList.cmake | 68 ++++++++++--------- .../executeOpenfastLinearRegressionCase.py | 13 ++++ 2 files changed, 50 insertions(+), 31 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index bbe017d88f..e06a5c04a7 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -18,7 +18,7 @@ # Generic test functions #=============================================================================== -function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY STEADYSTATE_FLAG TESTNAME LABEL) +function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY STEADYSTATE_FLAG TESTNAME LABEL OTHER_FLAGS) file(TO_NATIVE_PATH "${EXECUTABLE}" EXECUTABLE) file(TO_NATIVE_PATH "${TEST_SCRIPT}" TEST_SCRIPT) @@ -57,6 +57,10 @@ function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY STEA set(STEADYSTATE_FLAG "") endif() + if(OTHER_FLAGS STREQUAL " ") + set(OTHER_FLAGS "") + endif() + add_test( ${TESTNAME} ${Python_EXECUTABLE} ${TEST_SCRIPT} @@ -70,6 +74,7 @@ function(regression TEST_SCRIPT EXECUTABLE SOURCE_DIRECTORY BUILD_DIRECTORY STEA ${RUN_VERBOSE_FLAG} # empty or "-v" ${NO_RUN_FLAG} # empty or "-n" ${STEADYSTATE_FLAG} # empty or "-steadystate" + ${OTHER_FLAGS} ) # limit each test to 90 minutes: 5400s set_tests_properties(${TESTNAME} PROPERTIES TIMEOUT 5400 WORKING_DIRECTORY "${CMAKE_CURRENT_BINARY_DIR}" LABELS "${LABEL}") @@ -85,7 +90,7 @@ function(of_regression TESTNAME LABEL) set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_regression) function(of_aeromap_regression TESTNAME LABEL) @@ -94,7 +99,7 @@ function(of_aeromap_regression TESTNAME LABEL) set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") set(STEADYSTATE_FLAG "-steadystate") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${STEADYSTATE_FLAG} ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} ${STEADYSTATE_FLAG} ${TESTNAME} "${LABEL}" " ") endfunction(of_aeromap_regression) function(of_fastlib_regression TESTNAME LABEL) @@ -103,7 +108,7 @@ function(of_fastlib_regression TESTNAME LABEL) set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") # extra flag in call to "regression" on next line sets the ${TESTDIR} - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " "${TESTNAME}_fastlib" "${LABEL}" ${TESTNAME}) + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " "${TESTNAME}_fastlib" "${LABEL}" ${TESTNAME} " ") endfunction(of_fastlib_regression) # openfast aeroacoustic @@ -112,7 +117,7 @@ function(of_regression_aeroacoustic TESTNAME LABEL) set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_regression_aeroacoustic) # FAST Farm @@ -121,16 +126,17 @@ function(ff_regression TESTNAME LABEL) set(FASTFARM_EXECUTABLE "${CTEST_FASTFARM_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/fast-farm") - regression(${TEST_SCRIPT} ${FASTFARM_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${FASTFARM_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ff_regression) # openfast linearized -function(of_regression_linear TESTNAME LABEL) +function(of_regression_linear TESTNAME OTHER_FLAGS LABEL) set(TEST_SCRIPT "${CMAKE_CURRENT_LIST_DIR}/executeOpenfastLinearRegressionCase.py") set(OPENFAST_EXECUTABLE "${CTEST_OPENFAST_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + set(OTHER_FLAGS "${OTHER_FLAGS}") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" "${OTHER_FLAGS}") endfunction(of_regression_linear) # openfast C++ interface @@ -139,7 +145,7 @@ function(of_cpp_interface_regression TESTNAME LABEL) set(OPENFAST_CPP_EXECUTABLE "${CTEST_OPENFASTCPP_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast-cpp") - regression(${TEST_SCRIPT} ${OPENFAST_CPP_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${OPENFAST_CPP_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_cpp_interface_regression) # openfast Python-interface @@ -148,7 +154,7 @@ function(of_regression_py TESTNAME LABEL) set(EXECUTABLE "None") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/python") - regression(${TEST_SCRIPT} ${EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(of_regression_py) # aerodyn @@ -157,7 +163,7 @@ function(ad_regression TESTNAME LABEL) set(AERODYN_EXECUTABLE "${CTEST_AERODYN_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/aerodyn") - regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ad_regression) # aerodyn-Py @@ -166,7 +172,7 @@ function(py_ad_regression TESTNAME LABEL) set(AERODYN_EXECUTABLE "${Python_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/aerodyn") - regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_ad_regression) @@ -176,7 +182,7 @@ function(ua_regression TESTNAME LABEL) set(AERODYN_EXECUTABLE "${CTEST_UADRIVER_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/unsteadyaero") - regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${AERODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ua_regression) @@ -186,7 +192,7 @@ function(bd_regression TESTNAME LABEL) set(BEAMDYN_EXECUTABLE "${CTEST_BEAMDYN_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/beamdyn") - regression(${TEST_SCRIPT} ${BEAMDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${BEAMDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(bd_regression) # hydrodyn @@ -195,7 +201,7 @@ function(hd_regression TESTNAME LABEL) set(HYDRODYN_EXECUTABLE "${CTEST_HYDRODYN_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/hydrodyn") - regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(hd_regression) # py_hydrodyn @@ -204,7 +210,7 @@ function(py_hd_regression TESTNAME LABEL) set(HYDRODYN_EXECUTABLE "${Python_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/hydrodyn") - regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${HYDRODYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_hd_regression) # subdyn @@ -213,7 +219,7 @@ function(sd_regression TESTNAME LABEL) set(SUBDYN_EXECUTABLE "${CTEST_SUBDYN_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/subdyn") - regression(${TEST_SCRIPT} ${SUBDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${SUBDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(sd_regression) # inflowwind @@ -222,7 +228,7 @@ function(ifw_regression TESTNAME LABEL) set(INFLOWWIND_EXECUTABLE "${CTEST_INFLOWWIND_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/inflowwind") - regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(ifw_regression) # py_inflowwind @@ -231,7 +237,7 @@ function(py_ifw_regression TESTNAME LABEL) set(INFLOWWIND_EXECUTABLE "${Python_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/inflowwind") - regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${INFLOWWIND_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_ifw_regression) # seastate @@ -240,7 +246,7 @@ function(seast_regression TESTNAME LABEL) set(SEASTATE_EXECUTABLE "${CTEST_SEASTATE_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/seastate") - regression(${TEST_SCRIPT} ${SEASTATE_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${SEASTATE_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(seast_regression) # moordyn @@ -249,7 +255,7 @@ function(md_regression TESTNAME LABEL) set(MOORDYN_EXECUTABLE "${CTEST_MOORDYN_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/moordyn") - regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(md_regression) # py_moordyn c-bindings interface @@ -258,7 +264,7 @@ function(py_md_regression TESTNAME LABEL) set(MOORDYN_EXECUTABLE "${Python_EXECUTABLE}") set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/modules/moordyn") - regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}") + regression(${TEST_SCRIPT} ${MOORDYN_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " ${TESTNAME} "${LABEL}" " ") endfunction(py_md_regression) # # Python-based OpenFAST Library tests @@ -336,15 +342,15 @@ of_regression_py("EllipticalWing_OLAF_py" "openfast;fastlib;p of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") # Linearized OpenFAST regression tests -# of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "openfast;linear;elastodyn") #Also: aerodyn -# of_regression_linear("Fake5MW_AeroLin_B3_UA6" "openfast;linear;elastodyn") #Also: aerodyn -of_regression_linear("WP_Stationary_Linear" "openfast;linear;elastodyn") -of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "openfast;linear;beamdyn") -of_regression_linear("Ideal_Beam_Free_Free_Linear" "openfast;linear;beamdyn") -of_regression_linear("5MW_Land_BD_Linear" "openfast;linear;beamdyn;servodyn") -of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;servodyn") -of_regression_linear("StC_test_OC4Semi_Linear_Nac" "openfast;linear;servodyn;stc") -of_regression_linear("StC_test_OC4Semi_Linear_Tow" "openfast;linear;servodyn;stc") +of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") +of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") +of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") +of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-lowpass=0.05" "openfast;linear;beamdyn") +of_regression_linear("Ideal_Beam_Free_Free_Linear" "-lowpass=0.05" "openfast;linear;beamdyn") +of_regression_linear("5MW_Land_BD_Linear" "" "openfast;linear;beamdyn;servodyn") +of_regression_linear("5MW_OC4Semi_Linear" "" "openfast;linear;hydrodyn;servodyn") +of_regression_linear("StC_test_OC4Semi_Linear_Nac" "" "openfast;linear;servodyn;stc") +of_regression_linear("StC_test_OC4Semi_Linear_Tow" "" "openfast;linear;servodyn;stc") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index bd740f8741..5ddc3401ed 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -67,6 +67,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") +parser.add_argument("-lowpass", dest='lowpass', metavar="LowPass-Filter", type=float, nargs='?', default=0.0, help="low pass filter on linearization frequencies to compare") args = parser.parse_args() @@ -79,6 +80,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): plotError = args.plot noExec = args.noExec verbose = args.verbose +lowpass = args.lowpass # --- Tolerances for matrix comparison # Outputs of lin matrices have 3 decimal digits leading to minimum error of 0.001 @@ -212,6 +214,14 @@ def newError(msg): print(msg) Errors.append(msg) + def ApplyLowPass(freq,zeta): + freqL=np.array([]) + zetaL=np.array([]) + for i in range(len(freq)): + if freq[i]>lowpass: + freqL = np.append(freqL,freq[i]) + zetaL = np.append(zetaL,zeta[i]) + return freqL,zetaL @@ -250,6 +260,9 @@ def newError(msg): _, zeta_bas, _, freq_bas = eigA(Abas, nq=None, nq1=None, sort=True, fullEV=True) _, zeta_loc, _, freq_loc = eigA(Aloc, nq=None, nq1=None, sort=True, fullEV=True) + freq_bas, zeta_bas = ApplyLowPass( freq_bas, zeta_bas ) + freq_loc, zeta_loc = ApplyLowPass( freq_loc, zeta_loc ) + if len(freq_bas)==0: # We use complex eigenvalues instead of frequencies/damping # If this fails often, we should discard this test. From 5c0c8a6552d906fcafc94380f4b7055219f29a45 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 6 Feb 2024 17:45:29 -0700 Subject: [PATCH 189/232] Lin Testing: disable Fake* linearization tests There is a bug in the AD15 linearization that is getting corrected in PR #2014 --- reg_tests/CTestList.cmake | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index e06a5c04a7..2aa2d2ad4d 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -342,8 +342,8 @@ of_regression_py("EllipticalWing_OLAF_py" "openfast;fastlib;p of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") # Linearized OpenFAST regression tests -of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") -of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") +#of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") +#of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-lowpass=0.05" "openfast;linear;beamdyn") of_regression_linear("Ideal_Beam_Free_Free_Linear" "-lowpass=0.05" "openfast;linear;beamdyn") From 6f9e9a3a3dd0ccf798748cb79d2d6e66fffb62f8 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 7 Feb 2024 09:28:03 -0700 Subject: [PATCH 190/232] Lin: fix name: lowpass --> highpass Started with name lowcut, then mistyped and never thought about it again. Definitely a blundering mistake from someone who has designed and built multiple low and high-pass electronic filters over the years (facepalm). --- reg_tests/CTestList.cmake | 10 +++++----- reg_tests/executeOpenfastLinearRegressionCase.py | 12 ++++++------ 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 2aa2d2ad4d..84117dc328 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -108,7 +108,7 @@ function(of_fastlib_regression TESTNAME LABEL) set(SOURCE_DIRECTORY "${CMAKE_CURRENT_LIST_DIR}/..") set(BUILD_DIRECTORY "${CTEST_BINARY_DIR}/glue-codes/openfast") # extra flag in call to "regression" on next line sets the ${TESTDIR} - regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " "${TESTNAME}_fastlib" "${LABEL}" ${TESTNAME} " ") + regression(${TEST_SCRIPT} ${OPENFAST_EXECUTABLE} ${SOURCE_DIRECTORY} ${BUILD_DIRECTORY} " " "${TESTNAME}_fastlib" "${LABEL}" " " ${TESTNAME}) endfunction(of_fastlib_regression) # openfast aeroacoustic @@ -342,11 +342,11 @@ of_regression_py("EllipticalWing_OLAF_py" "openfast;fastlib;p of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroacoustics") # Linearized OpenFAST regression tests -#of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") -#of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-lowpass=0.05" "openfast;linear;elastodyn;aerodyn") +#of_regression_linear("Fake5MW_AeroLin_B1_UA4_DBEMT3" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") +#of_regression_linear("Fake5MW_AeroLin_B3_UA6" "-highpass=0.05" "openfast;linear;elastodyn;aerodyn") of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") -of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-lowpass=0.05" "openfast;linear;beamdyn") -of_regression_linear("Ideal_Beam_Free_Free_Linear" "-lowpass=0.05" "openfast;linear;beamdyn") +of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-highpass=0.05" "openfast;linear;beamdyn") +of_regression_linear("Ideal_Beam_Free_Free_Linear" "-highpass=0.05" "openfast;linear;beamdyn") of_regression_linear("5MW_Land_BD_Linear" "" "openfast;linear;beamdyn;servodyn") of_regression_linear("5MW_OC4Semi_Linear" "" "openfast;linear;hydrodyn;servodyn") of_regression_linear("StC_test_OC4Semi_Linear_Nac" "" "openfast;linear;servodyn;stc") diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 5ddc3401ed..501d91d3c7 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -67,7 +67,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): parser.add_argument("-p", "-plot", dest="plot", action='store_true', help="bool to include plots in failed cases") parser.add_argument("-n", "-no-exec", dest="noExec", action='store_true', help="bool to prevent execution of the test cases") parser.add_argument("-v", "-verbose", dest="verbose", action='store_true', help="bool to include verbose system output") -parser.add_argument("-lowpass", dest='lowpass', metavar="LowPass-Filter", type=float, nargs='?', default=0.0, help="low pass filter on linearization frequencies to compare") +parser.add_argument("-highpass", dest='highpass', metavar="LowPass-Filter", type=float, nargs='?', default=0.0, help="high pass filter on linearization frequencies to compare") args = parser.parse_args() @@ -80,7 +80,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): plotError = args.plot noExec = args.noExec verbose = args.verbose -lowpass = args.lowpass +highpass = args.highpass # --- Tolerances for matrix comparison # Outputs of lin matrices have 3 decimal digits leading to minimum error of 0.001 @@ -214,11 +214,11 @@ def newError(msg): print(msg) Errors.append(msg) - def ApplyLowPass(freq,zeta): + def ApplyHighPass(freq,zeta): freqL=np.array([]) zetaL=np.array([]) for i in range(len(freq)): - if freq[i]>lowpass: + if freq[i]>highpass: freqL = np.append(freqL,freq[i]) zetaL = np.append(zetaL,zeta[i]) return freqL,zetaL @@ -260,8 +260,8 @@ def ApplyLowPass(freq,zeta): _, zeta_bas, _, freq_bas = eigA(Abas, nq=None, nq1=None, sort=True, fullEV=True) _, zeta_loc, _, freq_loc = eigA(Aloc, nq=None, nq1=None, sort=True, fullEV=True) - freq_bas, zeta_bas = ApplyLowPass( freq_bas, zeta_bas ) - freq_loc, zeta_loc = ApplyLowPass( freq_loc, zeta_loc ) + freq_bas, zeta_bas = ApplyHighPass( freq_bas, zeta_bas ) + freq_loc, zeta_loc = ApplyHighPass( freq_loc, zeta_loc ) if len(freq_bas)==0: # We use complex eigenvalues instead of frequencies/damping From ba6eb28405d737418942fcf19173546f23cd38a5 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 7 Feb 2024 21:58:44 -0700 Subject: [PATCH 191/232] SeaState: combine SeaSt_Interp into SeaSt_WaveField There is no reason to ever acces the interp routines directly outside of the WaveField module, so combining the two. --- modules/seastate/CMakeLists.txt | 3 - modules/seastate/src/SeaSt_WaveField.f90 | 1042 ++++++++++++----- modules/seastate/src/SeaSt_WaveField.txt | 21 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 180 ++- modules/seastate/src/SeaState.f90 | 226 ++-- modules/seastate/src/SeaState.txt | 3 +- modules/seastate/src/SeaState_Interp.f90 | 715 ----------- modules/seastate/src/SeaState_Interp.txt | 42 - .../seastate/src/SeaState_Interp_Types.f90 | 258 ---- modules/seastate/src/SeaState_Output.f90 | 2 +- modules/seastate/src/SeaState_Types.f90 | 11 +- 11 files changed, 1042 insertions(+), 1461 deletions(-) delete mode 100644 modules/seastate/src/SeaState_Interp.f90 delete mode 100644 modules/seastate/src/SeaState_Interp.txt delete mode 100644 modules/seastate/src/SeaState_Interp_Types.f90 diff --git a/modules/seastate/CMakeLists.txt b/modules/seastate/CMakeLists.txt index d30787e698..f0860e89ef 100644 --- a/modules/seastate/CMakeLists.txt +++ b/modules/seastate/CMakeLists.txt @@ -18,7 +18,6 @@ if (GENERATE_TYPES) generate_f90_types(src/Current.txt ${CMAKE_CURRENT_LIST_DIR}/src/Current_Types.f90 -noextrap) generate_f90_types(src/Waves.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves_Types.f90 -noextrap) generate_f90_types(src/Waves2.txt ${CMAKE_CURRENT_LIST_DIR}/src/Waves2_Types.f90 -noextrap) - generate_f90_types(src/SeaState_Interp.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaState_Interp_Types.f90 -noextrap) generate_f90_types(src/SeaSt_WaveField.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaSt_WaveField_Types.f90 -noextrap) generate_f90_types(src/SeaState.txt ${CMAKE_CURRENT_LIST_DIR}/src/SeaState_Types.f90 -noextrap) endif() @@ -28,7 +27,6 @@ add_library(seastlib STATIC src/Waves.f90 src/Waves2.f90 src/UserWaves.f90 - src/SeaState_Interp.f90 src/SeaSt_WaveField.f90 src/SeaState_Input.f90 src/SeaState.f90 @@ -36,7 +34,6 @@ add_library(seastlib STATIC src/Current_Types.f90 src/Waves_Types.f90 src/Waves2_Types.f90 - src/SeaState_Interp_Types.f90 src/SeaSt_WaveField_Types.f90 src/SeaState_Types.f90 ) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index c8ffabbc84..830964b471 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -1,10 +1,9 @@ MODULE SeaSt_WaveField -USE SeaState_Interp USE SeaSt_WaveField_Types IMPLICIT NONE - + PRIVATE ! Public functions and subroutines @@ -17,56 +16,59 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetWaveKin +public WaveField_SetParam + CONTAINS !-------------------- Subroutine for wave elevation ------------------! -FUNCTION WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(SiKi) :: WaveField_GetNodeWaveElev1 - REAL(SiKi) :: Zeta - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev1' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - +function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeWaveElev1 + real(SiKi) :: Zeta + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev1' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None ErrMsg = "" - + IF (ALLOCATED(WaveField%WaveElev1)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + Zeta = WaveField_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Zeta = 0.0_SiKi END IF - + WaveField_GetNodeWaveElev1 = Zeta -END FUNCTION WaveField_GetNodeWaveElev1 - -FUNCTION WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(SiKi) :: WaveField_GetNodeWaveElev2 - REAL(SiKi) :: Zeta - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveElev2' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - +end function WaveField_GetNodeWaveElev1 + + +function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveField_GetNodeWaveElev2 + real(SiKi) :: Zeta + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveElev2' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None ErrMsg = "" - + IF (ALLOCATED(WaveField%WaveElev2)) THEN - Zeta = SeaSt_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + Zeta = WaveField_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE Zeta = 0.0_SiKi @@ -74,93 +76,100 @@ FUNCTION WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrSt WaveField_GetNodeWaveElev2 = Zeta -END FUNCTION WaveField_GetNodeWaveElev2 +end function WaveField_GetNodeWaveElev2 + -FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None +FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(SiKi) :: WaveField_GetNodeTotalWaveElev - REAL(SiKi) :: Zeta1, Zeta2 - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeTotalWaveElev' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 + real(SiKi) :: WaveField_GetNodeTotalWaveElev + real(SiKi) :: Zeta1, Zeta2 + character(*), parameter :: RoutineName = 'WaveField_GetNodeTotalWaveElev' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" - - Zeta1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Zeta2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + Zeta1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + Zeta2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; WaveField_GetNodeTotalWaveElev = Zeta1 + Zeta2 - + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END FUNCTION WaveField_GetNodeTotalWaveElev -SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, SeaSt_Interp_m, Time, pos, r, n, ErrStat, ErrMsg ) - - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. - REAL(ReKi), INTENT( IN ) :: r ! Distance for central differencing - REAL(ReKi), INTENT( OUT ) :: n(3) ! Free-surface normal vector - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - REAL(SiKi) :: ZetaP,ZetaM - REAL(ReKi) :: r1,dZetadx,dZetady - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveNormal' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 + +SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. + real(ReKi), intent(in ) :: r ! Distance for central differencing + real(ReKi), intent( out) :: n(3) ! Free-surface normal vector + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: ZetaP,ZetaM + real(ReKi) :: r1,dZetadx,dZetady + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveNormal' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + ErrStat = ErrID_None ErrMsg = "" r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)+r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1)-r1,pos(2)/), ErrStat2, ErrMsg2 ); if (Failed()) return; dZetadx = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - - ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ZetaP = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)+r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; + ZetaM = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, (/pos(1),pos(2)-r1/), ErrStat2, ErrMsg2 ); if (Failed()) return; dZetady = REAL(ZetaP-ZetaM,ReKi)/(2.0_ReKi*r1) - + n = (/-dZetadx,-dZetady,1.0_ReKi/) n = n / SQRT(Dot_Product(n,n)) +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveNormal + !-------------------- Subroutine for full wave field kinematics --------------------! -SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT( INOUT ) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(3) - LOGICAL, INTENT( IN ) :: forceNodeInWater - REAL(SiKi), INTENT( OUT ) :: WaveElev1 - REAL(SiKi), INTENT( OUT ) :: WaveElev2 - REAL(SiKi), INTENT( OUT ) :: WaveElev - REAL(SiKi), INTENT( OUT ) :: FV(3) - REAL(SiKi), INTENT( OUT ) :: FA(3) - REAL(SiKi), INTENT( OUT ) :: FAMCF(3) - REAL(SiKi), INTENT( OUT ) :: FDynP - INTEGER(IntKi), INTENT( OUT ) :: nodeInWater - - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveKin' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 +SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + real(SiKi), intent( out) :: WaveElev1 + real(SiKi), intent( out) :: WaveElev2 + real(SiKi), intent( out) :: WaveElev + real(SiKi), intent( out) :: FV(3) + real(SiKi), intent( out) :: FA(3) + real(SiKi), intent( out) :: FAMCF(3) + real(SiKi), intent( out) :: FDynP + integer(IntKi), intent( out) :: nodeInWater + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveKin' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" @@ -170,28 +179,21 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force FAMCF(:) = 0.0 ! Wave elevation - WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + WaveElev1 = WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + WaveElev2 = WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; WaveElev = WaveElev1 + WaveElev2 - + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching - + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) END IF ELSE ! Node is above the SWL nodeInWater = 0_IntKi @@ -200,116 +202,103 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos, force FDynP = 0.0 FAMCF(:) = 0.0 END IF - + ELSE ! Wave stretching enabled - + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged - + nodeInWater = 1_IntKi - + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching - + IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual - - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) END IF ELSE ! Node is above SWL - need wave stretching - + ! Vertical wave stretching - CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_vec( WaveField%WaveAccMCF, WaveField_m ) END IF - + ! Extrapoled wave stretching - IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = FA(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = FDynP + SeaSt_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (WaveField%WaveStMod == 2) THEN + FV(:) = FV(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; + FA(:) = FA(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; + FDynP = FDynP + WaveField_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = FAMCF(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%seast_interp_p, SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = FAMCF(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; END IF END IF - + END IF ! Node is submerged - + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL - - ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] posPrime = pos posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth - posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. - + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + ! Obtain the wave-field variables by interpolation with the mapped position. - CALL SeaSt_Interp_Setup( Time, posPrime, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FA(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAcc, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FDynP = SeaSt_Interp_4D ( WaveField%WaveDynP, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) + FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = SeaSt_Interp_4D_Vec( WaveField%WaveAccMCF, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + FAMCF(:) = WaveField_Interp_4D_Vec( WaveField%WaveAccMCF, WaveField_m ) END IF END IF - + ELSE ! Node is out of water - zero-out all wave dynamics - - nodeInWater = 0_IntKi + + nodeInWater = 0_IntKi FV(:) = 0.0 FA(:) = 0.0 FDynP = 0.0 FAMCF(:) = 0.0 - + END IF ! If node is in or out of water - + END IF ! If wave stretching is on or off - + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveKin + !-------------------- Subroutine for wave field velocity only --------------------! -SUBROUTINE WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(3) - LOGICAL, INTENT( IN ) :: forceNodeInWater - INTEGER(IntKi), INTENT( OUT ) :: nodeInWater - REAL(SiKi), INTENT( OUT ) :: FV(3) - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - REAL(SiKi) :: WaveElev - REAL(ReKi) :: posXY(2), posPrime(3), posXY0(3) - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetNodeWaveVel' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 +SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, FV, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) + logical, intent(in ) :: forceNodeInWater + integer(IntKi), intent( out) :: nodeInWater + real(SiKi), intent( out) :: FV(3) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + real(SiKi) :: WaveElev + real(ReKi) :: posXY(2), posPrime(3), posXY0(3) + character(*), parameter :: RoutineName = 'WaveField_GetNodeWaveVel' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None ErrMsg = "" @@ -318,112 +307,109 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, SeaSt_Interp_m, Time, pos, force posXY0 = (/pos(1),pos(2),0.0_ReKi/) ! Wave elevation - WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + WaveElev = WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrStat2, ErrMsg2 ); if (Failed()) return; + IF (WaveField%WaveStMod == 0) THEN ! No wave stretching - + IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) ELSE ! Node is above the SWL nodeInWater = 0_IntKi FV(:) = 0.0 END IF - + ELSE ! Wave stretching enabled - + IF ( (pos(3) <= WaveElev) .OR. forceNodeInWater ) THEN ! Node is submerged - + nodeInWater = 1_IntKi - + IF ( WaveField%WaveStMod < 3 ) THEN ! Vertical or extrapolated wave stretching - + IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual - - ! Use location to obtain interpolated values of kinematics - CALL SeaSt_Interp_Setup( Time, pos, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Use location to obtain interpolated values of kinematics + CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) ELSE ! Node is above SWL - need wave stretching - + ! Vertical wave stretching - CALL SeaSt_Interp_Setup( Time, posXY0, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL WaveField_Interp_Setup( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) + ! Extrapoled wave stretching - IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + SeaSt_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%seast_interp_p, seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (WaveField%WaveStMod == 2) THEN + FV(:) = FV(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) + if (Failed()) return; END IF - + END IF ! Node is submerged - + ELSE ! Wheeler stretching - no need to check whether the node is above or below SWL - - ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] + + ! Map the node z-position linearly from [-EffWtrDpth,m%WaveElev(j)] to [-EffWtrDpth,0] posPrime = pos posPrime(3) = WaveField%EffWtrDpth*(WaveField%EffWtrDpth+pos(3))/(WaveField%EffWtrDpth+WaveElev)-WaveField%EffWtrDpth - posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. - + posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. + ! Obtain the wave-field variables by interpolation with the mapped position. - CALL SeaSt_Interp_Setup( Time, posPrime, WaveField%seast_interp_p, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - FV(:) = SeaSt_Interp_4D_Vec( WaveField%WaveVel, seast_interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL WaveField_Interp_Setup( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) + END IF - + ELSE ! Node is out of water - zero-out all wave dynamics - - nodeInWater = 0_IntKi + + nodeInWater = 0_IntKi FV(:) = 0.0 - + END IF ! If node is in or out of water - + END IF ! If wave stretching is on or off - + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function END SUBROUTINE WaveField_GetNodeWaveVel -SUBROUTINE WaveField_GetWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT( IN ) :: WaveField - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: SeaSt_Interp_m - REAL(DbKi), INTENT( IN ) :: Time - REAL(ReKi), INTENT( IN ) :: pos(:,:) - LOGICAL, INTENT( IN ) :: forceNodeInWater - REAL(SiKi), INTENT( OUT ) :: WaveElev1(:) - REAL(SiKi), INTENT( OUT ) :: WaveElev2(:) - REAL(SiKi), INTENT( OUT ) :: WaveElev(:) - REAL(ReKi), INTENT( OUT ) :: FV(:,:) - REAL(ReKi), INTENT( OUT ) :: FA(:,:) - REAL(ReKi), INTENT( OUT ) :: FAMCF(:,:) - REAL(ReKi), INTENT( OUT ) :: FDynP(:) - INTEGER(IntKi), INTENT( OUT ) :: nodeInWater(:) - INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None - - CHARACTER(*), PARAMETER :: RoutineName = 'WaveField_GetWaveKin' - INTEGER(IntKi) :: errStat2 - CHARACTER(ErrMsgLen) :: errMsg2 - - INTEGER(IntKi) :: NumPoints, i - REAL(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) + +SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInWater, nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat, ErrMsg ) + type(SeaSt_WaveFieldType), intent(in ) :: WaveField + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WaveField_m + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(:,:) + logical, intent(in ) :: forceNodeInWater + real(SiKi), intent( out) :: WaveElev1(:) + real(SiKi), intent( out) :: WaveElev2(:) + real(SiKi), intent( out) :: WaveElev(:) + real(ReKi), intent( out) :: FV(:,:) + real(ReKi), intent( out) :: FA(:,:) + real(ReKi), intent( out) :: FAMCF(:,:) + real(ReKi), intent( out) :: FDynP(:) + integer(IntKi), intent( out) :: nodeInWater(:) + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if errStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_GetWaveKin' + integer(IntKi) :: errStat2 + character(ErrMsgLen) :: errMsg2 + + integer(IntKi) :: NumPoints, i + real(SiKi) :: FDynP_node, FV_node(3), FA_node(3), FAMCF_node(3) ErrStat = ErrID_None ErrMsg = "" NumPoints = size(pos, dim=2) DO i = 1, NumPoints - CALL WaveField_GetNodeWaveKin( WaveField, SeaSt_Interp_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos(:,i), forceNodeInWater, nodeInWater(i), WaveElev1(i), WaveElev2(i), WaveElev(i), FDynP_node, FV_node, FA_node, FAMCF_node, ErrStat2, ErrMsg2 ) + if (Failed()) return; FDynP(i) = REAL(FDynP_node,ReKi) FV(:, i) = REAL(FV_node, ReKi) FA(:, i) = REAL(FA_node, ReKi) @@ -432,6 +418,526 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, SeaSt_Interp_m, Time, pos, forceNode END IF END DO -END SUBROUTINE WaveField_GetWaveKin +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +end subroutine WaveField_GetWaveKin + + +!---------------------------------------------------------------------------------------------------- +! Interpolation related functions +!---------------------------------------------------------------------------------------------------- + +!> Set the WaveField 4D Params +subroutine WaveField_SetParam( InitInp, p ) + type(SeaSt_WaveField_InitInputType), intent(in ) :: InitInp + type(SeaSt_WaveField_ParameterType), intent( out) :: p + + ! Copy things from the InitData to the ParamData. + p%n = InitInp%n ! number of points on the evenly-spaced grid (in each direction) + p%delta = InitInp%delta ! distance between consecutive grid points in each direction (s,m,m,m) + p%pZero = InitInp%pZero ! fixed location of first time-XYZ grid point (i.e., XYZ coordinates of m%V(:,1,1,1,:)) + p%Z_Depth = InitInp%Z_Depth + + return +end subroutine WaveField_SetParam + + +subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) + REAL(ReKi), intent(in ) :: p + REAL(ReKi), intent(in ) :: pZero + REAL(ReKi), intent(in ) :: delta + INTEGER(IntKi), intent(in ) :: nMax + INTEGER(IntKi), intent(inout) :: Indx_Lo + INTEGER(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + logical, intent(inout) :: FirstWarn + INTEGER(IntKi), intent( out) :: ErrStat + CHARACTER(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + + + Tmp = (p-pZero) / delta + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + if ( Indx_Lo < 1 ) then + Indx_Lo = 1 + isopc = -1.0 + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds + FirstWarn = .false. + end if + end if + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + + if ( Indx_Lo >= Indx_Hi ) then + ! Need to clamp to grid boundary + if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds + FirstWarn = .false. + end if + Indx_Lo = max(Indx_Hi - 1, 1) + isopc = 1.0 + end if + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + +end subroutine SetCartesianXYIndex + + +subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) + real(ReKi), intent(in ) :: p + real(ReKi), intent(in ) :: z_depth + real(ReKi), intent(in ) :: delta + integer(IntKi), intent(in ) :: nMax + integer(IntKi), intent(inout) :: Indx_Lo + integer(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + logical, intent(inout) :: FirstWarn + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + + + !Tmp = acos(-p / z_depth) / delta + Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta + Tmp = nmax - 1 - Tmp + Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + if ( Indx_Lo < 1 ) then + Indx_Lo = 1 + isopc = -1.0 + if (FirstWarn) then + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the lower bounds + FirstWarn = .false. + end if + end if + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, one-based + + if ( Indx_Lo >= Indx_Hi ) then + ! Need to clamp to grid boundary + if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary + call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the upper bounds + FirstWarn = .false. + end if + Indx_Lo = max(Indx_Hi - 1, 1) + isopc = 1.0 + end if + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + +end subroutine SetCartesianZIndex + + +subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: deltaT + integer(IntKi), intent(in ) :: nMax + integer(IntKi), intent(inout) :: Indx_Lo + integer(IntKi), intent(inout) :: Indx_Hi + real(SiKi), intent(inout) :: isopc + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + + real(ReKi) :: Tmp + + ErrStat = ErrID_None + ErrMsg = "" + + isopc = -1.0 + Indx_Lo = 0 + Indx_Hi = 0 + if ( Time < 0.0_DbKi ) then + CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeIndex') !error out if time is outside the lower bounds + RETURN + end if + +! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 +! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 +! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to +! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. + + Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) + Tmp = MOD(Tmp,real((nMax), ReKi)) + Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER + + isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 + + !------------------------------------------------------------------------------------------------- + ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) + !------------------------------------------------------------------------------------------------- + isopc = min( 1.0_SiKi, isopc ) + isopc = max(-1.0_SiKi, isopc ) + + Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based + +end subroutine SetTimeIndex + + +!==================================================================================================== +!> This routine sets up interpolation of a 3-d or 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +subroutine WaveField_Interp_Setup( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(3) !< Array of XYZ coordinates, 3 + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup' + integer(IntKi) :: i + real(SiKi) :: isopc(4) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + !------------------------------------------------------------------------------------------------- + ! Find the bounding indices for time + !------------------------------------------------------------------------------------------------- + call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Find the bounding indices for XY position + !------------------------------------------------------------------------------------------------- + do i=2,3 ! x and y components + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + enddo + + !------------------------------------------------------------------------------------------------- + ! Find the bounding indices for Z position + !------------------------------------------------------------------------------------------------- + i=4 ! z component + call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! compute weighting factors + !------------------------------------------------------------------------------------------------- + m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) + m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) + m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END Subroutine WaveField_Interp_Setup + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/WaveFieldolation.pdf +function WaveField_Interp_4D( pKinXX, m ) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m + + real(SiKi) :: WaveField_Interp_4D + real(SiKi) :: u(16) ! size 2^n + + WaveField_Interp_4D = 0.0_SiKi + + ! interpolate + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) + + WaveField_Interp_4D = SUM ( m%N4D * u ) + +end function WaveField_Interp_4D + + +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_4D_Vec( pKinXX, m) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation + + real(SiKi) :: WaveField_Interp_4D_Vec(3) + real(SiKi) :: u(16) ! size 2^n + integer(IntKi) :: iDir + + WaveField_Interp_4D_Vec = 0.0_SiKi + + ! interpolate + do iDir = 1,3 + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + + WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) + end do +END FUNCTION WaveField_Interp_4D_Vec + + +!==================================================================================================== +!> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_3D( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 + real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + logical, intent(inout) :: FirstWarn_Clamp !< first warning + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_Interp_3D' + real(SiKi) :: WaveField_Interp_3D + real(SiKi) :: u(8) ! size 2^n + real(ReKi) :: N3D(8) + integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) + integer(IntKi) :: i ! loop counter + real(SiKi) :: isopc(3) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + WaveField_Interp_3D = 0.0_SiKi + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + end do + + N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize + + ! interpolate + u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3) ) + u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3) ) + u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3) ) + u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3) ) + u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3) ) + u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3) ) + u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3) ) + u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3) ) + + WaveField_Interp_3D = SUM ( N3D * u ) + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +end function WaveField_Interp_3D + + +FUNCTION WaveField_Interp_3D_VEC( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + logical, intent(inout) :: FirstWarn_Clamp !< first warning + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' + real(SiKi) :: WaveField_Interp_3D_VEC(3) + real(SiKi) :: u(8) ! size 2^n + real(ReKi) :: N3D(8) + integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) + integer(IntKi) :: i ! loop counter + real(SiKi) :: isopc(3) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + WaveField_Interp_3D_VEC = 0.0_SiKi + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + end do + + N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize + + ! interpolate + do i = 1,3 + u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) + u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) + u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) + u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) + u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) + u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) + u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) + u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) + + WaveField_Interp_3D_VEC(i) = SUM ( N3D * u ) + end do +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +end function WaveField_Interp_3D_VEC + + +function Wavefield_Interp_3D_VEC6( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + logical, intent(inout) :: FirstWarn_Clamp !< first warning + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' + real(SiKi) :: Wavefield_Interp_3D_VEC6(6) + real(SiKi) :: u(8) ! size 2^n + real(ReKi) :: N3D(8) + integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) + integer(IntKi) :: i ! loop counter + real(SiKi) :: isopc(3) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + Wavefield_Interp_3D_VEC6 = 0.0_SiKi + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + + ! Find the bounding indices for XY position + do i=2,3 + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) + end do + + N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize + + ! interpolate + do i = 1,6 + u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) + u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) + u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) + u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) + u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) + u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) + u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) + u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) + + Wavefield_Interp_3D_VEC6(i) = SUM ( N3D * u ) + end do +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +end function Wavefield_Interp_3D_VEC6 + + END MODULE SeaSt_WaveField diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 9d5c659752..76aac062df 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -1,8 +1,6 @@ #--------------------------------------------------------------------------------------------------------------------------------------------------------- # Data structures for representing wave fields. # -usefrom SeaState_Interp.txt - param SeaSt_WaveField - INTEGER WaveDirMod_None - 0 - "WaveDirMod = 0 [Directional spreading function is NONE]" - param SeaSt_WaveField - INTEGER WaveDirMod_COS2S - 1 - "WaveDirMod = 1 [Directional spreading function is COS2S]" - @@ -19,6 +17,23 @@ param SeaSt_WaveField - INTEGER WaveMod_User #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- +typedef ^ InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - +typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" +typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m + +typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - +typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" +typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m + +typedef ^ MiscVarType SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - +typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - +typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the index into the 4-d velocity field for each wave component" - +typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - + + typedef SeaSt_WaveField SeaSt_WaveFieldType SiKi WaveTime {:} - - "Time array" (s) typedef ^ ^ SiKi WaveDynP {:}{:}{:}{:} - - "Incident wave dynamic pressure" (N/m^2) typedef ^ ^ SiKi WaveAcc {:}{:}{:}{:}{:} - - "Incident wave acceleration" (m/s^2) @@ -31,7 +46,7 @@ typedef ^ ^ SiKi PWaveVel0 typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT)" (m) typedef ^ ^ SiKi WaveElev1 {:}{:}{:} - - "First order wave elevation" (m) typedef ^ ^ SiKi WaveElev2 {:}{:}{:} - - "Second order wave elevation" (m) -typedef ^ ^ SeaSt_Interp_ParameterType SeaSt_Interp_p - - - "Parameter information from the SeaState Interpolation module" (-) +typedef ^ ^ SeaSt_WaveField_ParameterType GridParams - - - "Parameters for grid spacing" (-) typedef ^ ^ IntKi WaveStMod - - - "Wave stretching model" typedef ^ ^ ReKi EffWtrDpth - - - "Water depth" (-) typedef ^ ^ ReKi MSL2SWL - - - "Vertical distance from mean sea level to still water level" (m) diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 656e7f8460..74821c23b4 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SeaSt_WaveField_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE SeaState_Interp_Types USE NWTC_Library IMPLICIT NONE INTEGER(IntKi), PUBLIC, PARAMETER :: WaveDirMod_None = 0 ! WaveDirMod = 0 [Directional spreading function is NONE] [-] @@ -45,6 +44,31 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] +! ========= SeaSt_WaveField_InitInputType ======= + TYPE, PUBLIC :: SeaSt_WaveField_InitInputType + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] + END TYPE SeaSt_WaveField_InitInputType +! ======================= +! ========= SeaSt_WaveField_ParameterType ======= + TYPE, PUBLIC :: SeaSt_WaveField_ParameterType + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] + END TYPE SeaSt_WaveField_ParameterType +! ======================= +! ========= SeaSt_WaveField_MiscVarType ======= + TYPE, PUBLIC :: SeaSt_WaveField_MiscVarType + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] + LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] + END TYPE SeaSt_WaveField_MiscVarType +! ======================= ! ========= SeaSt_WaveFieldType ======= TYPE, PUBLIC :: SeaSt_WaveFieldType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Time array [(s)] @@ -59,7 +83,7 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point (NOTE THAT THIS CAN GET MODIFIED IN WAMIT) [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] - TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] + TYPE(SeaSt_WaveField_ParameterType) :: GridParams !< Parameters for grid spacing [(-)] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] @@ -88,6 +112,150 @@ MODULE SeaSt_WaveField_Types ! ======================= CONTAINS +subroutine SeaSt_WaveField_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_InitInputType), intent(in) :: SrcInitInputData + type(SeaSt_WaveField_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%n = SrcInitInputData%n + DstInitInputData%delta = SrcInitInputData%delta + DstInitInputData%pZero = SrcInitInputData%pZero + DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth +end subroutine + +subroutine SeaSt_WaveField_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SeaSt_WaveField_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%Z_Depth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData + type(SeaSt_WaveField_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%n = SrcParamData%n + DstParamData%delta = SrcParamData%delta + DstParamData%pZero = SrcParamData%pZero + DstParamData%Z_Depth = SrcParamData%Z_Depth +end subroutine + +subroutine SeaSt_WaveField_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_WaveField_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackParam' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%n) + call RegPack(RF, InData%delta) + call RegPack(RF, InData%pZero) + call RegPack(RF, InData%Z_Depth) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackParam' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveField_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_WaveField_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%N3D = SrcMiscData%N3D + DstMiscData%N4D = SrcMiscData%N4D + DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo + DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi + DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp +end subroutine + +subroutine SeaSt_WaveField_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_WaveField_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_WaveField_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackMisc' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%N3D) + call RegPack(RF, InData%N4D) + call RegPack(RF, InData%Indx_Lo) + call RegPack(RF, InData%Indx_Hi) + call RegPack(RF, InData%FirstWarn_Clamp) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_WaveField_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_WaveField_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackMisc' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Lo); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Indx_Hi); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_WaveFieldType), intent(in) :: SrcSeaSt_WaveFieldTypeData type(SeaSt_WaveFieldType), intent(inout) :: DstSeaSt_WaveFieldTypeData @@ -244,7 +412,7 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 end if - call SeaSt_Interp_CopyParam(SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyParam(SrcSeaSt_WaveFieldTypeData%GridParams, DstSeaSt_WaveFieldTypeData%GridParams, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod @@ -351,7 +519,7 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then deallocate(SeaSt_WaveFieldTypeData%WaveElev2) end if - call SeaSt_Interp_DestroyParam(SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyParam(SeaSt_WaveFieldTypeData%GridParams, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaSt_WaveFieldTypeData%WaveElevC)) then deallocate(SeaSt_WaveFieldTypeData%WaveElevC) @@ -381,7 +549,7 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, Indata) call RegPackAlloc(RF, InData%WaveElev0) call RegPackAlloc(RF, InData%WaveElev1) call RegPackAlloc(RF, InData%WaveElev2) - call SeaSt_Interp_PackParam(RF, InData%SeaSt_Interp_p) + call SeaSt_WaveField_PackParam(RF, InData%GridParams) call RegPack(RF, InData%WaveStMod) call RegPack(RF, InData%EffWtrDpth) call RegPack(RF, InData%MSL2SWL) @@ -429,7 +597,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) call RegUnpackAlloc(RF, OutData%WaveElev0); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElev1); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%WaveElev2); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_Interp_UnpackParam(RF, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + call SeaSt_WaveField_UnpackParam(RF, OutData%GridParams) ! GridParams call RegUnpack(RF, OutData%WaveStMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EffWtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 0e3e27033d..e0fb3532bd 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -30,7 +30,6 @@ MODULE SeaState USE SeaSt_WaveField USE SeaState_Input USE SeaState_Output - use SeaState_Interp USE Current USE Waves2 @@ -90,7 +89,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(FileInfoType) :: InFileInfo !< The derived type for holding the full input file for parsing -- we may pass this in the future TYPE(Waves_InitOutputType) :: Waves_InitOut ! Initialization Outputs from the Waves submodule initialization TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 submodule initialization - TYPE(SeaSt_Interp_InitInputType) :: SeaSt_Interp_InitInp + TYPE(SeaSt_WaveField_InitInputType) :: WaveField_InitInp TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization INTEGER :: I ! Generic counters INTEGER :: it ! Generic counters @@ -123,103 +122,54 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init x%UnusedStates = 0.0 xd%UnusedStates = 0.0 OtherState%UnusedStates = 0.0 - m%SeaSt_Interp_m%FirstWarn_Clamp = .true. + m%WaveField_m%FirstWarn_Clamp = .true. - - ! Initialize the NWTC Subroutine Library - CALL NWTC_Init( ) - ! Display the module information - CALL DispNVD( SeaSt_ProgDesc ) - IF ( InitInp%UseInputFile ) THEN - CALL ProcessComFile( InitInp%InputFile, InFileInfo, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL ProcessComFile( InitInp%InputFile, InFileInfo, ErrStat2, ErrMsg2 ); if(Failed()) return; ELSE - CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, InFileInfo, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - ENDIF + CALL NWTC_Library_CopyFileInfoType( InitInp%PassedFileData, InFileInfo, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if(Failed()) return; ENDIF ! For diagnostic purposes, the following can be used to display the contents ! of the InFileInfo data structure. ! call Print_FileInfo_Struct( CU, InFileInfo ) ! CU is the screen -- different number on different systems. - ! Parse all SeaState-related input and populate the InputFileData structure - CALL SeaSt_ParseInput( InitInp%InputFile, InitInp%OutRootName, InitInp%defWtrDens, InitInp%defWtrDpth, InitInp%defMSL2SWL, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + CALL SeaSt_ParseInput( InitInp%InputFile, InitInp%OutRootName, InitInp%defWtrDens, InitInp%defWtrDpth, InitInp%defMSL2SWL, InFileInfo, InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; + ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level + ! because the HydroDynInput module is also responsible for parsing all this + ! initialization data from a file + CALL SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat2, ErrMsg2 ); if(Failed()) return; - ! Verify all the necessary initialization data. Do this at the HydroDynInput module-level - ! because the HydroDynInput module is also responsible for parsing all this - ! initialization data from a file - - CALL SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Now call each sub-module's *_Init subroutine - ! to fully initialize each sub-module based on the necessary initialization data + ! Now call each sub-module's *_Init subroutine + ! to fully initialize each sub-module based on the necessary initialization data - - ! Initialize Current module - - CALL Current_Init(InputFileData%Current, Current_InitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! Initialize Current module + CALL Current_Init(InputFileData%Current, Current_InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; - ! Move initialization output data from Current module into the initialization input data for the Waves module - + ! Move initialization output data from Current module into the initialization input data for the Waves module IF (ALLOCATED(Current_InitOut%CurrVxi)) CALL Move_Alloc( Current_InitOut%CurrVxi, InputFileData%Waves%CurrVxi ) IF (ALLOCATED(Current_InitOut%CurrVyi)) CALL Move_Alloc( Current_InitOut%CurrVyi, InputFileData%Waves%CurrVyi ) InputFileData%Waves%PCurrVxiPz0 = Current_InitOut%PCurrVxiPz0 InputFileData%Waves%PCurrVyiPz0 = Current_InitOut%PCurrVyiPz0 - - - ! distribute wave field and turbine location variables as needed to submodule initInputs + ! distribute wave field and turbine location variables as needed to submodule initInputs InputFileData%Waves%WaveFieldMod = InitInp%WaveFieldMod InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY + ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) + CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; - ! Initialize Waves module (Note that this may change InputFileData%Waves%WaveDT) - CALL Waves_Init(InputFileData%Waves, Waves_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! note that we DO NOT RETURN on error until AFTER the pointers modified, below - - - ! check error - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - ! Copy Waves initialization output into the initialization input type for the WAMIT module p%WaveDT = InputFileData%Waves%WaveDT @@ -260,60 +210,40 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init !---------------------------------- ! Initialize Waves2 module !---------------------------------- - - IF (InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN - CALL Waves2_Init(InputFileData%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + CALL Waves2_Init(InputFileData%Waves2, Waves2_InitOut, p%WaveField, ErrStat2, ErrMsg2 ); if(Failed()) return; ! The acceleration, velocity, and dynamic pressures will get added to the parts passed to the morrison module later... - ! Difference frequency results + ! Difference frequency results IF ( InputFileData%Waves2%WvDiffQTFF ) THEN + ! Dynamic pressure -- difference frequency terms ! WaveDynP = WaveDynP + WaveDynP2D + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2); if(Failed()) return; - ! Dynamic pressure -- difference frequency terms - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2D,'WaveDynP_D', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2D - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle velocity -- difference frequency terms - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel_D', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2D - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle acceleration -- difference frequency terms - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc_D', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2D - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + ! Particle velocity -- difference frequency terms ! WaveVel = WaveVel + WaveVel2D + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2D,'WaveVel_D', ErrStat2, ErrMsg2); if(Failed()) return; + ! Particle acceleration -- difference frequency terms ! WaveAcc = WaveAcc + WaveAcc2D + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2D,'WaveAcc_D', ErrStat2, ErrMsg2); if(Failed()) return; ENDIF ! second order wave kinematics difference frequency results ! Sum frequency results IF ( InputFileData%Waves2%WvSumQTFF ) THEN + ! Dynamic pressure -- sum frequency terms ! WaveDynP = WaveDynP + WaveDynP2S + CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2); if(Failed()) return; - ! Dynamic pressure -- sum frequency terms - CALL AddArrays_4D(p%WaveField%WaveDynP, Waves2_InitOut%WaveDynP2S,'WaveDynP_S', ErrStat2, ErrMsg2) ! WaveDynP = WaveDynP + WaveDynP2S - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle velocity -- sum frequency terms - CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel_S', ErrStat2, ErrMsg2) ! WaveVel = WaveVel + WaveVel2S - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! Particle acceleration -- sum frequency terms - ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions - CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc_S', ErrStat2, ErrMsg2) ! WaveAcc = WaveAcc + WaveAcc2S - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! Particle velocity -- sum frequency terms ! WaveVel = WaveVel + WaveVel2S + CALL AddArrays_5D(p%WaveField%WaveVel, Waves2_InitOut%WaveVel2S,'WaveVel_S', ErrStat2, ErrMsg2); if(Failed()) return; + ! Particle acceleration -- sum frequency terms ! WaveAcc = WaveAcc + WaveAcc2S + ! Note: MacCamy-Fuchs scaled accleration should not contain second-order contributions + CALL AddArrays_5D(p%WaveField%WaveAcc, Waves2_InitOut%WaveAcc2S,'WaveAcc_S', ErrStat2, ErrMsg2); if(Failed()) return; ENDIF ! second order wave kinematics sum frequency results ELSE - ! these need to be set to zero since we don't have a UseWaves2 flag: - InputFileData%Waves2%NWaveElevGrid = 0 - + ! these need to be set to zero since we don't have a UseWaves2 flag: + InputFileData%Waves2%NWaveElevGrid = 0 ENDIF ! InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF - END IF ! Check for WaveMod = 6 (WaveMod_ExtFull) ! Create the Output file if requested @@ -325,31 +255,22 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Define initialization-routine output here: InitOut%Ver = SeaSt_ProgDesc - ! These three come directly from processing the inputs, and so will exist even if not using Morison elements: - CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - -!=============================================== + CALL SeaStOut_Init( SeaSt_ProgDesc, InitInp%OutRootName, InputFileData, y, p, m, InitOut, ErrStat2, ErrMsg2 ); if(Failed()) return; - CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat2, ErrMsg2); if(Failed()) return; ! Setup the 4D grid information for the Interpolation Module - SeaSt_Interp_InitInp%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) - SeaSt_Interp_InitInp%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) - SeaSt_Interp_InitInp%pZero(1) = 0.0 !Time - SeaSt_Interp_InitInp%pZero(2) = -InputFileData%X_HalfWidth - SeaSt_Interp_InitInp%pZero(3) = -InputFileData%Y_HalfWidth - SeaSt_Interp_InitInp%pZero(4) = -InputFileData%Z_Depth ! zi - SeaSt_Interp_InitInp%Z_Depth = InputFileData%Z_Depth - call SeaSt_Interp_Init(SeaSt_Interp_InitInp, p%WaveField%seast_interp_p, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + WaveField_InitInp%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) + WaveField_InitInp%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) + WaveField_InitInp%pZero(1) = 0.0 !Time + WaveField_InitInp%pZero(2) = -InputFileData%X_HalfWidth + WaveField_InitInp%pZero(3) = -InputFileData%Y_HalfWidth + WaveField_InitInp%pZero(4) = -InputFileData%Z_Depth ! zi + WaveField_InitInp%Z_Depth = InputFileData%Z_Depth + call WaveField_SetParam(WaveField_InitInp, p%WaveField%GridParams) 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! @@ -359,22 +280,22 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: - InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & !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 ) - InputFileData%WaveDirMod /= WaveDirMod_None .or. & !call SetErrStat( ErrID_Fatal, 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.', ErrStat, ErrMsg, RoutineName ) - InputFileData%Waves2%WvDiffQTFF .or. & !call SetErrStat( ErrID_Fatal, 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) - InputFileData%Waves2%WvSumQTFF !call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) + InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & ! 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.' + InputFileData%WaveDirMod /= WaveDirMod_None .or. & ! 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.' + InputFileData%Waves2%WvDiffQTFF .or. & ! 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.' + InputFileData%Waves2%WvSumQTFF ! 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.' ! Write Wave Kinematics? if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then if ( InitInp%WrWvKinMod == 2 ) then call SeaStOut_WriteWvKinFiles( InitInp%OutRootname, SeaSt_ProgDesc, p%WaveField, p%WaveDT, InputFileData%X_HalfWidth, InputFileData%Y_HalfWidth, & p%deltaGrid, p%NGrid, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if(Failed()) return; else if ( InitInp%WrWvKinMod == 1 ) then call SeaStOut_WriteWaveElev0(InitInp%OutRootname, p%WaveField%NStepWave, & p%NGrid, p%WaveField%WaveElev1, p%WaveField%WaveElev2, & p%WaveField%WaveTime, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if(Failed()) return; end if end if @@ -382,9 +303,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! If requested, output wave elevation data for VTK visualization if (InitInp%SurfaceVis) then - call SurfaceVisGenerate(ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return + call SurfaceVisGenerate(ErrStat2, ErrMsg2); if(Failed()) return; endif @@ -420,6 +339,11 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL CleanUp() CONTAINS + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function !................................ SUBROUTINE CleanUp() @@ -458,15 +382,15 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) ErrMsg3 = "" ! Grid half width from the WaveField - HWidX = (real(p%WaveField%SeaSt_Interp_p%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%SeaSt_Interp_p%delta(2) - HWidY = (real(p%WaveField%SeaSt_Interp_p%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%SeaSt_Interp_p%delta(3) + HWidX = (real(p%WaveField%GridParams%n(2)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(2) + HWidY = (real(p%WaveField%GridParams%n(3)-1,SiKi)) / 2.0_SiKi * p%WaveField%GridParams%delta(3) if ((InitInp%SurfaceVisNx <= 0) .or. (InitInp%SurfaceVisNy <= 0))then ! use the SeaState points exactly ! Set number of points to the number of seastate grid points in each direction - Nx = p%WaveField%SeaSt_Interp_p%n(2) - Ny = p%WaveField%SeaSt_Interp_p%n(3) - dx = p%WaveField%SeaSt_Interp_p%delta(2) - dy = p%WaveField%SeaSt_Interp_p%delta(3) + Nx = p%WaveField%GridParams%n(2) + Ny = p%WaveField%GridParams%n(3) + dx = p%WaveField%GridParams%delta(2) + dy = p%WaveField%GridParams%delta(3) call SetErrStat(ErrID_Info,"Setting wavefield visualization grid to "//trim(Num2LStr(Nx))//" x "//trim(Num2LStr(Ny))//"points",ErrStat3,ErrMsg3,RoutineName) elseif ((InitInp%SurfaceVisNx < 3) .or. (InitInp%SurfaceVisNx < 3)) then ! Set to 3 for minimum Nx = 3 @@ -500,31 +424,19 @@ subroutine SurfaceVisGenerate(ErrStat3, ErrMsg3) InitOut%WaveElevVisY(i2) = -HWidY + real(i2-1,SiKi)*dy enddo -!FIXME: calculate from the FFT of the data. + !TODO: sometime in the future, we might want larger grids than is stored in the WaveField. When + ! we want that, we will need to add a WaveField routine to generate for arbitrary points from an + ! FFT of the whole complex series. do it = 0,size(p%WaveField%WaveTime)-1 do i1 = 1, nx loc(1) = InitOut%WaveElevVisX(i1) do i2 = 1, ny loc(2) = InitOut%WaveElevVisX(i2) - InitOut%WaveElevVisGrid(it,i1,i2) = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), p%WaveField%WaveElev1, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat4, ErrMsg4 ) + InitOut%WaveElevVisGrid(it,i1,i2) = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), ErrStat4, ErrMsg4 ) call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) enddo end do end do - - if (allocated(p%WaveField%WaveElev2)) then - do it = 0,size(p%WaveField%WaveTime)-1 - do i1 = 1, nx - loc(1) = InitOut%WaveElevVisX(i1) - do i2 = 1, ny - loc(2) = InitOut%WaveElevVisX(i2) - TmpElev = SeaSt_Interp_3D( real(p%WaveField%WaveTime(it),DbKi), real(loc,ReKi), p%WaveField%WaveElev2, p%WaveField%seast_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat4, ErrMsg4 ) - call SetErrStat( ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, RoutineName ) - InitOut%WaveElevVisGrid(it,i1,i2) = InitOut%WaveElevVisGrid(it,i1,i2) + TmpElev - end do - end do - end do - end if end subroutine SurfaceVisGenerate END SUBROUTINE SeaSt_Init @@ -764,7 +676,7 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveKin positionXYZ = (/p%WaveKinxi(i),p%WaveKinyi(i),p%WaveKinzi(i)/) - CALL WaveField_GetNodeWaveKin( p%WaveField, m%seast_interp_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -772,9 +684,9 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) - WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%SeaSt_Interp_m, Time, positionXY, ErrStat2, ErrMsg2 ) + WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 1ef0d93440..5b50752f8a 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -17,7 +17,6 @@ include Registry_NWTC_Library.txt usefrom Current.txt usefrom Waves.txt usefrom Waves2.txt -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt # # @@ -120,7 +119,7 @@ typedef ^ OtherStateType R8Ki Unu typedef ^ MiscVarType INTEGER Decimate - - - "The output decimation counter" - typedef ^ ^ DbKi LastOutTime - - - "Last time step which was written to the output file (sec)" - typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/seastate/src/SeaState_Interp.f90 b/modules/seastate/src/SeaState_Interp.f90 deleted file mode 100644 index 143ad80180..0000000000 --- a/modules/seastate/src/SeaState_Interp.f90 +++ /dev/null @@ -1,715 +0,0 @@ -!> This module is an interpolator for SeaState pointer arrays based on a 3D grid and time. -!! @note This module does not need to exactly conform to the FAST Modularization Framework standards. Three routines are required -!! though: -!! -- SeaSt_Interp_Init -- Load or create any wind data. Only called at the start of FAST. -!! -- SeaSt_Interp_CalcOutput -- This will be called at each timestep with a series of data points to give the wave kinematics. -!! -- SeaSt_Interp_End -- clear out any stored stuff. Only called at the end of FAST. -MODULE SeaState_Interp -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2016 National Renewable Energy Laboratory -! -! This file is part of SeaState. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** - - USE NWTC_Library - USE SeaState_Interp_Types - - IMPLICIT NONE - PRIVATE - - TYPE(ProgDesc), PARAMETER :: SeaSt_Interp_Ver = ProgDesc( 'SeaSt_Interp', '', '' ) - - PUBLIC :: SeaSt_Interp_Init - PUBLIC :: SeaSt_Interp_End - PUBLIC :: SeaSt_Interp_3D - PUBLIC :: SeaSt_Interp_3D_Vec - PUBLIC :: SeaSt_Interp_3D_Vec6 - PUBLIC :: SeaSt_Interp_4D - PUBLIC :: SeaSt_Interp_4D_Vec - PUBLIC :: SeaSt_Interp_Setup - -CONTAINS - -!==================================================================================================== - -!---------------------------------------------------------------------------------------------------- -!> A subroutine to initialize the SeaState 4D interpolator module. -!---------------------------------------------------------------------------------------------------- -SUBROUTINE SeaSt_Interp_Init(InitInp, p, ErrStat, ErrMsg) - - - IMPLICIT NONE - - ! Passed Variables - - TYPE(SeaSt_Interp_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization - TYPE(SeaSt_Interp_ParameterType), INTENT( OUT) :: p !< Parameters - ! TYPE(SeaSt_Interp_InitOutputType), INTENT( OUT) :: InitOut !< Initial output - - ! REAL(DbKi), INTENT(IN ) :: Interval !< Do not change this!! - - - - ! Error handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< determines if an error has been encountered - CHARACTER(*), INTENT( OUT) :: ErrMsg !< A message about the error. See NWTC_Library info for ErrID_* levels. - - ! local variables - ! Put local variables used during initializing your wind here. DO NOT USE GLOBAL VARIABLES EVER! - ! INTEGER(IntKi) :: UnitWind ! Use this unit number if you need to read in a file. - - ! Temporary variables for error handling -! INTEGER(IntKi) :: ErrStat2 ! Temp variable for the error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_Init' - - !------------------------------------------------------------------------------------------------- - ! Set the Error handling variables - !------------------------------------------------------------------------------------------------- - - ErrStat = ErrID_None - ErrMsg = "" - - - !------------------------------------------------------------------------------------------------- - ! Copy things from the InitData to the ParamData. - !------------------------------------------------------------------------------------------------- - p%n = InitInp%n ! number of points on the evenly-spaced grid (in each direction) - p%delta = InitInp%delta ! distance between consecutive grid points in each direction (s,m,m,m) - p%pZero = InitInp%pZero ! fixed location of first time-XYZ grid point (i.e., XYZ coordinates of m%V(:,1,1,1,:)) - p%Z_Depth = InitInp%Z_Depth - - - !------------------------------------------------------------------------------------------------- - ! Set the InitOutput information. Set any outputs here. - !------------------------------------------------------------------------------------------------- - - ! InitOut%Ver = SeaSt_Interp_Ver - - RETURN - -END SUBROUTINE SeaSt_Interp_Init - -!==================================================================================================== - - -subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) - REAL(ReKi), INTENT(IN ) :: p !< - REAL(ReKi), INTENT(IN ) :: pZero - REAL(ReKi), INTENT(IN ) :: delta - INTEGER(IntKi), INTENT(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - logical, intent(inout) :: FirstWarn - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - - - Tmp = (p-pZero) / delta - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - if ( Indx_Lo < 1 ) then - Indx_Lo = 1 - isopc = -1.0 - if (FirstWarn) then - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds - FirstWarn = .false. - end if - end if - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - - if ( Indx_Lo >= Indx_Hi ) then - ! Need to clamp to grid boundary - if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianXYIndex') !error out if time is outside the lower bounds - FirstWarn = .false. - end if - Indx_Lo = max(Indx_Hi - 1, 1) - isopc = 1.0 - end if - - - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - -end subroutine SetCartesianXYIndex - -subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) - REAL(ReKi), INTENT(IN ) :: p !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: z_depth - REAL(ReKi), INTENT(IN ) :: delta - INTEGER(IntKi), INTENT(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - logical, intent(inout) :: FirstWarn - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - - - !Tmp = acos(-p / z_depth) / delta - Tmp = acos( max(-1.0_ReKi, min(1.0_ReKi, 1+(p / z_depth)) ) ) / delta - Tmp = nmax - 1 - Tmp - Indx_Lo = INT( Tmp ) + 1 ! convert REAL to INTEGER, then add one since our grid indices start at 1, not 0 - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo - 1, ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - if ( Indx_Lo < 1 ) then - Indx_Lo = 1 - isopc = -1.0 - if (FirstWarn) then - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the lower bounds - FirstWarn = .false. - end if - end if - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, one-based - - if ( Indx_Lo >= Indx_Hi ) then - ! Need to clamp to grid boundary - if (FirstWarn .and. Indx_Lo /= Indx_Hi) then ! don't warn if we are exactly at the boundary - call SetErrStat(ErrID_Warn,'Position has been clamped to the grid boundary. Warning will not be repeated though condition may persist.',ErrStat,ErrMsg,'SetCartesianZIndex') !error out if z is outside the upper bounds - FirstWarn = .false. - end if - Indx_Lo = max(Indx_Hi - 1, 1) - isopc = 1.0 - end if - - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - -end subroutine SetCartesianZIndex - -subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, ErrMsg) - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: deltaT - INTEGER(IntKi), INTENT(in ) :: nMax - INTEGER(IntKi), intent(inout) :: Indx_Lo - INTEGER(IntKi), intent(inout) :: Indx_Hi - real(SiKi), intent(inout) :: isopc - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - real(ReKi) :: Tmp - - ErrStat = ErrID_None - ErrMsg = "" - - isopc = -1.0 - Indx_Lo = 0 - Indx_Hi = 0 - if ( Time < 0.0_DbKi ) then - CALL SetErrStat(ErrID_Fatal,'Time value must be greater than or equal to zero!',ErrStat,ErrMsg,'SetTimeLoIndex') !error out if time is outside the lower bounds - RETURN - end if - -! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 -! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 -! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to -! wrap it back to index 0, if Indx_Lo = 11 we want to wrap back to index 1. - - Tmp = real( (Time/ real(deltaT,DbKi)) ,ReKi) - Tmp = MOD(Tmp,real((nMax), ReKi)) - Indx_Lo = INT( Tmp ) ! convert REAL to INTEGER - - isopc = 2.0_ReKi * (Tmp - REAL(Indx_Lo , ReKi)) - 1.0_ReKi ! convert to value between -1 and 1 - - !------------------------------------------------------------------------------------------------- - ! to verify that we don't extrapolate, make sure isopc is bound between -1 and 1 (effectively nearest neighbor) - !------------------------------------------------------------------------------------------------- - isopc = min( 1.0_SiKi, isopc ) - isopc = max(-1.0_SiKi, isopc ) - - Indx_Hi = min( Indx_Lo + 1, nMax ) ! make sure it's a valid index, zero-based - -end subroutine SetTimeIndex - - -!==================================================================================================== -!> This routine sets up interpolation of a 3-d or 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -subroutine SeaSt_Interp_Setup( Time, Position, p, m, ErrStat, ErrMsg ) - - ! I/O variables - - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(3) !< Array of XYZ coordinates, 3 - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: m !< MiscVars - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_Setup' - - ! Local variables - - INTEGER(IntKi) :: i ! loop counter - - REAL(SiKi) :: isopc(4) ! isoparametric coordinates - - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - ErrStat = ErrID_None - ErrMsg = "" - - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 ! x and y components - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - enddo - - - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for Z position - !------------------------------------------------------------------------------------------------- - i=4 ! z component - call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if z is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! compute weighting factors - !------------------------------------------------------------------------------------------------- - - m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 4) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 5) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 6) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 7) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D( 8) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D( 9) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(10) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(11) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(12) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(13) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(14) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D(15) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) - m%N4D(16) = ( 1.0_SiKi + isopc(1) ) * ( 1.0_SiKi + isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi + isopc(4) ) - m%N4D = m%N4D / REAL( SIZE(m%N4D), SiKi ) ! normalize - - -END Subroutine SeaSt_Interp_Setup - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -FUNCTION SeaSt_Interp_4D( pKinXX, m, ErrStat, ErrMsg ) - - ! I/O variables - - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN ) :: m !< Parameters - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_PointSetup' - Real(SiKi) :: SeaSt_Interp_4D - ! Local variables - - REAL(SiKi) :: u(16) ! size 2^n - - - SeaSt_Interp_4D = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4) ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - - SeaSt_Interp_4D = SUM ( m%N4D * u ) - -END FUNCTION SeaSt_Interp_4D - -!==================================================================================================== -!> This routine interpolates a 4-d dataset. -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -FUNCTION SeaSt_Interp_4D_Vec( pKinXX, m, ErrStat, ErrMsg ) - - ! I/O variables - - real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN ) :: m !< misc vars for interpolation - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_PointSetup' - Real(SiKi) :: SeaSt_Interp_4D_Vec(3) - ! Local variables - - REAL(SiKi) :: u(16) ! size 2^n - integer(IntKi) :: iDir - - SeaSt_Interp_4D_Vec = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - do iDir = 1,3 - u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) - u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) - u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) - u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - - SeaSt_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) - end do -END FUNCTION SeaSt_Interp_4D_Vec - - !==================================================================================================== -!> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) -!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -FUNCTION SeaSt_Interp_3D( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - - ! I/O variables - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(2) !< Array of XYZ coordinates, 3 - real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - logical, INTENT(INOUT) :: FirstWarn_Clamp !< first warning - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_3D' - Real(SiKi) :: SeaSt_Interp_3D - ! Local variables - - REAL(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - INTEGER(IntKi) :: i ! loop counter - REAL(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - SeaSt_Interp_3D = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - end do - if (ErrStat >= AbortErrLev ) return - - - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3) ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3) ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3) ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3) ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3) ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3) ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3) ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3) ) - - SeaSt_Interp_3D = SUM ( N3D * u ) - -END FUNCTION SeaSt_Interp_3D - -FUNCTION SeaSt_Interp_3D_VEC ( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - ! I/O variables - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(2) !< Array of XYZ coordinates, 3 - real(SiKi), INTENT(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - LOGICAL, INTENT(INOUT) :: FirstWarn_Clamp !< first warning - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_3D_VEC' - Real(SiKi) :: SeaSt_Interp_3D_VEC(3) - ! Local variables - - REAL(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - INTEGER(IntKi) :: i ! loop counter - REAL(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - SeaSt_Interp_3D_VEC = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - end do - if (ErrStat >= AbortErrLev ) return - - - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - do i = 1,3 - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) - - SeaSt_Interp_3D_VEC(i) = SUM ( N3D * u ) - end do -END FUNCTION SeaSt_Interp_3D_VEC - -FUNCTION SeaSt_Interp_3D_VEC6 ( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - ! I/O variables - REAL(DbKi), INTENT(IN ) :: Time !< time from the start of the simulation - REAL(ReKi), INTENT(IN ) :: Position(2) !< Array of XYZ coordinates, 3 - real(SiKi), INTENT(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN ) :: p !< Parameters - LOGICAL, INTENT(INOUT) :: FirstWarn_Clamp !< first warning - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_3D' - Real(SiKi) :: SeaSt_Interp_3D_VEC6(6) - ! Local variables - - REAL(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - INTEGER(IntKi) :: i ! loop counter - REAL(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - SeaSt_Interp_3D_VEC6 = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if time is outside the bounds - if (ErrStat >= AbortErrLev ) return - - !------------------------------------------------------------------------------------------------- - ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !warning if x,y is outside the bounds - end do - if (ErrStat >= AbortErrLev ) return - - - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize - - !------------------------------------------------------------------------------------------------- - ! interpolate - !------------------------------------------------------------------------------------------------- - do i = 1,6 - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) - - SeaSt_Interp_3D_VEC6(i) = SUM ( N3D * u ) - end do -END FUNCTION SeaSt_Interp_3D_VEC6 -!---------------------------------------------------------------------------------------------------- -!> This routine deallocates any memory in the FDext module. -SUBROUTINE SeaSt_Interp_End( ParamData, MiscVars, ErrStat, ErrMsg) - - - IMPLICIT NONE - - CHARACTER(*), PARAMETER :: RoutineName="SeaSt_Interp_End" - - - ! Passed Variables - TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: ParamData !< Parameters - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: MiscVars !< Misc variables for optimization (not copied in glue code) - - - ! Error Handling - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< determines if an error has been encountered - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Message about errors - - - ! Local Variables - INTEGER(IntKi) :: TmpErrStat ! temporary error status - CHARACTER(ErrMsgLen) :: TmpErrMsg ! temporary error message - - - ErrMsg = '' - ErrStat = ErrID_None - - - - ! Destroy parameter data - - CALL SeaSt_Interp_DestroyParam( ParamData, TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - - - ! Destroy the misc data - - CALL SeaSt_Interp_DestroyMisc( MiscVars, TmpErrStat, TmpErrMsg ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - - -END SUBROUTINE SeaSt_Interp_End -!==================================================================================================== -END MODULE SeaState_Interp diff --git a/modules/seastate/src/SeaState_Interp.txt b/modules/seastate/src/SeaState_Interp.txt deleted file mode 100644 index 5f12cd5a6a..0000000000 --- a/modules/seastate/src/SeaState_Interp.txt +++ /dev/null @@ -1,42 +0,0 @@ -################################################################################################################################### -# Registry for SeaState_Interp, creates MODULE SeaState_Interp_Types -# Module SeaState_Interp_Types contains all of the user-defined types needed in SeaState_Interp. It also contains copy, destroy, pack, and -# unpack routines associated with each defined data types. -################################################################################################################################### -# Entries are of the form -# keyword -################################################################################################################################### - -include Registry_NWTC_Library.txt - - -######################### - -typedef SeaState_Interp/SeaSt_Interp InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - -typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" -typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m - -# Init Output -typedef ^ InitOutputType ProgDesc Ver - - - "Version information of this submodule" - - - -# ..... 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 SiKi N3D {8} - - "this is the weighting function for 3-d velocity field" - -typedef ^ MiscVarType SiKi N4D {16} - - "this is the weighting function for 4-d velocity field" - -typedef ^ MiscVarType integer Indx_Lo 4 - - "this is the index into the 4-d velocity field for each wave component" - -typedef ^ MiscVarType integer Indx_Hi 4 - - "this is the index into the 4-d velocity field for each wave component" - -typedef ^ MiscVarType logical FirstWarn_Clamp - .true. - "used to avoid too many 'Position has been clamped to the grid boundary' warning messages " - - -# ..... 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 IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - -typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" -typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ ParameterType ReKi Z_Depth - - - "grid depth" m - - - diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 deleted file mode 100644 index 3322b030fc..0000000000 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ /dev/null @@ -1,258 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'SeaState_Interp_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* -! SeaState_Interp_Types -!................................................................................................................................. -! This file is part of SeaState_Interp. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in SeaState_Interp. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE SeaState_Interp_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= SeaSt_Interp_InitInputType ======= - TYPE, PUBLIC :: SeaSt_Interp_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_Interp_InitInputType -! ======================= -! ========= SeaSt_Interp_InitOutputType ======= - TYPE, PUBLIC :: SeaSt_Interp_InitOutputType - TYPE(ProgDesc) :: Ver !< Version information of this submodule [-] - END TYPE SeaSt_Interp_InitOutputType -! ======================= -! ========= SeaSt_Interp_MiscVarType ======= - TYPE, PUBLIC :: SeaSt_Interp_MiscVarType - REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the weighting function for 3-d velocity field [-] - REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the weighting function for 4-d velocity field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the index into the 4-d velocity field for each wave component [-] - LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] - END TYPE SeaSt_Interp_MiscVarType -! ======================= -! ========= SeaSt_Interp_ParameterType ======= - TYPE, PUBLIC :: SeaSt_Interp_ParameterType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_Interp_ParameterType -! ======================= -CONTAINS - -subroutine SeaSt_Interp_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_InitInputType), intent(in) :: SrcInitInputData - type(SeaSt_Interp_InitInputType), intent(inout) :: DstInitInputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitInput' - ErrStat = ErrID_None - ErrMsg = '' - DstInitInputData%n = SrcInitInputData%n - DstInitInputData%delta = SrcInitInputData%delta - DstInitInputData%pZero = SrcInitInputData%pZero - DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth -end subroutine - -subroutine SeaSt_Interp_DestroyInitInput(InitInputData, ErrStat, ErrMsg) - type(SeaSt_Interp_InitInputType), intent(inout) :: InitInputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_Interp_PackInitInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%n) - call RegPack(RF, InData%delta) - call RegPack(RF, InData%pZero) - call RegPack(RF, InData%Z_Depth) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackInitInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitInput' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_InitOutputType), intent(in) :: SrcInitOutputData - type(SeaSt_Interp_InitOutputType), intent(inout) :: DstInitOutputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitOutput' - ErrStat = ErrID_None - ErrMsg = '' - call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return -end subroutine - -subroutine SeaSt_Interp_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) - type(SeaSt_Interp_InitOutputType), intent(inout) :: InitOutputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = '' - call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine SeaSt_Interp_PackInitOutput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitOutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitOutput' - if (RF%ErrStat >= AbortErrLev) return - call NWTC_Library_PackProgDesc(RF, InData%Ver) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackInitOutput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_InitOutputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' - if (RF%ErrStat /= ErrID_None) return - call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver -end subroutine - -subroutine SeaSt_Interp_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_MiscVarType), intent(in) :: SrcMiscData - type(SeaSt_Interp_MiscVarType), intent(inout) :: DstMiscData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - DstMiscData%N3D = SrcMiscData%N3D - DstMiscData%N4D = SrcMiscData%N4D - DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo - DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi - DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp -end subroutine - -subroutine SeaSt_Interp_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(SeaSt_Interp_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_Interp_PackMisc(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%N3D) - call RegPack(RF, InData%N4D) - call RegPack(RF, InData%Indx_Lo) - call RegPack(RF, InData%Indx_Hi) - call RegPack(RF, InData%FirstWarn_Clamp) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackMisc(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackMisc' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%N3D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%N4D); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Indx_Lo); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Indx_Hi); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%FirstWarn_Clamp); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_Interp_ParameterType), intent(in) :: SrcParamData - type(SeaSt_Interp_ParameterType), intent(inout) :: DstParamData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyParam' - ErrStat = ErrID_None - ErrMsg = '' - DstParamData%n = SrcParamData%n - DstParamData%delta = SrcParamData%delta - DstParamData%pZero = SrcParamData%pZero - DstParamData%Z_Depth = SrcParamData%Z_Depth -end subroutine - -subroutine SeaSt_Interp_DestroyParam(ParamData, ErrStat, ErrMsg) - type(SeaSt_Interp_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyParam' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_Interp_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%n) - call RegPack(RF, InData%delta) - call RegPack(RF, InData%pZero) - call RegPack(RF, InData%Z_Depth) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_Interp_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_Interp_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackParam' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return -end subroutine -END MODULE SeaState_Interp_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index b18e2c2726..55f529f490 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -273,7 +273,7 @@ SUBROUTINE SeaStOut_WriteWvKinFiles( Rootname, SeaSt_Prog, WaveField, WaveDT, X_ y_gridPts(i+1) = -Y_HalfWidth + deltaGrid(2)*i end do do i = 0, NGrid(3)-1 - z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%SeaSt_Interp_p%Z_Depth + z_gridPts(i+1) = - ( 1.0 - cos( real((NGrid(3) - 1) - i, ReKi) * deltaGrid(3) ) ) * WaveField%GridParams%Z_Depth end do ! Write the increments from [0, NStepWave] even though for OpenFAST data, NStepWave = 0, but for arbitrary user data this may not be true. diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f2807fdb04..8f87fc33c4 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -34,7 +34,6 @@ MODULE SeaState_Types USE Current_Types USE Waves_Types USE Waves2_Types -USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -142,7 +141,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE SeaSt_MiscVarType ! ======================= ! ========= SeaSt_ParameterType ======= @@ -874,7 +873,7 @@ subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Decimate = SrcMiscData%Decimate DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -888,7 +887,7 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -900,7 +899,7 @@ subroutine SeaSt_PackMisc(RF, Indata) call RegPack(RF, InData%Decimate) call RegPack(RF, InData%LastOutTime) call RegPack(RF, InData%LastIndWave) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -912,7 +911,7 @@ subroutine SeaSt_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%Decimate); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastOutTime); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) From 9daf2e6bbc87a0c4bcf5ae9e03d9dd4fc0e68a87 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 7 Feb 2024 23:30:29 -0700 Subject: [PATCH 192/232] SeaState WaveField: make WaveField_Interp_Setup3D public Also use this routine internally, and condense a bunch of redundant code sections as a result --- modules/seastate/src/SeaSt_WaveField.f90 | 306 +++++++++-------------- 1 file changed, 112 insertions(+), 194 deletions(-) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 830964b471..9ef4c688cb 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -18,6 +18,8 @@ MODULE SeaSt_WaveField public WaveField_SetParam +public WaveField_Interp_Setup3D, WaveField_Interp_Setup4D + CONTAINS !-------------------- Subroutine for wave elevation ------------------! @@ -39,8 +41,9 @@ function WaveField_GetNodeWaveElev1( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev1)) THEN - Zeta = WaveField_Interp_3D( Time, pos(1:2), WaveField%WaveElev1, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta = WaveField_Interp_3D( WaveField%WaveElev1, WaveField_m ) ELSE Zeta = 0.0_SiKi END IF @@ -68,8 +71,9 @@ function WaveField_GetNodeWaveElev2( WaveField, WaveField_m, Time, pos, ErrStat, ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev2)) THEN - Zeta = WaveField_Interp_3D( Time, pos(1:2), WaveField%WaveElev2, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL WaveField_Interp_Setup3D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Zeta = WaveField_Interp_3D( WaveField%WaveElev2, WaveField_m ) ELSE Zeta = 0.0_SiKi END IF @@ -188,7 +192,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) @@ -214,7 +218,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) @@ -225,7 +229,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching - CALL WaveField_Interp_Setup( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) FA(:) = WaveField_Interp_4D_vec( WaveField%WaveAcc, WaveField_m ) FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) @@ -235,11 +239,12 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; - FA(:) = FA(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveAcc0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; - FDynP = FDynP + WaveField_Interp_3D ( Time, posXY, WaveField%PWaveDynP0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) + FA(:) = FA(:) + WaveField_Interp_3D_vec( WaveField%PWaveAcc0, WaveField_m ) * pos(3) + FDynP = FDynP + WaveField_Interp_3D ( WaveField%PWaveDynP0, WaveField_m ) * pos(3) IF ( ALLOCATED(WaveField%WaveAccMCF) ) THEN - FAMCF(:) = FAMCF(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveAccMCF0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3); if (Failed()) return; + FAMCF(:) = FAMCF(:) + WaveField_Interp_3D_vec( WaveField%PWaveAccMCF0, WaveField_m ) * pos(3) END IF END IF @@ -253,7 +258,7 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. ! Obtain the wave-field variables by interpolation with the mapped position. - CALL WaveField_Interp_Setup( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) FA(:) = WaveField_Interp_4D_Vec( WaveField%WaveAcc, WaveField_m ) FDynP = WaveField_Interp_4D ( WaveField%WaveDynP, WaveField_m ) @@ -314,7 +319,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_ReKi) THEN ! Node is at or below the SWL nodeInWater = 1_IntKi ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) ELSE ! Node is above the SWL nodeInWater = 0_IntKi @@ -332,19 +337,19 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod IF ( pos(3) <= 0.0_SiKi) THEN ! Node is below the SWL - evaluate wave dynamics as usual ! Use location to obtain interpolated values of kinematics - CALL WaveField_Interp_Setup( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) ELSE ! Node is above SWL - need wave stretching ! Vertical wave stretching - CALL WaveField_Interp_Setup( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, posXY0, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_vec( WaveField%WaveVel, WaveField_m ) ! Extrapoled wave stretching IF (WaveField%WaveStMod == 2) THEN - FV(:) = FV(:) + WaveField_Interp_3D_vec( Time, posXY, WaveField%PWaveVel0, WaveField%GridParams, WaveField_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) * pos(3) - if (Failed()) return; + CALL WaveField_Interp_Setup3D( Time, posXY, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + FV(:) = FV(:) + WaveField_Interp_3D_vec( WaveField%PWaveVel0, WaveField_m ) * pos(3) END IF END IF ! Node is submerged @@ -357,7 +362,7 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod posPrime(3) = MIN( posPrime(3), 0.0_ReKi) ! Clamp z-position to zero. Needed when forceNodeInWater=.TRUE. ! Obtain the wave-field variables by interpolation with the mapped position. - CALL WaveField_Interp_Setup( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL WaveField_Interp_Setup4D( Time, posPrime, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2 ); if (Failed()) return; FV(:) = WaveField_Interp_4D_Vec( WaveField%WaveVel, WaveField_m ) END IF @@ -607,7 +612,7 @@ end subroutine SetTimeIndex !==================================================================================================== !> This routine sets up interpolation of a 3-d or 4-d dataset. !! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -subroutine WaveField_Interp_Setup( Time, Position, p, m, ErrStat, ErrMsg ) +subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) real(DbKi), intent(in ) :: Time !< time from the start of the simulation real(ReKi), intent(in ) :: Position(3) !< Array of XYZ coordinates, 3 type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters @@ -616,7 +621,7 @@ subroutine WaveField_Interp_Setup( Time, Position, p, m, ErrStat, ErrMsg ) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'WaveField_Interp_Setup' + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup4D' integer(IntKi) :: i real(SiKi) :: isopc(4) ! isoparametric coordinates integer(IntKi) :: ErrStat2 @@ -625,30 +630,22 @@ subroutine WaveField_Interp_Setup( Time, Position, p, m, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - !------------------------------------------------------------------------------------------------- ! Find the bounding indices for time - !------------------------------------------------------------------------------------------------- call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) if (Failed()) return; - !------------------------------------------------------------------------------------------------- ! Find the bounding indices for XY position - !------------------------------------------------------------------------------------------------- do i=2,3 ! x and y components call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) if (Failed()) return; enddo - !------------------------------------------------------------------------------------------------- ! Find the bounding indices for Z position - !------------------------------------------------------------------------------------------------- i=4 ! z component call SetCartesianZIndex(Position(i-1), p%Z_Depth, p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) if (Failed()) return; - !------------------------------------------------------------------------------------------------- ! compute weighting factors - !------------------------------------------------------------------------------------------------- m%N4D( 1) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi - isopc(4) ) m%N4D( 2) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi - isopc(3) ) * ( 1.0_SiKi + isopc(4) ) m%N4D( 3) = ( 1.0_SiKi - isopc(1) ) * ( 1.0_SiKi - isopc(2) ) * ( 1.0_SiKi + isopc(3) ) * ( 1.0_SiKi - isopc(4) ) @@ -672,7 +669,53 @@ logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function -END Subroutine WaveField_Interp_Setup +END Subroutine WaveField_Interp_Setup4D + + +subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< time from the start of the simulation + real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 + type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars + integer(IntKi), intent( out) :: ErrStat !< Error status + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'WaveField_Interp_Setup3D' + integer(IntKi) :: i + real(SiKi) :: isopc(4) ! isoparametric coordinates + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Find the bounding indices for time + call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) + if (Failed()) return; + + ! Find the bounding indices for XY position + do i=2,3 ! x and y components + call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), m%Indx_Lo(i), m%Indx_Hi(i), isopc(i), m%FirstWarn_Clamp, ErrStat2, ErrMsg2) + if (Failed()) return; + enddo + + ! compute weighting factors + m%N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) + m%N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) + m%N3D = m%N3D / REAL( SIZE(m%N3D), ReKi ) ! normalize + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function +END Subroutine WaveField_Interp_Setup3D !==================================================================================================== @@ -685,8 +728,6 @@ function WaveField_Interp_4D( pKinXX, m ) real(SiKi) :: WaveField_Interp_4D real(SiKi) :: u(16) ! size 2^n - WaveField_Interp_4D = 0.0_SiKi - ! interpolate u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4) ) u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4) ) @@ -704,9 +745,7 @@ function WaveField_Interp_4D( pKinXX, m ) u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4) ) u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4) ) u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4) ) - WaveField_Interp_4D = SUM ( m%N4D * u ) - end function WaveField_Interp_4D @@ -721,8 +760,6 @@ function WaveField_Interp_4D_Vec( pKinXX, m) real(SiKi) :: u(16) ! size 2^n integer(IntKi) :: iDir - WaveField_Interp_4D_Vec = 0.0_SiKi - ! interpolate do iDir = 1,3 u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) @@ -741,7 +778,6 @@ function WaveField_Interp_4D_Vec( pKinXX, m) u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) - WaveField_Interp_4D_Vec(iDir) = SUM ( m%N4D * u ) end do END FUNCTION WaveField_Interp_4D_Vec @@ -750,192 +786,74 @@ END FUNCTION WaveField_Interp_4D_Vec !==================================================================================================== !> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) !! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf -function WaveField_Interp_3D( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - real(DbKi), intent(in ) :: Time !< time from the start of the simulation - real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 +!FIXME: do like the above and call the WaveField_Interp_Setup3D routine ahead +function WaveField_Interp_3D( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:) !< 3D Wave elevation data (SiKi for storage space reasons) - type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters - logical, intent(inout) :: FirstWarn_Clamp !< first warning - integer(IntKi), intent( out) :: ErrStat !< Error status - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars character(*), parameter :: RoutineName = 'WaveField_Interp_3D' real(SiKi) :: WaveField_Interp_3D - real(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - integer(IntKi) :: i ! loop counter - real(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - WaveField_Interp_3D = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - ! Find the bounding indices for time - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - if (Failed()) return; - - ! Find the bounding indices for XY position - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - if (Failed()) return; - end do - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize + real(SiKi) :: u(8) + integer(IntKi) :: i ! interpolate - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3) ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3) ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3) ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3) ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3) ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3) ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3) ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3) ) - - WaveField_Interp_3D = SUM ( N3D * u ) - -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3) ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3) ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3) ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3) ) + WaveField_Interp_3D = SUM ( m%N3D * u ) end function WaveField_Interp_3D -FUNCTION WaveField_Interp_3D_VEC( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - real(DbKi), intent(in ) :: Time !< time from the start of the simulation - real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 +FUNCTION WaveField_Interp_3D_VEC( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters - logical, intent(inout) :: FirstWarn_Clamp !< first warning - integer(IntKi), intent( out) :: ErrStat !< Error status - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< MiscVars character(*), parameter :: RoutineName = 'WaveField_Interp_3D_VEC' real(SiKi) :: WaveField_Interp_3D_VEC(3) - real(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - integer(IntKi) :: i ! loop counter - real(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - WaveField_Interp_3D_VEC = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - ! Find the bounding indices for time - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - if (Failed()) return; - - ! Find the bounding indices for XY position - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - if (Failed()) return; - end do - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize + real(SiKi) :: u(8) + integer(IntKi) :: i ! interpolate do i = 1,3 - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) - - WaveField_Interp_3D_VEC(i) = SUM ( N3D * u ) + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + WaveField_Interp_3D_VEC(i) = SUM ( m%N3D * u ) end do -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function end function WaveField_Interp_3D_VEC -function Wavefield_Interp_3D_VEC6( Time, Position, pKinXX, p, FirstWarn_Clamp, ErrStat, ErrMsg ) - real(DbKi), intent(in ) :: Time !< time from the start of the simulation - real(ReKi), intent(in ) :: Position(2) !< Array of XYZ coordinates, 3 +function Wavefield_Interp_3D_VEC6( pKinXX, m ) real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) - type(SeaSt_WaveField_ParameterType), intent(in ) :: p !< Parameters - logical, intent(inout) :: FirstWarn_Clamp !< first warning - integer(IntKi), intent( out) :: ErrStat !< Error status - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + type(SeaSt_WaveField_MiscVarType), intent(inout) :: m !< Miscvars character(*), parameter :: RoutineName = 'Wavefield_Interp_3D_VEC6' real(SiKi) :: Wavefield_Interp_3D_VEC6(6) - real(SiKi) :: u(8) ! size 2^n - real(ReKi) :: N3D(8) - integer(IntKi) :: Indx_Lo(3), Indx_Hi(3) - integer(IntKi) :: i ! loop counter - real(SiKi) :: isopc(3) ! isoparametric coordinates - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - Wavefield_Interp_3D_VEC6 = 0.0_SiKi - ErrStat = ErrID_None - ErrMsg = "" - - ! Find the bounding indices for time - call SetTimeIndex(Time, p%delta(1), p%n(1), Indx_Lo(1), Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) - - ! Find the bounding indices for XY position - do i=2,3 - call SetCartesianXYIndex(Position(i-1), p%pZero(i), p%delta(i), p%n(i), Indx_Lo(i), Indx_Hi(i), isopc(i), FirstWarn_Clamp, ErrStat2, ErrMsg2) - end do - - N3D(1) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(2) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(3) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(4) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi - isopc(3) ) - N3D(5) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(6) = ( 1.0_ReKi + isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(7) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi + isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D(8) = ( 1.0_ReKi - isopc(1) )*( 1.0_ReKi - isopc(2) )*( 1.0_ReKi + isopc(3) ) - N3D = N3D / REAL( SIZE(N3D), ReKi ) ! normalize + real(SiKi) :: u(8) + integer(IntKi) :: i ! interpolate do i = 1,6 - u(1) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Lo(3), i ) - u(2) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Lo(3), i ) - u(3) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Lo(3), i ) - u(4) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Lo(3), i ) - u(5) = pKinXX( Indx_Hi(1), Indx_Lo(2), Indx_Hi(3), i ) - u(6) = pKinXX( Indx_Hi(1), Indx_Hi(2), Indx_Hi(3), i ) - u(7) = pKinXX( Indx_Lo(1), Indx_Hi(2), Indx_Hi(3), i ) - u(8) = pKinXX( Indx_Lo(1), Indx_Lo(2), Indx_Hi(3), i ) - - Wavefield_Interp_3D_VEC6(i) = SUM ( N3D * u ) + u(1) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(2) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(3) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), i ) + u(4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), i ) + u(5) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + u(6) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), i ) + u(8) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), i ) + Wavefield_Interp_3D_VEC6(i) = SUM ( m%N3D * u ) end do -contains - logical function Failed() - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - end function end function Wavefield_Interp_3D_VEC6 From 75162249d0a1784f137f71e5765f0f5c9fcaa34c Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 7 Feb 2024 23:48:09 -0700 Subject: [PATCH 193/232] SeaState: propagate changes from SeaState to HydroDyn --- modules/hydrodyn/src/Morison.f90 | 11 +++--- modules/hydrodyn/src/Morison.txt | 3 +- modules/hydrodyn/src/Morison_Types.f90 | 11 +++--- modules/hydrodyn/src/SS_Excitation.f90 | 9 ++--- modules/hydrodyn/src/SS_Excitation.txt | 11 +++--- modules/hydrodyn/src/SS_Excitation_Types.f90 | 11 +++--- modules/hydrodyn/src/WAMIT.f90 | 19 +++++----- modules/hydrodyn/src/WAMIT.txt | 3 +- modules/hydrodyn/src/WAMIT_Interp.f90 | 37 ++++++++++++++++++++ modules/hydrodyn/src/WAMIT_Types.f90 | 10 +++--- 10 files changed, 78 insertions(+), 47 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 57bb88f075..bd5533dda4 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -23,7 +23,6 @@ MODULE Morison USE Waves USE Morison_Types USE Morison_Output - USE SeaState_Interp USE SeaSt_WaveField ! USE HydroDyn_Output_Types USE NWTC_Library @@ -2603,7 +2602,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, !=============================================================================================== ! Calculate the fluid kinematics at all mesh nodes and store for use in the equations below - CALL WaveField_GetWaveKin( p%WaveField, m%SeaSt_Interp_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetWaveKin( p%WaveField, m%WaveField_m, Time, m%DispNodePosHdn, .FALSE., m%nodeInWater, m%WaveElev1, m%WaveElev2, m%WaveElev, m%FDynP, m%FV, m%FA, m%FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Compute fluid velocity relative to the structure DO j = 1, p%NNodes @@ -3037,7 +3036,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Compute the distributed loads at the point of intersection between the member and the free surface ! !----------------------------------------------------------------------------------------------------! ! Get wave kinematics at the free-surface intersection. Set forceNodeInWater=.TRUE. to guarantee the free-surface intersection is in water. - CALL WaveField_GetNodeWaveKin( p%WaveField, m%SeaSt_Interp_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, FSInt, .TRUE., nodeInWater, WaveElev1, WaveElev2, WaveElev, FDynP, FV, FA, FAMCF, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FDynPFSInt = REAL(FDynP,ReKi) FVFSInt = REAL(FV, ReKi) @@ -3579,7 +3578,7 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%SeaSt_Interp_m, Time, pos, ErrStat2, ErrMsg2 ) + Zeta = WaveField_GetNodeTotalWaveElev( p%WaveField, m%WaveField_m, Time, pos, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetTotalWaveElev @@ -3597,7 +3596,7 @@ SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - CALL WaveField_GetNodeWaveNormal( p%WaveField, m%SeaSt_Interp_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveNormal( p%WaveField, m%WaveField_m, Time, pos, r, n, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE GetFreeSurfaceNormal @@ -4212,7 +4211,7 @@ SUBROUTINE Morison_UpdateDiscState( Time, u, p, x, xd, z, OtherState, m, errStat END IF ! Get fluid velocity at the joint - CALL WaveField_GetNodeWaveVel( p%WaveField, m%SeaSt_Interp_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) + CALL WaveField_GetNodeWaveVel( p%WaveField, m%WaveField_m, Time, pos, .FALSE., nodeInWater, FVTmp, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FV = REAL(FVTmp, ReKi) vrel = ( FV - u%Mesh%TranslationVel(:,J) ) * nodeInWater diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index e47b40c867..43ff0ab18c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -13,7 +13,6 @@ # ...... Include files (definitions from NWTC Library) ............................................................................ # make sure that the file name does not have any trailing white spaces! include Registry_NWTC_Library.txt -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt # # @@ -323,7 +322,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi V_rel_n {:} - - "Normal relative flow velocity at joints" m/s typedef ^ ^ ReKi V_rel_n_HiPass {:} - - "High-pass filtered normal relative flow velocity at joints" m/s typedef ^ ^ MeshMapType VisMeshMap - - - "Mesh mapping for visualization mesh" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index d63aaef883..c68757261d 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE Morison_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -386,7 +385,7 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n !< Normal relative flow velocity at joints [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] TYPE(MeshMapType) :: VisMeshMap !< Mesh mapping for visualization mesh [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= @@ -3570,7 +3569,7 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call NWTC_Library_CopyMeshMapType(SrcMiscData%VisMeshMap, DstMiscData%VisMeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -3654,7 +3653,7 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyMeshMapType(MiscData%VisMeshMap, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -3694,7 +3693,7 @@ subroutine Morison_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%V_rel_n) call RegPackAlloc(RF, InData%V_rel_n_HiPass) call NWTC_Library_PackMeshMapType(RF, InData%VisMeshMap) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -3740,7 +3739,7 @@ subroutine Morison_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%V_rel_n); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%V_rel_n_HiPass); if (RegCheckErr(RF, RoutineName)) return call NWTC_Library_UnpackMeshMapType(RF, OutData%VisMeshMap) ! VisMeshMap - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 9cc0bf72ff..125217fb3e 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -20,8 +20,8 @@ ! !********************************************************************************************************************************** MODULE SS_Excitation - USE SeaState_Interp - USE SS_Excitation_Types + USE SS_Excitation_Types + use SeaSt_WaveField, only: WaveField_GetNodeTotalWaveElev USE NWTC_Library IMPLICIT NONE @@ -110,8 +110,9 @@ function GetWaveElevation ( time, u_in, t_in, p, m, ErrStat, ErrMsg ) call SS_Exc_Input_ExtrapInterp(u_in, t_in, u_out, time, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - do iBody = 1, p%NBody - GetWaveElevation(iBody) = SeaSt_Interp_3D( time, u_out%PtfmPos(1:2,iBody), p%WaveField%WaveElev1, p%WaveField%SeaSt_interp_p, m%SeaSt_Interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + do iBody = 1, p%NBody +!FIXME: this is the total wave elevation. Should it include second order, or should it only include first order? + GetWaveElevation(iBody) = WaveField_GetNodeTotalWaveElev(p%WaveField, m%WaveField_m, time, u_out%PtfmPos(1:2,iBody), ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index f5b9311d60..1372e9a823 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -14,7 +14,6 @@ # (File) Revision #: $Rev$ # URL: $HeadURL$ ################################################################################################################################### -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt typedef SS_Excitation/SS_Exc InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - @@ -24,14 +23,14 @@ typedef ^ ^ R8Ki typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - - + typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output" - - + typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - - + typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - - + # Define constraint states here: typedef ^ ConstraintStateType SiKi DummyConstrState - - - "" - @@ -44,7 +43,7 @@ typedef ^ ^ SS_Exc_ContinuousStateType # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. typedef ^ MiscVarType INTEGER LastIndWave - 1 - "last used index in the WaveTime array" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ......................... diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 08bfc7e05f..3e7179fe5a 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -31,7 +31,6 @@ !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE SS_Excitation_Types !--------------------------------------------------------------------------------------------------------------------------------- -USE SeaState_Interp_Types USE SeaSt_WaveField_Types USE NWTC_Library IMPLICIT NONE @@ -74,7 +73,7 @@ MODULE SS_Excitation_Types ! ========= SS_Exc_MiscVarType ======= TYPE, PUBLIC :: SS_Exc_MiscVarType INTEGER(IntKi) :: LastIndWave = 1 !< last used index in the WaveTime array [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE SS_Exc_MiscVarType ! ======================= ! ========= SS_Exc_ParameterType ======= @@ -495,7 +494,7 @@ subroutine SS_Exc_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' DstMiscData%LastIndWave = SrcMiscData%LastIndWave - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -509,7 +508,7 @@ subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -519,7 +518,7 @@ subroutine SS_Exc_PackMisc(RF, Indata) character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%LastIndWave) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -529,7 +528,7 @@ subroutine SS_Exc_UnPackMisc(RF, OutData) character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%LastIndWave); if (RegCheckErr(RF, RoutineName)) return - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index b740b6cd35..d73dd5c2c3 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -25,12 +25,10 @@ MODULE WAMIT USE WAMIT_Types USE WAMIT_Interp USE NWTC_Library - ! USE Waves_Types USE Conv_Radiation USE SS_Radiation USE SS_Excitation USE NWTC_FFTPACK - use SeaState_Interp IMPLICIT NONE @@ -976,13 +974,13 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF if (p%ExctnDisp > 0 ) then - ALLOCATE ( WaveExctnCGrid(0:p%WaveField%NStepWave2 ,p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3),6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( WaveExctnCGrid(0:p%WaveField%NStepWave2 ,p%WaveField%GridParams%n(2)*p%WaveField%GridParams%n(3),6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctnC array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() RETURN END IF - ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave,p%WaveField%SeaSt_Interp_p%n(2),p%WaveField%SeaSt_Interp_p%n(3), 6*p%NBody) , STAT=ErrStat2 ) + ALLOCATE ( p%WaveExctnGrid (0:p%WaveField%NStepWave,p%WaveField%GridParams%n(2),p%WaveField%GridParams%n(3), 6*p%NBody) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error allocating memory for the WaveExctn array.', ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -1141,7 +1139,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS CALL Cleanup() RETURN END IF - do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) + do iGrid = 1, p%WaveField%GridParams%n(2)*p%WaveField%GridParams%n(3) WaveExctnCGrid(I,iGrid,J) = WaveExctnC(I,J) * CMPLX(p%WaveField%WaveElevC(1,I,iGrid), p%WaveField%WaveElevC(2,I,iGrid)) end do END DO ! J - All wave excitation forces and moments @@ -1158,9 +1156,9 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END IF DO J = 1,6*p%NBody ! Loop through all wave excitation forces and moments - do iGrid = 1, p%WaveField%SeaSt_Interp_p%n(2)*p%WaveField%SeaSt_Interp_p%n(3) - iX = mod(iGrid-1, p%WaveField%SeaSt_Interp_p%n(2)) + 1 ! 1st n index is time - iY = (iGrid-1) / p%WaveField%SeaSt_Interp_p%n(2) + 1 + do iGrid = 1, p%WaveField%GridParams%n(2)*p%WaveField%GridParams%n(3) + iX = mod(iGrid-1, p%WaveField%GridParams%n(2)) + 1 ! 1st n index is time + iY = (iGrid-1) / p%WaveField%GridParams%n(2) + 1 CALL ApplyFFT_cx ( p%WaveExctnGrid(0:p%WaveField%NStepWave-1,iX,iY,J), WaveExctnCGrid(:,iGrid,J), FFT_Data, ErrStat2 ) CALL SetErrStat( ErrStat2, ' An error occured while applying an FFT to WaveExctnC.', ErrStat, ErrMsg, RoutineName) IF ( ErrStat >= AbortErrLev) THEN @@ -1842,7 +1840,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er END IF iStart = (iBody-1)*6+1 ! WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for each WAMIT Body - m%F_Waves1(iStart:iStart+5) = SeaSt_Interp_3D_Vec6( Time, bodyPosition, p%WaveExctnGrid(:,:,:,iStart:iStart+5), p%WaveField%SeaSt_interp_p, m%seast_interp_m%FirstWarn_Clamp, ErrStat2, ErrMsg2 ) + m%F_Waves1(iStart:iStart+5) = WAMIT_ForceWaves_Interp( Time, bodyPosition, p%WaveExctnGrid(:,:,:,iStart:iStart+5), p%WaveField%GridParams, m%WaveField_m, ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SeaState_CalcOutput' ) END DO end if @@ -1931,8 +1929,9 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Output channels will be dealt with by the HydroDyn module - END SUBROUTINE WAMIT_CalcOutput + + !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states SUBROUTINE WAMIT_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index 51c0294603..608afe87b4 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -16,7 +16,6 @@ include Registry_NWTC_Library.txt usefrom Conv_Radiation.txt usefrom SS_Radiation.txt usefrom SS_Excitation.txt -usefrom SeaState_Interp.txt usefrom SeaSt_WaveField.txt typedef WAMIT/WAMIT InitInputType INTEGER NBody - - - "[>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6]" - @@ -93,7 +92,7 @@ typedef ^ ^ SS_Exc_Outp typedef ^ ^ Conv_Rdtn_MiscVarType Conv_Rdtn - - - "" - typedef ^ ^ Conv_Rdtn_InputType Conv_Rdtn_u - - - "" - typedef ^ ^ Conv_Rdtn_OutputType Conv_Rdtn_y - - - "" - -typedef ^ ^ SeaSt_Interp_MiscVarType SeaSt_Interp_m - - - "misc var information from the SeaState Interpolation module" - +typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - # ..... Parameters ................................................................................................................ # Define parameters here: diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 7e7ce8cfaa..4067454658 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -29,6 +29,8 @@ MODULE WAMIT_Interp USE NWTC_Library + use SeaSt_WaveField_Types, only: SeaSt_WaveField_ParameterType, SeaSt_WaveField_MiscVarType + use SeaSt_WaveField, only: WaveField_Interp_Setup3D IMPLICIT NONE PRIVATE @@ -37,6 +39,7 @@ MODULE WAMIT_Interp PUBLIC :: WAMIT_Interp2D_Cplx PUBLIC :: WAMIT_Interp3D_Cplx PUBLIC :: WAMIT_Interp4D_Cplx + public :: WAMIT_ForceWaves_Interp CONTAINS @@ -621,5 +624,39 @@ SUBROUTINE CalcIsoparCoords( InCoord, posLo, posHi, isopc ) END SUBROUTINE CalcIsoparCoords + +!> retrieve indices from the WaveField info, and do interpolation for this point. +!! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. +function WAMIT_ForceWaves_Interp(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(*) !< position + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + real(SiKi) :: WAMIT_ForceWaves_Interp(6) + real(SiKi) :: u(8) + integer(IntKi) :: i + + ! get the bounding indices from the WaveField info (same indexing used in WAMIT) + call WaveField_Interp_Setup3D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) + + ! interpolate + do i = 1,6 + u(1) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(2) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), i ) + u(4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), i ) + u(5) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) + u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) + WAMIT_ForceWaves_Interp(i) = SUM ( WF_m%N3D * u ) + end do +end function + + !---------------------------------------------------------------------------------------------------------------------------------- END MODULE WAMIT_Interp diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 0c82e5c2d8..1f1bbd75dd 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -105,7 +105,7 @@ MODULE WAMIT_Types TYPE(Conv_Rdtn_MiscVarType) :: Conv_Rdtn !< [-] TYPE(Conv_Rdtn_InputType) :: Conv_Rdtn_u !< [-] TYPE(Conv_Rdtn_OutputType) :: Conv_Rdtn_y !< [-] - TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] + TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE WAMIT_MiscVarType ! ======================= ! ========= WAMIT_ParameterType ======= @@ -722,7 +722,7 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call Conv_Rdtn_CopyOutput(SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SeaSt_WaveField_CopyMisc(SrcMiscData%WaveField_m, DstMiscData%WaveField_m, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end subroutine @@ -766,7 +766,7 @@ subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call Conv_Rdtn_DestroyOutput(MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SeaSt_WaveField_DestroyMisc(MiscData%WaveField_m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine @@ -789,7 +789,7 @@ subroutine WAMIT_PackMisc(RF, Indata) call Conv_Rdtn_PackMisc(RF, InData%Conv_Rdtn) call Conv_Rdtn_PackInput(RF, InData%Conv_Rdtn_u) call Conv_Rdtn_PackOutput(RF, InData%Conv_Rdtn_y) - call SeaSt_Interp_PackMisc(RF, InData%SeaSt_Interp_m) + call SeaSt_WaveField_PackMisc(RF, InData%WaveField_m) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -815,7 +815,7 @@ subroutine WAMIT_UnPackMisc(RF, OutData) call Conv_Rdtn_UnpackMisc(RF, OutData%Conv_Rdtn) ! Conv_Rdtn call Conv_Rdtn_UnpackInput(RF, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u call Conv_Rdtn_UnpackOutput(RF, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y - call SeaSt_Interp_UnpackMisc(RF, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m + call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) From c2f8051ece04808bce6ff09a3a1e470a43a11f94 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 8 Feb 2024 01:39:51 -0700 Subject: [PATCH 194/232] SeaState: fix seg fault due to time indexing when deltaT == 0 --- modules/seastate/src/SeaSt_WaveField.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 9ef4c688cb..7d40e860b2 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -587,6 +587,9 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er RETURN end if + ! if there are no timesteps, don't proceed + if (EqualRealNos(deltaT,0.0_ReKi) .or. deltaT < 0.0_ReKi) return; + ! NOTE: nMax is the total number of time values in the grid, since this is zero-based indexing, the max index is nMax-1 ! for example: in a time grid with 11 grid points, the indices run from 0,1,2,3,4,5,6,7,8,9,10 ! for the repeating waves feature, index 10 is the same as index 0, so if Indx_Lo = 10 then we want to From 1c4f0578ee9da73dc11acf3fa969fd0ea2acf7d7 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 8 Feb 2024 01:41:26 -0700 Subject: [PATCH 195/232] SeaState: cleanup error handling in Waves.f90 Attempting to troubleshoot the issue led to cleaning up when I couldn't really follow what was going on due to too much error hanlding in the way. --- modules/seastate/src/Waves.f90 | 1188 +++++++++++++------------------- 1 file changed, 492 insertions(+), 696 deletions(-) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index fd1efff906..15998ac18f 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -585,34 +585,33 @@ SUBROUTINE StillWaterWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Initialize everything to zero: - !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) - WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on - WaveField%NStepWave2 = 1 - InitOut%WaveTMax = InitInp%WaveTMax - WaveField%WaveDOmega = 0.0 - - ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! Add the current velocities to the wave velocities: - count = 0 - - !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed - do k = 1, InitInp%NGrid(3) - do j = 1, InitInp%NGrid(2) - do i = 1, InitInp%NGrid(1) - count = count + 1 - WaveField%WaveVel(:,i,j,k,1) = InitInp%CurrVxi(count) ! xi-direction - WaveField%WaveVel(:,i,j,k,2) = InitInp%CurrVyi(count) ! yi-direction - end do + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 0 (WaveMod_None) + WaveField%NStepWave = 2 ! We must have at least two elements in order to interpolate later on + WaveField%NStepWave2 = 1 + InitOut%WaveTMax = InitInp%WaveTMax + WaveField%WaveDOmega = 0.0 + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, 1.0_DbKi, ErrStatTmp, ErrMsgTmp) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! Add the current velocities to the wave velocities: + count = 0 + + !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed + do k = 1, InitInp%NGrid(3) + do j = 1, InitInp%NGrid(2) + do i = 1, InitInp%NGrid(1) + count = count + 1 + WaveField%WaveVel(:,i,j,k,1) = InitInp%CurrVxi(count) ! xi-direction + WaveField%WaveVel(:,i,j,k,2) = InitInp%CurrVyi(count) ! yi-direction end do end do + end do - ! END DO ! J - All points where the incident wave kinematics will be computed + ! END DO ! J - All points where the incident wave kinematics will be computed END SUBROUTINE StillWaterWaves_Init @@ -629,8 +628,6 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - ! Local Variables COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) COMPLEX(SiKi), ALLOCATABLE :: PWaveAccC0HxiPz0(:,:) ! Partial derivative of WaveAccC0Hxi(:) with respect to zi at zi = 0 (1/s^2) @@ -714,377 +711,259 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - ! Tell our users what is about to happen that may take a while: - CALL WrScr ( ' Generating incident wave kinematics and current time history.' ) + ! Tell our users what is about to happen that may take a while: + CALL WrScr ( ' Generating incident wave kinematics and current time history.' ) - ! Determine the number of, NWaveKin0Prime, and the zi-coordinates for, - ! WaveKinzi0Prime(:), points where the incident wave kinematics will be - ! computed before applying stretching to the instantaneous free surface. - ! The locations are relative to the mean see level. - - NWaveKin0Prime = 0 - DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - NWaveKin0Prime = NWaveKin0Prime + 1 - END IF - END DO ! J - All Morison nodes where the incident wave kinematics will be computed + ! Determine the number of, NWaveKin0Prime, and the zi-coordinates for, + ! WaveKinzi0Prime(:), points where the incident wave kinematics will be + ! computed before applying stretching to the instantaneous free surface. + ! The locations are relative to the mean see level. + NWaveKin0Prime = 0 + DO J = 1,InitInp%NWaveKinGrid ! Loop through all mesh points where the incident wave kinematics will be computed + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + NWaveKin0Prime = NWaveKin0Prime + 1 + END IF + END DO ! J - All Morison nodes where the incident wave kinematics will be computed - ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: - ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinzi0Prime.',ErrStat,ErrMsg,RoutineName) + ! ALLOCATE the WaveKinzi0Prime(:) array and compute its elements here: - ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveKinPrimeMap.',ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ALLOCATE ( WaveKinzi0Prime(NWaveKin0Prime) , STAT=ErrStatTmp ); if (Failed0('WaveKinzi0Prime')) return; + ALLOCATE ( WaveKinPrimeMap(NWaveKin0Prime) , STAT=ErrStatTmp ); if (Failed0('WaveKinPrimeMap')) return; + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - I = 1 - DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN + I = 1 - WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) - WaveKinPrimeMap(I) = J - I = I + 1 + DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed without stretching + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + IF ( InitInp%WaveKinGridzi(J) >= -WaveField%EffWtrDpth .AND. InitInp%WaveKinGridzi(J) <= 0 ) THEN - END IF + WaveKinzi0Prime(I) = InitInp%WaveKinGridzi(J) + WaveKinPrimeMap(I) = J + I = I + 1 - END DO ! J - All points where the incident wave kinematics will be computed without stretching + END IF + END DO ! J - All points where the incident wave kinematics will be computed without stretching - ! Perform some initialization computations including calculating the total number of frequency - ! components = total number of time steps in the incident wave, - ! calculating the frequency step, calculating the index of the frequency - ! component nearest to WaveTp, and ALLOCATing the arrays: - ! NOTE: WaveDOmega = 2*Pi/WaveTMax since, in the FFT: - ! Omega = (K-1)*WaveDOmega - ! Time = (J-1)*WaveDT - ! and therefore: - ! Omega*Time = (K-1)*(J-1)*WaveDOmega*WaveDT - ! = (K-1)*(J-1)*2*Pi/NStepWave [see NWTC_FFTPACK] - ! or: - ! WaveDOmega = 2*Pi/(NStepWave*WaveDT) - ! = 2*Pi/WaveTMax + ! Perform some initialization computations including calculating the total number of frequency + ! components = total number of time steps in the incident wave, + ! calculating the frequency step, calculating the index of the frequency + ! component nearest to WaveTp, and ALLOCATing the arrays: + ! NOTE: WaveDOmega = 2*Pi/WaveTMax since, in the FFT: + ! Omega = (K-1)*WaveDOmega + ! Time = (J-1)*WaveDT + ! and therefore: + ! Omega*Time = (K-1)*(J-1)*WaveDOmega*WaveDT + ! = (K-1)*(J-1)*2*Pi/NStepWave [see NWTC_FFTPACK] + ! or: + ! WaveDOmega = 2*Pi/(NStepWave*WaveDT) + ! = 2*Pi/WaveTMax - ! Set new value for NStepWave so that the FFT algorithms are efficient. Note that if this method is changed, the method - ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine - ! will need to be updated. - !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) - ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine - ! using file information (an FFT was performed there, so the information was needed before now). - ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. - ! Need to make sure the wave-direction in formation is not overwritten later. - IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN - WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... - IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. - - WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is - WaveField%NStepWave = 2 * PSF( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + ! Set new value for NStepWave so that the FFT algorithms are efficient. Note that if this method is changed, the method + ! used to calculate the number of multidirectional wave directions (WaveNDir) and the UserWaveElevations_Init subroutine + ! will need to be updated. - WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. - InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. - WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. + !>>>>>> COMPUTE INITOUT SCALARS WaveField%NStepWave, WaveField%NStepWave2, InitOut%WaveTMax, and InitOut%WaveDOmega for WAVEMOD = 1,2,3,4,10 (5 and 7 also call this routine, but have been set already) + ! NOTE: For WaveMod = 5, NStepWave and several other things were already set in the UserWaveElevations_Init routine + ! using file information (an FFT was performed there, so the information was needed before now). + ! Same with WaveMod = 7 (WaveMod_UserFreq). With WaveMod = 7, WaveDirArr is also populated in UserWaveComponents_Init routine. + ! Need to make sure the wave-direction in formation is not overwritten later. + IF (WaveField%WaveMod /= WaveMod_ExtElev .AND. WaveField%WaveMod /= WaveMod_UserFreq) THEN + WaveField%NStepWave = CEILING ( InitInp%WaveTMax/InitInp%WaveDT ) ! Set NStepWave to an even integer ... + IF ( MOD(WaveField%NStepWave,2) == 1 ) WaveField%NStepWave = WaveField%NStepWave + 1 ! ... larger or equal to WaveTMax/WaveDT. - ! >>> Allocate and initialize (set to 0) InitOut arrays - call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) - ENDIF - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - - - ! Allocate all the arrays we need. - ALLOCATE ( tmpComplexArr(0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array tmpComplexArr.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynPC0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVelC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hxi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVelC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0Hyi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVelC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVelC0V.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAccC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hxi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAccC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0Hyi.', ErrStat,ErrMsg,RoutineName) + WaveField%NStepWave2 = MAX( WaveField%NStepWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + WaveField%NStepWave = 2 * PSF( WaveField%NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. - ALLOCATE ( WaveAccC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0V.', ErrStat,ErrMsg,RoutineName) - - - ALLOCATE ( WaveDynP0B (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveDynP0B.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVel0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hxi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVel0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0Hyi.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveVel0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveVel0V.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hxi.', ErrStat,ErrMsg,RoutineName) + WaveField%NStepWave2 = WaveField%NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + InitOut%WaveTMax = WaveField%NStepWave*InitInp%WaveDT ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveField%WaveDOmega = TwoPi/InitOut%WaveTMax ! Compute the frequency step for incident wave calculations. + + ! >>> Allocate and initialize (set to 0) InitOut arrays + call Initial_InitOut_Arrays(InitOut, WaveField, InitInp, InitInp%WaveDT, ErrStatTmp, ErrMsgTmp); CALL SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + ENDIF + + + ! Allocate all the arrays we need. + ALLOCATE ( tmpComplexArr(0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('tmpComplexArr')) return; + ALLOCATE ( WaveDynPC0 (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveDynPC0 ')) return; + ALLOCATE ( WaveVelC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0Hxi')) return; + ALLOCATE ( WaveVelC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0Hyi')) return; + ALLOCATE ( WaveVelC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVelC0V ')) return; + ALLOCATE ( WaveAccC0Hxi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0Hxi')) return; + ALLOCATE ( WaveAccC0Hyi (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0Hyi')) return; + ALLOCATE ( WaveAccC0V (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0V ')) return; + + ALLOCATE ( WaveDynP0B (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveDynP0B ')) return; + ALLOCATE ( WaveVel0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0Hxi ')) return; + ALLOCATE ( WaveVel0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0Hyi ')) return; + ALLOCATE ( WaveVel0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveVel0V ')) return; + ALLOCATE ( WaveAcc0Hxi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0Hxi ')) return; + ALLOCATE ( WaveAcc0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0Hyi ')) return; + ALLOCATE ( WaveAcc0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0V ')) return; + + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model + ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0HxiMCF')) return; + ALLOCATE ( WaveAccC0HyiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0HyiMCF')) return; + ALLOCATE ( WaveAccC0VMCF (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAccC0VMCF ')) return; + ALLOCATE ( WaveAcc0HxiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0HxiMCF ')) return; + ALLOCATE ( WaveAcc0HyiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0HyiMCF ')) return; + ALLOCATE ( WaveAcc0VMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ); if (Failed0('WaveAcc0VMCF ')) return; + ALLOCATE ( WaveField%WaveAccMCF (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ); if (Failed0('WaveField%WaveAccMCF')) return; + END IF + + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + ALLOCATE ( PWaveDynPC0BPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveDynPC0BPz0 ')) return; + ALLOCATE ( PWaveVelC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0HxiPz0')) return; + ALLOCATE ( PWaveVelC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0HyiPz0')) return; + ALLOCATE ( PWaveVelC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVelC0VPz0 ')) return; + ALLOCATE ( PWaveAccC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HxiPz0')) return; + ALLOCATE ( PWaveAccC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HyiPz0')) return; + ALLOCATE ( PWaveAccC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0VPz0 ')) return; + ALLOCATE ( PWaveDynP0BPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveDynP0BPz0 ')) return; + ALLOCATE ( PWaveVel0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0HxiPz0 ')) return; + ALLOCATE ( PWaveVel0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0HyiPz0 ')) return; + ALLOCATE ( PWaveVel0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveVel0VPz0 ')) return; + ALLOCATE ( PWaveAcc0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HxiPz0 ')) return; + ALLOCATE ( PWaveAcc0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HyiPz0 ')) return; + ALLOCATE ( PWaveAcc0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0VPz0 ')) return; + ALLOCATE ( WaveField%PWaveDynP0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveDynP0')) return; + ALLOCATE ( WaveField%PWaveVel0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveVel0 ')) return; + ALLOCATE ( WaveField%PWaveAcc0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveAcc0 ')) return; + IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model + ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HxiMCFPz0')) return; + ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0HyiMCFPz0')) return; + ALLOCATE ( PWaveAccC0VMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAccC0VMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HxiMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0HyiMCFPz0 ')) return; + ALLOCATE ( PWaveAcc0VMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ); if (Failed0('PWaveAcc0VMCFPz0 ')) return; + ALLOCATE ( WaveField%PWaveAccMCF0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ); if (Failed0('WaveField%PWaveAccMCF0')) return; + END IF + END IF - ALLOCATE ( WaveAcc0Hyi (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0Hyi.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0V (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0V.', ErrStat,ErrMsg,RoutineName) - - - IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs model - - ALLOCATE ( WaveAccC0HxiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HxiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAccC0HyiMCF(0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0HyiMCF.', ErrStat,ErrMsg,RoutineName) + ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. + ALLOCATE ( CosWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('CosWaveDir')) return; + ALLOCATE ( SinWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('SinWaveDir')) return; + ALLOCATE ( OmegaArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('OmegaArr ')) return; + + ! Arrays for the constrained wave + ALLOCATE ( WaveS1SddArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ); if (Failed0('WaveS1SddArr')) return; - ALLOCATE ( WaveAccC0VMCF (0:WaveField%NStepWave2 ,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAccC0VMCF.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveAcc0HxiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0HxiMCF.', ErrStat,ErrMsg,RoutineName) + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - ALLOCATE ( WaveAcc0HyiMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0HyiMCF.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( WaveAcc0VMCF (0:WaveField%NStepWave-1,NWaveKin0Prime ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveAcc0VMCF.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%WaveAccMCF (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),InitInp%NGrid(3),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%WaveAccMCF.', ErrStat,ErrMsg,RoutineName) - END IF - - - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - ALLOCATE ( PWaveDynPC0BPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynPC0BPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVelC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVelC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVelC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVelC0VPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0HxiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0HyiPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0VPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VPz0.', ErrStat,ErrMsg,RoutineName) + ! Compute the positive-frequency components (including zero) of the discrete + ! Fourier transforms of the wave kinematics: + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + OmegaArr(I) = I*WaveField%WaveDOmega + END DO - ALLOCATE ( PWaveDynP0BPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveDynP0BPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVel0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVel0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveVel0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveVel0Pz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAcc0HxiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAcc0HyiPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAcc0VPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VPz0.', ErrStat,ErrMsg,RoutineName) + call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) - ALLOCATE ( WaveField%PWaveDynP0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2) ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveDynP0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%PWaveVel0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveVel0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%PWaveAcc0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAcc0.', ErrStat,ErrMsg,RoutineName) - - IF (WaveField%MCFD > 0.0_ReKi) THEN ! MacCamy-Fuchs model - - ALLOCATE ( PWaveAccC0HxiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0HyiMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( PWaveAccC0VMCFPz0 (0:WaveField%NStepWave2 ,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAccC0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - ALLOCATE ( PWaveAcc0HxiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) + !> # Multi Directional Waves + call CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp); if (Failed()) return; - ALLOCATE ( PWaveAcc0HyiMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) + ! Store the minimum and maximum wave directions + WaveField%WaveDirMin = MINVAL(WaveField%WaveDirArr) + WaveField%WaveDirMax = MAXVAL(WaveField%WaveDirArr) - ALLOCATE ( PWaveAcc0VMCFPz0 (0:WaveField%NStepWave-1,InitInp%NWaveElevGrid), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array PWaveAcc0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( WaveField%PWaveAccMCF0 (0:WaveField%NStepWave,InitInp%NGrid(1),InitInp%NGrid(2),3), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveField%PWaveAccMCF0.', ErrStat,ErrMsg,RoutineName) - - END IF - - END IF -! END TODO SECTION + ! Set the CosWaveDir and SinWaveDir arrays + CosWaveDir=COS(D2R*WaveField%WaveDirArr) + SinWaveDir=SIN(D2R*WaveField%WaveDirArr) - - ! Arrays for the Sin and Cos of the wave direction for each frequency. Used in calculating wave elevation, velocity, acceleration etc. - ALLOCATE ( CosWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array CosWaveDir.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( SinWaveDir( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array SinWaveDir.', ErrStat,ErrMsg,RoutineName) - - ALLOCATE ( OmegaArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array OmegaArr.', ErrStat,ErrMsg,RoutineName) - - - ! Arrays for the constrained wave - ALLOCATE ( WaveS1SddArr( 0:WaveField%NStepWave2 ), STAT=ErrStatTmp ) - IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveS1SddArr.', ErrStat,ErrMsg,RoutineName) - - ! Now check if all the allocations worked properly + + ! make sure this is called before calling ConstrainedNewWaves + CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN CALL CleanUp() RETURN END IF - - - - ! Compute the positive-frequency components (including zero) of the discrete - ! Fourier transforms of the wave kinematics: - DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms - OmegaArr(I) = I*WaveField%WaveDOmega - END DO - - call Get_1Spsd_and_WaveElevC0(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr) - - !> # Multi Directional Waves - call CalculateWaveDirection(InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp) - call SetErrStat(ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + !-------------------------------------------------------------------------------- + !=== Constrained New Waves === + ! Modify the wave components to implement the constrained wave + ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 + IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod > 0) THEN + ! adjust InitOut%WaveElevC0 for constrained wave: + call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) + call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + ENDIF + ! End of Constrained Wave + + !-------------------------------------------------------------------------------- + !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP + !> This changes the phasing of all wave kinematics and loads to reflect the turbine's + !! location in the larger farm, in the case of FAST.Farm simulations, based on + !! specified PtfmLocationX and PtfmLocationY. + + IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin + + CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) + + DO I = 0,WaveField%NStepWave2 + + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) - ! Store the minimum and maximum wave directions - WaveField%WaveDirMin = MINVAL(WaveField%WaveDirArr) - WaveField%WaveDirMax = MAXVAL(WaveField%WaveDirArr) + ! some redundant calculations with later, but insignificant + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + ! apply the phase shift + tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) + + ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) + WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) + WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) + + END DO + END IF - ! Set the CosWaveDir and SinWaveDir arrays - CosWaveDir=COS(D2R*WaveField%WaveDirArr) - SinWaveDir=SIN(D2R*WaveField%WaveDirArr) - - - ! make sure this is called before calling ConstrainedNewWaves - CALL InitFFT ( WaveField%NStepWave, FFT_Data, .TRUE., ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !-------------------------------------------------------------------------------- - !=== Constrained New Waves === - ! Modify the wave components to implement the constrained wave - ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 - IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod > 0) THEN - ! adjust InitOut%WaveElevC0 for constrained wave: - call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) - call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - ENDIF - ! End of Constrained Wave - - !-------------------------------------------------------------------------------- - !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP - !> This changes the phasing of all wave kinematics and loads to reflect the turbine's - !! location in the larger farm, in the case of FAST.Farm simulations, based on - !! specified PtfmLocationX and PtfmLocationY. - - IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin - - CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) - - DO I = 0,WaveField%NStepWave2 - - tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) - - ! some redundant calculations with later, but insignificant - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) - - ! apply the phase shift - tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) - - ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) - WaveField%WaveElevC0 (1,I) = REAL( tmpComplex) - WaveField%WaveElevC0 (2,I) = AIMAG(tmpComplex) - - END DO - END IF - - - !-------------------------------------------------------------------------------- - !> ## Compute IFFTs - !> Compute the discrete Fourier transform of the instantaneous elevation of - !! incident waves at each desired point on the still water level plane - !! where it can be output: - - DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms - - - ! Set tmpComplex to the Ith element of the WAveElevC0 array - tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + !-------------------------------------------------------------------------------- + !> ## Compute IFFTs + !> Compute the discrete Fourier transform of the instantaneous elevation of + !! incident waves at each desired point on the still water level plane + !! where it can be output: + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + ! Set tmpComplex to the Ith element of the WAveElevC0 array + tmpComplex = CMPLX( WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) ! Compute the frequency of this component and its imaginary value: - - ImagOmega = ImagNmbr*OmegaArr(I) + ImagOmega = ImagNmbr*OmegaArr(I) ! Compute the wavenumber: - - WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) + WaveNmbr = WaveNumber ( OmegaArr(I), InitInp%Gravity, WaveField%EffWtrDpth ) ! Wavenumber-dependent acceleration scaling for MacCamy-Fuchs model MCFC = 0.0_ReKi @@ -1100,424 +979,350 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! before applying stretching at the zi-coordinates for the WAMIT reference point, and all ! points where are Morison loads will be calculated. - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & - InitInp%WaveKinGridyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) + WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(WaveKinPrimeMap(J))*CosWaveDir(I) + & + InitInp%WaveKinGridyi(WaveKinPrimeMap(J))*SinWaveDir(I) )) - WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveDynPC0 (I,J) = WaveField%RhoXg*tmpComplex*WaveElevxiPrime0 * COSHNumOvrCOSHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hxi (I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveVelC0Hyi (I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex* WaveElevxiPrime0 * COSHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) - WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) + WaveVelC0V (I,J) = ImagOmega*tmpComplex* WaveElevxiPrime0 * SINHNumOvrSINHDen ( WaveNmbr, WaveField%EffWtrDpth, WaveKinzi0Prime(J) ) + WaveAccC0Hxi (I,J) = ImagOmega* WaveVelC0Hxi (I,J) - WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) - WaveAccC0V (I,J) = ImagOmega* WaveVelC0V (I,J) + WaveAccC0Hyi (I,J) = ImagOmega* WaveVelC0Hyi (I,J) + WaveAccC0V (I,J) = ImagOmega* WaveVelC0V (I,J) - IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveAccC0HxiMCF(I,J) = WaveAccC0Hxi(I,J) * MCFC - WaveAccC0HyiMCF(I,J) = WaveAccC0Hyi(I,J) * MCFC - WaveAccC0VMCF(I,J) = WaveAccC0V(I,J) * MCFC - END IF - - - END DO ! J - All points where the incident wave kinematics will be computed without stretching + IF (WaveField%MCFD > 0.0_SiKi) THEN + WaveAccC0HxiMCF(I,J) = WaveAccC0Hxi(I,J) * MCFC + WaveAccC0HyiMCF(I,J) = WaveAccC0Hyi(I,J) * MCFC + WaveAccC0VMCF(I,J) = WaveAccC0V(I,J) * MCFC + END IF + END DO ! J - All points where the incident wave kinematics will be computed without stretching - !=================================== - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching - DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL - WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & - InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) - ! Partial derivatives at zi = 0 - PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*WaveField%EffWtrDpth ) - PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr - PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation wave stretching + DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL + WaveElevxiPrime0 = EXP( -ImagNmbr*WaveNmbr*( InitInp%WaveKinGridxi(J)*CosWaveDir(I) + & + InitInp%WaveKinGridyi(J)*SinWaveDir(I) )) + ! Partial derivatives at zi = 0 + PWaveDynPC0BPz0 (I,J) = WaveField%RhoXg* tmpComplex*WaveElevxiPrime0*WaveNmbr*TANH ( WaveNmbr*WaveField%EffWtrDpth ) + PWaveVelC0HxiPz0(I,J) = CosWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + PWaveVelC0HyiPz0(I,J) = SinWaveDir(I)*OmegaArr(I)*tmpComplex*WaveElevxiPrime0*WaveNmbr + + IF (I == 0_IntKi) THEN ! Zero frequency component - Need to avoid division by zero. + PWaveVelC0VPz0 (I,J) = 0.0_ReKi + ELSE + PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*WaveField%EffWtrDpth ) + END IF + + PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) + PWaveAccC0HyiPz0(I,J) = ImagOmega*PWaveVelC0HyiPz0(I,J) + PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) - IF (I == 0_IntKi) THEN ! Zero frequency component - Need to avoid division by zero. - PWaveVelC0VPz0 (I,J) = 0.0_ReKi - ELSE - PWaveVelC0VPz0 (I,J) = ImagOmega*tmpComplex*WaveElevxiPrime0*WaveNmbr/TANH ( WaveNmbr*WaveField%EffWtrDpth ) - END IF - PWaveAccC0HxiPz0(I,J) = ImagOmega*PWaveVelC0HxiPz0(I,J) - PWaveAccC0HyiPz0(I,J) = ImagOmega*PWaveVelC0HyiPz0(I,J) - PWaveAccC0VPz0 (I,J) = ImagOmega*PWaveVelC0VPz0 (I,J) - - - IF (WaveField%MCFD > 0.0_SiKi) THEN - PWaveAccC0HxiMCFPz0(I,J) = PWaveAccC0HxiPz0(I,J) * MCFC - PWaveAccC0HyiMCFPz0(I,J) = PWaveAccC0HyiPz0(I,J) * MCFC - PWaveAccC0VMCFPz0(I,J) = PWaveAccC0VPz0(I,J) * MCFC - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - END IF - !=================================== - - END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms - - ! Calculate the array of simulation times at which the instantaneous - ! elevation of, velocity of, acceleration of, and loads associated with - ! the incident waves are to be determined: - DO I = 0,WaveField%NStepWave ! Loop through all time steps - WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) - END DO ! I - All time steps - - - DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform - tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) - END DO - - ! Compute the inverse discrete Fourier transforms to find the time-domain - ! representations of the wave kinematics without stretcing: - - CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveElev0.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN + IF (WaveField%MCFD > 0.0_SiKi) THEN + PWaveAccC0HxiMCFPz0(I,J) = PWaveAccC0HxiPz0(I,J) * MCFC + PWaveAccC0HyiMCFPz0(I,J) = PWaveAccC0HyiPz0(I,J) * MCFC + PWaveAccC0VMCFPz0(I,J) = PWaveAccC0VPz0(I,J) * MCFC + END IF + + END DO ! J - All points where the incident wave kinematics will be computed without stretching END IF -!NOTE: For all grid points - DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) - ! This subroutine call applies the FFT at the correct location. - i = mod(k-1, InitInp%NGrid(1)) + 1 - j = (k-1) / InitInp%NGrid(1) + 1 - ! note that this subroutine resets tmpComplexArr - CALL WaveElevTimeSeriesAtXY( InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), WaveField%WaveElev1(:,i,j), WaveField%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets tmpComplexArr - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveField%WaveElev1.',ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO ! J - All points where the incident wave elevations can be output - - + END DO ! I - The positive frequency components (including zero) of the discrete Fourier transforms - ! User requested data points -- Do all the FFT calls first, then return if something failed. - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - CALL ApplyFFT_cx ( WaveDynP0B (:,J), WaveDynPC0 (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveDynP0B.', ErrStat,ErrMsg,RoutineName) + ! Calculate the array of simulation times at which the instantaneous + ! elevation of, velocity of, acceleration of, and loads associated with + ! the incident waves are to be determined: + DO I = 0,WaveField%NStepWave ! Loop through all time steps + WaveField%WaveTime(I) = I*REAL(InitInp%WaveDT,SiKi) + END DO ! I - All time steps + + + DO I = 0,WaveField%NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transform + tmpComplexArr(I) = CMPLX(WaveField%WaveElevC0(1,I), WaveField%WaveElevC0(2,I)) + END DO - CALL ApplyFFT_cx ( WaveVel0Hxi (:,J), WaveVelC0Hxi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0Hxi.', ErrStat,ErrMsg,RoutineName) + ! Compute the inverse discrete Fourier transforms to find the time-domain + ! representations of the wave kinematics without stretcing: - CALL ApplyFFT_cx ( WaveVel0Hyi (:,J), WaveVelC0Hyi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0Hyi.', ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx ( WaveField%WaveElev0 (0:WaveField%NStepWave-1), tmpComplexArr (: ), FFT_Data, ErrStatTmp ) + if (FailedFFT('WaveField%WaveElev0' )) return; +!NOTE: For all grid points + DO k = 1,InitInp%NWaveElevGrid ! Loop through all points where the incident wave elevations are to be computed (normally all the XY grid points) + ! This subroutine call applies the FFT at the correct location. + i = mod(k-1, InitInp%NGrid(1)) + 1 + j = (k-1) / InitInp%NGrid(1) + 1 - CALL ApplyFFT_cx ( WaveVel0V (:,J), WaveVelC0V (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveVel0V.', ErrStat,ErrMsg,RoutineName) + ! note that this subroutine resets tmpComplexArr + CALL WaveElevTimeSeriesAtXY( InitInp%WaveKinGridxi(k), InitInp%WaveKinGridyi(k), WaveField%WaveElev1(:,i,j), WaveField%WaveElevC(:,:,k), tmpComplexArr, ErrStatTmp, ErrMsgTmp ) ! Note this sets tmpComplexArr + if (FailedFFT('WaveField%WaveElev1' )) return; + END DO ! J - All points where the incident wave elevations can be output - CALL ApplyFFT_cx ( WaveAcc0Hxi (:,J), WaveAccC0Hxi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0Hxi.', ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx ( WaveAcc0Hyi (:,J), WaveAccC0Hyi (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0Hyi.', ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx ( WaveAcc0V (:,J), WaveAccC0V (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0V.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! User requested data points -- Do all the FFT calls first, then return if something failed. + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + CALL ApplyFFT_cx ( WaveDynP0B (:,J), WaveDynPC0 (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveDynPC0 ')) return; + CALL ApplyFFT_cx ( WaveVel0Hxi (:,J), WaveVelC0Hxi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0Hxi')) return; + CALL ApplyFFT_cx ( WaveVel0Hyi (:,J), WaveVelC0Hyi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0Hyi')) return; + CALL ApplyFFT_cx ( WaveVel0V (:,J), WaveVelC0V (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveVelC0V ')) return; + CALL ApplyFFT_cx ( WaveAcc0Hxi (:,J), WaveAccC0Hxi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0Hxi')) return; + CALL ApplyFFT_cx ( WaveAcc0Hyi (:,J), WaveAccC0Hyi (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0Hyi')) return; + CALL ApplyFFT_cx ( WaveAcc0V (:,J), WaveAccC0V (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAccC0V ')) return; + END DO ! J - All points where the incident wave kinematics will be computed without stretching + IF (WaveField%MCFD > 0.0_SiKi) THEN + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + CALL ApplyFFT_cx ( WaveAcc0HxiMCF (:,J), WaveAccC0HxiMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0HxiMCF')) return; + CALL ApplyFFT_cx ( WaveAcc0HyiMCF (:,J), WaveAccC0HyiMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0HyiMCF')) return; + CALL ApplyFFT_cx ( WaveAcc0VMCF (:,J), WaveAccC0VMCF (:,J), FFT_Data, ErrStatTmp ); if (FailedFFT('WaveAcc0VMCF ')) return; + END DO + END IF + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL where z-partial derivatives will be computed for extrapolated stretching + ! FFT's of the partial derivatives + CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveDynP0BPz0 ')) return; + CALL ApplyFFT_cx ( PWaveVel0HxiPz0 (:,J ), PWaveVelC0HxiPz0( :,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0HxiPz0')) return; + CALL ApplyFFT_cx ( PWaveVel0HyiPz0 (:,J ), PWaveVelC0HyiPz0( :,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0HyiPz0')) return; + CALL ApplyFFT_cx ( PWaveVel0VPz0 (:,J ), PWaveVelC0VPz0 (:,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveVel0VPz0 ')) return; + CALL ApplyFFT_cx ( PWaveAcc0HxiPz0 (:,J ), PWaveAccC0HxiPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HxiPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0HyiPz0 (:,J ), PWaveAccC0HyiPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HyiPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0VPz0 (:,J ), PWaveAccC0VPz0( :,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0VPz0 ')) return; END DO ! J - All points where the incident wave kinematics will be computed without stretching - - IF (WaveField%MCFD > 0.0_SiKi) THEN - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - CALL ApplyFFT_cx ( WaveAcc0HxiMCF (:,J), WaveAccC0HxiMCF (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0HxiMCF.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( WaveAcc0HyiMCF (:,J), WaveAccC0HyiMCF (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0HyiMCF.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( WaveAcc0VMCF (:,J), WaveAccC0VMCF (:,J), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to WaveAcc0VMCF.', ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + + IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field + DO J = 1,InitInp%NWaveElevGrid + CALL ApplyFFT_cx ( PWaveAcc0HxiMCFPz0 (:,J ), PWaveAccC0HxiMCFPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HxiMCFPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0HyiMCFPz0 (:,J ), PWaveAccC0HyiMCFPz0(:,J ),FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0HyiMCFPz0')) return; + CALL ApplyFFT_cx ( PWaveAcc0VMCFPz0 (:,J ), PWaveAccC0VMCFPz0( :,J ), FFT_Data, ErrStatTmp ); if (FailedFFT('PWaveAcc0VMCFPz0 ')) return; END DO END IF - - !=================================== - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - DO J = 1,InitInp%NWaveElevGrid ! Loop through all points on the SWL where z-partial derivatives will be computed for extrapolated stretching - ! FFT's of the partial derivatives - CALL ApplyFFT_cx ( PWaveDynP0BPz0(:,J ), PWaveDynPC0BPz0(:,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveDynP0BPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveVel0HxiPz0 (:,J ), PWaveVelC0HxiPz0( :,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveVel0HyiPz0 (:,J ), PWaveVelC0HyiPz0( :,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveVel0VPz0 (:,J ), PWaveVelC0VPz0 (:,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveVel0VPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0HxiPz0 (:,J ), PWaveAccC0HxiPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HxiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0HyiPz0 (:,J ), PWaveAccC0HyiPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HyiPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0VPz0 (:,J ), PWaveAccC0VPz0( :,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0VPz0.', ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - END DO ! J - All points where the incident wave kinematics will be computed without stretching - - IF (WaveField%MCFD > 0.0_SiKi) THEN ! MacCamy-Fuchs scaled acceleration field - DO J = 1,InitInp%NWaveElevGrid - - CALL ApplyFFT_cx ( PWaveAcc0HxiMCFPz0 (:,J ), PWaveAccC0HxiMCFPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HxiMCFPz0.', ErrStat,ErrMsg,RoutineName) - - CALL ApplyFFT_cx ( PWaveAcc0HyiMCFPz0 (:,J ), PWaveAccC0HyiMCFPz0(:,J ),FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0HyiMCFPz0.', ErrStat,ErrMsg,RoutineName) - CALL ApplyFFT_cx ( PWaveAcc0VMCFPz0 (:,J ), PWaveAccC0VMCFPz0( :,J ), FFT_Data, ErrStatTmp ) - CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to PWaveAcc0VMCFPz0.', ErrStat,ErrMsg,RoutineName) - - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - END DO - END IF - - END IF -!=================================== + END IF + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF - CALL ExitFFT(FFT_Data, ErrStatTmp) - CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! Add the current velocities to the wave velocities: + ! NOTE: Both the horizontal velocities and the partial derivative of the + ! horizontal velocities with respect to zi at zi = 0 are found here. + ! + ! NOTE: The current module must be called prior to the waves module. If that was not done, then we + ! don't have a current to add to the wave velocity. So, check if the current velocity components + ! exist. - ! Add the current velocities to the wave velocities: - ! NOTE: Both the horizontal velocities and the partial derivative of the - ! horizontal velocities with respect to zi at zi = 0 are found here. - ! - ! NOTE: The current module must be called prior to the waves module. If that was not done, then we - ! don't have a current to add to the wave velocity. So, check if the current velocity components - ! exist. + ! If there is a current, we need to add that (the current module was called prior to calling this module - ! If there is a current, we need to add that (the current module was called prior to calling this module + IF(ALLOCATED(InitInp%CurrVxi)) THEN - IF(ALLOCATED(InitInp%CurrVxi)) THEN + DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching - DO J = 1,NWaveKin0Prime ! Loop through all points where the incident wave kinematics will be computed without stretching + WaveVel0Hxi (:,J) = WaveVel0Hxi (:,J) + InitInp%CurrVxi(WaveKinPrimeMap(J)) ! xi-direction + WaveVel0Hyi (:,J) = WaveVel0Hyi (:,J) + InitInp%CurrVyi(WaveKinPrimeMap(J)) ! yi-direction - WaveVel0Hxi (:,J) = WaveVel0Hxi (:,J) + InitInp%CurrVxi(WaveKinPrimeMap(J)) ! xi-direction - WaveVel0Hyi (:,J) = WaveVel0Hyi (:,J) + InitInp%CurrVyi(WaveKinPrimeMap(J)) ! yi-direction + END DO ! J - All points where the incident wave kinematics will be computed without stretching - END DO ! J - All points where the incident wave kinematics will be computed without stretching + ! Commented out - We do not extrapolate the current profile with extrapolated wave stretching + !PWaveVel0HxiPz0(: ) = PWaveVel0HxiPz0(: ) + InitInp%PCurrVxiPz0 ! xi-direction + !PWaveVel0HyiPz0(: ) = PWaveVel0HyiPz0(: ) + InitInp%PCurrVyiPz0 ! yi-direction - ! Commented out - We do not extrapolate the current profile with extrapolated wave stretching - !PWaveVel0HxiPz0(: ) = PWaveVel0HxiPz0(: ) + InitInp%PCurrVxiPz0 ! xi-direction - !PWaveVel0HyiPz0(: ) = PWaveVel0HyiPz0(: ) + InitInp%PCurrVyiPz0 ! yi-direction + ENDIF - ENDIF + ! Apply stretching to obtain the wave kinematics, WaveDynP0, WaveVel0, and + ! WaveAcc0, at the desired locations from the wave kinematics at + ! alternative locations, WaveDynP0B, WaveVel0Hxi, WaveVel0Hyi, WaveVel0V, + ! WaveAcc0Hxi, WaveAcc0Hyi, WaveAcc0V, if the elevation of the point defined by + ! WaveKinGridzi(J) lies between the seabed and the instantaneous free + ! surface, else set WaveDynP0, WaveVel0, and WaveAcc0 to zero. This + ! depends on which incident wave kinematics stretching method is being + ! used: - ! Apply stretching to obtain the wave kinematics, WaveDynP0, WaveVel0, and - ! WaveAcc0, at the desired locations from the wave kinematics at - ! alternative locations, WaveDynP0B, WaveVel0Hxi, WaveVel0Hyi, WaveVel0V, - ! WaveAcc0Hxi, WaveAcc0Hyi, WaveAcc0V, if the elevation of the point defined by - ! WaveKinGridzi(J) lies between the seabed and the instantaneous free - ! surface, else set WaveDynP0, WaveVel0, and WaveAcc0 to zero. This - ! depends on which incident wave kinematics stretching method is being - ! used: + ! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? + ! CASE ( 0 ) ! None=no stretching. - ! SELECT CASE ( InitInp%WaveStMod ) ! Which model are we using to extrapolate the incident wave kinematics to the instantaneous free surface? - ! CASE ( 0 ) ! None=no stretching. + ! Since we have no stretching, the wave kinematics between the seabed and + ! the mean sea level are left unchanged; below the seabed or above the + ! mean sea level, the wave kinematics are zero: + ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 - ! Since we have no stretching, the wave kinematics between the seabed and - ! the mean sea level are left unchanged; below the seabed or above the - ! mean sea level, the wave kinematics are zero: + primeCount = 1 + count = 1 + !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed + do k = 1, InitInp%NGrid(3) + do j = 1, InitInp%NGrid(2) + do i = 1, InitInp%NGrid(1) - ! InitOut%PWaveDynP0(:,:,:,:) = 0.0 + ! ii = mod(count-1, InitInp%NGrid(1)) + 1 + ! jj = mod( (count-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 + ! kk = (count-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 + + IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN + ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) + ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL + + WaveField%WaveDynP(:,i,j,k ) = 0.0 + WaveField%WaveVel (:,i,j,k,:) = 0.0 + WaveField%WaveAcc (:,i,j,k,:) = 0.0 + ELSE + ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) + + WaveField%WaveDynP(0:WaveField%NStepWave-1,i,j,k ) = WaveDynP0B( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,3) = WaveVel0V( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END IF + count = count + 1 + end do + end do + end do + + ! MacCamy-Fuchs scaled fluid acceleration + IF (WaveField%MCFD > 0.0_SiKi) THEN primeCount = 1 count = 1 - !DO J = 1,InitInp%NWaveKinGrid ! Loop through all points where the incident wave kinematics will be computed do k = 1, InitInp%NGrid(3) do j = 1, InitInp%NGrid(2) do i = 1, InitInp%NGrid(1) - - ! ii = mod(count-1, InitInp%NGrid(1)) + 1 - ! jj = mod( (count-1) /InitInp%NGrid(1), InitInp%NGrid(2) ) + 1 - ! kk = (count-1) / (InitInp%NGrid(1)*InitInp%NGrid(2)) + 1 - IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - - WaveField%WaveDynP(:,i,j,k ) = 0.0 - WaveField%WaveVel (:,i,j,k,:) = 0.0 - WaveField%WaveAcc (:,i,j,k,:) = 0.0 - + WaveField%WaveAccMCF(:,i,j,k,:) = 0.0 ELSE ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) - - WaveField%WaveDynP(0:WaveField%NStepWave-1,i,j,k ) = WaveDynP0B( 0:WaveField%NStepWave-1,primeCount) - WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,1) = WaveVel0Hxi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,2) = WaveVel0Hyi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveVel (0:WaveField%NStepWave-1,i,j,k,3) = WaveVel0V( 0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0Hxi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0Hyi(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAcc (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0V( 0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:WaveField%NStepWave-1,primeCount) + WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END IF count = count + 1 end do end do end do + END IF - ! MacCamy-Fuchs scaled fluid acceleration + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + + primeCount = 1 + DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed + DO i = 1, InitInp%NGrid(1) + WaveField%PWaveDynP0(0:WaveField%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:WaveField%NStepWave-1,primeCount) + primeCount = primeCount + 1 + END DO + END DO + IF (WaveField%MCFD > 0.0_SiKi) THEN - primeCount = 1 - count = 1 - do k = 1, InitInp%NGrid(3) - do j = 1, InitInp%NGrid(2) - do i = 1, InitInp%NGrid(1) - IF ( ( InitInp%WaveKinGridzi(count) < -WaveField%EffWtrDpth ) .OR. ( InitInp%WaveKinGridzi(count) > 0.0 ) ) THEN - ! .TRUE. if the elevation of the point defined by WaveKinGridzi(J) lies below the seabed or above mean sea level (exclusive) - ! NOTE: We test to 0 instead of MSL2SWL because the locations of WaveKinGridzi and EffWtrDpth have already been adjusted using MSL2SWL - WaveField%WaveAccMCF(:,i,j,k,:) = 0.0 - ELSE - ! The elevation of the point defined by WaveKinGridzi(J) must lie between the seabed and the mean sea level (inclusive) - WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,1) = WaveAcc0HxiMCF(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,2) = WaveAcc0HyiMCF(0:WaveField%NStepWave-1,primeCount) - WaveField%WaveAccMCF (0:WaveField%NStepWave-1,i,j,k,3) = WaveAcc0VMCF( 0:WaveField%NStepWave-1,primeCount) - primeCount = primeCount + 1 - END IF - count = count + 1 - end do - end do - end do - END IF - - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - primeCount = 1 DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed DO i = 1, InitInp%NGrid(1) - WaveField%PWaveDynP0(0:WaveField%NStepWave-1,i,j ) = PWaveDynP0BPz0( 0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,1) = PWaveVel0HxiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,2) = PWaveVel0HyiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveVel0 (0:WaveField%NStepWave-1,i,j,3) = PWaveVel0VPz0( 0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAcc0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VPz0( 0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:WaveField%NStepWave-1,primeCount) + WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:WaveField%NStepWave-1,primeCount) primeCount = primeCount + 1 END DO END DO - - IF (WaveField%MCFD > 0.0_SiKi) THEN - primeCount = 1 - DO j = 1, InitInp%NGrid(2) ! Loop through all points on the SWL where partial derivatives about z were computed - DO i = 1, InitInp%NGrid(1) - WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,1) = pWaveAcc0HxiMCFPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,2) = pWaveAcc0HyiMCFPz0(0:WaveField%NStepWave-1,primeCount) - WaveField%PWaveAccMCF0 (0:WaveField%NStepWave-1,i,j,3) = PWaveAcc0VMCFPz0( 0:WaveField%NStepWave-1,primeCount) - primeCount = primeCount + 1 - END DO - END DO - END IF - END IF + END IF - ! END DO ! J - All points where the incident wave kinematics will be computed - - ! CASE ( 1 ) ! Vertical stretching. - - - ! Vertical stretching says that the wave kinematics above the mean sea level - ! equal the wave kinematics at the mean sea level. The wave kinematics - ! below the mean sea level are left unchanged: + ! CASE ( 1 ) ! Vertical stretching. + ! Vertical stretching says that the wave kinematics above the mean sea level + ! equal the wave kinematics at the mean sea level. The wave kinematics + ! below the mean sea level are left unchanged: + ! CASE ( 2 ) ! Extrapolation stretching. + ! Extrapolation stretching uses a linear Taylor expansion of the wave + ! kinematics (and their partial derivatives with respect to z) at the mean + ! sea level to find the wave kinematics above the mean sea level. The + ! wave kinematics below the mean sea level are left unchanged: - - ! CASE ( 2 ) ! Extrapolation stretching. - - - ! Extrapolation stretching uses a linear Taylor expansion of the wave - ! kinematics (and their partial derivatives with respect to z) at the mean - ! sea level to find the wave kinematics above the mean sea level. The - ! wave kinematics below the mean sea level are left unchanged: - - - - - - ! CASE ( 3 ) ! Wheeler stretching. - - - ! Wheeler stretching says that wave kinematics calculated using Airy theory - ! at the mean sea level should actually be applied at the instantaneous - ! free surface and that Airy wave kinematics computed at locations between - ! the seabed and the mean sea level should be shifted vertically to new - ! locations in proportion to their elevation above the seabed. - ! - ! Computing the wave kinematics with Wheeler stretching requires that first - ! say that the wave kinematics we computed at the elevations defined by - ! the WaveKinzi0Prime(:) array are actual applied at the elevations found - ! by stretching the elevations in the WaveKinzi0Prime(:) array using the - ! instantaneous wave elevation--these new elevations are stored in the - ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics - ! computed without stretching to the desired elevations (defined in the - ! WaveKinGridzi(:) array) using the WaveKinzi0St(:) array: - - - - - ! ENDSELECT - - ! Set the ending timestep to the same as the first timestep - WaveField%WaveElev0 (WaveField%NStepWave) = WaveField%WaveElev0 (0 ) - WaveField%WaveDynP (WaveField%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) - WaveField%WaveVel (WaveField%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) - WaveField%WaveAcc (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) + ! CASE ( 3 ) ! Wheeler stretching. + ! Wheeler stretching says that wave kinematics calculated using Airy theory + ! at the mean sea level should actually be applied at the instantaneous + ! free surface and that Airy wave kinematics computed at locations between + ! the seabed and the mean sea level should be shifted vertically to new + ! locations in proportion to their elevation above the seabed. + ! + ! Computing the wave kinematics with Wheeler stretching requires that first + ! say that the wave kinematics we computed at the elevations defined by + ! the WaveKinzi0Prime(:) array are actual applied at the elevations found + ! by stretching the elevations in the WaveKinzi0Prime(:) array using the + ! instantaneous wave elevation--these new elevations are stored in the + ! WaveKinzi0St(:) array. Next, we interpolate the wave kinematics + ! computed without stretching to the desired elevations (defined in the + ! WaveKinGridzi(:) array) using the WaveKinzi0St(:) array: + + ! ENDSELECT + + ! Set the ending timestep to the same as the first timestep + WaveField%WaveElev0 (WaveField%NStepWave) = WaveField%WaveElev0 (0 ) + WaveField%WaveDynP (WaveField%NStepWave,:,:,: ) = WaveField%WaveDynP (0,:,:,: ) + WaveField%WaveVel (WaveField%NStepWave,:,:,:,:) = WaveField%WaveVel (0,:,:,:,:) + WaveField%WaveAcc (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAcc (0,:,:,:,:) + IF (WaveField%MCFD > 0.0_SiKi) THEN + WaveField%WaveAccMCF (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) + END IF + + IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching + WaveField%PWaveDynP0(WaveField%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) + WaveField%PWaveVel0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) + WaveField%PWaveAcc0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveField%WaveAccMCF (WaveField%NStepWave,:,:,:,:) = WaveField%WaveAccMCF(0,:,:,:,:) - END IF - - IF (WaveField%WaveStMod .EQ. 2_IntKi) THEN ! Extrapolation Wave Stretching - WaveField%PWaveDynP0(WaveField%NStepWave,:,: ) = WaveField%PWaveDynP0(0,:,: ) - WaveField%PWaveVel0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveVel0 (0,:,:,:) - WaveField%PWaveAcc0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAcc0 (0,:,:,:) - IF (WaveField%MCFD > 0.0_SiKi) THEN - WaveField%PWaveAccMCF0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) - END IF + WaveField%PWaveAccMCF0 (WaveField%NStepWave,:,:,:) = WaveField%PWaveAccMCF0(0,:,:,:) END IF + END IF CALL CleanUp ( ) CONTAINS - + logical function Failed() + CALL SetErrStat( ErrStatTmp, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) CALL Cleanup() + end function + logical function Failed0(TmpName) + character(*), intent(in) :: TmpName + if (ErrStatTmp /= 0) then + ErrStatTmp = ErrID_Fatal + CALL SetErrStat( ErrStatTmp, 'Error while allocating '//trim(TmpName), ErrStat, ErrMsg, RoutineName ) + endif + Failed0 = ErrStat >= AbortErrLev + if (Failed0) CALL Cleanup() + end function + logical function FailedFFT(TmpName) + character(*), intent(in) :: TmpName + CALL SetErrStat( ErrStatTmp, 'Error occured while applying the FFT to '//trim(TmpName), ErrStat, ErrMsg, RoutineName ) + FailedFFT = ErrStat >= AbortErrLev + if (FailedFFT) CALL Cleanup() + end function !-------------------------------------------------------------------------------- SUBROUTINE WaveElevTimeSeriesAtXY(Xcoord,Ycoord, WaveElevAtXY, WaveElevCAtXY, tmpComplexArr, ErrStatLcl, ErrMsgLcl ) @@ -1630,23 +1435,18 @@ END SUBROUTINE VariousWaves_Init !> This routine is called at the start of the simulation to perform initialization steps. !! The initial states and initial guess for the input are defined. SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) -!.................................................................................................................................. - TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine !NOTE: We are making this INOUT because UserWaveComponents_Init changes the value of InitInp%WaveDT TYPE(Waves_InitOutputType), INTENT( OUT) :: InitOut !< Output for initialization routine TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: WaveField ! SeaState wave field type containing the wave field data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local Variables: INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for processing CHARACTER(ErrMsgLen) :: ErrMsgTmp ! Temporary error message for procesing ! Initialize ErrStat - ErrStat = ErrID_None ErrStatTmp = ErrID_None ErrMsg = "" @@ -1657,19 +1457,15 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) CALL RandNum_Init(InitInp%RNG, ErrStat, ErrMsg) IF ( ErrStat >= AbortErrLev ) RETURN - ! Define initialization-routine output here: - - - - ! Initialize the variables associated with the incident wave: + ! Initialize the variables associated with the incident wave: SELECT CASE ( WaveField%WaveMod ) ! Which incident wave kinematics model are we using? CASE ( WaveMod_None ) ! None=still water. CALL StillWaterWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1678,8 +1474,8 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Now call the init with all the zi locations for the Morrison member nodes CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') - IF ( ErrStat >= AbortErrLev ) RETURN + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + IF ( ErrStat >= AbortErrLev ) RETURN CASE ( WaveMod_ExtElev ) ! User-supplied wave elevation time history; HD derives full wave kinematics from this elevation time series data. @@ -1691,7 +1487,7 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Now call VariousWaves to continue using the wave elevation and derived frequency information from the file CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN @@ -1705,12 +1501,12 @@ SUBROUTINE Waves_Init( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) ! Get the wave frequency information from the file (by reading in wave frequency components) CALL UserWaveComponents_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN ! Now call VariousWaves to continue using the wave frequency information from the file CALL VariousWaves_Init( InitInp, InitOut, WaveField, ErrStatTmp, ErrMsgTmp ) - CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') IF ( ErrStat >= AbortErrLev ) RETURN ENDSELECT From 605daf495703a45a8bed926bb57348e4bea225eb Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 8 Feb 2024 02:09:09 -0700 Subject: [PATCH 196/232] SeaState: update VS projects for removal of SeaState_Interp --- vs-build/FASTlib/FASTlib.vfproj | 39 ------------------- vs-build/HydroDyn/HydroDynDriver.vfproj | 25 ------------ .../HydroDyn_c_binding.vfproj | 25 ------------ vs-build/SeaState/SeaStateDriver.vfproj | 24 ------------ 4 files changed, 113 deletions(-) diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 9325e85b01..afd7a04d23 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -2179,44 +2179,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2306,7 +2268,6 @@ - diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 82488ba7a2..91a7989cbf 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -558,30 +558,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - @@ -641,7 +617,6 @@ - diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 4481a2cde7..f447d872ac 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -318,30 +318,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - @@ -401,7 +377,6 @@ - diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index 208b6ce568..2d598d9e7c 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -295,29 +295,6 @@ - - - - - - - - - - - - - - - - - - - - - - - @@ -358,7 +335,6 @@ - From 6f66359d72d2db394e5f3963ddf360eab681a831 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 8 Feb 2024 15:11:48 -0700 Subject: [PATCH 197/232] WAMIT: add interface for 4d interpolation with WaveField indexing Add interface WAMIT_ForceWaves_Interp (WAMIT_Interp) for * WAMIT_ForceWaves_Interp_3D_vec6 -- 3D interpolation * WAMIT_ForceWaves_Interp_4D_vec6 -- 4D interpolation Also added WaveField_Interp_4D_Vec6 routine to SeaSt_WaveField for completeness (not currently used). Also an update to the RunRegistry.bat file for something missed before. --- modules/hydrodyn/src/WAMIT_Interp.f90 | 58 ++++++++++++++++++++++-- modules/seastate/src/SeaSt_WaveField.f90 | 34 ++++++++++++++ vs-build/RunRegistry.bat | 1 - 3 files changed, 87 insertions(+), 6 deletions(-) diff --git a/modules/hydrodyn/src/WAMIT_Interp.f90 b/modules/hydrodyn/src/WAMIT_Interp.f90 index 4067454658..585867a33a 100644 --- a/modules/hydrodyn/src/WAMIT_Interp.f90 +++ b/modules/hydrodyn/src/WAMIT_Interp.f90 @@ -30,7 +30,7 @@ MODULE WAMIT_Interp USE NWTC_Library use SeaSt_WaveField_Types, only: SeaSt_WaveField_ParameterType, SeaSt_WaveField_MiscVarType - use SeaSt_WaveField, only: WaveField_Interp_Setup3D + use SeaSt_WaveField, only: WaveField_Interp_Setup3D, WaveField_Interp_Setup4D IMPLICIT NONE PRIVATE @@ -42,6 +42,13 @@ MODULE WAMIT_Interp public :: WAMIT_ForceWaves_Interp + + ! 3D and 4D interpolations using WaveField indexing + interface WAMIT_ForceWaves_Interp + module procedure WAMIT_ForceWaves_Interp_3D_vec6 + module procedure WAMIT_ForceWaves_Interp_4D_vec6 + end interface + CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -627,16 +634,16 @@ END SUBROUTINE CalcIsoparCoords !> retrieve indices from the WaveField info, and do interpolation for this point. !! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. -function WAMIT_ForceWaves_Interp(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) +function WAMIT_ForceWaves_Interp_3D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) real(DbKi), intent(in ) :: Time - real(ReKi), intent(in ) :: pos(*) !< position + real(ReKi), intent(in ) :: pos(2) !< position real(SiKi), intent(in ) :: pKinXX(0:,:,:,:) !< 3D Wave excitation data (SiKi for storage space reasons) type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables integer(IntKi), intent( out) :: ErrStat3 character(*), intent( out) :: ErrMsg3 - real(SiKi) :: WAMIT_ForceWaves_Interp(6) + real(SiKi) :: WAMIT_ForceWaves_Interp_3D_vec6(6) real(SiKi) :: u(8) integer(IntKi) :: i @@ -653,7 +660,48 @@ function WAMIT_ForceWaves_Interp(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg u(6) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) u(7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), i ) u(8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), i ) - WAMIT_ForceWaves_Interp(i) = SUM ( WF_m%N3D * u ) + WAMIT_ForceWaves_Interp_3D_vec6(i) = SUM ( WF_m%N3D * u ) + end do +end function + + +!> retrieve indices from the WaveField info, and do interpolation for this point. This is for interpolating on 4D +!! NOTE: the WAMIT field passed in here through pKinXX is based on WaveField sizing, which is why we can do this. +function WAMIT_ForceWaves_Interp_4D_vec6(Time, pos, pKinXX, WF_p, WF_m, ErrStat3, ErrMsg3) + real(DbKi), intent(in ) :: Time + real(ReKi), intent(in ) :: pos(3) !< position + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) !< 4D Wave excitation data (SiKi for storage space reasons) + type(SeaSt_WaveField_ParameterType), intent(in ) :: WF_p !< wavefield parameters + type(SeaSt_WaveField_MiscVarType), intent(inout) :: WF_m !< wavefield misc/optimization variables + integer(IntKi), intent( out) :: ErrStat3 + character(*), intent( out) :: ErrMsg3 + + real(SiKi) :: WAMIT_ForceWaves_Interp_4D_vec6(6) + real(SiKi) :: u(16) + integer(IntKi) :: i + + ! get the bounding indices from the WaveField info (same indexing used in WAMIT) + call WaveField_Interp_Setup4D( Time, pos, WF_p, WF_m, ErrStat3, ErrMsg3 ) + + ! interpolate + do i = 1,6 + u( 1) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 2) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 3) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 4) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u( 5) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u( 6) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u( 7) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u( 8) = pKinXX( WF_m%Indx_Lo(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u( 9) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u(10) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(11) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(12) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Lo(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + u(13) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Lo(4), i ) + u(14) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Lo(3), WF_m%Indx_Hi(4), i ) + u(15) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Lo(4), i ) + u(16) = pKinXX( WF_m%Indx_Hi(1), WF_m%Indx_Hi(2), WF_m%Indx_Hi(3), WF_m%Indx_Hi(4), i ) + WAMIT_ForceWaves_Interp_4D_vec6(i) = SUM ( WF_m%N4D * u ) end do end function diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 7d40e860b2..8c8f46b9e6 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -786,6 +786,40 @@ function WaveField_Interp_4D_Vec( pKinXX, m) END FUNCTION WaveField_Interp_4D_Vec +!==================================================================================================== +!> This routine interpolates a 4-d dataset. +!! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf +function WaveField_Interp_4D_Vec6( pKinXX, m) + real(SiKi), intent(in ) :: pKinXX(0:,:,:,:,:) + type(SeaSt_WaveField_MiscVarType), intent(in ) :: m !< misc vars for interpolation + + real(SiKi) :: WaveField_Interp_4D_Vec6(6) + real(SiKi) :: u(16) ! size 2^n + integer(IntKi) :: iDir + + ! interpolate + do iDir = 1,6 + u( 1) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 2) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 3) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 4) = pKinXX( m%Indx_Lo(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 5) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u( 6) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u( 7) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u( 8) = pKinXX( m%Indx_Lo(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u( 9) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(10) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(11) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(12) = pKinXX( m%Indx_Hi(1), m%Indx_Lo(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + u(13) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Lo(4), iDir ) + u(14) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Lo(3), m%Indx_Hi(4), iDir ) + u(15) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Lo(4), iDir ) + u(16) = pKinXX( m%Indx_Hi(1), m%Indx_Hi(2), m%Indx_Hi(3), m%Indx_Hi(4), iDir ) + WaveField_Interp_4D_Vec6(iDir) = SUM ( m%N4D * u ) + end do +END FUNCTION WaveField_Interp_4D_Vec6 + + !==================================================================================================== !> This routine interpolates a 3-d dataset with index 1 = time (zero-based indexing), 2 = x-coordinate (1-based indexing), 3 = y-coordinate (1-based indexing) !! This method is described here: http://rjwagner49.com/Mathematics/Interpolation.pdf diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index adbc861f41..28964ae6dc 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -224,7 +224,6 @@ GOTO checkError :Current :Waves :Waves2 -:SeaState_Interp :SeaSt_WaveField SET CURR_LOC=%SEAST_Loc% From 64693134069dc1c341fa9aa16b118edb1c07cbb9 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 8 Feb 2024 15:22:11 -0700 Subject: [PATCH 198/232] WaveField: remove InitInp type and set params directly This was excess code that simply isn't needed. --- modules/seastate/src/SeaSt_WaveField.f90 | 17 ------ modules/seastate/src/SeaSt_WaveField.txt | 5 -- .../seastate/src/SeaSt_WaveField_Types.f90 | 55 ------------------- modules/seastate/src/SeaState.f90 | 16 +++--- 4 files changed, 7 insertions(+), 86 deletions(-) diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 8c8f46b9e6..a117d3db79 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -16,8 +16,6 @@ MODULE SeaSt_WaveField PUBLIC WaveField_GetWaveKin -public WaveField_SetParam - public WaveField_Interp_Setup3D, WaveField_Interp_Setup4D CONTAINS @@ -435,21 +433,6 @@ end subroutine WaveField_GetWaveKin ! Interpolation related functions !---------------------------------------------------------------------------------------------------- -!> Set the WaveField 4D Params -subroutine WaveField_SetParam( InitInp, p ) - type(SeaSt_WaveField_InitInputType), intent(in ) :: InitInp - type(SeaSt_WaveField_ParameterType), intent( out) :: p - - ! Copy things from the InitData to the ParamData. - p%n = InitInp%n ! number of points on the evenly-spaced grid (in each direction) - p%delta = InitInp%delta ! distance between consecutive grid points in each direction (s,m,m,m) - p%pZero = InitInp%pZero ! fixed location of first time-XYZ grid point (i.e., XYZ coordinates of m%V(:,1,1,1,:)) - p%Z_Depth = InitInp%Z_Depth - - return -end subroutine WaveField_SetParam - - subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, FirstWarn, ErrStat, ErrMsg) REAL(ReKi), intent(in ) :: p REAL(ReKi), intent(in ) :: pZero diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index 76aac062df..f0b4aeaf14 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -17,11 +17,6 @@ param SeaSt_WaveField - INTEGER WaveMod_User #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- -typedef ^ InitInputType IntKi n 4 - - "number of grid points in the t, x, y, and z directions" - -typedef ^ InitInputType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction (time, x, y, z)" "s,m,m,m" -typedef ^ InitInputType ReKi pZero 4 - - "fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ InitInputType ReKi Z_Depth - - - "grid depth" m - typedef ^ ParameterType IntKi n 4 - - "number of evenly-spaced grid points in the t, x, y, and z directions" - typedef ^ ParameterType ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "s,m,m,m" typedef ^ ParameterType ReKi pZero 4 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 74821c23b4..869882a3aa 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -44,14 +44,6 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] -! ========= SeaSt_WaveField_InitInputType ======= - TYPE, PUBLIC :: SeaSt_WaveField_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] - END TYPE SeaSt_WaveField_InitInputType -! ======================= ! ========= SeaSt_WaveField_ParameterType ======= TYPE, PUBLIC :: SeaSt_WaveField_ParameterType INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] @@ -112,53 +104,6 @@ MODULE SeaSt_WaveField_Types ! ======================= CONTAINS -subroutine SeaSt_WaveField_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) - type(SeaSt_WaveField_InitInputType), intent(in) :: SrcInitInputData - type(SeaSt_WaveField_InitInputType), intent(inout) :: DstInitInputData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopyInitInput' - ErrStat = ErrID_None - ErrMsg = '' - DstInitInputData%n = SrcInitInputData%n - DstInitInputData%delta = SrcInitInputData%delta - DstInitInputData%pZero = SrcInitInputData%pZero - DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth -end subroutine - -subroutine SeaSt_WaveField_DestroyInitInput(InitInputData, ErrStat, ErrMsg) - type(SeaSt_WaveField_InitInputType), intent(inout) :: InitInputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine SeaSt_WaveField_PackInitInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SeaSt_WaveField_InitInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackInitInput' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%n) - call RegPack(RF, InData%delta) - call RegPack(RF, InData%pZero) - call RegPack(RF, InData%Z_Depth) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SeaSt_WaveField_UnPackInitInput(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SeaSt_WaveField_InitInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackInitInput' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%delta); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%pZero); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%Z_Depth); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine SeaSt_WaveField_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_WaveField_ParameterType), intent(in) :: SrcParamData type(SeaSt_WaveField_ParameterType), intent(inout) :: DstParamData diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index e0fb3532bd..a0d1424ac6 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -89,7 +89,6 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init TYPE(FileInfoType) :: InFileInfo !< The derived type for holding the full input file for parsing -- we may pass this in the future TYPE(Waves_InitOutputType) :: Waves_InitOut ! Initialization Outputs from the Waves submodule initialization TYPE(Waves2_InitOutputType) :: Waves2_InitOut ! Initialization Outputs from the Waves2 submodule initialization - TYPE(SeaSt_WaveField_InitInputType) :: WaveField_InitInp TYPE(Current_InitOutputType) :: Current_InitOut ! Initialization Outputs from the Current module initialization INTEGER :: I ! Generic counters INTEGER :: it ! Generic counters @@ -263,14 +262,13 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! Setup the 4D grid information for the Interpolation Module - WaveField_InitInp%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) - WaveField_InitInp%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) - WaveField_InitInp%pZero(1) = 0.0 !Time - WaveField_InitInp%pZero(2) = -InputFileData%X_HalfWidth - WaveField_InitInp%pZero(3) = -InputFileData%Y_HalfWidth - WaveField_InitInp%pZero(4) = -InputFileData%Z_Depth ! zi - WaveField_InitInp%Z_Depth = InputFileData%Z_Depth - call WaveField_SetParam(WaveField_InitInp, p%WaveField%GridParams) + p%WaveField%GridParams%n = (/p%WaveField%NStepWave,p%nGrid(1),p%nGrid(2),p%nGrid(3)/) + p%WaveField%GridParams%delta = (/real(p%WaveDT,ReKi),p%deltaGrid(1),p%deltaGrid(2),p%deltaGrid(3)/) + p%WaveField%GridParams%pZero(1) = 0.0 !Time + p%WaveField%GridParams%pZero(2) = -InputFileData%X_HalfWidth + p%WaveField%GridParams%pZero(3) = -InputFileData%Y_HalfWidth + p%WaveField%GridParams%pZero(4) = -InputFileData%Z_Depth ! zi + p%WaveField%GridParams%Z_Depth = InputFileData%Z_Depth IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! From e1577b37b82781519d6c39db2b27bd76364d813d Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Mon, 12 Feb 2024 15:10:40 -0700 Subject: [PATCH 199/232] Update CTestList.cmake with new r-tests added through https://github.com/OpenFAST/r-test/pull/120 --- reg_tests/CTestList.cmake | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 84117dc328..098698969c 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -394,16 +394,20 @@ bd_regression("bd_static_twisted_with_k1" "beamdyn;static") # HydroDyn regression tests hd_regression("hd_OC3tripod_offshore_fixedbottom_wavesirr" "hydrodyn;offshore") -#hd_regression("hd_5MW_ITIBarge_DLL_WTurb_WavesIrr" "hydrodyn;offshore") +#hd_regression("hd_5MW_ITIBarge_DLL_WTurb_WavesIrr" "hydrodyn;offshore") hd_regression("hd_5MW_OC3Spar_DLL_WTurb_WavesIrr" "hydrodyn;offshore") -#hd_regression("hd_5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "hydrodyn;offshore") +#hd_regression("hd_5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "hydrodyn;offshore") hd_regression("hd_5MW_OC4Semi_WSt_WavesWN" "hydrodyn;offshore") hd_regression("hd_5MW_TLP_DLL_WTurb_WavesIrr_WavesMulti" "hydrodyn;offshore") hd_regression("hd_TaperCylinderPitchMoment" "hydrodyn;offshore") hd_regression("hd_NBodyMod1" "hydrodyn;offshore") hd_regression("hd_NBodyMod2" "hydrodyn;offshore") hd_regression("hd_NBodyMod3" "hydrodyn;offshore") - +hd_regression("hd_MHstLMod2" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod0" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod1" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod2" "hydrodyn;offshore") +hd_regression("hd_MCF_WaveStMod3" "hydrodyn;offshore") # Py-HydroDyn regression tests py_hd_regression("py_hd_5MW_OC4Semi_WSt_WavesWN" "hydrodyn;offshore;python") @@ -441,7 +445,13 @@ py_ifw_regression("py_ifw_turbsimff" "inflowwind;python # SeaState regression tests seast_regression("seastate_1" "seastate") seast_regression("seastate_wavemod5" "seastate") +seast_regression("seastate_wavemod7" "seastate") seast_regression("seastate_wr_kin1" "seastate") +seast_regression("seastate_CNW1" "seastate") +seast_regression("seastate_CNW2" "seastate") +seast_regression("seastate_WaveStMod1" "seastate") +seast_regression("seastate_WaveStMod2" "seastate") +seast_regression("seastate_WaveStMod3" "seastate") # MoorDyn regression tests md_regression("md_5MW_OC4Semi" "moordyn") From 2da016d8042ee7bb671f4b0d872013a35655c16c Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Tue, 13 Feb 2024 12:54:02 -0700 Subject: [PATCH 200/232] Updated CTestList.cmake again --- reg_tests/CTestList.cmake | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 098698969c..f00d1e67bb 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -445,13 +445,12 @@ py_ifw_regression("py_ifw_turbsimff" "inflowwind;python # SeaState regression tests seast_regression("seastate_1" "seastate") seast_regression("seastate_wavemod5" "seastate") -seast_regression("seastate_wavemod7" "seastate") seast_regression("seastate_wr_kin1" "seastate") seast_regression("seastate_CNW1" "seastate") seast_regression("seastate_CNW2" "seastate") -seast_regression("seastate_WaveStMod1" "seastate") -seast_regression("seastate_WaveStMod2" "seastate") -seast_regression("seastate_WaveStMod3" "seastate") +seast_regression("seastate_WaveMod7_WaveStMod1" "seastate") +seast_regression("seastate_WaveMod7_WaveStMod2" "seastate") +seast_regression("seastate_WaveMod7_WaveStMod3" "seastate") # MoorDyn regression tests md_regression("md_5MW_OC4Semi" "moordyn") From 75eff1d17be47daf588da81cf77243a02d0e21e4 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Tue, 13 Feb 2024 17:20:36 -0700 Subject: [PATCH 201/232] Updated CTestList.cmake again --- reg_tests/CTestList.cmake | 3 +++ 1 file changed, 3 insertions(+) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index f00d1e67bb..cb6e46cefb 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -403,6 +403,9 @@ hd_regression("hd_TaperCylinderPitchMoment" "hydrodyn;offshore") hd_regression("hd_NBodyMod1" "hydrodyn;offshore") hd_regression("hd_NBodyMod2" "hydrodyn;offshore") hd_regression("hd_NBodyMod3" "hydrodyn;offshore") +hd_regression("hd_WaveStMod1" "hydrodyn;offshore") +hd_regression("hd_WaveStMod2" "hydrodyn;offshore") +hd_regression("hd_WaveStMod3" "hydrodyn;offshore") hd_regression("hd_MHstLMod2" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod0" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod1" "hydrodyn;offshore") From dffb1aa6c4807ada48ee66d31ce8954775f5cc8d Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Tue, 13 Feb 2024 18:05:13 -0700 Subject: [PATCH 202/232] Updated CTestList.cmake again --- reg_tests/CTestList.cmake | 2 ++ 1 file changed, 2 insertions(+) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index cb6e46cefb..9d7cb9abaf 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -407,6 +407,8 @@ hd_regression("hd_WaveStMod1" "hydrodyn;offshore") hd_regression("hd_WaveStMod2" "hydrodyn;offshore") hd_regression("hd_WaveStMod3" "hydrodyn;offshore") hd_regression("hd_MHstLMod2" "hydrodyn;offshore") +hd_regression("hd_MHstLMod1_compare" "hydrodyn;offshore") +hd_regression("hd_MHstLMod2_compare" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod0" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod1" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod2" "hydrodyn;offshore") From 8c60d791c86589cb2c3fafb8d085797a2082e407 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Wed, 14 Feb 2024 15:44:52 -0700 Subject: [PATCH 203/232] Backward compatibility for the AXIAL COEFFICIENTS section of the HydroDyn input file --- modules/hydrodyn/src/HydroDyn_Input.f90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index f7fc6b9b5a..4e4800c3ea 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -364,9 +364,19 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi END IF DO I = 1,InputFileData%Morison%NAxCoefs - ! read the table entries AxCoefID CdAx CaAx in the HydroDyn input file + ! read the table entries AxCoefID, AxCd, AxCa, AxCp, AxFdMod, AxVnCOff, AxFDLoFSc in the HydroDyn input file + ! Try reading in 7 entries first call ParseAry( FileInfo_In, CurLine, ' axial coefficients line '//trim( Int2LStr(I)), tmpReArray, size(tmpReArray), ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return; + if ( ErrStat2 /= 0 ) then ! Try reading in 5 entries + tmpReArray(6) = -1.0 ! AxVnCoff + tmpReArray(7) = 1.0 ! AxFDLoFSc + call ParseAry( FileInfo_In, CurLine, ' axial coefficients line '//trim( Int2LStr(I)), tmpReArray(1:5), 5, ErrStat2, ErrMsg2, UnEc ) + if ( ErrStat2 /= 0 ) then ! Try reading in 4 entries + tmpReArray(5) = 0.0 ! AxFdMod + call ParseAry( FileInfo_In, CurLine, ' axial coefficients line '//trim( Int2LStr(I)), tmpReArray(1:4), 4, ErrStat2, ErrMsg2, UnEc ) + if (Failed()) return; + end if + end if InputFileData%Morison%AxialCoefs(I)%AxCoefID = NINT(tmpReArray(1)) InputFileData%Morison%AxialCoefs(I)%AxCd = tmpReArray(2) InputFileData%Morison%AxialCoefs(I)%AxCa = tmpReArray(3) From 231afd9ac9e44ca31e0588c56ebea5ece528b391 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 14 Feb 2024 17:05:56 -0700 Subject: [PATCH 204/232] Add 3 linearization regression tests: - 5MW_Land_BD_Linear_Aero: BD + AD15 (based on 5MW_Land_BD_Linear, but with aero) - 5MW_Land_Linear_Aero: ED + AD15 (based on 5MW_Land_BD_Linear_Aero, but with ED) - 5MW_OC4Semi_MD_Linear: MD equivalent of 5MW_OC4Semi_Linear --- reg_tests/CTestList.cmake | 5 ++++- reg_tests/r-test | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 7fda42b586..ba662a8fa1 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -314,8 +314,11 @@ of_regression_linear("Fake5MW_AeroLin_B3_UA6" "openfast;linear;elastodyn" of_regression_linear("WP_Stationary_Linear" "openfast;linear;elastodyn") of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "openfast;linear;beamdyn") of_regression_linear("Ideal_Beam_Free_Free_Linear" "openfast;linear;beamdyn") +of_regression_linear("5MW_Land_Linear_Aero" "openfast;linear;elastodyn;servodyn;aerodyn") of_regression_linear("5MW_Land_BD_Linear" "openfast;linear;beamdyn;servodyn") -of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;servodyn") +of_regression_linear("5MW_Land_BD_Linear_Aero" "openfast;linear;beamdyn;servodyn;aerodyn") +of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;servodyn;map") +of_regression_linear("5MW_OC4Semi_MD_Linear" "openfast;linear;hydrodyn;servodyn;moordyn") of_regression_linear("StC_test_OC4Semi_Linear_Nac" "openfast;linear;servodyn;stc") of_regression_linear("StC_test_OC4Semi_Linear_Tow" "openfast;linear;servodyn;stc") diff --git a/reg_tests/r-test b/reg_tests/r-test index b63e928023..f4d94ce8d9 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit b63e9280234c2fb5695a37931d2329f3011e97ec +Subproject commit f4d94ce8d9685ff1b83d23008470a83c1842c381 From 7fee687722d5bffd79bd74b521ece00bd6cb806d Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 15 Feb 2024 13:27:38 -0700 Subject: [PATCH 205/232] Add linearization of OC3Spar case --- reg_tests/CTestList.cmake | 1 + reg_tests/r-test | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index ba662a8fa1..00d14710d8 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -321,6 +321,7 @@ of_regression_linear("5MW_OC4Semi_Linear" "openfast;linear;hydrodyn;se of_regression_linear("5MW_OC4Semi_MD_Linear" "openfast;linear;hydrodyn;servodyn;moordyn") of_regression_linear("StC_test_OC4Semi_Linear_Nac" "openfast;linear;servodyn;stc") of_regression_linear("StC_test_OC4Semi_Linear_Tow" "openfast;linear;servodyn;stc") +of_regression_linear("5MW_OC3Spar_Linear" "openfast;linear;map;hydrodyn") # FAST Farm regression tests if(BUILD_FASTFARM) diff --git a/reg_tests/r-test b/reg_tests/r-test index f4d94ce8d9..ad32005c11 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit f4d94ce8d9685ff1b83d23008470a83c1842c381 +Subproject commit ad32005c1176776a0d16cb10addd53744234b9b1 From 423ed815b49e9eaf324d7960855f3b86e2812741 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Fri, 16 Feb 2024 11:24:38 -0700 Subject: [PATCH 206/232] Upgrade to setup-python@v5 and cache@v4 for GH actions --- .github/workflows/automated-dev-tests.yml | 76 +++++++++++------------ 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 8c139019ab..5e0ca58038 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -39,7 +39,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -74,7 +74,7 @@ jobs: run: | cmake --build . --target all - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-all-debug-${{ github.sha }} @@ -125,7 +125,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -157,7 +157,7 @@ jobs: run: | cmake --build . --target regression_test_module_drivers - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-drivers-release-${{ github.sha }} @@ -171,7 +171,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -209,7 +209,7 @@ jobs: working-directory: ${{runner.workspace}}/openfast/build run: cmake --build . --target openfast_postlib - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} @@ -220,12 +220,12 @@ jobs: needs: build-postlib-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -247,7 +247,7 @@ jobs: run: | cmake --build . --target openfastlib openfast_cpp_driver openfastcpp aerodyn_inflow_c_binding moordyn_c_binding ifw_c_binding hydrodyn_c_binding regression_test_controllers - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-interfaces-release-${{ github.sha }} @@ -258,12 +258,12 @@ jobs: needs: build-postlib-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -285,7 +285,7 @@ jobs: run: | cmake --build . --target openfast - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} @@ -296,12 +296,12 @@ jobs: needs: build-postlib-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -323,7 +323,7 @@ jobs: run: | cmake --build . --target FAST.Farm - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-fastfarm-release-${{ github.sha }} @@ -341,7 +341,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -398,12 +398,12 @@ jobs: needs: build-drivers-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-drivers-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -454,12 +454,12 @@ jobs: needs: build-all-debug steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-all-debug-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -513,12 +513,12 @@ jobs: needs: build-interfaces-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-interfaces-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -561,12 +561,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -614,12 +614,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -664,12 +664,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -714,12 +714,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -764,12 +764,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -814,12 +814,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -864,12 +864,12 @@ jobs: needs: build-openfast-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -914,12 +914,12 @@ jobs: needs: build-fastfarm-release steps: - name: Cache the workspace - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{runner.workspace}} key: build-fastfarm-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' From fdf86428c9242a45bb5e93f7590e6e52f2f15b32 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 14:51:04 +0000 Subject: [PATCH 207/232] Update fast_linearization_file.py to use less memory Specify using np.float32 where possible in reading the linearization file. Also use np.float64 instead of float for matrices. Read matrices with genfromtxt instead of line by line --- reg_tests/lib/fast_linearization_file.py | 32 ++++++++++++------------ 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/reg_tests/lib/fast_linearization_file.py b/reg_tests/lib/fast_linearization_file.py index 3606e6699f..bda25b1ba2 100644 --- a/reg_tests/lib/fast_linearization_file.py +++ b/reg_tests/lib/fast_linearization_file.py @@ -84,17 +84,17 @@ def readOP(fid, n, name=''): OP=[] Var = {'RotatingFrame': [], 'DerivativeOrder': [], 'Description': []} colNames=fid.readline().strip() - dummy= fid.readline().strip() + fid.readline().strip() bHasDeriv= colNames.find('Derivative Order')>=0 for i, line in enumerate(fid): - sp=line.strip().split() - if sp[1].find(',')>=0: + sp = line.strip().split() + if sp[1].find(',') >= 0: # Most likely this OP has three values (e.g. orientation angles) # For now we discard the two other values - OP.append(float(sp[1][:-1])) + OP.append(np.float32(sp[1][:-1])) iRot=4 else: - OP.append(float(sp[1])) + OP.append(np.float32(sp[1])) iRot=2 Var['RotatingFrame'].append(sp[iRot]) if bHasDeriv: @@ -109,23 +109,23 @@ def readOP(fid, n, name=''): return OP, Var def readMat(fid, n, m, name=''): - pattern = re.compile(r"[\*]+") - vals=[pattern.sub(' inf ', fid.readline().strip() ).split() for i in np.arange(n)] - vals = np.array(vals) + + # Read rows from file, raise exception on failure try: - vals = np.array(vals).astype(float) # This could potentially fail + vals = np.genfromtxt(fid, dtype=np.float64, max_rows=n) except: raise Exception('Failed to convert into an array of float the matrix `{}`\n\tin linfile: {}'.format(name, self.filename)) + + # Raise exception if actual matrix shape does not match expected shape if vals.shape[0]!=n or vals.shape[1]!=m: shape1 = vals.shape shape2 = (n,m) raise Exception('Shape of matrix `{}` has wrong dimension ({} instead of {})\n\tin linfile: {}'.format(name, shape1, shape2, name, self.filename)) - nNaN = sum(np.isnan(vals.ravel())) - nInf = sum(np.isinf(vals.ravel())) - if nInf>0: + # Raise exceptions if any elements are NaN or infinity + if np.any(np.isnan(vals.ravel())): raise Exception('Some ill-formated/infinite values (e.g. `*******`) were found in the matrix `{}`\n\tin linflile: {}'.format(name, self.filename)) - if nNaN>0: + if np.any(np.isinf(vals.ravel())): raise Exception('Some NaN values were found in the matrix `{}`\n\tin linfile: `{}`.'.format(name, self.filename)) return vals @@ -142,15 +142,15 @@ def readMat(fid, n, m, name=''): ny = int(extractVal(self['header'],'Number of outputs:' )) bJac = extractVal(self['header'],'Jacobians included in this file?') try: - self['Azimuth'] = float(extractVal(self['header'],'Azimuth:')) + self['Azimuth'] = np.float32(extractVal(self['header'],'Azimuth:')) except: self['Azimuth'] = None try: - self['RotSpeed'] = float(extractVal(self['header'],'Rotor Speed:')) # rad/s + self['RotSpeed'] = np.float32(extractVal(self['header'],'Rotor Speed:')) # rad/s except: self['RotSpeed'] = None try: - self['WindSpeed'] = float(extractVal(self['header'],'Wind Speed:')) + self['WindSpeed'] = np.float32(extractVal(self['header'],'Wind Speed:')) except: self['WindSpeed'] = None From 73e66a90c537e5f6423b4adaa99e148e7fa0f091 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 14:52:42 +0000 Subject: [PATCH 208/232] Use env var to set CTest parallel runs, reduce to 2 Previously the number of parallel threads in CTest was set via the -j flag. This changes it to use an environment variable set at the top of the file. The number of parallel tests was reduced from 4 to 2 as the linearization tests were failing from lack of memory. This may need to be adjusted. --- .github/workflows/automated-dev-tests.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 8c139019ab..1e2c595024 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -21,6 +21,7 @@ env: C_COMPILER: gcc-12 GCOV_EXE: gcov-12 CMAKE_BUILD_PARALLEL_LEVEL: 8 + CTEST_PARALLEL_LEVEL: 2 jobs: @@ -589,7 +590,7 @@ jobs: - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -j4 \ + ctest -VV \ -L openfast \ -LE "cpp|linear|python|fastlib" \ -E "5MW_OC4Semi_WSt_WavesWN|5MW_OC3Mnpl_DLL_WTurb_WavesIrr|5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth|5MW_OC3Trpd_DLL_WSt_WavesReg|5MW_Land_BD_DLL_WTurb" @@ -892,7 +893,7 @@ jobs: - name: Run OpenFAST linearization tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -j4 -L linear + ctest -VV -L linear - name: Failing test artifacts uses: actions/upload-artifact@v3 if: failure() From 577aded77fe0b0193a8e2f7f50ec720bdc3f3cfd Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 14:55:00 +0000 Subject: [PATCH 209/232] Use more efficient method to compare linearization matrices in regression tests. The previous method looped over each element and checked to see if it was within tolerance of the reference. This does the compare for the full matrices and then iterates over the element indices which were not within tolerance. This should significantly reduce the time to do the comparison for large matrices. Also prints out the row/column variables which correspond to that element. --- .../executeOpenfastLinearRegressionCase.py | 72 +++++++++++-------- 1 file changed, 41 insertions(+), 31 deletions(-) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 2e88bd67e4..e681c0d264 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -263,40 +263,50 @@ def indent(msg, sindent='\t'): # --- Compare individual matrices/vectors - KEYS= ['A','B','C','D','dUdu','dUdy'] - KEYS+=['x','y','u','xdot'] + KEYS = ['A','B','C','D','dUdu','dUdy', 'x','y','u','xdot'] for k,v in fbas.items(): - if k in KEYS and v is not None: - if verbose: - print(CasePrefix+'key:', k) - # Arrays - Mloc=np.atleast_2d(floc[k]) - Mbas=np.atleast_2d(fbas[k]) - - # --- Compare dimensions + if k not in KEYS or v is None: + continue + if verbose: + print(CasePrefix+'key:', k) + # Arrays + Mloc=np.atleast_2d(floc[k]) + Mbas=np.atleast_2d(fbas[k]) + + # --- Compare dimensions + try: + np.testing.assert_equal(Mloc.shape, Mbas.shape) + except Exception as e: + Err = 'Different dimensions for variable `{k}`.\n' + Err += f'\tNew:{Mloc.shape}\n' + Err += f'\tRef:{Mbas.shape}\n' + Err += f'\tLinfile: {local_file}.\n' + raise Exception(Err) + + # Get boolean matrix where Mloc is within tolerance of Mbas + M_in_tol = np.isclose(Mloc, Mbas, rtol=rtol, atol=atol) + + # Loop through elements where Mloc is not within tolerance of Mbas + # Retest to get error message + for n, (i,j) in enumerate(zip(*np.where(M_in_tol == False)), 1): try: - np.testing.assert_equal(Mloc.shape, Mbas.shape) + np.testing.assert_allclose(Mloc[i,j], Mbas[i,j], rtol=rtol, atol=atol) except Exception as e: - Err = 'Different dimensions for variable `{}`.\n'.format(k) - Err+= '\tNew:{}\n'.format(Mloc.shape) - Err+= '\tRef:{}\n'.format(Mbas.shape) - Err+= '\tLinfile: {}.\n'.format(local_file) - raise Exception(Err) - - - # We for loop below to get the first element that mismatch - # Otherwise, do: np.testing.assert_allclose(floc[k], fbas[k], rtol=rtol, atol=atol) - for i in range(Mbas.shape[0]): - for j in range(Mbas.shape[1]): - # Old method: - #if not isclose(Mloc[i,j], Mbas[i,j], rtol=rtol, atol=atol): - # sElem = 'Element [{},{}], new : {}, baseline: {}'.format(i+1,j+1,Mloc[i,j], Mbas[i,j]) - # raise Exception('Failed to compare variable `{}`, {} \n\tLinfile: {}.'.format(k, sElem, local_file)) #, e.args[0])) - try: - np.testing.assert_allclose(Mloc[i,j], Mbas[i,j], rtol=rtol, atol=atol) - except Exception as e: - sElem = 'Element [{},{}], new : {}, baseline: {}'.format(i+1,j+1,Mloc[i,j], Mbas[i,j]) - raise Exception('Failed to compare variable `{}`, {} \n\tLinfile: {}.\n\tException: {}'.format(k, sElem, local_file, indent(e.args[0]))) + sElem = f'Element [{i+1},{j+1}], new: {Mloc[i,j]}, baseline: {Mbas[i,j]}' + if k in ['dXdx', 'A', 'dXdu', 'B']: + sElem += '\n row:', fbas['x_info']['Description'][i] + if k in ['dYdx', 'C', 'dYdu', 'D']: + sElem += '\n row:', fbas['y_info']['Description'][i] + if k in ['dUdu', 'dUdy']: + sElem += '\n row:', fbas['u_info']['Description'][i] + if k in ['dXdx', 'A', 'dYdx', 'C']: + sElem += '\n col:', fbas['x_info']['Description'][j] + if k in ['dXdu', 'B', 'dYdu', 'D', 'dUdu']: + sElem += '\n col:', fbas['u_info']['Description'][j] + if k in ['dUdy']: + sElem += '\n col:', fbas['y_info']['Description'][j] + raise Exception('Failed to compare matrix `{}`, {} \n\tLinfile: {}.\n\tException: {}'.format(k, sElem, local_file, indent(e.args[0]))) + except Exception as e: exitWithError(e.args[0]) From 7f49d462d98b2955a85e88886432cab82fc1cd1d Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 16:00:34 +0000 Subject: [PATCH 210/232] Fix printing bug in Python Linear Regression test script --- .../executeOpenfastLinearRegressionCase.py | 28 +++++++++---------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index e681c0d264..289abe292c 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -237,22 +237,20 @@ def indent(msg, sindent='\t'): else: #if verbose: - print(CasePrefix+'freq_ref:', np.around(freq_bas[:8] ,5), '[Hz]') - print(CasePrefix+'freq_new:', np.around(freq_loc[:8] ,5),'[Hz]') - print(CasePrefix+'damp_ref:', np.around(zeta_bas[:8]*100,5), '[%]') - print(CasePrefix+'damp_new:', np.around(zeta_loc[:8]*100,5), '[%]') + print(CasePrefix+'freq_ref:', np.around(freq_bas[:10] ,5), '[Hz]') + print(CasePrefix+'freq_new:', np.around(freq_loc[:10] ,5), '[Hz]') + print(CasePrefix+'damp_ref:', np.around(zeta_bas[:10]*100,5), '[%]') + print(CasePrefix+'damp_new:', np.around(zeta_loc[:10]*100,5), '[%]') try: np.testing.assert_allclose(freq_loc[:10], freq_bas[:10], rtol=rtol_f, atol=atol_f) except Exception as e: raise Exception('Failed to compare A-matrix frequencies\n\tLinfile: {}.\n\tException: {}'.format(local_file, indent(e.args[0]))) - if caseName=='Ideal_Beam_Free_Free_Linear': - # The free-free case is a bit weird, smae frequencies but dampings are +/- a value - zeta_loc=np.abs(zeta_loc) - zeta_bas=np.abs(zeta_bas) - + # The free-free case is a bit weird, same frequencies but damping values are +/- a value + zeta_loc = np.abs(zeta_loc) + zeta_bas = np.abs(zeta_bas) try: # Note: damping ratios in [%] @@ -294,17 +292,17 @@ def indent(msg, sindent='\t'): except Exception as e: sElem = f'Element [{i+1},{j+1}], new: {Mloc[i,j]}, baseline: {Mbas[i,j]}' if k in ['dXdx', 'A', 'dXdu', 'B']: - sElem += '\n row:', fbas['x_info']['Description'][i] + sElem += '\n\t\t row: ' + fbas['x_info']['Description'][i] if k in ['dYdx', 'C', 'dYdu', 'D']: - sElem += '\n row:', fbas['y_info']['Description'][i] + sElem += '\n\t\t row: ' + fbas['y_info']['Description'][i] if k in ['dUdu', 'dUdy']: - sElem += '\n row:', fbas['u_info']['Description'][i] + sElem += '\n\t\t row: ' + fbas['u_info']['Description'][i] if k in ['dXdx', 'A', 'dYdx', 'C']: - sElem += '\n col:', fbas['x_info']['Description'][j] + sElem += '\n\t\t col: ' + fbas['x_info']['Description'][j] if k in ['dXdu', 'B', 'dYdu', 'D', 'dUdu']: - sElem += '\n col:', fbas['u_info']['Description'][j] + sElem += '\n\t\t col: ' + fbas['u_info']['Description'][j] if k in ['dUdy']: - sElem += '\n col:', fbas['y_info']['Description'][j] + sElem += '\n\t\t col: ' + fbas['y_info']['Description'][j] raise Exception('Failed to compare matrix `{}`, {} \n\tLinfile: {}.\n\tException: {}'.format(k, sElem, local_file, indent(e.args[0]))) From 7fdf58017f7b94af7b83864093a3dce59d4e39bb Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 19 Feb 2024 09:32:19 -0700 Subject: [PATCH 211/232] GH actions: upgrade upload-artifact to v4 This will prevent warnings about node 16 deprecation --- .github/workflows/automated-dev-tests.yml | 24 +++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 1e2c595024..68c9c3ec96 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -383,7 +383,7 @@ jobs: ctest -VV -R "^ua_" - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-uadriver @@ -442,7 +442,7 @@ jobs: - name: Run SubDyn tests uses: ./.github/actions/tests-module-subdyn - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-module-drivers @@ -500,7 +500,7 @@ jobs: - name: Run VersionInfo tests uses: ./.github/actions/tests-module-version - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-modules-debug @@ -543,7 +543,7 @@ jobs: run: | ctest -VV -L "cpp|python|fastlib" - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-interfaces @@ -595,7 +595,7 @@ jobs: -LE "cpp|linear|python|fastlib" \ -E "5MW_OC4Semi_WSt_WavesWN|5MW_OC3Mnpl_DLL_WTurb_WavesIrr|5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth|5MW_OC3Trpd_DLL_WSt_WavesReg|5MW_Land_BD_DLL_WTurb" - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF @@ -645,7 +645,7 @@ jobs: run: | ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC4Semi_WSt_WavesWN - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF-5MW_OC4Semi_WSt_WavesWN @@ -695,7 +695,7 @@ jobs: run: | ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC3Mnpl_DLL_WTurb_WavesIrr - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF-5MW_OC3Mnpl_DLL_WTurb_WavesIrr @@ -745,7 +745,7 @@ jobs: run: | ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF-5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth @@ -795,7 +795,7 @@ jobs: run: | ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_OC3Trpd_DLL_WSt_WavesReg - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF-5MW_OC3Trpd_DLL_WSt_WavesReg @@ -845,7 +845,7 @@ jobs: run: | ctest -VV -L openfast -LE "cpp|linear|python" -R 5MW_Land_BD_DLL_WTurb - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF-5MW_Land_BD_DLL_WTurb @@ -895,7 +895,7 @@ jobs: run: | ctest -VV -L linear - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-OF-linearization @@ -947,7 +947,7 @@ jobs: set OMP_NUM_THREADS=2 ctest -VV -L fastfarm --verbose - name: Failing test artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: failure() with: name: rtest-FF From 44146020d1eaf7f60b6267c7e0e3f839be456747 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 16:38:16 +0000 Subject: [PATCH 212/232] Fix bug in HD_Perturb_x where SS_Exctn%numStates was used instead of SS_Rdtn%numStates This also moves to a simpler scheme that just checks if the perturbation index 'n' is equal to the current value index 'k' --- modules/hydrodyn/src/HydroDyn.f90 | 42 ++++++++++++++----------------- 1 file changed, 19 insertions(+), 23 deletions(-) diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 86d5b0927c..65c012d0a9 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -3567,39 +3567,35 @@ SUBROUTINE HD_Perturb_x( p, n, perturb_sign, x, dx ) ! local variables - integer(intKi) :: i, offset1, offset2, n2 + integer(intKi) :: i, j, k if ( p%totalStates == 0 ) return !Note: All excitation states for all bodies are stored 1st, then all radiation states dx = p%dx(n) - offset1 = 1 - if ( n <= p%totalExctnStates ) then - - ! Find body index for exctn states - do i=1,p%nWAMITObj - offset2 = offset1 + p%WAMIT(i)%SS_Exctn%numStates - if ( n >= offset1 .and. n < offset2) then - n2 = n - offset1 + 1 - x%WAMIT(i)%SS_Exctn%x( n2 ) = x%WAMIT(i)%SS_Exctn%x( n2 ) + dx * perturb_sign - exit + k = 1 + + ! Find body index for exctn states + do i = 1, p%nWAMITObj + do j = 1, p%WAMIT(i)%SS_Exctn%numStates + if (n == k) then + x%WAMIT(i)%SS_Exctn%x(j) = x%WAMIT(i)%SS_Exctn%x(j) + dx * perturb_sign + return end if - offset1 = offset2 + k = k + 1 end do + end do - else - offset1 = p%totalExctnStates + 1 - ! Find body index for rdtn states - do i=1,p%nWAMITObj - offset2 = offset1 + p%WAMIT(i)%SS_Exctn%numStates - if ( n >= offset1 .and. n < offset2) then - n2 = n - offset1 + 1 - x%WAMIT(i)%SS_Rdtn%x( n2 ) = x%WAMIT(i)%SS_Rdtn%x( n2 ) + dx * perturb_sign - exit + ! Find body index for rdtn states + do i = 1, p%nWAMITObj + do j = 1, p%WAMIT(i)%SS_Rdtn%numStates + if (n == k) then + x%WAMIT(i)%SS_Rdtn%x(j) = x%WAMIT(i)%SS_Rdtn%x(j) + dx * perturb_sign + return end if - offset1 = offset2 + k = k + 1 end do - end if + end do END SUBROUTINE HD_Perturb_x From 07d608a1f61d24fcd0c05778e395e7a79275cc6f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 17:36:07 +0000 Subject: [PATCH 213/232] GH actions: upgrade checkout to v4 and setup-python to v5 --- .github/workflows/automated-dev-tests.yml | 46 +++++++++++------------ 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 68c9c3ec96..fad27ad793 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -36,11 +36,11 @@ jobs: runs-on: ubuntu-22.04 steps: - name: Checkout - uses: actions/checkout@main + uses: actions/checkout@v4 with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -87,7 +87,7 @@ jobs: runs-on: ubuntu-22.04 steps: - name: Checkout - uses: actions/checkout@main + uses: actions/checkout@v4 with: submodules: recursive - name: Install dependencies @@ -122,11 +122,11 @@ jobs: runs-on: ubuntu-22.04 steps: - name: Checkout - uses: actions/checkout@main + uses: actions/checkout@v4 with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -168,11 +168,11 @@ jobs: runs-on: ubuntu-22.04 steps: - name: Checkout - uses: actions/checkout@main + uses: actions/checkout@v4 with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -226,7 +226,7 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -264,7 +264,7 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -302,7 +302,7 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -338,11 +338,11 @@ jobs: runs-on: ubuntu-22.04 steps: - name: Checkout - uses: actions/checkout@main + uses: actions/checkout@v4 with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -404,7 +404,7 @@ jobs: path: ${{runner.workspace}} key: build-drivers-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -460,7 +460,7 @@ jobs: path: ${{runner.workspace}} key: build-all-debug-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -519,7 +519,7 @@ jobs: path: ${{runner.workspace}} key: build-interfaces-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -567,7 +567,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -620,7 +620,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -670,7 +670,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -720,7 +720,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -770,7 +770,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -820,7 +820,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -870,7 +870,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' @@ -920,7 +920,7 @@ jobs: path: ${{runner.workspace}} key: build-fastfarm-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v5 with: python-version: '3.11' cache: 'pip' From 158459facb18dd1acdeb3821bbfd4a81c2cb2d62 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Mon, 19 Feb 2024 17:59:51 +0000 Subject: [PATCH 214/232] Update regression test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index ad32005c11..e281d0529e 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit ad32005c1176776a0d16cb10addd53744234b9b1 +Subproject commit e281d0529e10086f1ad3a2a7da8514d56bf8be84 From 5f1760fbba9fddddf38cecd29fd08b5cbf886df6 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Fri, 26 Jan 2024 12:17:02 -0700 Subject: [PATCH 215/232] Remove typo in warning, retains c/con option for output flags for backwards compatibility --- modules/moordyn/src/MoorDyn_IO.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 144a355ff6..c13a65003b 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -563,7 +563,7 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) END IF ! Point case - ELSE IF (let1(1:1) == 'P') THEN ! Look for P?xxx or Point?xxx + ELSE IF (let1(1:1) == 'P' .OR. let1(1:1) == 'C') THEN ! Look for P?xxx or Point?xxx (C?xxx and Con?xxx for backwards compatability) p%OutParam(I)%OType = 2 ! Point object type qVal = let2 ! quantity type string @@ -601,7 +601,7 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) ! error ELSE CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid - CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Must start with L, C, R, or B') + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Must start with L, R, or B') CYCLE END IF From 4c664a09d36b8a6a92aa647b34a7de800f2e0a67 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 29 Jan 2024 09:37:09 -0700 Subject: [PATCH 216/232] Bathymetry grid bug fix --- modules/moordyn/src/MoorDyn_IO.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index c13a65003b..b03c24bb9e 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -182,7 +182,7 @@ SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, Bat READ(UnCoef,*,IOSTAT=ErrStat4) nGridY_string, nGridY ! read in the third line as the number of y values in the BathGrid ! Allocate the bathymetry matrix and associated grid x and y values - ALLOCATE(BathGrid(nGridX, nGridY), STAT=ErrStat4) + ALLOCATE(BathGrid(nGridY, nGridX), STAT=ErrStat4) ALLOCATE(BathGrid_Xs(nGridX), STAT=ErrStat4) ALLOCATE(BathGrid_Ys(nGridY), STAT=ErrStat4) From ad169900542f15b9541f00f6fa0d170cef07a599 Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Mon, 29 Jan 2024 12:42:27 -0700 Subject: [PATCH 217/232] Bathymetry grid slope normal vector bug fix --- modules/moordyn/src/MoorDyn_Misc.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index 3f52dfc16e..b3a652a3a3 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -883,7 +883,7 @@ SUBROUTINE getDepthFromBathymetry(BathymetryGrid, BathGrid_Xs, BathGrid_Ys, Line else dc_dx = 0.0_DbKi ! maybe this should raise an error end if - if ( dx > 0.0 ) then + if ( dy > 0.0 ) then dc_dy = (cx1-cx0)/dy else dc_dy = 0.0_DbKi ! maybe this should raise an error From 26f5a490faad3acb9ca34832ea349c7d350d8a2e Mon Sep 17 00:00:00 2001 From: RyanDavies19 Date: Tue, 30 Jan 2024 16:03:13 -0700 Subject: [PATCH 218/232] Change input string size for bathgrid and waterkin --- modules/moordyn/src/MoorDyn_IO.f90 | 2 +- modules/moordyn/src/MoorDyn_Misc.f90 | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index b03c24bb9e..caad8b3b15 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -139,7 +139,7 @@ SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, Bat INTEGER(IntKi) :: ErrStat4 CHARACTER(120) :: ErrMsg4 - CHARACTER(120) :: Line2 + CHARACTER(4096) :: Line2 CHARACTER(20) :: nGridX_string ! string to temporarily hold the nGridX string from Line2 CHARACTER(20) :: nGridY_string ! string to temporarily hold the nGridY string from Line3 diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index b3a652a3a3..82252d1258 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1297,8 +1297,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) REAL(SiKi) :: t, Frac CHARACTER(1024) :: FileName ! Name of MoorDyn input file CHARACTER(120) :: Line - CHARACTER(120) :: Line2 - CHARACTER(120) :: entries2 + CHARACTER(4096) :: entries2 INTEGER(IntKi) :: coordtype INTEGER(IntKi) :: NStepWave ! From e59b016433f88f091c4bfe921cfa8fcf1ad7fc67 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Mon, 19 Feb 2024 13:14:12 -0700 Subject: [PATCH 219/232] HD Bug Fix associated with ExctnDisp=2 Fixed the following problems: * HD driver seg fault when ExctnDisp=2 * Filtered WAMIT body position used in WAMIT_CalcOutput lags by one time step --- modules/hydrodyn/src/WAMIT.f90 | 29 +++++------------------------ 1 file changed, 5 insertions(+), 24 deletions(-) diff --git a/modules/hydrodyn/src/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index d73dd5c2c3..e256247382 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -1565,7 +1565,7 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval - TYPE(WAMIT_InputType), INTENT(IN ) :: Inputs(:) !< Inputs at InputTimes + TYPE(WAMIT_InputType), INTENT(INOUT) :: Inputs(:) !< Inputs at InputTimes REAL(DbKi), INTENT(IN ) :: InputTimes(:) !< Times in seconds associated with Inputs TYPE(WAMIT_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: x !< Input: Continuous states at t; @@ -1598,7 +1598,6 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState TYPE(SS_Rad_InputType), ALLOCATABLE :: SS_Rdtn_u(:) ! Inputs TYPE(SS_Exc_InputType), ALLOCATABLE :: SS_Exctn_u(:) ! Inputs - TYPE(WAMIT_InputType), ALLOCATABLE :: WAMIT_u(:) ! Inputs TYPE(WAMIT_InputType) :: WAMIT_u_t @@ -1669,23 +1668,9 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState END IF IF ( (p%ExctnMod>0).AND.(p%ExctnDisp==2) ) THEN - ALLOCATE( WAMIT_u(nTime), STAT = ErrStat ) - IF (ErrStat /=0) THEN - ErrMsg = ' Failed to allocate array WAMIT_u.' - RETURN - END IF - DO I=1,nTime - ALLOCATE( WAMIT_u(I)%Mesh%TranslationDisp(3,p%NBody), STAT = ErrStat ) - IF (ErrStat /=0) THEN - ErrMsg = ' Failed to allocate array WAMIT_u(I)%Mesh%TranslationDisp.' - RETURN - END IF - DO iBody=1,p%NBody - WAMIT_u(I)%Mesh%TranslationDisp(:,iBody) = Inputs(I)%Mesh%TranslationDisp(:,iBody) - END DO - END DO ! Interpolate WAMIT input at time t+dt - CALL WAMIT_Input_ExtrapInterp(WAMIT_u, InputTimes, WAMIT_u_t, t+p%dt, ErrStat, ErrMsg) + CALL WAMIT_CopyInput(Inputs(1), WAMIT_u_t, MESH_NEWCOPY, ErrStat, ErrMsg) + CALL WAMIT_Input_ExtrapInterp(Inputs, InputTimes, WAMIT_u_t, t+p%dt, ErrStat, ErrMsg) DO iBody = 1,p%NBody ! Current unfiltered body position at time t+dt bodyPosition(1) = WAMIT_u_t%Mesh%TranslationDisp(1,iBody) @@ -1697,10 +1682,6 @@ SUBROUTINE WAMIT_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState xd%BdyPosFilt(2,iBody,1) = p%ExctnFiltConst * xd%BdyPosFilt(2,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * bodyPosition(2) END DO CALL WAMIT_DestroyInput( WAMIT_u_t, ErrStat, ErrMsg) - DO I=1,nTime - CALL WAMIT_DestroyInput( WAMIT_u(I), ErrStat, ErrMsg) - END DO - DEALLOCATE(WAMIT_u) END IF IF ( p%ExctnMod == 2 ) THEN ! Update the state-space wave excitation sub-module's states @@ -1835,8 +1816,8 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er bodyPosition(2) = u%Mesh%TranslationDisp(2,iBody) ELSE IF ( p%ExctnDisp == 2 ) THEN ! Use filtered body position - bodyPosition(1) = xd%BdyPosFilt(1,iBody,1) - bodyPosition(2) = xd%BdyPosFilt(2,iBody,1) + bodyPosition(1) = p%ExctnFiltConst * xd%BdyPosFilt(1,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * u%Mesh%TranslationDisp(1,iBody) + bodyPosition(2) = p%ExctnFiltConst * xd%BdyPosFilt(2,iBody,1) + (1.0_ReKi - p%ExctnFiltConst) * u%Mesh%TranslationDisp(2,iBody) END IF iStart = (iBody-1)*6+1 ! WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for each WAMIT Body From fe87ebfcf6abb5599745010bbf85c94dc3b2c2d0 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Mon, 19 Feb 2024 13:17:50 -0700 Subject: [PATCH 220/232] Updated CTestList.cmake again with additional regression tests for ExctnDisp=1 and ExctnDisp=2 with ExctnMod=1 --- reg_tests/CTestList.cmake | 2 ++ 1 file changed, 2 insertions(+) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 9d7cb9abaf..de1d33f7ed 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -413,6 +413,8 @@ hd_regression("hd_MCF_WaveStMod0" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod1" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod2" "hydrodyn;offshore") hd_regression("hd_MCF_WaveStMod3" "hydrodyn;offshore") +hd_regression("hd_ExctnMod1_ExctnDisp1" "hydrodyn;offshore") +hd_regression("hd_ExctnMod1_ExctnDisp2" "hydrodyn;offshore") # Py-HydroDyn regression tests py_hd_regression("py_hd_5MW_OC4Semi_WSt_WavesWN" "hydrodyn;offshore;python") From 26515842501302b299621afe4eb75f859da6084d Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Mon, 19 Feb 2024 21:29:40 -0700 Subject: [PATCH 221/232] Add r-test pointer --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index ae1afd59f3..81529c446d 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit ae1afd59f3d82971c5e53bbe9960a8c588d64fb1 +Subproject commit 81529c446d9b494ee64a3d8f78317b2ee48f59de From 517ad58c21d59ee100466deaf54225bf1b77dc22 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Mon, 4 Mar 2024 16:53:54 -0700 Subject: [PATCH 222/232] HD bug fixes to the inertial loads from marine growth and ballast water on strip-theory members * There should not be a parallel-axis correction to the axial component of the marine-growth/ballast-water moment of inertia. * The matrix Imat used to rotate the moment of inertia to the earth-fixed system was not properly zeroed for each node. --- modules/hydrodyn/src/Morison.f90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index bd5533dda4..e3b5b8073b 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2715,9 +2715,10 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! lower node Ioffset = mem%h_cmg_l(i)*mem%h_cmg_l(i)*mem%m_mg_l(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rmg_l(i) - Ioffset Imat(2,2) = mem%I_rmg_l(i) - Ioffset - Imat(3,3) = mem%I_lmg_l(i) - Ioffset + Imat(3,3) = mem%I_lmg_l(i) Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cmg_l(i) * k_hat iTerm = ( -a_s1 - cross_product(omega_s1, cross_product(omega_s1,iArm )) - cross_product(alpha_s1,iArm) ) * mem%m_mg_l(i) @@ -2730,9 +2731,10 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! upper node Ioffset = mem%h_cmg_u(i)*mem%h_cmg_u(i)*mem%m_mg_u(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rmg_u(i) - Ioffset Imat(2,2) = mem%I_rmg_u(i) - Ioffset - Imat(3,3) = mem%I_lmg_u(i) - Ioffset + Imat(3,3) = mem%I_lmg_u(i) Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cmg_u(i) * k_hat iTerm = ( -a_s2 - cross_product(omega_s2, cross_product(omega_s2,iArm )) - cross_product(alpha_s2,iArm) ) * mem%m_mg_u(i) @@ -2828,9 +2830,10 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! ------------------ flooded ballast inertia: sides: Section 6.1.1 : Always compute regardless of PropPot setting --------------------- ! lower node Ioffset = mem%h_cfb_l(i)*mem%h_cfb_l(i)*mem%m_fb_l(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rfb_l(i) - Ioffset Imat(2,2) = mem%I_rfb_l(i) - Ioffset - Imat(3,3) = mem%I_lfb_l(i) - Ioffset + Imat(3,3) = mem%I_lfb_l(i) iArm = mem%h_cfb_l(i) * k_hat iTerm = ( -a_s1 - cross_product(omega_s1, cross_product(omega_s1,iArm )) - cross_product(alpha_s1,iArm) ) * mem%m_fb_l(i) F_If(1:3) = iTerm @@ -2842,9 +2845,10 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! upper node Ioffset = mem%h_cfb_u(i)*mem%h_cfb_u(i)*mem%m_fb_u(i) + Imat = 0.0_ReKi Imat(1,1) = mem%I_rfb_u(i) - Ioffset Imat(2,2) = mem%I_rfb_u(i) - Ioffset - Imat(3,3) = mem%I_lfb_u(i) - Ioffset + Imat(3,3) = mem%I_lfb_u(i) iArm = mem%h_cfb_u(i) * k_hat iTerm = ( -a_s2 - cross_product(omega_s2, cross_product(omega_s2,iArm )) - cross_product(alpha_s2,iArm) ) * mem%m_fb_u(i) F_If(1:3) = iTerm From 57c1b5c67b73d84f135f5b813df4794fe9225ea6 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Mar 2024 10:04:47 -0700 Subject: [PATCH 223/232] SeaSt Vis: corrections to PR #1992 A few minor issues were noted with PR #1992 after it was merged. Co-authored-by: bjonkman --- modules/openfast-library/src/FAST_Subs.f90 | 3 +-- modules/seastate/src/SeaState.txt | 2 +- modules/seastate/src/SeaState_Types.f90 | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2248343b26..f82ec22c6f 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -883,7 +883,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (allocated(Init%OutData_SeaSt%WaveElevVisGrid)) then p_FAST%VTK_surface%NWaveElevPts(1) = size(Init%OutData_SeaSt%WaveElevVisX) - p_FAST%VTK_surface%NWaveElevPts(2) = size(Init%OutData_SeaSt%WaveElevVisX) + p_FAST%VTK_surface%NWaveElevPts(2) = size(Init%OutData_SeaSt%WaveElevVisY) else p_FAST%VTK_surface%NWaveElevPts(1) = 0 p_FAST%VTK_surface%NWaveElevPts(2) = 0 @@ -4157,7 +4157,6 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_S !bjj: interpolate here instead of each time step? if ( allocated(InitOutData_SeaSt%WaveElevVisGrid) ) then -print*,'Storing Wave surface visualization' call move_alloc( InitOutData_SeaSt%WaveElevVisX, p_FAST%VTK_Surface%WaveElevVisX ) call move_alloc( InitOutData_SeaSt%WaveElevVisY, p_FAST%VTK_Surface%WaveElevVisY ) call move_alloc( InitOutData_SeaSt%WaveElevVisGrid,p_FAST%VTK_Surface%WaveElevVisGrid ) diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 5b50752f8a..455938b537 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -91,7 +91,7 @@ typedef ^ ^ CHARACTER(ChanLen) Wri typedef ^ ^ ProgDesc Ver - - - "Version of SeaState" typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SiKi WaveElevVisX {:} - - "X locations of grid output" "m,-" -typedef ^ ^ SiKi WaveElevVisY {:} - - "X locations of grid output" "m,-" +typedef ^ ^ SiKi WaveElevVisY {:} - - "Y locations of grid output" "m,-" typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 8f87fc33c4..f5d01aa62e 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -111,7 +111,7 @@ MODULE SeaState_Types TYPE(ProgDesc) :: Ver !< Version of SeaState [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisX !< X locations of grid output [m,-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< X locations of grid output [m,-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations of grid output [m,-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType From 84424899d6ad52e1f48e7ecdb82a786756c8bf48 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Mar 2024 15:13:35 -0700 Subject: [PATCH 224/232] GH actions: update matlab-actions version update matlab-actions from v1 to v2 node.js 16 is getting deprecated. Matlab-actions v2 uses node.js 20 --- .github/workflows/automated-dev-tests.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 17760a5dfa..00b2d8c70a 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -45,7 +45,7 @@ jobs: python-version: '3.11' cache: 'pip' - name: Set up MATLAB - uses: matlab-actions/setup-matlab@v1 + uses: matlab-actions/setup-matlab@v2 - name: Install dependencies run: | python -m pip install --upgrade pip @@ -180,7 +180,7 @@ jobs: python-version: '3.11' cache: 'pip' - name: Set up MATLAB - uses: matlab-actions/setup-matlab@v1 + uses: matlab-actions/setup-matlab@v2 - name: Install dependencies run: | python -m pip install --upgrade pip @@ -634,7 +634,7 @@ jobs: sudo apt-get update -y sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev libopenblas-dev libopenblas-openmp-dev - name: Set up MATLAB - uses: matlab-actions/setup-matlab@v1 + uses: matlab-actions/setup-matlab@v2 - name: Build FAST_SFunc working-directory: ${{runner.workspace}}/openfast/build run: | @@ -643,7 +643,7 @@ jobs: ${GITHUB_WORKSPACE} cmake --build . --target FAST_SFunc - name: Run MATLAB tests and generate artifacts - uses: matlab-actions/run-tests@v1 + uses: matlab-actions/run-tests@v2 with: source-folder: ${{runner.workspace}}/openfast/build/glue-codes/simulink; ${{runner.workspace}}/openfast/glue-codes/simulink/examples test-results-junit: test-results/results.xml From d1c132adeb1d892edd4d8ef88858771f318f5344 Mon Sep 17 00:00:00 2001 From: Lu Wang Date: Tue, 5 Mar 2024 15:40:10 -0700 Subject: [PATCH 225/232] HD bug fix to the inertial load from ballast water on strip-theory members The inertia matrix for ballast water was not transformed to the earth-fixed coordinate system. --- modules/hydrodyn/src/Morison.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index e3b5b8073b..b192582519 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2834,6 +2834,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, Imat(1,1) = mem%I_rfb_l(i) - Ioffset Imat(2,2) = mem%I_rfb_l(i) - Ioffset Imat(3,3) = mem%I_lfb_l(i) + Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cfb_l(i) * k_hat iTerm = ( -a_s1 - cross_product(omega_s1, cross_product(omega_s1,iArm )) - cross_product(alpha_s1,iArm) ) * mem%m_fb_l(i) F_If(1:3) = iTerm @@ -2849,6 +2850,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, Imat(1,1) = mem%I_rfb_u(i) - Ioffset Imat(2,2) = mem%I_rfb_u(i) - Ioffset Imat(3,3) = mem%I_lfb_u(i) + Imat = matmul(matmul(CMatrix, Imat), CTrans) iArm = mem%h_cfb_u(i) * k_hat iTerm = ( -a_s2 - cross_product(omega_s2, cross_product(omega_s2,iArm )) - cross_product(alpha_s2,iArm) ) * mem%m_fb_u(i) F_If(1:3) = iTerm From 57f3649571819fd4348544fd652e9b841ba771bb Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Mar 2024 15:40:34 -0700 Subject: [PATCH 226/232] GH actions: add product:Simulink to recipe --- .github/workflows/automated-dev-tests.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 00b2d8c70a..1ad047e16d 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -46,6 +46,8 @@ jobs: cache: 'pip' - name: Set up MATLAB uses: matlab-actions/setup-matlab@v2 + with: + products: Simulink - name: Install dependencies run: | python -m pip install --upgrade pip @@ -181,6 +183,8 @@ jobs: cache: 'pip' - name: Set up MATLAB uses: matlab-actions/setup-matlab@v2 + with: + products: Simulink - name: Install dependencies run: | python -m pip install --upgrade pip @@ -635,6 +639,8 @@ jobs: sudo apt-get install -y libhdf5-dev libopenmpi-dev libyaml-cpp-dev libopenblas-dev libopenblas-openmp-dev - name: Set up MATLAB uses: matlab-actions/setup-matlab@v2 + with: + products: Simulink - name: Build FAST_SFunc working-directory: ${{runner.workspace}}/openfast/build run: | @@ -645,6 +651,7 @@ jobs: - name: Run MATLAB tests and generate artifacts uses: matlab-actions/run-tests@v2 with: + products: Simulink source-folder: ${{runner.workspace}}/openfast/build/glue-codes/simulink; ${{runner.workspace}}/openfast/glue-codes/simulink/examples test-results-junit: test-results/results.xml code-coverage-cobertura: code-coverage/coverage.xml From 1ed4bd9be44e640b921b48a2947743a7829649b8 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 5 Mar 2024 16:40:28 -0700 Subject: [PATCH 227/232] GH actions: remove extraneous "products:" from recipe --- .github/workflows/automated-dev-tests.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 1ad047e16d..5c1d4a984a 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -651,7 +651,6 @@ jobs: - name: Run MATLAB tests and generate artifacts uses: matlab-actions/run-tests@v2 with: - products: Simulink source-folder: ${{runner.workspace}}/openfast/build/glue-codes/simulink; ${{runner.workspace}}/openfast/glue-codes/simulink/examples test-results-junit: test-results/results.xml code-coverage-cobertura: code-coverage/coverage.xml From 1ae6028581675eff3f72ce73a01540c3c9a9af37 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Wed, 6 Mar 2024 13:59:55 -0700 Subject: [PATCH 228/232] Move flag for WriteThisStep to FAST_PreWork In the glue code, a flag `WriteThisStep` indicates when to write output to files (or store outputs). This had been in `FAST_Solution`, but should be located in `FAST_PreWork` (it was left in `FAST_Solution` when that routine was split into several parts). Co-authored-by: bjonkman --- modules/openfast-library/src/FAST_Subs.f90 | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index f82ec22c6f..3cb106fbac 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7392,9 +7392,6 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ErrMsg = "" n_t_global_next = n_t_global+1 - t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.a: set some variables and Extrapolate Inputs @@ -7486,6 +7483,7 @@ SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, S CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step @@ -7501,7 +7499,11 @@ SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, S 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 + + ! set flag for writing output at time t_global_next + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) !! determine if the Jacobian should be calculated this time IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian From 7b94ca26ee035ea8fddbe927ae22f0c1d78b7f0c Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 7 Mar 2024 10:14:08 -0700 Subject: [PATCH 229/232] r-test: reduce SeaState memory usage --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 0fce74e2da..78db425f5e 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 0fce74e2da3fc385439e0ed00ad517eeb8e9e9ee +Subproject commit 78db425f5e224d7977ed90b898a249056a9fe6b0 From 163b20fdcf80d58ea9ed752d295099ee3d136396 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Thu, 7 Mar 2024 11:03:45 -0700 Subject: [PATCH 230/232] r-test: reduce SeaState memory usage --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 78db425f5e..7e3ed6d74c 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 78db425f5e224d7977ed90b898a249056a9fe6b0 +Subproject commit 7e3ed6d74c793360a3e147bbf1df2a7423384f59 From 37d2cfe114aa68a7ba4db40646774f8c6e7f1f39 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 5 Mar 2024 11:38:18 -0700 Subject: [PATCH 231/232] Visual Studio solution: Minor tweaks - alphabetized ExternalInflow and ExtLoads modules (so they don't keep showing up as changes) --- vs-build/FASTlib/FASTlib.vfproj | 162 ++++++++++++++++---------------- 1 file changed, 81 insertions(+), 81 deletions(-) diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index afd7a04d23..4485780101 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -128,7 +128,7 @@ - + @@ -678,6 +678,86 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -1467,45 +1547,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2039,47 +2080,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - From 5159a510cef99af59018d32042fa0c9cb79df22b Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Thu, 7 Mar 2024 14:32:28 -0700 Subject: [PATCH 232/232] Remove unused variables + replace `norm2` with `TwoNorm` - `norm2` is not standard Fortran 2003, so produced warning on build. --- modules/openfast-library/src/FAST_Subs.f90 | 40 +++------------------- 1 file changed, 5 insertions(+), 35 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index d44166a3c0..dc400a1bff 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -122,7 +122,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, INTEGER(IntKi) :: IceDim ! dimension we're pre-allocating for number of IceDyn legs/instances INTEGER(IntKi) :: I ! generic loop counter INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: nNodes ! temp var for ExtInfw coupling logical :: CallStart REAL(R8Ki) :: theta(3) ! angles for hub orientation matrix for aeromaps @@ -1626,7 +1625,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize data for VTK output ! ------------------------------------------------------------------------- if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%InData_SeaSt, Init%OutData_SeaSt, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%OutData_SeaSt, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -3938,12 +3937,11 @@ end subroutine cleanup END SUBROUTINE FAST_ReadSteadyStateFile !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up the information needed for plotting VTK surfaces. -SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_SeaSt, InitOutData_SeaSt, InitOutData_HD, ED, BD, AD, HD, ErrStat, ErrMsg) +SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitOutData_SeaSt, InitOutData_HD, ED, BD, AD, HD, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< The parameters of the glue code TYPE(ED_InitOutputType), INTENT(IN ) :: InitOutData_ED !< The initialization output from structural dynamics module TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutData_AD !< The initialization output from AeroDyn - TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInData_SeaSt !< The initialization input to SeaState TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutData_SeaSt !< The initialization output from SeaState TYPE(HydroDyn_InitOutputType),INTENT(INOUT) :: InitOutData_HD !< The initialization output from HydroDyn TYPE(ElastoDyn_Data), TARGET, INTENT(IN ) :: ED !< ElastoDyn data @@ -4520,7 +4518,7 @@ SUBROUTINE ExtLd_SetInitInput(InitInData_ExtLd, InitOutData_ED, y_ED, InitOutDat do k=1,InitInData_ExtLd%NumBlades InitInData_ExtLd%BldRloc(1,k) = 0.0 do j = 2, InitInData_ExtLd%NumBldNodes(k) - InitInData_ExtLd%BldRloc(j,k) = InitInData_ExtLd%BldRloc(j-1,k) + norm2(InitInData_ExtLd%BldPos(:,j,k) - InitInData_ExtLd%BldPos(:,j-1,k)) + InitInData_ExtLd%BldRloc(j,k) = InitInData_ExtLd%BldRloc(j-1,k) + TwoNorm(InitInData_ExtLd%BldPos(:,j,k) - InitInData_ExtLd%BldPos(:,j-1,k)) end do end do @@ -4582,7 +4580,7 @@ SUBROUTINE ExtLd_SetInitInput(InitInData_ExtLd, InitOutData_ED, y_ED, InitOutDat InitInData_ExtLd%TwrHloc(1) = 0.0 do j = 2, InitInData_ExtLd%NumTwrNds - InitInData_ExtLd%TwrHloc(j) = InitInData_ExtLd%TwrHloc(j-1) + norm2(InitInData_ExtLd%TwrPos(:,j) - InitInData_ExtLd%TwrPos(:,j-1)) + InitInData_ExtLd%TwrHloc(j) = InitInData_ExtLd%TwrHloc(j-1) + TwoNorm(InitInData_ExtLd%TwrPos(:,j) - InitInData_ExtLd%TwrPos(:,j-1)) end do END IF @@ -6204,9 +6202,6 @@ SUBROUTINE FAST_Reset_SubStep(t_initial, n_t_global, n_timesteps, p_FAST, y_FAST CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi) :: i, j, k ! generic loop counters REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -6792,9 +6787,6 @@ SUBROUTINE FAST_Store_SubStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi) :: i, j, k ! generic loop counters REAL(DbKi) :: t_global ! the time to which states, inputs and outputs are reset INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7371,23 +7363,12 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed - LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed - - INTEGER(IntKi) :: I, k ! generic loop counters - - !REAL(ReKi) :: ControlInputGuess ! value of controller inputs - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' - ErrStat = ErrID_None ErrMsg = "" @@ -7485,11 +7466,6 @@ SUBROUTINE FAST_Prework(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, S ! local variables INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - - INTEGER(IntKi) :: I, k ! generic loop counters - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7599,8 +7575,7 @@ SUBROUTINE FAST_UpdateStates(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, 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 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7747,12 +7722,8 @@ SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_F ! local variables REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter - INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step - INTEGER(IntKi) :: I, k ! generic loop counters - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' @@ -8008,7 +7979,6 @@ SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, B CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: I, k ! generic loop counters REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2

xTAj)L+$<@cL`CJZa=&9@hjz zUm8``7n*89G(kILk~&4nTEbxI_ycwEl;xy`bFeV?&ZMOYasnE4(g+`QJ!1q zPm}dR&7H^m5^Fr3f|LveGIyS5g>AnPl?E=6(E~D`+9e6wpymZhq$ZA9+b5oRDr$rV z0gK={;gLMQleY7iZKB>w2I{p2c+%a)-Kep>1{V*s-_G$o>F9FmL2!&0BJ*LHq@vqp zv<;)6li@~td=1;8)>#+3))HB{Z5rj@NwC2(7M=4DD)SRzIqc08$wF89UiO6z{3Nel5w+r zB-~|hX86f&17OWJ63<4%ql$xF=E^pN>pQ!(_d9D5()ThC&tg$WFa`WRPPmKkjLbto zyugzV{LZU7DIn?f*%j?Uug}q9osF4`{R%~D>_^FoCQHrCbUN*(zs%iC{wO%H2xg3v z*Xfs!=%nIPI&u3AKKW22#_eKBw?yBah17``7ggq4D*^RCYgLU35|i{ZI;ppkj)C?F3iWe zfrD3s)^Jc|mb7WeTA2d}u&Ckc+{_v3;n?@4RLCw?J4ofY9*hOGYDbV4()GH!(MySa9+Tgf3_CATJ}H>6~Yx>13eCz zJ{PMDc|Do>@RN{M445?w(iVUtVVEI~;kHj2N9dwU>!_*4aNykJrsAVuo;2~<2>JB& zbbNcgQH*NjK8tk5%2Iegt{b(q%Kn9Dub7_8 zocF7a_?skXBKL(t72B?R0+RYSq#X{x6R8zUCgUf|vWp^G8`sz;1c|YVp#V!>sPL!r z-XncbywPt;E{VE4gGbDd71qnDd(P7s2@x4)5HRm&Sq}mM2PXW{14rIHC*1(cI2*6y zS;Xy7aW_@&WcbRwBdH}DV^vXXxh#(pXOswGK9}>!PXg$xu?;*+rr4YgBMJQMdDr%PQf)NqqhRsy3jDW9fgs~zPi*49wIKL z#f6xL^~h%R0NT{OmjbVN1w@HeIV|~%g;?!lL8VCbaUSnrUh^8t!cc0B>&aIX#7&@! ze8BP@oa=i%pheN|y>3^y1pNKf~>Bz+-efENhZU zc9v1!u70jj#@oOD@|Wwa3k&_lr5vkNv=0Tep4=%N&@W0eNh>*%{ne%ff+41Rb|2kg z9Ghz&)x~9_{%Yw5Qi35fl{j=vSMC2gp)kb#u2^*qjBlp)n)JvtqW_@&MXB>t#rS z*&CCABhelE9Y?ZBVfTKL_N~K{@VbS5-DAtH2NRG>v?G})dUY(cb{rFj#L4)E1lFY+ zb-m*CL^*0{RFTncr=4I0)Jd_{rpPjh!d`&E2qo{QVtuf%vY4tlk7 zU)4&FYx>5;+;^S>mg|WhyKZGZ&6MAOw7yTnU-oS$v>I_`!fZk^yx#+Km3NA6tx`8} zD2Mix6t|)=E1|;}-%p=R#4Hc+IGiyZI?TEsi9y{)q+(?%#>H}2!{0}aZarbIAeo2j zrl|Uty3sxN6ws0rT*yu}3j?#QQSzq53g>fJ^Gx7Ktw ztu=k+9U?9w#$!`ee@1d14cOb}M-%M0*5}zrv8@RC@3q-VHHiIwpwPhX;jAp0hK}vY zog1J&v$)lSsD;?C%7eO2U(T1z1cz*81#9LlbimWtoo(3j;!ta+VVc~^Tx!R9X{_KE zWNpQjXL&Gp<{@L`@bA$`mf?CB+#E~>br*d96`m6Cy*Pq6>!+zT5q_!B5<8%c2O{J_ zEcwyPRUX9+F3eE`Tj@xUn;ubj$=>~VuQsd;7-R*)E7P`e<@_k&2{__*CtZ;H3~b}j zi|_zn33Qvcna$Y)$|TYplHBu7E5g*HJ~CH-PK{GVQX)xQ*S_h-+U_aTL5`<6Xw~gJ z?4SW(PT*PFDni%0ENT+@WUHXJ%{zIZHX{e|S?n1=2>MpLUKAB*bd2Va7Glu|TmQG| zlzM#$gx*0$y=dGc4#@t*Hw&_+r@Sr$JAu25f*NrHj%D~j!=KkrTS*t4Qb8O zq_ObSF!S0|J&d!`q_uV>LCUBJo69kespU!c2Z-20hI?CP^DMhvuO=i^754acXZ;=n zHVg8tXHN;ocM>8uLbJlUB3qTqu?2 zg~Uv*4IUVoLr8h3q^p@7Nw2nd$XSX;ciizPUkxzg5nvI`Z|qNd?|u5E0TJf7KoLuJ;YMR@G^kn!8Ti9*~Ycy&bsaKh<6lh z8`zwDVM(kx-Dw70v{LNIAv9CZD6;Mb3Jb%DpSLsfVp#?l)Aqfxpx!i^&%Hjy4{Q0R zlF<#%=$G7Up_{ovo|VV=J_(^;@wYahK9FilYF&jmcEaC!7ix0qUL85q>G3eejj(x+ z(H`;m;4Yb`RX`Gi9$Wg$Dpx_Q%_Q9?H zyuQ3XJqn8OBX@|x=>{udjUc%C)b zk0zFwg$Bl6CN+#&MNfQVne)PAF46^|&zPU~XFE+hycnep$6~3_o(#Zl8Ac>+>@3ug zOvkkwmi1$`#@Pc{X>To6Q=X=|{t+C^HL54IAMWXlwbfh)HZH^VH|;NxWdc9?5)Ard zEUl#@oQu@zviKvMWgvOyz0}0=?)qmHZzc!GbR%lRid5i(aK5W6m^lfZ$J12A6QOPz zc;_#`&mCC^Ow&tDFp~Ir+2lonMvH~ww_tFxMDlJ)v|c$s#(C6Rn`Z_My?+y4yHp`` z(28Mo%pmb&_KQ^vo*b4GT`6$$f(MNdHHOV_#|cY4($jBAOO1 zUka*cHjs?gx&OiyS!kggC@W>1L#9=ZL`taT&2X#Lw)>Iu;<~dZvX5N0L~Lc zBMZZUNOhg7k>_$@KcemtI_fSKOu#!XQkxa#5u~Hnr&4Yx2@OM5v%g9hXic2ps($o) z;^Rx?m~LWL`C=1A5~|Va)Y<+bp#6F|cYC2$>7pfx!+} z`%QJf9<^?@tQ#`jof!-5ZV|&f2H}P>+^loWm2J7GkqS>3!_R@Vz?Q|1Y{v?dvo?dW zkB(Stx}M{ktD*YQ8wp7N=#^h({f5FrwL)?+4FMwqh`qpE(WV}v_lBDN(an)c0mJuP zx#CpI%-Rf@r#$w(Mxd_5OKbyJCfn!+sN~D1#dWQMy*@HqqB*9x;^2lO;U+7%NhTSr zfr-O~%9huHov>?$2)_>|O%`MYACw!)&H9S5dC#n8_D#lfo91HdPEG2EO7c@_+4M{g zY)xLQrVny?GQ$jth50al+(>oY7>2J%JrUYe6?&1G7f`ymVZSt=l?PEMye>P|9>`7OOgMsOFp=kXfJG_C#bgH{nD5cmD@O{eks~^2$Z2Yv(oy)kB=W#fd06pcT zGrtdJBTpJy`>4Y_@+J64QL|uUp8NB{@Z_DxVMIMx7afb+p~!5J@i9gm9I)JVx@^T+ zu&lvt{DZ2NT*Hp~xNO(#*}Dkk!ttsRYi(IrH#YKP*sc1GQm2&Tf@ag_dFvgGYxC3P zi7Dq(>;S;o-xprInF)M5^pP*$yy8!jcW|^f*0=tb!~b0l&Bny`PssmEPyaAh24?1e zGyA{8+^kH@?EhNf@9guxh1Hq8mwcQN#f2OJb=W+F~ zx##~DSO0pYW^UwY=76t>&%(xt|L^tKe=YsLZuY;I^Z&Zd|BlZ8zv{&j{kXB9G{5+pH4>K_0My|XJBCddY7oJjpG+-8-D@!UxD*~ zr}ICK{C%c>)A^r+1^(HH{YB>t|A?Xglg=6bW4QSjoiqGny7~W+&RtB^<5wGL{qaF! z2?;Z@yL02G3LbUx^L*js0CI>4AUeb^@jKWG!tY>b5-9N{5l~7L^NaC2z|*rW&z%-J zA9-Itcqe~H@1+^GJB%r8xbW(-FJEFpkoU?r+OZ%bk^!KCNC5tFa$@Ph|LVvl1P6iu zX6J}RU^jizbp|M+zzz_}j#2!C$%*h2vU5#?1PS?ek{iQM!)A)F4g!vv1SBQy$Iq`1 ze+0`rM~4qd1gh-UOr*!JEs%}+Rg(?G{!77(4!U;(Fof^0N(`SZ;Tw3TgP8y4qH}gG z)Sork{Mz6XfEWIJUp3ianE$BBCTKRswqvhPh=~aa3Bm6Nr3&p`8oj;(=7DGbmQ8>S zHPqav-~BVr&mA7^DT@ROh}~}x7W~XM1YrdB@TQ*ChJ~52OR`61f`!aoz4Qe6+FPU zjuNpj!v2TfS4(!c$S+E8XzXwy{r12Q>`ElWeZRYBOXHBQmTcNoKnEeH6nunA8#@`4 zEnDafkf&7>xFNs+{y0R!I0OD>D)>fr7xB}7eyZZb4 zxt0Qbde`3JRbLS_262?=QbSweuj#TRg#b2S$P-12GCN+J#o zGT`I)+4T(DzI5Z0_big|Ieh0cDLy{F{H&JN?DKf|c_pL;KcVA8cs1wLw{4vLv-c<9 z^QAn~)7NjWwN^Xy-tqm-j#PGVov#rI9^3_>-MRkw)0^kQdh_s^c1zkIuqRh(tX=1% zX#NhO_}eZD>iq*K0h>Wxvfh!Gy1eaXIkHcdAU_WeY|%h|qETNg;?rf@wHJSI0I3io zgSN?MRVTB<`}gp-13Yc-su}R((d!h_Hy_eD0|$Y`l4J9N!RyxHO~D2MYC&T{CjvmW zXfFYLMmLMHw?pEiFLlAT4g;SA_iWw14A^?g`c(L=1K2f_VM9K#hxto}urCDH`11#gQJDXFo=NZfJ>e{VS9#Xv| zX{GBfY_ym(!Qyl4^f4#=edznVKy1v^V_2t5qFRC|P1mEHXjV$g=$7nNg+NwtiPx}> z7suUfCN)o7FSvTg*;*=9=X8{One6>;6>3?7L$8CnTJTA9SvQ)uHGn=k%-k`ixx$De z<|`acS^E6Z<7a+?n}{~;r*R=Ls)?=7ZlQ7vXo50LrBXO6SNT3h^<#55|GGw{tFjvK z)Qfc}-d(+{>AbqWLw{f*V~u26FWw3b_~XQ@UobMWP(^ZR53O9dhj%}?4uR!4rclT*S=TB0D7e2Z~TiMNJ;A*1lF7j=5!mM`AO;W7et@Wa4ieW?*KFk zXd+WrB{|}|Mo@I;zH;9-ky;l>Qn}`!a=@GR*;;=~y+9_wdIK%;{TNaJnZ|?$sUqPG zH&;sEwEq3`0HaDj^~t%RLYXy2`D$X8ZW*hM@Ig9)Yq@rDiJG%~dBS>9VS%kNAz23M zFzVGmxRTi>ZQbB?kiU5@IsV=rx3(j=wJLaCZVN(!c5f{Z!nVn^|A?mweKBTL>3VgQ z@I4`Z%7boSW3}l8vwHV^MDKORk~l+eH7e1nf-$s8CPc_8>|7`l4foNXEeBN#e`v2l z!vP4QO30)8-tik)Uf~p(RzKXk*_0`e;i+>xoNr9Lge5;+d|h$V@yZ0{jGbv``~W9v zrM$|J)X{lbYK%cJyj3gH7}8=^Yyq+fGFu3W+wD=T67OdK`fC3e&1DX%BKWg>ad89U z@0}MXgVf{r&RD}M(#<2}`zMl-DifH7-T*V@#u15!I`LdsxfX%8M@*+7R4diN(pNfc zCYW!zZ$VG8!%2xp3w~eS?o1PLQX2=eVMi{OUv=hQ7?wcM^U-5cb6w zC_V-ZT~=1*&&Aqj<7YfKY;Cj{qQ8=Ng?2z2)XeBvw@1GMnjeiN{qBTY9OPU4u zw{16Zh=)bXR~wi|tT-$_Bd`wbESxv8_UkvCwySeTn(N4?kkY$6XCZQ#?qYttkgq?D zYgbRMcArMn55EmJyR=v+@iq>g_gOm=>t}WCt33&yL|EI2I647>jXPXW!=g^&;d$C7 z$H&99^EN2krhn=K+^{!cU}v+Af2DTgQtuR@TyYWf$FYJ}-EV(-HGwH!&K2 z5I5f^3U@bB(Hd=BELHt9F=kFF;*`Frjoof`3tyDMOtG@+s5T7$2xtu2Ql*@zEQ^-5 z*AP1N+9Ndxx*09Yq-@JRNE9GS-}jE5&iaZjJ+V)PjfhMOYrAdbD7F^>uq_2?pAu+< z;Ojk#;*C)`vJS`RRuKy4r&t32a@R!uzC}h>{@&)H7A9(|VkWexS`O%|-I7)1jhQEE z4CR(m#ny$%`9KN%sfUWG-CQNAMq@=3nvcmXf04aJ^l_1j5c} zeWbR)_|WFcS&@Ohen4XJURTqB+Unx>4?^7;!zHu|bTR~L%3Vg4n3TeA{x0SKvM{PD%3y?OaU7woydWb9B`79BNu`WEV%6qtdvAJ$X zPW;mD?lV67gDG_~C!z#{!mA^nG-?3L${7{QqZy&`l?99g@lTul5U^kt;3ZR=O;Z_ zbjT;0BBOq7&T>OpM6S$+QFmav#<1;cI>@L6)MH|(M~go#fhDKo=RBi2Zp`*MAF}{5 zn_r$YyO~m-p&LOsnI8!cy0Nc%b64a`+S8O-%^i|n)FU@f;`Vi?w&l#jOl|28qMr@1 zRilTVqj57AHqBon#bF^h6A*rquh7MDv^iaJg85U}`G0UBcM;WEVLwIBIuz%V!%4WF6VENr*Ux@ZG1lt{6N{_Zy8NVII@+2<62R9tLqiGe2=7sEDp4aB%Ru zkTQ-;n3sKbEZ5ey-fk+gQpPL;109pK?xk-{#y~yIW{K$9FF`SqC5_?|tAa@Z z37XGFl%Fe6!F4W#tVI{kre?&XOM9i2CEvdy!gDHBjC@W*)BPczT*n#1N z8BlQav4o2C_N)%iB&8wK-69B$DADb##t%#;<>#4;qq z(3NzXk=y)89I7CW_Z4oAyMoW~1$Ch#f)%x4YlT@z-Olm38#y#*CmjpeL-Ji@0HaCl zF#GpZX#ry87=i%5f{eFr1sL%_+D)%5z!X}>b}0*^?%9eu=|H_^vgfxaLb99v!7mV7 zOF~BSk3BbazwT)Gv~PL_9{||DXZt6}FE|t@l9ZbFx58hIt*6r<6VMKgW6%=SrgQM8 zXUd)xjbJDOx-4|6M}u=eI@~N`s65?NypasVv|3FDn8M;MxTTlYYQP)CHSR)$KrVe_ zgX5W>1V!oX`&whBje-Q}&8zkgB93f73fg1aJb% zvv^X)jSGgW8qlx<8#xXkM#bxs%01c`= zBOxl%#)tEXUu|%g;Vl_?JC@d@Q#;mH0M|aCYzTzW&N1O1oV{rxAS5fQa3ppft{DhR zf==yb<`D=}vv8WvRCLsssPCi_0#T{*jMbCV?SFdvOPZB}<0qs`?((ccA|$5-{4O(< z5cad0&{%zy31HJV;RKf>Dpm_P5*QR>Bf)8&sGU`=^t+_3e~ah~v@# zxc5uEkf)Yp<0^ENF z3WO>Y^Yy5bQj?g!%pD7xEt^IeSujy$6c9_=;LJFzr6N0_cv1;6=d2|1LyFR9w~3^nir2GU+ov<2V=V4buR~)& z$L&-?&}%E=ZTe);p90uLk<6Fy-zHybwII3dOY27oZds;Ww@8dEWCUS;B+S;92zYih3$!Bc1 zH zzi2ZZ?P(@nK@06$hv#06Vwj$Gpc>7a`?`e5Hz`%2BK7eXx#haPVM+Aq5zp2w`eo=7 zbXp&{klo0vdbBLIn~E)Jd#gXtN0;!XTef&22JWcN9vTuy1LxpueoGV$Rq?ek&xGs3SDaW zOsUHl3|55uhVKKP*69`b0M;CQT(unM3V zUt3f46?y`&lr(gTvwPC=aN0e?JiOCemGcI;mBPWErYs3Y+Wx)5Y?T5|ZZHRXv18>N z<~<3w_5JnQR1eEo5{-9O&8oO@H)tL4Y6Fn8|X{i2{n*pjyKjiqMv<%eD%Fz|v{ zZ@TqU<|x|Q(3Ts})N%G5(u-_cTLnByK82(-4wu}Q)<<%mHk;?BG7d&abBivKLG&3# z16C?&;XI9}*6*PAWKt9R=@T1m+0vnW4^nX>+QvKz)}w>Gr+zh$f-&g zSw$<>-fGYSqTU`6J*gKMQ`FLy`M5t#X~s$Rf(INxmhFc+u4uYfREw|3r{ls*!-Tq~ zxW_*{=+Ue_5_>H+o-kR0J*%Y4Ht(6ikXzIDK8`=RhwxHOrk}1FQ#K%De=qgM)%Pnm zwN|jC`*DXn5MprpOK16(xKydLzLepeYg9knyYDWV<~Le9uKdlYyT(wvtBK&-o5JFn z;SaAFJF$Wi5s7E{=NP(C%Kk}12*hNX9p?_^I6h~c9}HBDof&3WFdTCC_ggs&^(jT= zN22`roiV&tZNAy6QD5EI!@jvdi{VLvuWYT8y8?p5#5sZ5CFD8pV$BMo_Hs7~89bf( zoH}8HGLdWxAz+MccX}@6-uzP4*9EO|vX}icdIw9p%8|{fddcw^8V1Yrqju7TSx!Ci zTFz?tt2{e5a`$ZY-t&(dogP9=q|Rj<;8*zIKF!Ip6F-tpjS6W~m&N!x9D^}pQA%^p z_JGPTUQ0CI&5+!<)eQQ7j}@$*p=jF4wa}-GJ($(BuqQ@KPwxgh18!yG3~R;4$f#yh zcJ}XB1w$keAnYd%kdi*{2wo8xwJ=9A%Bav4{DFDa9Rs=Yx*x z!{uewSvAYCUqHMXDcZQQ@nG_;BEE13?RiYD8OLzaI?3(W$m<7#^xISoF}w`jaEp0e z>j#VKVEueRb~_$-qUTj|WYT#orqGphD!=(-Q7h5cR2lM`Ex+7jQ>SWsLdy9N390+so~zGH1Z z>@%OYHcn*44<_++au2iyVe(~IZU?TY z)siF23U7S(W}AtR^VH&h40+#g*x^t_dj6hS03oC~F&$5#EUm=4KEcj0m_WBB&#up37@Rp8hhGtDWdW?R<+gDYS>Cq>(9d4qlATJvMWMeEDc(*$wsD~>W+c*l8EPcvgJ+$0Kgn+Jb*;D;w@ zi5d3#D`o#(gb=lNG&oQJ7#|-Hps5jaNkOy!(7%VKM|WLElKvqzgm`&r?%fz z8e!4ZZ5g{TBx;?-RE+6pW&DZ~KsSqjtX6o{9P#KR1?6bY?nW-P`uZJ^!YD)nyuUv; z50fvN68>E_wMT z8Pc~E9fInoHPE58t$j#^#HS5PmG=$qJE!ReYS88x2F1#ei!AFs@-ou|MO*7+iQ(zE zxPj#!j}BcxT)2mVX3oky2c-1yZ{?{s*=v%IV*2A+UlI2-lJ}EH3QP8t;<({ys87Bt zDb&nST($Fi=SxOTYd&jvwmh{6uk8xke_(9~%>i4E2^6m7vcTRt#;WjXXEy~?B&(Fi zZ+5-MPLur3q(2=3XCKU_lMj57X$w1Xz{OrG2=g7 z_fH1=%YYgGS!K=erv?6Tl$D-^{$KC?+k5}bfdBdV|M|djK^ZAgQMoSz{<nz~zLxkW0sr~xp9IXv#`d2C{O8ht!|1=f`rp3&Pgj-Iw>HM7`!Bov z?*y2Q0iTAE{f`(jGd(^VJA*bPorI&lmARpSjp-N7e(g-a!O+;o5ufdkUH+p{}GJ-!+-w~jQ*GZ z{>LQqKm7L}qs;%0{_AF{u5`LW8d{G}*dhKMU&Z1`hBJrlI0FFCpTG~EQyh&o6r5c0 zS1CLQvOuZ$FTyVjK9)pDAT{=PpZIu4NwGb6)QZRZ?Ve@dCD(F!Po{MiJm^0%K`w?4 z64VdwA0%u9sM4{jhrll^EG;f9jNCt93^atV=QD;+%Y?py6(ul|dm;fsEJ3JI1mynQ=Jzv+4yq-E6>^_JK*j><<6%yhW>_&Y_ww*rYIxIP*K3er6(T5a-7b`#D;O`&7K16?PBxz z7Iq^9_Ri7V9Xmmb7H{`(jm#?2+u^CFVbOgFpAK=?G>#GsNGvQYoNv?*kctc`8 z>B|Oj6$pqXdliJSC?Fm~HiBf=!vYB9*Vb*vmyK^*Ob6Ya?WIQ`@Hu}yi3AP}mcA{E z-i>eoDdztnI+UVM+cnv|pSS(t+W;Pwt_L8dv~@|Qi4B*bATHd!x!v_ZRsMfbc27}~ zY>T>p%eJj9+qP}nwr#u1)#d6^mu=hZvTfV9*4le*-965^_bJDik&zi0IUh3Pi~pY$ zg|_;6W1nsBenP)Wa^C_71RN0g<&_0N0Cw4-#JBMTKOl`DLOv}N_w2N33ZS9lpLJ+# zr9VrT9-G(!Huz4qfj=S&<9ch*z^*=I9I+805y{rjpFV$_bc>9BMsA~%f08A9C8rVa zL3S3S-Thz>{TzjOw!;1S0NH0>^zDJBg|?0T-=^f9mO^|1b$Qa5)`oWZIy5oJWg$kz z)o{{3qY*D)177@4q=MoQRVp-G=lFlMn-vW5L1#Y^OwXNdO4wXQE{pd~}J!KtK~JVBma}LU|GT zLqox~E|o-s5S&H#ZuLhZ&xSzXbp@~uZn49QaDBdZLI-j@=gu^@>sb#bKUCe)HT3C! z(34H~laET!j&=~0ZeJzexbXGtcWMb~j~&Q8g9MRIUwX$@A@LnhO+}{(T~hH~Shlcs zluW(~StOh@n|CxOuouw|lzf<7Mfl8~2kd)JyYsDw$$_4Z+O24ar-RBQsRqh*1Wxo` zBK+RzT09uNzWLs1nI`6Qv{sqK(AJ5v;YAN zjwl)*vPU`}%QtWp_fA-9mNU6rpZFv|hz)5NBA|Mk4<9QEWTyKg+>?#Lkx`SO8sRPX z1ak{cQA29J2p^h~GV_D}LXS#s_#s+*YovaQC68q$+VSb!-Pq;SYBM`R^h$Bkh#>Ot z1^lEiX>nkl`N13xc;&|P)!lO3s)ma`r9l)uIX%>;&J_KTY&?-M$Zj&gz)`B{zWT>O zZcef;lg>Im2>b=lFRruF3tekC2EV+e%HgvU@XlWsrnqc8BpE$7!3a^u9lwp?=JH!e z>5pI4UxE>^Xz)?4W%kn`+vN#}3`t~`A~*ZmNxmb$oePLt%*XofzR~Yv^u~>{-f$}_ zey&}=CuU^?}pCPGbqRogwUHj~)^v%ng?PR+)rj;&AN+*o2(xHfq#ku9KSYjJ5` zTD^Pgmjfs(92`($&s(g#72zdy?{(F#s7}6CNkdxK<16hGrrN;7x!KVfX=lClr*blh z+zNeftF)}MGn1xVjFEx6wFQ~nZHR?^psn@8QQw0ROj>D2uqy-HBfcm`BuHpp9zyGz zeLS$e-iYIJiYQBGxmT*pH1^G6cmrf@npt+z*ay4jVnD4cTZ%}pb7Qf-RQIq+sC zS@j{LmpV?PsX0(hZ;~0Ho`8QoO3-4JNqNe2vW%=L(vx^qlO@LI!@gS_W)XBv(w2)e z(hf{@is2nK#m5FXj@+5)YMhiUe(O}n7#;H6Bv~N}?6-(v%m%Sj@C^{q2+@Y!yI|6c;F%YhHc;cs>&OMO09?^o#0BV z_c>tHR{LVk?bJACW5!BmS$QXgA)zu~riK}*6Ac&XrTFXA+4zBnBX}VW`?261c7LGf z8?{#xeGVMUH7UjLKJlETmEbfd?-rdQ-<*ufHN^I@bMlY0*~oyr_;&!Xg_*iG*>Y`G zC*4&8Ru>nl9k89wvjxlta7`DFs>aQvoM~Tmhe$J|bR&x8`8nQMFH?$}TCy27@vn~9 znUVdr)UUK;|KWSD8I9V25wxH%ofc@PBxCl8wBi~jfd|42GY51v|8P`3hVyr% z!8YHufxuIts?j>X{6q= zY&His$0Hl>dvm2yR{R#VQF-|jhVx+(#_Oc3gBqb1P6sX9QSGm*m2nHy{amy{E;HI1 zs!S%lMyNX5s2&>8qNPD0GsXM-S|j z>9s8r!P#yj8{UTrKW{WjWa%a2#nzv(2Jqk>A}7zObxR$eNWya_eR$Uffi zr+sekAHqB=_@J5AB;Db9ZN@l`j>y1F`8|mq-~{Ne1C3;xB}#ukl5a}-azgx8JNTa$ zTvy)$)5PKQMZtfQ+5X&c%om{)I zdxowjLjUM_h!0K0ikPWLPalanWW5`N(;+FQWI|vZ&JKfS7MDtmt`)Vd--vScaUDBY zXh#A!{!j;ZG*38vy0uXJsqq91Lf6|+&S5p{P|a)*+F=UImB4v3b8vf%sJsU8_50(H zR-WkV|GldEZGJI=_(Nk`UHakq8v(Ef3;nP3;AUpO27cEh4K}X$nFqjqI5ZhFwY0F9 zyLmOM=*7ACgzew6Avq4k2eQrVvcP45y7VbX3_P>z4nSv{kibJj98VTD8*ZU(#UJn z+3%%e@RIYJFLDlbxf*~0t3FT+nCe_Be-InfWZQAmo*X@fZ$fsXpj#jJrD3e4&3jUs z4zF;`E@@oSCJ$drd90v3Ju@k4(3<<7nG*jV^DJIeH2;;Bvn;n*WT}knz444RI9BQn zsvyHt4eFYf@_@K&mE@9z^(& z(-^v#Jq}oDh9?23@?i?dS4v6&UdwK62eM(}e$zYW)|Ad2wXdtV^5O3F9YIs%fKFD^ zIHu6@7v)nkY>vf`(9dVxb<7-hwhq_cgyos z$fOyamapv&S*k8qdfPGr+2^*$#qNOX3ArV8fZLoC<}+oCu%n7gn0XzYhwbfU>q@hE zjN%JH2zj5I4K#4l_q@!duuFEZ{(dYt7?VL`)^enF6T>SH95gA75w_{X1F_ndI4CyG zjxb+m?ov}FBFBjK1dAa!+WF{8`v?6j-g6qi7F%j;bTFF=q;k!V+ZsMxWzE7VqypeyKQdNo+7h?f zR|DTXQ*Gx2nz%PpjG;93e?;l6;yEKp?YC7|aIxt$C6Hy`;Jzg>C1IWCd3Wx=rxoq@ zZP3nI#%`HvzE|u7*eeEN)DcB!G1_u`zlhf74~pSI!z?}5R%?+>+jzf8QnIM!H&&CvdR~-x71rHN(}zUgIQ1# zP?l`d-FL1U)k@Q+x~QPKd^Gga{1#A#0eV^sdc1)Gd-?FgUZZg}ld&;@d97v$575N> zigJ*Bvy$$D=Ji12y49vh+Wo(eY&1D(`p5wDSc z$$F)G(zc&?-`u-kRU8tk7kXNwQ$l#S?@62st|sIR9D2Mfly>W;*(ZL_dX%l?IXdKk z%*8*R+muyoMunS82LL|A{Yr^r>)gSuf#0?I4x>ej4$EWodt1|qQkkx5S^quVLCPdw zZ0x}^jRElqpt*)kS?t)gVQA$jyApdr(Vk9nt$PfFb6i@HV9YY6{6cZgIc}t_@#t$ofS9WsSgBx3r$yw;zZ40Z}*ka8pHiCiilnbm|Ir;Ow1 z5o9vB*`N{njT+2eF{oCXK`E4V;2_M@qrTWX#UrkUQ;(a3(lPdL1#YY_i)IF?2sJIg zqwnLUxX?J5Bb6wm)I7BB+QGxamZ`^OPYn%BIzmRPWxc43*P zBw9W3tC#URVp6rDejTmC%4kkkUQcvrBHD8K0QYkUL>H#*D7YxWq>3lTF`BZQ{Mvkb zDt*pSl%x691YMq)xw+ zKqr+hgd2xObja-d!Sd?3FL4n^*q3qeX$QiWMU!Vd4}dMf>>dp_Qq16MCVW{nxFejMzDxBE^UAp>U5JT&O+cyh zYZDgC;kFq&G<9K^!F~n-X)M_u_sBC8?ROd(cF4cuW8U8?Xy_TaIECg$L#bw*=iJ&M z}O&PK7L9H0;r{RjtEX@)o8((pq<`E!s0QnjD$G{3K=SZQ(p}*$P^xjZPVru z$zA?lL(`mkayS`7Uf3oS9+eAWD0;_H!zBq%o}Snd^S?Pm$7IYN~LUT+Q;HW zdceZ$4^u(jI^?7HQpvE9$pd6hG*|xH9ls8+R3f8uzfy`|cckm8W_=x#HFk~IsFiD* zyb})(> z`Bgp!3a>SE8EN##HtjE=tcy;278xV4;~cMQ%~aoEy* z+qErq5BZ^TEW;`%unu@J`IZB+$_WSMFJywK7A0i4u`vEhYgcZVbvg6`@5)N%w=P|T z%foW=pe_*U;m)%l$(GzRO{A4R1Nu5xPkn0(JIJ z=aN|UA}`K_lJlF#`#(r!E&TB$GqUm{O^3<{hokOyxp zOAEOv`}-wNW;_%QYV@>c*~`?ZnVjxd`gk|Jo}8H$$+jq&@e22-{WLBEPgY;EYGZR2$yb?skU6lCjDNt&0iWv{t zzMGwU+Y<{VbPRUD5rXA>6=HiykajGs5`>GjQB9YHKMPfYP)~yx-kTNA2<+Mb`)$2K zG|b`?N-`C*BKMkeV~iQ$!a4f9S>n-6+Bjso_AScAtza#4r?khM3=x{j`4B79&ZIVX z!n98dJ= z?$P(s%u12@`?@k#nDt!MNlqdnwifeLczcT9h}tEq9j_$HhwNG*TE6Oe3Ofn&$KW1P zP8P$qKYS>{ki%Y+kRbKc%YgRwHTB71t;Ri{CFXPWSGk5w1lO zci5Z@iU&HJ#W510)rsFC_4DJ>MBT2s!(jGR?lf?0H0Jo1F^%FH?V|kQwCH({ZB6cq zhfM3>@l6A>vyCxCR5azLMl)Eoh8gu@(=rvEcQy}y_{p^X(&MWzq$YH_q_2I3^#x+h z_~}wla~pH|Vtmx%u7lOkqVzK*&wV zWApKh++I>vgK`xY#87CMKgc?u_XvMRT)0kT_FS_xu0v5q$2MnRv=P%m$lzG$b%)8Q zI&AhZYir}N(F@yq5YNeK{_gvaP{oP6{ql?ysRNxr)c9=0wik?KFo`aYxQBM&NNtx+ z(bk{yc34OXE>^;OCP9y8S?M6LBc6D4*{Bv53n84v_+V&1U~NTd^7i*64P7>nB%p#f z<03YKl>r(tSG@DFDwk8U;A^9)e|yW>4M8_qF3#3By9^#hU4~}{JGYWRR%2%K-8~9# z$W-?jQY&iC&RXR46*3Avl2n{nn6<&bc)gZROk@->)nCC1cqFSCkxYkx%8s~4>7nZC z_d|x)2)AhhKf3j~W`57SOlDulj3jNX(;!mB%KO=l2rAaFmu|XCZwA{!7GY2^-rN04@oUXG{0L!oNIe6>avz}KU7VhkZ8XfYT zStnF%;Ty%HJ@a$WiP85#PN!|2_nmKF+FfyV(Ju{EHe+rTms}&sv2#>YgJK)vu*N6$ zc@BQJ>FF@}iGSrK_!&3e0|^+E&p-}O{sMR82XGQp{U?O}C!hW!7R%21&#>&DiuQ-K zF)-8r3#$Iro6W+`_AjG<fcoH>(Sc4*+kgn&$s(R%)g&?cR-!^ z9@{hl7^=kCu}Ccc!ziwbDo zpf6wZ8mE8Rf=F#n5W%p&5vV7#-#B7_ySpcLbEa~jYjw`y#@IVxYfe-EBf`K`c5xU;_0AS}#Ymj2mQ|vqMqbZW1Z;80f<+6oC!u1K-PwZ>69EA)tZ_lb8q> z8uJtI!+<0V3cf=LdyE2D>f5oSOe2HY=Ec)9Go(_E_DvyQoCWq=+%A6WhTaAiE-Wkr z@hb!#y`Yz42Z;u`>&8G&<8l>)zyM6kC9uaByu?RnccjIL4vP*CkBf_=U&5t{zHwIF zLI&~P!a(oF2o3e{?91(*N&)n#<~oxb>+RR}{{@ZnzG@KY*!$$qV*s$=@Bh`h&CEIg z4H@DAw6qS0Z1aWIz<)<;geN8(er5GLJ$t`eKcJrPT?su15TonB(RV@LvH;20fxs}# zkD!da83F+?Am1?|L~|9E9J@F4*@4c&VV_huF{b5Nfx4Fn-;d#8uYZDkj$zTEnJYFK+IJDV_N5L_#7DpjtgE`-Ez%k=xLW*T7d0}<0uP!K|OUjWeSg+~of!Aie#>vzi?(lIrL$15fMQVfbI)1%iUUxef8D_2=gUpuqJ2#L}CwCp_6Xmt!8>dByPf$u-mI z1NR~+qjW2xKD~~hNr{j{MO?jdebpI9nX7C5NVkG~!|d*=R#ukp0hcj;K;^ipPgxd{a5{wW>~|3sF;3pJ*V(f!Ic zV;4lsk8qZ8^vSj!kVEmwmhvh594Gww7|Gm@5U!`R^Ujm~*$3|$_U-LMSU>$Vq^Fc0 zK4c!~W>bhppHBtm>ZB*vp6=1_(bA|}orU~cR!uY-QU@VS>$TSp`+Bf7bTF1+BLdnk zjoVe*2PHcQb|lkq!9KqY`X%Z!o14?SkNrMNw4Klnk!f|y567Nrte3;#`R@oQcg0Kn z#KeHr#biry7+woY$sh;>kt!r82d`1%UkPobke*)PCA=U2vLv$WsUT25q6_;1^q1n~ zr_TWEz@AyWGsyQvRlcZTcMnfPm8YobrP2@0&jfCm1LzS{pLeFu;wEqQ!CkZ1qc5HZEO#Hc0EKE4(#FnEwL0d$=s zSgT{)Zd`JnJpC#C-Ziz!%axuEvw_K$K+MKgneY7j7Kz6ur8ca-0bcOg_NB9kQ&$6a z6QqPzPv@)XEx_;a{qRxFo>nAQ`6ZaW#XA7ss&^Y^hwQP z4s_cb;xs-Pv{>#xxXCZ(_sXlVJm)t(MkI@llttu#LXail~ z*;Se?^VrGy(($bZ5J5YhoXY_OgceWnJ?BblZsTd)u~mT=7XOvpCkKWYJLT zWKzY}aJ(PIMP?CtP8fEKYuss5;pCYd6|gOLkL%hh-D9-TQ9j;E@O4c_QX;uGtbJw} z){uStch=1EvY=#Y&&D^7S7mKyQrJC2EGDaHBYrKW3%RV`k{po9f@7oa?PBwu&n7jf zCS>Pqi8G^<(J>chGR?1dkNoa3Btia#!zd#ldfuqlbK_p4d9yF{T&?o5NO zHjQc?m*@3WP}#>W67LOm+ZT2HUuy_PG2t?&*-*N5es>9lbDjhN9JkB;wsvH4FQHYc zbBoAtz?MS>GU)=b;Yh+NPWi%ZC#!%f>P#7c)wV+pRNu{}q>2xA>4@`Li)+~ygm}(a zGw%32z02Bv=7Y(9za1BojH;SH3bB_0-%9LH126mT+bJOem2D1%oFM|W+sw{_T=fmb z1?@P})tddXVNik9d;X4{{n*4;YF&4V+R+wd5t& z06$ax#N7J!0KyZBh^On#ykJhu0J|2?d9^cL8I1$h;}f>qiY95G%r5x)xxS91wh{Ww zP&w9fY>uSWU=TW*Kf`NDtC=w*}|S_WuUf)`6seDxlSAHS8M6#bvz~;!i@R%8>NHXRHVy$ zNtn+u#*^bRQ+Ov}phaFkRw$sTu0?XOtwJ~4^}B&8QzGi@-U4$C^3=!Q<)f_CbU)~1 zyvbB-@QWbX#8|l9&)2iNGV+(^;s;4HQncv!ZbSv>4fQL^OHWzF=2H*utY0K{JH|E! zOOJ0!o?1jLY5QS}=OiBjpM#vgwd`ftDmy>oW+7mYu9$_oHYdYs@Io*DE|fnfr14|Z z9scFseAz_2(404|lW4#sbPiSwkW~|@z-&Z3@=>B6JWNjv24`0Y><=fKcdb7x58wgeiR}_CLMC(L_dsv z_s6AFL=3wQ>v&m4z_Tlu$E6r<*(z>1Lr$C9B<^!}TCG|AteRz>>Irf41KD9546!BEt_g>`MP-$}Ehy;V4w`F&&GIRXudB3*hStp^ z&v}J12V#d*oq3ZW_oufRB=XrO8;|SKf;JPxbp7_iX)l14a*zTu(CgCIw{}MoYhpxJ z6;qh6k9-_BhAj&!H3=KCS1YB&F z9HY0PvSCDTG|eptqrB`ZfESU{de$lUpfqPFYj>}t7Hxn?xZfKC(uvsVo5>a&1c%sy zGvP#E$(I^+md7|ZzA~Y)uwQZR4-db?T z*0p01q89D;8w>1q?P=(Dk$uV}e)BKB85B<{#FHOg^{HU%;63>k)HR$DdI0)Kv95a> z-rcC)AXN^`7ChWl?*IFd`^PRug-mB79tC`*up06JbGy1hnw^TSoR!x`gn;vWoP`d` z%2rzFOa9PZq&g9-(K9xFuRdx-p=_ZJJFjij%%b{Kz3_8E_$cx=&Lf#8U#LT%`axG1 ztLps^s@}F=C5G>DthR7>;I66U{C>?Z>86|T=QfOP_-|MGA=|RcQfBi8p?g2~;%=u_ z>gXh1^?YA8m_=PE)C=I9ns{3Hm`)rqBSZWy1DxOd51*nRIs}ufDweY+Asec!4BD9AfYPQbONKEuyaSZY zxw~5X@4=^!qSv1nFthJ>#)Td;5A}T%3)_2kQCa2aUED*LB6t!r7=orK*h7}Z} zKE%anZjJXupW;o)z96fIK|;<@G$Z-;rff&Jk1PF*d*=1gr)8vB>!aWah&(|-X;D$> zh<5V9)>aYj4+eRjQ?ukX)i7v7UQK8QuB@hC*|~{J>vTPpSZz09Fj9zP7hQ$_y?8H< z;rHTc-6eB!Z+&l_Z4KmFODx$ZYp{^|Ja8WV0y$RRw`?$x) zW@CJ}OW)^CG2P_*C6wc*@tb8|w1pU!iJj`K)q0IdtrizPeAC(Qt$lRXLU2a&mUgxZ zL!Pr7^OW)YF0g|wV{Ni0A_KgdU1kfkCZ8dC=A%1rO8E~lZ`OxL>9}BlTm!luQckTG zCCslIu3lc1eGSn7&EWSDdN_LyZvrY+43Uybg$xuqa?HdPc};(_@}!v+L7;6Q&5)ZJ zVp(DXqMGPOJE^Vg+J|tY`REhVM#HQdhZ4dYoYr07g}pZAE5t~;+?QeI@twgpCKm?| zjH$+$H?^v$PsCk1;)$1`H_VZ=j3RH=seqKS-U4~kF0Ld>h3BN0pK-~#v8@d&jjU)- zEvwL0IJ&9-#>AlHv1U&cd+qqN3udtt07%>0;ePaQN@#VV-e z<>HY3(4250bA6Gre*2b{+zUd4%?sjFGsw2;k&K3RVe*tW_uWKi8MK`?tLu0Q{R*aZp?A@R1 zE>^W23J03)neEaAHl{WCH6kZZb$8N!1AtJhM$?L?Ai|Qj%*L#7fRH##TB4q7It=iH zqP~x$o zKgb;yB_OsQQj;@|C&?gO__XT+q&jelt=2|-?jpi+E_Px~!jDPz2t{KpNH@;qgT-qE z$Fl5Una9!m&HfR$b5P^At(sd3HT6 zf4j_3Wv;!Os! z>2$taOA+;SV&=Zud62}cGe2iVW@{Nv(807dv98VKUE2Dl`?Vsj#v<1GmXYNVYP@vV zg*ko|7t?qb89|bol7hMGr9j7^Ssjy5Y%!;if&!2Vu9B(_J%y!+JgVIbBqGjee^SLN z`RSP``Fm#MqNEl%1>W}6(`{#YAI$k6_&y{NP5R&vyjpp^I*y1^hH8!_ELiA9qpZWs1Bi3 zIz}{@TIQq;Yl-hD>8UhoCUjyY)rHy-G<5~CD6HBuDJs4|JiOlteDNEXLL&&rKDaY3PM-S@53H$?);D zI=?#~VfYaXz+ev}rzSIc8SE=)M{^$Xns2*Y zIj&OMb;ps)>`sN_OveXO$Am;J;303^$*DL)ATOgatEh8(mMKD6*#m={^6uVf*loA_ zZm&m~XCcsD+TT)Cd|QesfFIH?HQ9dze!Ujp5+SqhAnZ1`X{lN{wK?urEu*O}m3#Q^ zo4%Ngr-ato2ovv%MJMRHGFF3Ich1)9W8pwEtIwOxFqkFH{-Gc^(SvG~LHiORoz$6m zdJiwW>Cwyj!YOQ3ayXJb0#@@KUwC5ydNOGIW^}v{=@eCt=;uO7MV)Q+Nk6;TuG*a) z+M}{{yb{&G;SbefKql@jWVlMeEPn8BS-EZ^bPI4Dzw;fHj79=un}uj!Y$c)f##4CK z?TznL10X=k+@Q%5U?h?T?Y|Yo(X7ItlEzOCsnxTv8l!m8Tii;3keY%S#RD>`F{rp@ zB)F-7DMIDhqUo(mMpAM*h*4X4^yZw^CC%<9%smXJC-bDw`S~cJgSz;{WPd|04p$`@ zX`SqUqA)`0GfIamOh%JWE#;fmBO@3M9NdICYT}7@vl~N>Fm2|%iXi$t)&{bHOq$8q z&PKIG2~Zgvabv|#0>8gjMe|DW%rVGL3MD#OanC6uY`HrzfEAl`I#f<>Zhxxz0PTAZ zHqt=l`Y9X~seDbh{zj=bfZf{>FL%wZmC^t{+~|k0gpJVM$<Ja!&GC9Wx1TSHs}Gi}yYBL$1w2fqU5#;PzTPoSV(CECQ!q4%;6`9hmdqv!)xG zslfDj&)MZ+k&`_NjKS(@Q>~vU&_WFCAf@7L;B%%qTcg zW!V)?CA;YqQh&#)km5*fk+^geE-x#lj1~oD9pl_ed`xur+vPOUDrad}4jM;V@`VZ7 z9&|A0r8jc!=+YKJ*hY8rzkbO2ejSKKGUuW3x;)3t5aL*%%Ik=-#!WCC??=$r6 z*r}P+;#oL3UrQ!z-amfZqh1NFsxBd}Lg|;sf_U77>(zReyFv_|R=Mlm=+0M{6qp*U zV|%e>dd2{)MzxZo{Z-1~^^3$LNd}Hz*L4!6taqCEy;T!t1h~A>z7F`t zhj^hs@$;B38q_*C!zq+rq7~a)67SuoIg{42Rz`MQ=^4vVgGh8@P3>@#%Ljy>yLroMr z2HftA^;hKyyFb(u(H)97sYQ0AbM5lrbWDAQ`^1HnHdP-uZr4MNqGyl?cY`>QK~w^) zJ|W}#yN~3KCj5nJP-;C>rP4HqJ{x&u47B?PpI0cdURd+Cu*S8mBNcVy@I)rWzM*(R zGn#)?s+&g6SPNL!su+kfn_h@ef_pT57kTZo4~m*f9ASHced}s~7SfEqV+8 zbjJ^2`Q7>FeV?f}Nk>ybm-L>OG1bu>0-%|M&u6SNA>4U`jgk6h?|m<}kzkVVcxqDI z4N)C4bilu5bBqE{+4%Q5EugUHn%lR%dp5HX%@kP1z-u_<=P6)N8#)*i?aE5^?|*tp zUtNim)h z{HgJbj?Y%p71n4B`vfC@CIc#H2qA6Jqwrkvns3{qcfeAW8khnR@;7XXy`FNZxB+e# z3fp0pM41`cWuD<{DEJ+|ZvSTw{L7~QCh`kDBRB*Q*h7ErT2HoZ|0ie|Y1Pz!qsPD6 zp;)%I*7#fY#n=gG_boZrs}O?Wjs@20;P zQ7W7F2|fJr=>nzM`BY-8cCc1-k%vYD%Dru*!q9)CpM~!SV=wt%=GUL+<&W9%Z?yg2 zr^kN}WB=#G_;0k$^j8?0jpM(BvHy*>|EDsE?C_WS!}`dZ4G>EHDG%eI;RuHXM_9^1`CJ;|z#RS_va zDSWS_o9L^;vX!e)fw;(@&@?pt`-N;_TY<>2C`b|tLSeF~pdkOTXLT-&|=6xo46A`Cxjq@!FR7XP3Yk+OM(P}nDM!QKtccm4HE(%i3JG!5g>>IeICu`pJnMKmf4Euke-W#f%8#MvWc=N`xb?N8Al$7EM3MJ{b5;xdGJPwz&;} z9_e8Y@hn_qdknD6A2C)RVq;tFSl_=ikQX2te>Ug+?_J#8L^ysA5O3*Ve5RfP3+=gk6r726&U8ZCgu4RgO7&*AIVY*i2Gnyd+2CDSI`lG0D%OE4&6L&L63a5 zYvA8L&XDfh3}Fjkq42NUbl-A6N|*Q9gaFq39K*q{ri@$3xt+HGF1o&dKoCO(?sS2C zc3s0gVcz%!Jx@`8A|8M0em^l18`3k{`QXXiWLM&T3blkFk9d*668WChav6mDQ?%0oqK zuhl9rlCp}1a2l7MdL*3UT35=vzP+g zZ>d4cu2_z`w=X|S-<8^_(0yu7cqX$1-^kD2`;_-fx%;*gA)poJ- zz-otkqGXq6xN1qY?uQdiHe`BMwl$eW76skQ6m%6yb746nsCIK1NpspP1ICd5rk}(9<$Eq&b3hfZrO}e0kD8lG&yG zcAzu%%(*f^8eDxG7fJj>1eG@wCY!}BqkD}OZfN|M&&3v^5~0&IN}K7oh9a#qOGjUmH=HU#+j1M#I!j4AX6Zh0PtG4ZCD7;H5Uyix>_wvgvK@S zvZjMH(gzu6<)Djod&k^x%liQtOrah5{xf!wXL12@4xkm~2n#+T;dQZ4I#knUpw)?s z0@8$Uv*U?yHL3itm|~{@;DnC}p%U9_ukiBPdV9>oT(clKHyvJ-TlXb5vATrJZ(=ed z$2Q>=QU##HS8mI4ZLY*Lq-A~ZOgwvA^5A<6)x-efhcOV+RF`S_CDbY-)4B1mwh5bE zjbWF+c5Zp4pPDhlNDj{h)KQyulZ|JF&o1e_% z5mw=Ask6F{tK72JCD*dCsr6w{f7t{!OLE`?{1}i;R8>MFl%OUS6SGve?gEYLj0l2W zHd`e;P*d)KHoG3o{*H#Cnt ztVEZo;b+uoVf;Gls*z(lins#2$&#m~Wh@7rRV*pS9YE(9FWQ+_XB~@6*Vv$E zY|gP}*1m@ug&d%fOWOxyUGF?>I**3_QOEIM`%?!`dg~ViA{i?)2CI~FmjG2(Km}s0 z-0wQ;YurL}?rqA@ zt*zD~0yR`#FBiWdSjZEn#sn9yDleCKHZN~+nQ6Dc9j`FIBjZAr* z;_iSO1mt@9pi3eKC!mNJY^kCr&-?7P>Bpz&>|2H1c!Y<6A_1l@qt3L4t!p}m3Oc{i zT+~fzc=M?;@-x~(O-#AGmNC4S_85VYn; zElq?xuw*rD=2P;Cy_`EkywhB0!h@Um07J-@w!WT}`uGZo6#?((UrhLXpEXeY{`2?x z^2sk~FVGEVtJOUD_k>YO$BW)7MV}AU7v;e-0ZH@WQ7?~QeXb-xkWZAUr5tX=A{Q1{ z3gZfSYXC;fp#+BC3R^}jo2Z`{C*ou9(*F-@?--n0yC&QwS+Q+<#kTDgbH%o;72CFL z+qP}n_LukV-o1DC*>%1?Rp&>ll9{R}_pDT^o|$otah;5d_6F>p?+%G(pZG1Cfa(0k zP-!{dOmG$)5N*iI8vdYsF>b(1=A!cPK%yUGxB}z8Y%-2k!musAEo(JgTq(qvlXreD z=UilK(c|?5%tktOvB;mC^~2_H{&n>S%h^#gUC$3CxQKyJwx{>}hZgGjAG@&m0YjrG zkuTE?hDxDA;08H;{+CsFz--_g#i#7Sf(E!!TnOv{YOlepKkEKMk$Wt9R+IMZ<@=Y& zN|l=lfTyS3W?GYb;$pdi9xo?;63+2!LmY3l69!G~6n#rSg`(EYU87m|Q){J^ftb#$ zYH?z2Yo6#h|M=ODV{jF|TFO&=n8XcPGPx8@SXzz3pH4G?!`<1ie7R_e;9UKdS1uZo zo_!7e+Nmf`vrs!ry+A(YqC)@pNLE+&ocZ9=CK3s5WR-Q|oA-Id+VctTG_Txz;RcC*LWyJsO$JZfH{&XLt4F&SMEfn`yiHviEJ&*e+1)R&qBvYhfY^H zhP`E)z}WM!7%UDUz9j8{FZ;CXlelKHULHc>dolZ958Kg1WbY}m^D&6$)Q2R>sJo0@ z2ZUNp!sOl7I;cjn#2A{k^3ou%ZhPq!_XN}QSEyTj@G;Ukg|Lb_@!n0r~Mu7&F*$O$#F z)j@h{lXQ21qFdHO%3z3_6+pHcKFH*mnlw?SZZ;(vP%-t}ZgNIUD*FZn2Wc+$-qWYb z0q)tBvgBtON`aC9Zb}}no*yK*z|VY`0UO_jNSwLFDtyy11mG2EV9YaUzj9@+6gUNE zk@D?%3KbYzMUX++8SATr!vmrpvKhJa8&<2MR~jhtgr^=;9F9ijD{(Kmz@;Hv+j^OxXQj7ogGQ4 zm$&vDXJ-|pFh&|0S_mS61`s7I1$2bQRYpLC1G&4G$JvsyFzpwo|7`2ie`oAhvk0wN zXDBOvX12xh6T3GCyFaw)Enx6Q2;P+qmRAx7`Mzw#si<2R%EZjwGAh47dQ(L;aa&+o z<&m_F=>m{BW6H6RQAAjUiM-u=(!Sx!h?}vXRN0VT=5OD)UYUc^mkX<$KI)ai5uND# zwuN$Qbme_<>ysvF=q>ZQX~nCf%ybxc69=rPu@04M`Z}!><2k4Q;cVcw#HJaIVVjroE(=Q`PdQ_#z-kI z4q!VA&GGqLq^9e1yeZy!hUCpLwT!0e#jWxcf(AvjfU6h8b!pN%65y3;bF9R@{Hq$f z{n%;{V^tGS=E!uY?2zDeTsz$*VIYJyNiA~c#1j<^RTdsgdLBE#Z{Fe_;UzORMTuR- zg}e-K7bENOeW&-2-QdX)| z&;eB2FLN%~gOdnwJKJHK^Bk_l+rgZ))c`&V@RbHfkq*D;`k(4>@+H7pR!t}j`*>@WN{z;X#5W1R*$A7gd>Ue=0>0t6Z{&IzOG&Z{i~ljFyW z%(t^`BJ#oXRd~{i9WXA=HwXOyk+n`CY1X~nR@n!gp6EX*r>ZfOFq>u6Up&fZ;tlX{ z7;5+UQnA>k^P>A?CO%dKjBgIvCYbHaUO!6ECBJ5S0d#d`%#hJE-vN(lUSRczumLqH`hBe`!LHB1S z66iI^jA(`>g*GMlxnq|i!LUd)(6`CEH1ABPzx+a;CVXlX!MjHB=j3g;P7@IJ#~jLz z^;|vAPRw)sQCHBm>etf))}RhI)pkNvCFfN1dE8)9BkcoyZeI-(mGlnA(hz|g{i%-V z7C>TG*2_<8X?G}*p5BVeMDs`CcpRg6p>CZRCR7i;d@i8-xACYQP8>jHnTg4Kl_6)o7?Oj$gsVnWR&a273u zpIcI&lgF%k+3w6@u2dU)%Lu|#C&hYlEfjTg{O+QnkPT0;s5v%Dlt-h0^3o(ZT2@y8 zDJat9B5T&Rsdk5wNn~vqj6(9bg%}1tj|>nCA|Cve!JZC~#APh50)`}e@`K%h|JRl? z0<{MvyvklageV+Sm&R4;(hC85x=T2h`xqeey@oMrhZ17a08%9imOGa9F=-lD}=10;qrSv&LVT3Xz-il3JYd@iE)WZSQ&R88Ji|O2MYL>cD)Cog%z1%5uDzm{2cUXrLd zhpp6zVkoE*7#B_0w@~@~0#SDydXvv|cNd8u1e_^@xI zG+8bgb^t>SKvC^i(*Y2%wcJ#cPQwHw!#WX|V;#GcMe#>0%B*rsjZ-032p{Cf%W7f8 z#Cql&M;O@N5;Jq}OVMtBvW9`UHDhVxjn%(xjdNenH?o-+nLBuhbJE1NcKV89B4_ro zGc)8>z%EEYp42r6HSn1>E;_IK3AUL0n50RDA0QX6Y&KN{E9%wh zrO?22ZjFj+WU(UTBMwd|{;im2XNK2Lzh!a*<=@TGZ$Z&^f!R}zn-*2d^~$`aDd-@Z zt^|`zcnJx?$}twU7Zc-{2C_c0@`J`rT^30*%Nj7Wv*(SUpENz;L*16}k zL9<@#-7UL{vq!Xjzeak!oMO?B|jms}3sBw7j8 zqfQH(k`5Fv-|6^Zafmmy(wv(aGdi%ytds4}3&cn4Ysx-@lT+e1->iD0!)nrNnWD6{ zXA_0JUe!L0cFV48X}iYDOFhpEU6FnX$YvS!*W~8Z@m}GIN0UzC1I_C`lonfe#8K;0 z56%kHR2<(1xRJmudi;w3R{f**)0O4 zY`r*-s9R&S(F>@BLcWggy_=*P*96-70#Wvj>kn?{x9_$-!Tq|C%u74?p+?Q#?%OM{j( z1yy|`#81eVHn#n@s|i#2QDs6SQMV4Q4ca4f*B_%ogx5x!C||Cn+P3#Im_XV-KtB0d zo!&-bWSg&_R?#7|5e&A*QB_$!Pg)y^uV7_@o+p|j{AlHw+WOfu1*hUcax(_W7>{h? zAL54i<2}fp)*~w$I%2J9mYWgsMoGMVB;n7B7e6|j2mA)5;Y?14tzN*qaDjK=$l_|$ zE|XSG#i0rtW2R^`^g#{&BrK`704qhbD^YndLGh+hGwd7e%$nLnO}b~tXYs+ZtDBIA zfB!MrbW|pY+FoOJ%VVbTXBH7Q4xgHYLL`u)u=CEJH0agRK}tTn5DgThKM2WeW%PQ{ zJnJiediY*pjUv;2LKd?y+fG|WAka%c76$!-gMrZ<1gU$ZR~YVy@s(%p46^iG36)Ez zL#QxkfH7$Q{qZUCq!s-395}cxj*)t1<|ySsIqB6A*-?7u=$COQ?zxkOo%q}8?HFnp zk=8F9jVAPk#(^AHXbr-ye57(RyqWi+&bN6xNln7HB zF5X1vSI>Ny*|H>|8OqjkoK~gN>z`lwn!+zZovRT*cG;<>pECgvg60L3z<^KbJ0hkp z(89CPKoU%tDoVVJiav}C3w5x%7_T&h*++vrs7H?pheL6Kb%AN@v~Lyz4fDqpEc^>i z??bX}xB-PeTW@dhu^ah?6CP{*BkBti6-D|Y{gv8T`Wb=|T8+yf!Mdc2jSYJ(#L{>| z4opRZK&Tdyx8@DHwQ@T-{_06{CHuepMe!^#PbETm$Mm235?vZ>6311o0*!6^0eab8 z7<@uYpCr{{BH;7XkB=XB#0i$d@?37(*T$9Zxv!nJ+LHv$=vm)M!J=(N?u5fI4f}p` zX*_MFQK3dp;+{t0xJ{cR)akpQAa?P?Hdz2(b<@Ad-ZbG7%+R$RCRC8p!T`<;S(iUt z9pQw7T&sS$WR_QLX*P{|y1nobYsJ&otk#m-kdpt=GH%318I&L`9WFzN;a$9 zxbmpqa@rZeY@IODON1A9keMc2C2@gyWay%I5-iitSp1#V+tHKKE>cqwnWy;~m8RRF zSJou8bVLrS7pYXaxd6@s(LJwxZ#hk)tHvz__L?!fpN>xPIq)9j%O)G$`77 zS~I{GaH+xb$!N>$L~Ytqa9pP23;UzIwIdAAZHsBQb4FhQPD1|gXbxR021%#OOYi!` zIv^vswp%4Nv=FtOjnggKyWyX8oY3zcCYMu6%OfbOPBmP1r&O}2EAGRq93M6K_aZ}l zJ#J0C+>~MxO|uLaO)nGd>v9pOLjM z_bc)C1u&?*Rnm0)!LOcRu&37zNRT`#Kvy>*1@E3FFK|9c9-LjhG=^^HF2IRYg`GKP zC4)th0>dwt3^hv;kEg8|VgmXIge%S!!t>~v^g&ur%+R1_ShIJNvd9`AYswT1-Gby& zI`k>Ylo%FRvbnDle`OANv1O7dnfDq-^5rdXv{mYK@_-?O$Frf%wnbwhXRPryZYEat z=Rk?(%)u!0p;pzjh$zS2$jfH(t1=bmSx7jX+SVkod%*U!t(o}v5SC}J<>k%h9xj#% z&ph?ZLtYtwr&T9f^)BkEUn{Ii0x8YJK3FsC_WqEQ_C& z6fhslQ~v$!obpX|_Lv`oeh}@*aceytD_rqeJzez|Wi2-QA}Oqyy)jQeSl!C?K-V1{ zJ#Bmy?TT&L1%=DFKy2l*GFs-ScuCUd9OqJcW1@6}_OcR`sC18w*691Xb_VV0jbY!U1SBhU7Nbv)@70&z4en#{u68;^_3+U8nFF;4#g zEe9Rsjqmz%#tqO!h}M=n{ixVW?8kwF6gb&_y>?gl;{>voEJmrTvZ$l!ztY##->uO2 zkTaC$^VlokpAy}0T=2W)I*uqX+(_+xts{*w9t35 z@7}rWI~eD&H;&h@WA9_{6r&>%Y?eQfeisPvLSntw-~|Do2iGSM^r_5HsP?0;a^ zzdvJQ{^zX2->mhotKXpizXllo1GxTm^}FP1-^f?cBcQ_j{SdS z?XG`$#h^5*0o9+py0)GI+@%=IRLT7;iO$j9uB7^aTqe%(z<>Lv3 zOXTBAfo4;(r{1`>-X_Oc@7x#nwJ6z*uRJU3o_LlVl^0t=mV>0h72pv3_1HFkqtr#E79*)0oYs(&Z+q*e9 zcy9neae8|B@zuc}NJt;yUR{%JfIxfEY;ewAU9CSDppin`zMn7x*R7neN7QhjV8Fn^ zeX^aq=;dj-(d6)d`dfY!f@=dW;_U#XCqSY1$_8&8g!%yk*gNN6;niUbqM!lv5d!%3 zKtYIRdqP0HPt$-?@hxM~&CP&?w<8?$_Plxn3HfxX|KJfDM zc(LoY2#UsQT@8YHvKKTh2lgohFO}_WVFiwj597mUaDWfc3&scByU}C3eaOEFzC8}X z&4_dhH{h<{4yYmk5iFZe>3jX7_pSFG0RZ+a2z=m6WvFY4PnLY!*MASd*dGfK<`pbM zN2K{P1xW@s3>w&q54_(WD7xCK(^Q)7+(_I|C2M69{NQkBHCNWak>(n@A6lzKg|cF?iX(_0Pq)LB>eT2 zY9Kn0KEj`EUf?D_F~Mzr+T$>G;?|3t#0x7itS|jOZFvo4{gx^^D}*In!+$) z@7Wd7K$v0x1P=82^7#{yj^_h%#p4U232j@0{?M^y0u}uO27V9#REbV?e9l#{4?wr0 z&cXPZA_=5pP0PFG4XpxbLkAT0V)?vfVHrpi3>fJ6!kJV@vF)Ww#h=t=DkJu$eYcea z0E7_y$B%T7?%KSG%gm}{y-axr8eRii79CZ!zLl0ZFsr-q8E0B9ABx)(o!xIkN&L!l z;M$a5&_>iX_6WV}b(dXON}*KzPIov)KlJ2nz-an;I)K$LN=3=6t+}MRe>@>cAktHS ziik^G8@}lTa{uL7vw)FCXA{b$0!4LAiRXdF&0@yjq$C{oLGA^tMkoxpEjSjz$Kyye z&!T;wjowN^x3GfmH6~+2w{X2j0e1r#LH1ZZ*8pMDNqP73)8zU{!X9GF$;rz}gT-nV zr_lL|c27x#!9k68S2C;+O7#3abdQ*~0cpiNAYwvcL<>%!@V95-yr7%uh~?#yI+mk8 zp1LAsqZz~A&1{XyzyyUg;z_{)(Xfowlyo4>JGwKwf+vji+Kj$hL&uTY(UIY9uj31i zEjju5Z}GjA-p!QzBf0ebnN_2y;#Ops!UOu8g?vUA+{FV(5zT$%NzqM&@tqETsT9eb*Jb9PJwzy5zXW>o7`dO=+?qVg2Qdt?Z!DAfUL#IeUt69BLp{dF6 zf@g=K2cb1G7}JdH3t~o6^;75_uY!Ay+q7%=P+HS4WlgK(#rTN$J-NsxCFV(-;j&Bc zt&T-AB)9#ZicQj=1QYM^oJHXpGzg3rPSN|v6zye@kYj0hRdC_ zUx#EU>q_7LC+KF(7-RhniGKRfds?9yez0+w?n;}D6d##X6qfFH@_e7weM^d|o{2Y0!h4^lzWHlc1wsRmL>I?F+&*!|eF|*=EI!j{r9~CJng9YXoXvJtZIZWRX9$AJZ;G34YK;+&T2dL$`4~$N`!NK;Q>ch zuIo7Q5|_NO(IvXN#6`2-Y!f8iM=tWt5Il>51=#hc4^4rsYOXc}-xNox$mZ2ha|Dz7 zJPv?MvsjPodDg&CAH~KNxQgL~-IBT+f5P59_PT5}0>+KgXex$BKC)jSoIC^FISeiT zTmt+ar}3$X*Gn0@Sk%K#TMlS8{&C_Ss!eh1nopx(=J-=L>|DU0R`R6Q?LGh=uqt## zp2u-h1*Ipln6xjc$nKWd+WFb9meH7&yDC0t`(ycmAB__#P?1Jn%GH0@lehv~F=Vuo z>y^r7eB4MuXnrp;FkG#JMN^z1O@Z)Mf0ZoNL)u=dHqmr#KtVGLH_cy)pH~~*vy5(L zmMvw;Q`>|YMf>PYQ5VDz4Fe%%^Kj_+Ap5{-xsOq%(xaJ!ayTL7ToOxc(F5O}$I` z=OgJ<3JE`IF2LbAnpP~lpJ$-mY~y-K0Xrv5uFIo3)v-gs{tL9>V&v0}8?P1jF(b+l zv{8nZEuK&~ExQl95sxL^n&lNa*oN#>Dg4xOcgK=$`&1$QdM*FDD2_2+%<-yYwZ%(? z8B>Gas^B8xA^4f)S4$sd;E@KNma!(q4ssY98{BGw_MsiiXnO07X0WZ`+lXW+0*ZO8 zc*MeC{ZbK07uC95mHXmLJp4(W^J1woRYV8MV==aso*h2w_GZDru{726>0s000KYe*JeuO-Gd8lw!}%G?>8h3)sWlLLubRF=}l_ z^EizI47dr2PjGhPkvkDXewVZ`b?V;+NoTx`wNLBS^^+@7XtaY3Tnip+n4vfoaBjLt zi7L3~43_m0!>E4-U$yH-F&X5Erg6T6sLC5i9dJ!m(On zNh+YG_Tf3)=L7}a&5PkxSb*Lf_RCc+x?G1iOgTR-8%FFXyv2M17-$dpDeGnD$?-!&oAhzC;g^!d`T!1V7dBj5n?2rjryrPI+Kcn zT=PqGo8)yp8|5pY?MIM)F2_!X>@#vV@kPz4~7^x4NN%@ zqZ^`==a5BG8ylO(vmh4$k>1YUeSuUiW375chWm*qyhRdv@{l2LYaeZfbujx;m??ka zSBnw|+AcG;VT&ky=*)kVNMueYXg0-LC45sXMqXcbNok4PdA`jYVOS38*v$SI8n}S> zd5f?F4mh3c?3Z%LuoNw^cr$sGpUYz%wChD+xB5$LMNEYB7uG#kj&50!!h@#8n_v@3 zZiSZ-V`!B`!g>VamWdPmF&Yi#Ze_=G5f4JGX_;c1m*nH3Cgm~e4HBlV`oq~E)HDy= z+efq7sm_M-VaI*@)c)4xPdjg8xuanv1}CnKei+@`H}BJdBC@j~ZJ(r}D<&JH3n>N9 z-PDkgHa|UmdLk8r6L|M{x=FNHyQIU_37;3NLfP4Y5ns*|nYC;VLqn+#0Jo_O^Rt3y zv801#W9gVq0P(}AmK1G&sfv@AW~{I$sQpk6zk*JUp_|2P_Nh6r=+iy>ZK0Xeoxoqg z!G~PrRR&$+!;B$#;yoS92dhcj?)Lj)|-(t;q)|kY#Ft2IYN+~eN zXe|{>vgvP=#7Y_|)=><+)p{4oDu35qL4`3LLs9SB$M+}U%->lqv3knNdlXsDWR{t2_1q}J5tCi4f6(+6S>_rdCMssS>iDb3(SwvhE>s59(8RPaU~KL zsk!}Urnlr0d2%GQZdzHU{I5@^Tj9C-PVZdKVg=ZOu7$1k&!Z;6q3O_TdT{uGD9AC; z6Om?N2}q?&M<^8Q$`9ek+1o!<#|j=K>4{2wWm-Ld@zjom3^}BsJ|=+j|KuVM?Q+jy zd@%QB$7#NV(*mcBGH_==UDUo@!mfH7C*t#rhM{O$$UD*@Df5<~QhmyqP;ft>Xgni5 zOT}c{5nyd0I=Bd}xa{MVf!!tE#BvpI*2`IF*Wu+qkT-W&CYU~IF0^3TDS zS_YEn!s8~*gOb2~u#F5Yy*nTuhjB;cI((yultBK1o%5tgKg1t3#E_^dtKr5^DGXc2Wl1C-Qf6mR*{KnL^|}E1K2g zuv=3P&YP%HEKaNTQsnQZio*xx-cN}Vi@Li-zwf8bp*~9%td#PL+B{g)=;X^QP?-v( z#ayJ0HuTu-T`)x^g}}#|0kA>hxpZVy{zUi>mpr+1AxUlaKgCQ6e%yP1E@d_=0XloCcbtevx+c~V` z06pn`HEu)Lu!jfG3-fNvkf9WEQ@VuSVwKN#dt;vG>Ekv$u6icZP)u@hS9>ADrGqgx z)l{*lm<*ABj3k%+K_Ok8?`qDi=R~wj+^uz_YEHTF$Yl0o`!^{xNKjs(vs!3e(gdEM z{VDE`EELunO1ZWbjI$evC8i)6vxo$bF1z(nYVA2C0Fe;XP=f_F#uk8(+jb2x<-la78!itvG25t9(H>4UE^Vzvff|=OP_ueJ6 zO_5Fp+D^NMmL<-Q8s6Brn7{TbX8Di3;24^Vz<}2vj-l6pI?Yc@|pW5 zjj+o<>nXfxK(Ci<&;W~PEJ7? zGYGM1YJSs@a<8I>*i&g>jpwJyni5=2(_Ajob%}rd&~d3yJG&>U{n;^!m3(hh*p^Jb z^am**p{Gc~mwfQbFkBf`$_<$6Pb5t!Bd*N7B&}Rm-vmnbE7?-}YvKo$#132HvkbkB zN>*t-Ept-7$zV4l_4D&AIN6~g*(H$seNFwSJ7HzM4oi$#414mRYig#V3Eau~WnpaU zXrldwYboCurEEWE%1iFGE<4i4_x?65I(=!fhqlKW+BTMgsd2l6C&4);;P6R=; z>xLR_)oS0Sm%#(bE}$1J-C5CPFfS~<55*hEC&@FH8naRp?IyX&4Gj&rw~fFj&>3dK z1I(Vdr3`aW3Y~dgKVLGvLw4b0Gw?5489y+*2q_=t0{J)n1m)V#Wp6GC zm4OS6*{kGKi@H_7nnfC<=u%YrAU zV!1bj1%YMI@u1Vy#g(ngv|M{D(B67l;;MD0zYX#VmT&tsE>LCOeBUkb1QV~grBO~ z%95UqOr&}0r^}R#_mAs+wEU@c*}Ua`5U?BE+`YTW8aX(NWv}-YE|UeoRE za~#>1yOryxh|Ig&vB-(V&c>9bJO4a2t4)@o^BdrUOT!vr4Sd@jQ>Ou;ba3uUL{E2WvG*c?+-1TNAP{fcxqD%el7p*A&WDgR zRxsG--TKH8v>qv!nxiIF1-4?77EReC8nbMC#bwNzXhRF+U9TR2T>E*+yO3!13Pt@p>4wAoUG-GiRChJ~im$m>q)MJafkvWosTZJaCp)j{IATe=o4RRhE%no;LeL$@{E zn3|l2Z>sZ7QL!}jfw3=fG(qBEyMb=?FHxnMdf#*`z}Olm?Yi@FdsIcY)mm!_L(Yym z@77F&*i*a?c;=sgmPiu0lkA-tXS0NYq%>tK`z4LQnIyiEXA*4&v^4~{W{x~zoZG>- zA?2ek2$PJW`*^04>~lPE`pewSh`AO^gnX}ogqS&p&4tS&9hJ9~ZyDr0*0eesw9oSC?ieq~v* zCcie_)A0%t^}F(o(80s7+wq`8E@9XQ@o4s&;>?5GEAU`$ufp zMV-4TS6x>j?nm#AIIE&J=IdqRhNTx_pjm^m^wC6?7AR?dPslEpwCCN628Y70kkTra z*4H`3U}@;_Sa7LBWDH^GvQ&*tBK-xLv|3#h)2Brk<{uOHi`nfOjw>X2lJ1sPczuu_ zraVWTgk?x9j5RaX^2|={2ql)ng`@YY{S%H5Hmha_kb4GH9c@lT*Bi*Dh{@r^!|s6b zyIDc`R*K`WMsOZuOq(6Ytn)_~*R4wIVNyl^>PU&8@pv(6@`LuXO#BAWin^?ij^Haq2}Ui9<>`? zJI@`yk{I^uC3jGW#H$iDlIETxiJORov}Jy^W8*=6yyR+&u8-r7O_GD$Sj3?SM~Igl zJlA&iKJE3zn`*62_%T@DU}>{ZW!|{@-^@_@SOOo2Ukr&D=fA-54BR|eI&?o9K5koF z1a#^>ZB^ljF~T*XM>t{>VYnBp7HKOW@7U&PQOfR;Gl`=e>e7^T1YBfvy)M*pC^YOr3q23jB##l02@LSRnzgXf3RdNo*Cr`j{nr zVa*k()H1ci;lkB+D4Y4{gYqh(!|=O|f75ovEWTBeGoRG6^%u_z)!h!L_5ofj_8hcd z#!P=2i%;$lrr|Fk1<9(=;5Bh=-acb0E1V!5nFA)RVN#r6)tB2G4cv1GTOTuofk?PWgQ z-@9;AGXBBF$(RIZi5?|^s*vO_JmcA>Ya&_BJ74M=dMM%!Wg8e%SpbdJ(k~44yGPjQ z*y>4EYIwq6(s!3|p?}));`^%jerWsx^yaw#62sfp0!K#;;_s=>%>DxOoTfhgca-`c z8Z;{dJ%URu|De==tHS@lp#M8ct)`|Rtt|3Q zsinpLoqNypx3B!a<|NYYc&%^$EGW|b~`R~{?%l}U* z_`huC{yy`+rPJT}f`8KK?_buxR?fd+{r@n*|Gx5%JN*ZpX8LcQ_cxtp`k$3^rvF(v z|Bko+jjR8!blTZiHEyku#upzrhLA8LyE`{-y5LDGKkpBGEI(8ACd?}(WjY6hfk9~8x;~_2#75~&V&}acN6e$ z9UT8#2M6!87xn#Ga>~wy`qse(qWLtzCjl>gzjbh1P|Tdabnr7gf@VYPZyh{7IyxvQ z2)`eMGPrkn?B@ChH#{3yHUT!&P;;MdcUY{C8$8-`76}v(o6jID__=iu!YJ$!U{AM? ziytEpq^RDF#(Fdz8)z^uj!AyWk9pC)n64gh#jHnQFRV|3g44;1bzP+@Awm8t zJLu10cv)txHFiR?9W<#7}7N@@JG1qo>PRYHKf z&FgoPb3GsMqvgw}l|&30c);7|tLp`}eficq??pKNYxv%KN^D|css(P z{G^sQ;q|;@-;QB+SZ^5M%attSb3nMydaDh3@5I4YM=Be*7Hp`PJ68cncdjq~%+`gF z&H{X<&9Wvi?CEtHOV(@ zc~d$#Xh2dq70yeqsn0BoAc zupyt>LVP8H*cJopag-?;T*0ZLhT*LX@lv6n!jXCK2Odfz)o6(^4-9^pCY5-e1D0{y zoX;!RagS$scJ0+E4k=%ew9tTNz;{t=3zD1G_t@i9HcO+=gVQNQFL)4Rap&q=E*V?=cZcLbWvU3p*t{{u}-q16K8?;_RrR)t37JBM}wj~!4UJ&1`13JNu)h)ZPtr4wdZFSB&z#T z+*CQFyz`5l+UhHfgBG2Fxhr3a+p=pbdxSTZuS^aaP!bS>G0)ab3=~93+GR}FvfVko zU;Vh|?7Cdx*^0DZD>qj78)rO)mmT0?(Hp z`da@u^;Hh4Jot-jad89U$nLA7Ug}9)XN>+e>DDpw!!yZfl@Uxsub+uxj_Ht|(r#Zh9 zK2;)j{Xa}n_u@Xb2nV9{KR*ZbombanFGSnt;$}TIt*w63N0sE>6xsl7QZb=t-5n?R zH9xL|()#H$M`?)Emoy6;>{xH%5D$x#uQf1@TCkgag<~Drm^p1`9n^0+?o{WFHrJ6) zBc*qF%t7Qb-bdTMl5aduXjV_Hb)SXT55EsLJGYoA@H7ry^jSI)>t=Nws5}duhFjVQ zJ2(P@PS{^k!JVuHQnY0sCh`-dA9zL0WLfogKC?}Sj0(>P zX}WIb$hQ{&ur3E^o)M@A;p;q!;Ehu{unfoLRuKy2rGjcc$mIaPKLle zx|~s##^bEGKT%tQ2gOQWRzk8z^GV2!tZK=p+l!hT-l*wWf$zCoA!P&BIapxSg9GDo z%Xm-zS*+^i&x0xm|3KYQvEbIka1Z&AoWWDFa<0)kFxxKQL^M6lFHjyQt4E@eu>4)q z(=QN(x#Ia&TEWLp))_mrjoy^zxt8?M_gT)x$ci|26tQH-tTxvQkhW%Ao|}1lh%4N9 z%@K;RE;(?EgqL`VGSgD`&O6K)ms>~Bx#bs2iynUI$Y?G)^WcF>LCaq3t0EN> z6fBNRx_geZ3{{X{m~v;cDh~WHKsa8H-K<7Jr){tWn1&&s>qkHqb{?UKO()XM{b_N z?dwi$%UOV#-qsyNKObVPMi0I~<6hs+`I~-r!#il%LzJE*$u6SxYJ$K2cHsbzu>A_hI?eH@xLmSQ z#NHz6&FZL@wM2LV23C|gi@s9&gjigI7q}Z*zJZAyQ$wNc3dY7eyU3p2L9@e4HrtRt z>)4uAT-YIq_aVh)<0x%$d(YR_8xH^FE~02$4#6_Df6n8pRbp}AdR$mHJn52nGx<^G{aa}0C1mt;_bHhlL8Fgfz%)Nbc{PWJ zL0r_xPuvVBqAl?s98?oj#E}m1wCj%H+}_do-ng!iF-K2N%V?>6^`|Cdpq_fGL}Wcd zK$K)zy|~1p;7K&5gl12i`l}HoY&9~l&Y6&<=<>zbgqU=BzqGPMO>MDrJL&8R*rp8Q z#C!pzp?8!0%8S?^8NvUDL3qFIHt10%M%qzh3Z)#dYXxvBmO~!ZA{YA;qZ4WQj$-Lj zxDB!}sccPERRS7vuAgj&p5jL)2SpVp%3K~MUgqN|N?kiMG03Tq_gLfE-ERct9T^x* zk;5e!X(Mj|siDLU3{OnIg5%F+RIK+GRd_~8b?N@rJhL0cKgI9$Cuf@t3){1NSC8`t zqRA3^qYp3ik%R>db~pk##m}_z6A}*Y-6JbczX4CBTJ(u@SZ$+G7D?fwo6~mFR#N*l z1<6ubReC!b3l!Zc_%7xj+ew;e7fMWYpY~f=%nKy%!+Xmeb9V74ui7q~BAsWVZ|%{0 zM}CtkQUz1!wdu`#3Th;1#OxCv&WVQ>#nOas;yra5Xa_nTi*KoqUKf#JNK;+#O*LE; zZI~FzD${nNM(01VRB==qPpV)Rdmgm0DJAW$_Xu@GOvnf2#ly4jNc+AyMgdJuNrkez zMh&D;@t!kLR8SF1lMF*w(r!iU@FB4)13NraxH{|!yucUK1&<0;)P}4VW+8Pu#pQ11 zP@kW6EMgDIc98*$C9%OAJW!_jiI!ss03-w$Zr|}U-~qQA-`Vq_H~WHLBDR(Ujpm+0+7blXGn)bKCUypC3 zQzH}53{7Cr5Y?uC%iozY=S8C!@_^2ZovKmbTu=75OBhPew-xUs1JSJ(Q+~#JLzcJ||WGJWC51EwyNK9wlNGGs~1|Oh&lM>mzka7s~{W zf+jz#le6`%pVicJ`6VqbBHYG{^Mzlncc0-U5pg%3)}&QC-c|tDKA@-%gwf7E=^L26 zWyCKiBO-S!dJ(GO4@-hhIb z(m8i!PA(CWLmYmOiBb^zMMdIjvXmFyRU125EC`}Fl7S|OG$#{l%`5W+S)HNk{N-M-ksUO_O6<*MDOR`}V#JkC~rY!c&;Hr-0$F99TPo|T88j49pT(zZu zziCUD8A1j@{A)-lZB_xhcT}chwPI6EM?IWw0@b+1?snz|u8R(#UB@VMotK`qy{%}< z^J1O-)8z3X_YkAm|6%VPgJW&`^xfE5Nmi^C+jg>I+qP}nwr$(CwPM@0wevhP@60<> z@1Fncs{LVq*wxitT~~Lt>Z-fC?(;m3pP$OheaGGjo?y~V5i(t`T!ligB2Ronkd2{< zdu4~cu_skRlF>=Tw$)58HAhCn_FNml53DEN5ZMx*UL|5mBGcFT69JPI<0u15M)X9c zIB%}~nKSOZ!D_*{(~SAp?{{t9 z$bvEvymjf@%S=VvgW{j3kG51N!qq7Sq|pfmS2pLGFEib|)3JkVgjqGtoZCLR>-uoS z`u@q{)ju?$(HPEf&`-9y*iUO0K!LE_E0SFKK$LukE!x*mSt| z^U&uifRLjz^+$y6FV3xawxStMUfQkFcpeAz0x|1(<@Fao0UC2X>5UZIrEi_wC*QppQ{_1f zvDZAYV>X9NXuKgo?`H@ zePmJMIM0vH5*IDTNAf#_K(m>ydil^wpjjVlW0h4}Jh0SsG_vyt;)*cpef@l#vpdC$ zM!40Yq2A_fQF`iu{h}PjLUv9tdpqG1g-eTJ6WWR+PY_smKFoLRhCimrnwl`?n=q7dcAXMSEZf_KT=L#U z#8mcIoL82|(qC3v7sitI28i=Z&XIw%nZ<(^is@loO=p%LpbsSCQwJGSo9#IgAv}-b zabuc>T(XwqL#Y?Yt_y2CFtPgJWX+4H8CKK#7sTXf2RLtLv3D6)W-3}n__+^z(!cCk zVwGceAkoA&8ptQusot}0Jt%75@6OX+*St=+k{N6E?su5&>_i4mc?K&`u2Mr=L)ai;x#vgZPHR# z1G74Z%XySLI0EDc@@PikH6{0ziS<(m-K zxDehgDN<9m$!7*d)M+ciJe>|f=&{IUx##;p<>+svY9A(uuAItx1EUj#Yv;)7Hqx!M zsS}STwXLj4(GoLzK~8|%IoKl_u`!ZLIpkdfyB0x^$#@7{9P`)>Mh)~)BiCO98=YYX z0-HV1+pIXR%*{47t#A8eQW|Pl@XzVM;Y{+lPKivuh{fQ)c1rtg z`c<a2mWxTD$F=cVg^VV~0<^5G+dKud&gv--PU!r-XSHE4kgBPH{6RL{2^?1N|(bhDT9Y2)J)x|m37KEAX%nA~!U$ofl z7}ruTaVhxFU`PmndNB@#>7Zjr7rPU%s$55kBqgw^>cuh}ALpU*`ziS2pmCQ?4)H}b zs}Pc3eQGA2OhH2a_iLF(0_&ijbT^MQd#V@y_R5@>JzVV)Uvm(OM<%^k>kbSS-+jH> zH2eH$`cb^f+mqHly}!egOf&YM{2}uUuC?)G5SY8xgD@B2sL>&@?jI20f~*adR!y&F zP+_f|HFPcNHnivi`geP#X}-MPdl*mC6ySNHdiP|GaAJPO{C*~mM`bbylm&XH9n81Y zunP|2WQXm*Q=71BG((m7?dL^@5U~QrAlQ1II$|oWy5fB-7g?|v(AYl8^%Sa|a>@k4 z&3!m92>!d~=SG-!KC#dG3z(6fX;kUE!S5t#Lo}>?`qM%kb=*PT(rpE?VL}ZR8R>l3 zc9qAOt=yAbN@rQIX0D=z+ATx2?zmwInu28sxM^v)3Gu<#P*ee4bmB`4Ck{DZNsUsg zwVZe2Xs}nc3eSWl^2=g<@o(nkq-hSOL*#Gq^~IXy^a7T^B^QtA1LfDaDlhdlwO{1wtY^OHVdf;?DQ*V|=F$pz8nA9d{u zjJ14)&tA&mn?lO974BnF6gMY#KE$rx#e(~{qk~a=H3q+DRcjtmAo6H}Qsjffsj?ey zq6BW8qm!*3J4-P?AgwS=k+ru?m+GHQis+f|b7|4|$Ax(t&qv+EwT50_cT$wRT@tZGrk*d^uxpVXtASv+5p}`hSg^cdFS~1Z z)&P$=`Sx>PE#)AYsHpTnK8_QfitPO%jKB@E=b#k?1VFkt!h=4#-g zk@R>2W`)4O{fi9v?*#C#SdfL5`Jd9>zhc0@R=;D#zXy{4+x`C-Lr%-|pQQ5Nf#6?{ z|1+ulk7xc@;P-zbm4%gLWCf-EB9;GT1pGHf`@fBV|I%gu2dYf}mvQ?)5@3e!>CxZU zZ&LZMk>P(+%m3r;|M6Mhuk`=Y<^O-B|MpAL|M#KpjQ=Ps{MT*uuhaVfwxRx2SkFTD z4{!VTj$vV?`)?!3|DS{8-{AZIBC7wdAo({+|KFqfe>5=uS=#=+i~k7||BmXJ{v8wl z50ISc@0!FvQ1fq){F{#d-$nJV#u{_#OGF{~AP6TpK;AK%{E3_H$(xYyxM)8`_`pvD z;Z6N!+vPwgaUntyWIzj^h&4<76vz-CxTig@7#OZ5j$S0W36Cl|r?`!;>K9*rG8=jF zbAt*Oa48^%_FVhEfD!=`WxDI|{+5wR(Uy^c7#K1F>F>$)?!{$BB!zGThcm%PkYNmw zggm(n_hW0(E}t0Re4pZob2_F!KC7pd25BcIl_3?%^WE2)p%T2kM3bbHKCu!vlKfzYIWt ziuMX;72?q6!Y?BO0N$hfLk0w+xesv%LJ+WJ5|AI(^7k}$*fam)C;v9+=P4|}A@~=^ zhIY9(ksqEHP0;sIXJZ`?LL03Q-RAq4?2}c-%rgYu5B(cHsyhUp6(f}6#{e{tKmWOH zz!pg`Kp7Mm0LW5)_ZUA%j?N_-BM%1HmttN|HDe2PIWAUWjFpuP2pH_EVgWr2sACVV zY!{HX)gw31N#ymH`7Q`QEBnW3Kz?z%4;|3q4&;Ii*r$vQ{IT@}dKjPpC@AP4Q2<~G zIKYFg4Z?Hc=ExE@)H{@)cW(<6(8osXr4M2igbD5hWY`I0?^*1{vcIudAl{8JJR#1j@j<_)%6)D4fPQ*Q zg`3ZHOPxOqV*wm#U+w^XGuNo0@>EFM@9O(XetCXBT4=7n8s~kr#Xpsyz7h|<2yeeQ zW6DUdKHG&ey3_A?0`aV9TduT0GEBJWSb>jmZJB?6pLs@l9q$Gx{xOemc=DJn3kw5c z3<4U!AT{CLh!CU{`0^Y3K^F}?naAv9PHRt_+P@!O#*+}^@k|x)*+%&ehb}`N`*JVq z2cuM6H@{4V{pX4~ascq`P4ZxXz#sqw6zC1;4mCOpBItWBD-AoJr&l-{{I)PI9jhWh z%PkNf2_e+|nNY8f4?R+p?>nD2@XtISAA+C$_B2zfUqXX6oF%~|mqf3qaK$8m&g*l& zKKz-VhoRdp-7{O$>sto8STIilUtpgsM=S%|5}>?npY1u?P)^qZJ54?BP0&@3-jm)u zBr+v%^MH(WVGc1+&Yp;yHuqvXNi17-*%R<Kx3TWvIVEHQy^EV&6@5`7q= z0percK(20h%<2x@TsAwavZY=3BNgvl*Ob^75ZT%+YUId@1ntz=M^KI5N67aFY1Okl z7a_2r@q(g#L(=tzgDqUXbVBft?m**>@Zm^p2&7s@w)C`)Z*D@iCd3Kw91yuEIzh34 zd$|Rt0ouEF)yjx3QoLlye%jwXMDUAjn?Cc3g0vVFpj@iZPFGzc`0IRI;s&NX?3y&~b4qM4EFi9YreR zb@X?hr8u}eK^6&U@IH1Pj8ESVWk>Cb z4uLq=S@ZP`UKPh|3aSiJGsH2_@E5-5Zdz~#`_5yUJlLp|_Dp%O!FJn)(!@K>`W-(% z{aD0DfNfkns12(^E0@t;(hmjtq>8uOdj**R0zNE^RO#AmJdKeWtbwQ)@ZDSO<5f+~ zgMCmg7`>5db#BmG+M^NL-EoD(yaGL9%zc=hN7AF=;?ck|{Wd$+n-&}oo+}|r8<`Q> z*DbHzzt5*PEAXdA=9};pOP-ZGDD(t8wAjf~e3a|BrUkz-_3~MBA7k6@YL0i%-K9|3 z8-{I1T?AKQ#9tk;AX}qjU>|JVqz{{8W1edod@|OIoWjvGyW#m&f))ti6e9E>uA~m5 z_|H8Z8nEIFW^fG7Phq%IC`fL4Wzwzx$Xq)?}SItAC|C12@+bMVe7{z}C480uOCi&GSH62I ze;!q7RR70OyoclzFSqw*wT)(cMcmgI$YW%j5l$9y5mI#Lf_4Ti?>W=4REVgzx%b@b zNXhF+<$kA%Z`|csnf}x!Wm%r|Zf7^9P(7G}Rsb$+!JE=sR$L6sGM5WU<{$(LB_ys` zdrZ~WX_Ka+J!cl%+Cd#dIwrUBCsRsE+v`F(Oe?h;M=RIOyd%cXwXAiDB(g|%XV3dW z!5#t_clwlR;Zv7*g914{(<^geS+%U~>OP*i$i(Zao>|kfdAb8@upl5fj}tWEX&hGC zI@L*63vl&?h02iQP!~FNqvc;_^9S9lUh1x58(q8b?(#NKxfaU8cPb>q8rO!>9m(Cx zSR3)O<@rk6KgoylDKZ69v<_poMU!T7T2a0lP&S&WtBkbN8m*|jMH=D)^VA-};R*b& zkd7YEsG>%c@VI*M;){{>FkUMvuCukJwH9xQ=BCt{XDZ?N-P`q|*{y!gm_J0+Lf5kK z)K=ezv(KOBO7A@gaQ|^73n;uxe~=IxkHkRPld3-Ql3HElQ)9NlyQ!^qk@}&Y^AIrP z8-6)=)K8jK^SsRL<&e_bLkEA;sg9WQCrTVQm@S+GTSc4+&hD@=>o^uG5Swecx= zg@$i&WOk7)r|(fhs{a5n^++u%Z!L)&uhM|&nSI8kj6hbjxO!RFWNx3bCr3;TOR6{$ zo@xETh-OC}$4xP{^3Yj<@+MNMD4xJHwEn1qcW++sslaUBTQnM|7ygGGhWbmFC9~xG5;Eqlg8WaBx;y+;rxa)cfz#_JVpRJQR(jx7EXbJdpTF z0m5oy= zjD{3B$-|OJdy>f3;8kfhL>gJl=NW!8cZZh26J5()!o2e0^7pw~OjZ6l_x@feU#s93 zDfu8O$fSwXU&~LbGO4UF#gh%+`1WbsziqsU5$RnnEAvjHv!jeCGOXFF=H_Ypu>da$kO*0tiI~fG} zL<}_3dFD83#$R`;dikOw`m7}Dt$A$bvtBivRza;!l@5fC`|%6O_4*+pfGLlP z)4(|rdcFMxC69vA2r&Uot=*~7P97P)Etkp55)O?WI*l@R_f1YsIGqprx0!NCq7t%R zrYXr)cKQ`jX)Pe-LEpa^m#Xgi%OWa>#sn&lSUjtiVzryHTDXg=W_Pp9RjnV8X0x(^ z-Jf$@&TP-d*AWlbiZJ~=xM_zvZ?=d|GHqG`Xx8FlDO4YXequ1L(2IKOCQ{!^C!G(Z z`EVh-fE(Vf_x7Y#?kiLyS{=~o+t~{9OQ`G@DnTfi;lT6G>}ytll(;@B&0|US znDQ1iN;M!o{00-)$F|rgyTX^ewOPzqmClg8E@KpU=bCp6TtZGEN$^IWzfTOO96ih3 zX@_A=Yd5{G4@i@D+p-UDz!PkIa?%*qM$%{0B>-&PYw)$HQDrHJ4pR5+n|F=B2UAmG zHuBnKn<2=30XymXa8iaeGVTD6`_$O<=XMRG3cso_Iq_gmFw#5w>onYvMyz7?3{ zBXTut-4q0gX8j>MS1W?`Kal`wj|pKBgj|m{2y|2#aY(<7e3B4&3(5-k5bUK7-@L;b zyVROfvQmUPL-##$>MD$e(Lxk<=BlL^F>Ngz(`1Kb$b0$KY?Kd;#kz`eyc~!ugi(jy zxllRxGrF2^w>6o$O*fQ$jP-(X%Q}CZ@yQ2_x#L&2XC>*Q%{r&p*FJcOH1d`Tk+=TU z`^;2~lFA%J>MKDM%R=2V3fQfu0S4k7T9aR4`1}O%xE{4FrTd;~l{gOm*{b<#^&wWj zd`yzFP~{fegbZ)Ly(ticx&V}Kk<%|&NCe|D&f`h5%i>Q58P`T?|L!EShxPfW$q$&f z6_kNyaK?0})kM%m0r?odJ8-DR z?L;hkAC8Q%=s3!(uw?XBQC)oA&JSdtk(o7i3J|qG3r`6 zW$TlgCn|@Uzi_kWqt-X&hbbPu<@XTq0n%fwojGE`f+6n2c0CSpeSJ*21Bpb158U)3 zE-mt@s2jyEquM0B`SU0=q_-;9v{L$76v8(H*w2|BF1lMIRj)tr%JTc|6?><7n!c>1 zD>o(|<>gm=*v^=n84tjLAgnr$%9JDv zv`8>08rN}ff=<17mZT+y)c#mCtfAaKtfD9*in4YCi-g=Z%f!eI94IMHnpW??DMPx6 zVEFOA9HeRaAuAzb2m?dwEyg6h@*Lzm!5LA_%V^Q1!I{8cJ=k<8Qy{0>-uukJFJzl1 z-2bXngNOGF-%`(_Abe@pIXsIiw^lfxVa;~$i+8$?iVt;soL-(7aW76MrV-U{>Dg-F zvxpT<%*?07$ZBe2<#R`TOv)geL|D#LQ6#Rq!9@Nwgr9~Xh<(bC38l7U9h-TMQ&}))(v0!_aEcig>yWOdT4Hcfg^)1ISDOLcl z(eT{9swjToEO!*fuQb=zQ$}lVk?unG{x4DPT(N_C%T#XXku+G*k(TkcO;4cqinPiI z!KeIq^8;rt&tg^C_EH9SvMk)<-{8?ozh;cKz$c6u770{InxoQ~t1$19_E_}nT9tI- zPTN}}-4K?^rl8bIv__P{6yt~NqrLbrR+6*K?^L*%MvrN>YQ1z<5YSIilq_zB(zW&^ zT_OrTyuz6s?y`~gJXZW1BT>w@AjkhGrc_RkGquQ?5@XL?!$Jn*(D$GW&mR;c@?~%b zXKqw?4tHnOdLIrVtnUm-_s*ENEaz!#F#tYs8Rj8M7maosb@7zlH+4*2m^V(ge{V-w z^~Q*D;RVF)Bc4%Opy(jcsiQqN6sO;J_;A|(;|McNJc)+D8<4I_8Dg148Y<{gVQbfw z2hEOA7ekg{Tji$MBB4nLC~nRbOWInqzg;aTkf1rp0;W>q`#H72nkOh5FTK!~H_-}c zg*TqZayqQDad724bmePlBJXqaL@m88U!#*^YlOR7^)M4S$e3&;*dz$Y!T!+OYN$qnEezN0HxkQD$3sZ(_l&<=W@n#E6gze(L|*Q- zWE)7eb&ciDEUD`+4dBZh&|W_+%vVN%oD>HwsGLe))ERKv{}kFeYGt3USyo8l*pbLa zXQ4ZIlPxwnhi#{tnPk9D3)R67OLou_TU}!=+kYOeL#w)FY^xTgal{aBh?zR=a>%Q{ z)_u)FI`f)#mFz7mkzX6+Hy#?HfF* z&*n@(oSsx*)+*RM-v4?GY%T3h3{Gk$J?9%HoJoSslE;J_=GGHj;%>`R-M*(CYfM4%J?!PfV{u>kNa@{JaeA z>GRmwERG>=Jpo5~qeye16SvjOWRa8LS?!fbxpTbZgj9C~9HIEBY>bKeM*e-zI+EIU z1x*WmTR-Br3wYK|oPhfAVwubn#m-j=Cm|h4XuC70+QkyRM-9O`tqG_bOVkP{56c(6 z8LD*oYY%gOF&lM64=V?5Qa@#B8v(h7WY&bseNYNmD6+iT^Xa|sd8t8i=*6_SW*xya zQ413YuxU_PrONwoX=qbmB+18Wx3epCsS!KEy#$ib`PnqGvwbO{z!niS7Zddu=gnc+ zvTaesi@*gPCEL}pTk)~y0i$EXxMK8=xV#B4#<+y5PLH1=;lCw0y2+$)f`5cSz*6>@MJu4o4IznwaU@2yFm;&7!f!_5Y|s%R^o{)?iBjuwtU#CMUYKY| z^Ahh@@p4Zd($$Zne!fqk^tnbXnnC9Lla*T&#vYwpWr9({T6{HgZ??0b2h~HeSsC`6 zp+}z{69ehyl%@->Wyr=wVYzNW?D}SRyq}N(JPr6A9PCPNyqXH~%Z85R*BmxK+ZL`+ zR^~5HG*6ieX=55CS)7YYtc5@nvu@ec14Va0YX7RVl^y03(~79coi!9nY)*Sa7DW}T zo6E}*BV#oq-Kawh`2h)X(+c#g=cSar-EP2TOqZ&L&(iA7-|&1qY$Op5ll-9XPJtx0 zz}i>CxO{@R+Wg_qMZU(j_i_5VJK2yJk$xy%r0HR;;67$~nvaAz&~db}dJ8vttI&dB z8l~J_9vZY%i4dm*!=2{XG3w4Y8(-(5Rneu6x}V~;uWUfyg5DJn7e^kx=q5}$gn3I! zt|$KhtCN{KN>p%|;kj}{JKiI)a(1p&@w@!cy$mIJic~WeyLYZfDp^2__#+$y$9ce? zwOlSj)lOXP6}F9@977j!bc(mG+<9-dwG+R6!?58tho@mIU| zQlf=`=O)p4=L;R@=^Fbd#|KA4e6@*uH#!HLTR&kMj$e|=0(S%>CozWcmN<05mRT08G@L>zFLN}_-(et2ga;0v}S9blc@0}clLuWimJ+~+I=UU zKY7gAxSJRmmo9)88-J2_zX&6V3CL^MjSGFKg7U&fZfx`C!()wH%wnvq&!&U!rROeb z+o?R~S3czV{qFFpb+5z}_=sV_w3ga}OxS?%Y;mmSSapk?V^yY(-5+4!bAQUWJ?aO$ z317aQf@R6_K50OxQ1uClQ>tG!^)ZR7vp?|NN2i3XAjtuLZpxIU%G@t3V^Pfc71F)J z+Q&uWx5}ipB^!%7K|W&4QvfF7fG%31tgkF@c1elRDiNp6f_1qRU#Qv?-{13PI%q3A z3Ny*^Fn{+kX95OwQ2Fj;9pO1ySKV_f!jDrzT>_KwRW@cHZ}ao;!l>zkqE=nYI@ikt zRw(9{sNBi5sG>u>=?-5*52id(EVf?!5- z<2y2gd$M|y9T=*1F7n*kAEHw=(-!4Wer*vyAL@SM&uR|S&)G+Q zVvgN8<+yd*sd$5BPITK;>T;QKlneSD7)0zg=kfm}U}Ir~Q}bs_&ffc+c(>-s`C<-( z{`Bt4{_(*x3l7eTj|8?O&Y;7DiUK{~+uCPHg|JNx}9{ ztAE9|f2}ezGW@42{_pJeuhoBQRnYzG`1^lqRj4S5$V!U--}v8|{-(eG*QJX8mH++U z4DkQO{{Hvd{Pk7-H>v%9{lNb!wEzEv{hjIGIQf6FzyH1Rk8k-8zMkp7(DQ$V_Ww@L z|7U3bcd_N4L;HWL1JL{*`TBpizXQqfSJ1+< z+AX6-GY&uji$n|-`;7$P2rSPA02CYN^P7;@&+kwq19dkVnb0J(=M|sMB=Bojc^F@Z z)lU*Qh#&x6=Z{ZSHYz|OP);3`3>zo}NKC-*eaPS4z;r60zkv^<9ROhn0W@JScA$SM z47-5q##&vn_ECRf0P)%A0+7?tkUYAx<%IF+#M+=?(E9AGBarq**`%QA1o;vmwB&gE z!?ztq^}AB|^a26`{-jN)1_3)OBBTTZ!L_~gA?ri+eGqN|Fg^eZqD9(uZvBbN+p~^+ z@-}P{WIG7jQv>0nbIsR>V4~dz#M1x`1P%WPHsNp&NMH@}DqZuL4M4YDy$B!!dAw!g zUC9m1m*-6r)VqV0zygCEAkYq2B|-zDQ&33b3q24DNZT;3iaRlm$}a+b2*>Z%n*j;f zjTj90om2uu{K@Msy9?Bh-DK5<)Gk<34culx1p^U^`|u<6O#n44{CA(@Bon^E&via8RQ58SngMp9t{7dBEde63U&hpSj<;EWv=*_ z*z#92EkJH}00GQ9M-pC8j|vFxJzVbvEWTnFDEiswt4eKmmdXx~`FWXi)gzpVZM?!H><+xN&IolBOcO59I)s*T$!xns>bGyeC{$QZeUVwKj{HVAj%|4C%rB1KvMO-fIsPW0mIf_4XX*3$5 z({-0G%gjxm!O9W{vFC)lF><*{tAE);R&5nVO6tHRS_WawLE?I(!|3uF+FD=@-44)B zg~>8Xt$+20sAJVEi26*}!*oVsCnQtbHegOmrWRDJ)tq-EfnqwbU4)vteez4g zx~S}oH{5hsNy>;*iyNUFqWYdVNmYw2=={(raL#&nxMdvOT>F{{hbKvX%lpO0ke8X7 zFZl~UIB)mzfN|5(qOX9bdX}*I@rS$6!Jr8(Y&B#gN@eeO%@1YTuwZ#YoK)O|erE*L z#Wd*I@EBdWyh~EfA_r0AImeQc*2z&R@+K}FoD&%UC@o#XgJ;}6(U(pk#>Kf#i*+Id6agAnk}?l%1$PLEQPgU;Pg+45zDos9X284#@^lqfH&IK45# z>BoqJZ{>R=;aYL^>}oHE^CX&S3BAB;!kqa?-wxh>_FPg0`#P;8Svna>KGqe5Hfu9} zbqj&VQ+k=iaZGS?+gV{?y}xpQcBwIfQO_t4}qU#lFivc(DwH&^Vo=C zof1q=>I_S`Jf^1$8M8f2t-G%;D|r3>=G}IPx!=lnl-tT9uDJu1Z{@od1*F}t>YyLN z{zEjA<-^w!?CaLfX<`ZI z`>W2QumZ?MOqOjSuA>VIH?4$DPfjVa)9XU33GK#LScv?UJ8_Pf=JjlI&;Hj$sT^|K zC%E$D*67jpAHs=1BnxX}=}QJdBKfmUP1Iofa2y_@h1@#7yww>mvxx=j7zn9|wa`LM z-X4uwa%1?=Eijr}vPwOK^H;%l=F(<{u1QP%!t>NPd8!leW$g74;g>%gcux52d_#~9 zCp`{6MA8vtA++XYcCQPF^Y~41nIG%)HYb%c+1rFQE^w9KHqjipwXGct6tfHn6MoWs z?_yWZ6WLZF%1#bF^JlG}0{0fmG!lf{MxD3S_8h3cs;zE~J0`-36KRfG+JN0e%iOe{ zb8X?N5;ZK2NrEvFaEcd=9$kv}bv?XRWsJZ@=)O1nWAXs z&J}GyMnttPVETo^rN#$8|?vr6Io3Po8tg6LtdpusG6FOW2gFUJ?) zy=4YEpAtT3#CZdsyRx2{J@C@lYwJ3HoOwv8(p0F;z%x0!C$=grW?AD_JRPSg14qgA zPs#U46d1!{F=;Hm0ETWi*w^N)fc;DP?lcm8``G`y$pRcNL5-aN^R0a64{`ADb#2o> zPcY{}4c7m1601EgL@~FGqB_@Gzx%xRESyGm=$K6=ZQw|#6?DR@Q!Q+OYr79b0JI#m zAj@98Di75Yo{!t1kY{t1YgYgGF2vZQYIDo_{H=WFya4qtSKeGy?mT&z82XL|7ec%xmknQSyy|qVv`{p>DOi-FO&!&xoMBRt zK5^DT(~%TbedAfw5>^-9fu6c~KD>R9b78eS$RSl^*T76N@R#x(QDoJIbUco|_aS5c zo6uxpP}7)#wWccq9F-j*`V3; zhphT>z6k+93DxS(0$ecg`vbzsR{8Ner!;|^^97YZC*(Kds$t;mntas1tN|D-`veNsD%WU?ahif1;7S)}zxrXRVL?4DZ_w>n`}sd!al zNmi!Z#MB3{^|h&co!^G;y|4tas3eQC4qE@J^La#4YRQPCFShbPG+OTXyoY@WDPy`R zI8@_bU7L%`MzLyL;xzXV3%OreD_itoDK#7}aMZL+fkSrV) z0Z!fhPk+DbDPgoyv){AbF6p9{%XPRDwS&_N7g~SuV__h8VRgc{^PPDX{Q~tb=R5wl z^IhfF2P+g{Rv^~dxAUD-bu?&xUMDR{lhP4XftX3KM@P6CQtYa4N+^zNQ?8deTpO^B;iYX(b$-wKMfeR-;&OQeyWb*dgCAjNr)kU0s$r(qj-Nb`YAK2iqBH^@O!l!O>5C3mq|i5$qGC*5T;)}6-MzN zNOKs?Bn_Pe1MlUI&Evg1h33LQ#8Yn?Tfl7Ix7w)nv&wcCqvFfAopeE1-P84kXAwrO zSQ}`_&SH^#e8~Fw#9{;+rD3Q)JV&*TOWb`GtmWZW=k;#r;`)9`VU@RmJ|?YEPv;6r z%520yPjsksBOJQ-jz{KPQXTX}vrZcrM=6OySio`NW2T@$+xT(p>0EWe@{<5NNqxR9SJxx=ksmdRikvts<#6++?~|2F1!$qWksdU9m>X*Tvb;GIT5a>{F;*1hQd#0T;t6|o8QX!-M^IYs(DW>=IxZ1M=0j2>~DvX zgYVg+M1M@#5e1znm)6E;DeTV48;!9I;&_%X(Z-E7Y4(jxZCLaf6)Uxr<2*R{Q3Q1v z%gzOdj~EC9SPE_yNZE~+rtOmjR_PL)%NT;YBhpGnMr+s};q_E_e~E5wmvr45@LjC> z=>@K(Wg$=@c|e$VwAj)a5h{*|HXoe`JGq9YNX_+S&Ek@_g1g?Z&^Q!%JxCYxFZugI zBOJt9NDueDj(uS4I%d0rn84KV9yGV#V^!?mOHV^Cc$hqPbh&}9AxyPZ{gCSTBYG%e z+rB&gXIGH;bVz+hrrC*wWP1Vp$ok0qgPznp8ii7m_OKe8f)O-NJkJ+T$W#5HF?~wg z^yv8Qinty!`TFgH52;FOI<`7YgCa*b)-k{?F7q~Eh)4sv+4BWT?9ITKXG5!s*&dThrSfaXoKWP;?BCb8ENJ%-zzGS ztQ{toos^^c;hNupY1c&GCJva_6o}PTrWT9d0`14Km-tr*D>a=_m~L)`1bP9{qocIp zsp4(_loQPjXzy>eB8+mj?nLL;0jk4PSM*xDnhtLCKeO=eOVzB#gP;?ie=?yR3$F{# zS(j=4&@V0z6+a@g$fr|~h+noOfab9d3oP#aYQ_05S|7wnOVHDJj*IL<>poo4{*>j? zCvj9xAUIY4tM=4o6(mcxY}|5d`J?1aziv^VI=YI_a;gIudh%|xJG^=u9Sy|Qh^$+!7VW!lDmsZ?_bfcr7WUs4W+UERb>bjd+{Aj7ccg1j+XuZ}0iwtARaUyU#*m2DcqyUL9=S;2s+ecnQL%AG!Q=zmYlDHMFVjY7b2~w4st}WyTONyP zi$G(Mmxv7Hspl#w>xT)Gs4&Ni;n3J4r(+vV#&|&2w#oec4}06&uorz3sY!huHB;zz zjK<`|T7+yDMe`V8_lo_sgLq=AKvZnQKx)b})CzsDKX~lcP8V-t(7>KO6c#dJDSK|( z2DQ09_0B>A;8)5^lo`%=?;B)>OO1<7aAh>kUhKyGZcnO9IVz&kUOQ{hR|IPl;WXN& z$B$Cp=Wx$O$v&Z0W8I2`@?3a{#b~XZMVA)P#K|AUdFAh6x%vpYZHj@e3Om~364xvjE z+Kevo4%|%jnlZ8VdX8DW_9X#OoW@nQ??~R3?=LjI()0>hgU`{t`(O7LT!WF;$_|v^m=JfhYHCyWhR>F;8=9X}@yDzkNY+Ig) zcYp7RUML&sFXg*mlq(@x6!EJ;QmLEm9cW3{sAF{&GEcZ1YZP0TCf52)KJlLTAQ4g0 z%$EixcNb@0sOwx*d(SUV{CswS0Y{b;$p$fpUqz#Q8;MXC_^E4aa!Se@PF1?OFb!QW zg7;(8NP;lq>BrUk*-w7x=4__xwb4Xyle(%kAE~!|&!Za@o3Vo|dM3bK^ADjAiq}l* zEebozIe)15ZXw?OSj%@r(`(&$nZn{IX~JHdF^{!6n{%{JTe^4yeB@PVFu2^N-GzTb zp)Ew`Y=@?RO34nP27Iv=_X0-?74@jimX4OE&xBPQX6s}nbL)P1UArVS#jQCOOw%!~ z7*!(cd3H+3w295@oU%hw>-fW>Nmxjt6~aStU57p2INichN>pAC;K66%2M&cN?Ot)f zy^91lBy(2;2yQLt`guK)YBjX~o)+2tOq$*7_E8GDK4uVH)!a8LiO6dydKg$yOpdm<3y%XC>gSSAhV#Ui;z&%!OVoF zbjrjzv`@NHA8VwzC%d_=r!&7f@s>*JHEIDBNV;dSXKtNQh#^DyJCh<=Ix_gn=ECVm zD|SAocxQqZblna!p1f%&e$(`-=cpCsi5AGGNh1oG#mA&~8QTKbyr;yiCtm~61GyT_ zw`Wl5%ZNf=uMomMP`=aUX97FlJ)7v+(?kVTlUQ_A?`G-Qmbc2z`A=`FF3k6;jXcbQ z)4{H;`G%s`?e?>%@}Cky{Fz!g5|0ml$?A4{Stk2)pYrF=35ww>?wr#3}kTA`B+)<8OlYq9pHaU)XpNC82mer@W@hX?oJPn5`$Z2TxerFZ2 zxzqOJ^<9~{A%kO>RyEqm+hp*HDF2mE9Gt3#%8)r&c@vaNH#bVS3QxXVu9r(&uLQE2 zWngjQATCu0sh0L~Raf;-VM_0EC9pB0G7BQg0h#_c(;~Ly){4sQ=KS8X1e@2r9~r_g zPdcUR=b{`azX>C|FkniL$m3WJx?&%yewTS7ae{y0bI~bv#qt%f*uPKYvS*lSjk$`; zMDh#ftoIZ;X>N!8NwYTdyK(*)8;|3%ze234{pY}UAI z;f1@qySo+??k*fVXsujxWmj33Kxs3>tklop(n? zy~fTQ>_xY>ZYRDK)pFd7r;r!Ng{&tWv^l=4q{bZ~RvU4BohMdpzxnHkorREdT&R@^lYrE?m?b_9_js>yum=t(#n3!YC zDWP0u@r-IJ-E$MxMbjQ;nVq!VZCg*{poxsYp?Yrta1w7rAdxw8*)SZ z!}(sKFaq`Ie4k`nZ{B77wR3jaAif9Ksok~7d?ak_T75$nGi7^GXz|mrqr1a+u8;ub-hU-E(LnV>?yK!%JWV$h^^c8^#I@;zEE9`-@I(UsH8 z{!5-gzkYJtr}JIa%2HNni4;*GD&xfYX-D3j>UQvi2OE;n58P3NJorGpjEq7`jd}1O zLh=0qw?OJJVHHgxI3a6F8(W+McbhMBti`TB z6w3%dMH29k=Ik1!Qlr$bO>VkO*XtsN51D2qjSFDQ{#AGXHWVSwr>D@$!SNF3UYX_n zt07;4j@x})@nn4LYa`b5s?!^BDhT*pwFT#126g9CkD5ehGkuDT5uH@EMy!^;AeQ!X zQ9msbE)FhnLi3t%#WCV@&mA7l=;)jEV)|#_Zdq+4%>+5z2@2aQ>A$tqaUxYZ6BX?e)X?$jDxKg$IoUmuIII^XvH}$rB2la2c%?| z7pmdu0rm?#%o|4K*sX@Il!^CSCd9>A;SdTtp!hSz_0VBKA~tFUrrZlW74CBds@&n* zrLc4T=io0?HSn`qhpgI$-_A6D5Vk!$|0cl;lGg7Z-n`h)UU~4=v>-5Hy;(XcvQr-b zKdo0#{}T!RGYS7M`T9RF;BQz+&qVjneElcc{5uJzWBv;X{xc2yR}%c^tpAEs|92!< zQB*-$Uh)6avCi^Gy!gLm!SoD&P1yhO?jH$z=Fe31zwqBbrv8(R{!Wyl<@v)Sf^%W_Z{eOvaGkgyGi-!F(xy|x-4g3EQ0{>mIKI88#FN_df^jor?_pr`M!0i9qu^tjH z2XZ8R)Gm&8ge}BZ43vZX+58uilXE)(*|MNzeCBphdvS4-_A1uFKEOGMwdZkg6R?xm zf!OKGJp)$|Dx~w&4TLA26&o1|h7JPa;}6P*hYtWAM2~d>^)d>#Nf(e!Z%rg{-H9JR zMF)Xur4Xod#fMD;>i2XKTDUdts4a{0H5xW8Xn=EjtRkwV@gaAvnc2@r|nno1^npk#R3k2 z3h+U>n%PPV)Q#B5BA6wYhY96-8Ayob181#_E+?y~4sa5%2P}YakH!~F2^Jy?z76Qp zDsXz~tz9hW{h8k8gXj?VS_tyV*&?G70RVPtFZy;#0Mju}0pUiRmx>AF(+@yX@;xwD zSB~n-8TI3VwI+g?tpB7oB{*Bp`c@9cJ-nPR2}IKiaB?8SB`cT}(5r==zphUX-c@VQ zb`D=MC&E6c!U~rgVVP5a2r&p&zUS$9} zbQAa>Js(FpQ8u7UC;K*x{Y$rqOx~~OpmhLSkWgUT#Za#=!%(uqZbUuvFIJD0h|tGH zC#EOIH}6Z{Uj6dlgfrUj=gT@X(0};M&5xE?7x>ult~fmp z!mQ@B+1*~1AfiuXVQqjvFr?5z3Ta@5?pSB3`E&5d-l1PV#+^3%6F)G=X>(ph3qIUL zO5im#z3M|woV?!QdHZ0`kKagvWY@q|+Fo29hr_E7GwgHV+Euocagl#{jN4nEXk4-cN1wJ?{^*Pz%wO`YSm!Yk&(1H z3dQt8pi(u?#uJJbT!Tr^)qB+v!_phnr5$4hO$US8Fl^q9R;I+w+DTitw33j`V%3^$ z>0v#4Rv(@p$PVDmY3=%rh~NnqxXkI9U%1$hB)?yn1=bxmIDAhqFk`F|`$MyC(Qv}3 zg}SEuN_bGa5|`C)G8&A$cDtfBV-e)-JSlPfwEo^%Jb+1 zFlOn>N)7lZjqN4%0Bu)7KeTCs-N0E?EgVx>psX z$zigjTKi?@N2S`_gQMv1L2^Bbyd|-wiQkF$-PeVX!UwIcQC2OFReayHuPq|NmliDUWt}PS{u^(w+1O#VC42&7#?H z5m+Y4Qac7*tWyz&*OQV>k9&C5Aq`zNfG601R`1Ry;6?KyFT zNV;Bsm+^eHSI~&6KOJN*Vm@iDnrNAGfbo{c|oOt6PKZduh$(EBD9g5 zY}MZSvsxylON?p{!cRplrxi6D=kPVfWlfehd8OqW$0gkp50t)Gk`=KHerL-mjLeew z9Ss&T^!<+T&Dt(0;1&YZZ2S`;yk_T!t9LxsAXE7q^cc*6yEd_0x4FXUS5al0;p)Kn zgF7tVmPX2mX-CWV6g}2%9qIEVU?keAqk_RV(vgx3e$Y%3Ft)ts(xY-P%&uHPh@KC- zA(Awi4t1LD&+w~!j2QlUctU+5G4?j;k^YX)O~!{1ZNr>g;*72#$EB(s5pujxKa1Vd zp16FA#w8mzwsKw1Vn9<9sz=r-5A1t8#Ju>|^+WTC108f+Del5cAHSTh+jEr|k&+Th zz9k;L+h=+7mInfmyT!D*?+BDYeiQHLCxn0Ilq)CYn%$9aYjRqo*$Au1>({ga)S{(B zPro@$3}|}z6+-Q&&lH&wR9D0b?e=!+m)VR%$*b<8-BU)1Cfd@rc!KRg0r$E!+xYp=mk96F2&~Kn39m^Q zXS!x& zNAi$BtE3@@)Fq6%~Uipv0gj!KxkH^MkPT@!;W^6nu9g{5}K)6-0F!VxBo_ zUeh65*nWALQDR@S?~-4^{O#;V^UW|g0a$ZnTCZB1x(DYqN+KOKE z0!K5d)=^p<}>;$cjctR%kj$z| z2|2CtRw5E`C%ov1IJVz!7+>%;WWwOvXf7cBtkyU9E@Ku2*y};fAoWu)k&zU=?*Z1 zPaG;)ldOq-f6)O-tb|8Fh{uaR#$ITudzV2;8q%6W)wvdz3yU7Q%k@i6dU2Gk8hm0)y;M*d#e|t` zi4%KWb4TCGCtypBZawP#E9WRS7jRFx(-H1toUy*72{s*f z$vGA)j{9^iWsY8Vx3_)l_ELF5p;(4~bn4-4<=MnQo@$>^aIoh2$gp=UtD6xu;WWlk z8^74EocpU$#G|psin&B&;tpPfC4EgLbxtO_#s#8^Rcv8S$I3+foaticxo>FG=&(bg zF|*RN8~x&fPDYxjJLy%U?Ec09^YYt!Q738icK-k)Dk0Ao_DiH@JciISn}F(bb}Quy z(Xi#Dlnq_&-J0Ky^%>7k$NGBr?W(k=f6x}&Lb4WtqeTACswt_-7%v8wS4Aepgy*kj z0ap}4>9_k943Zk%M?cKEKf7DIDJBYtcvLroEiQGUZ5(2Y?~j6u8h<9z(&!kt(eDLa z7y#ef`qbvUsRb8Hfm#YU*YrAT%yv5T=M5HiWY5tvQ;z>adK568 zh|-jn)GVc_MC>v2c*H={5JLcqX8F?Vd!pHDWUl=yzf$PSZXJS&IUP*xvbFJ=>8>tu50=OT-g5L53{HxkjlVoJtgY z!-`!|zu?uB;j1z7M|-KG)-B`dWXg1;a(e#ED3GaI14SX$M#ax2J*0$m7SFZzmapHx z1iSrgdj-+t7pUjq?a?Yyk;s-NL&ta#t`U#XMPuW6iDBf6V0SZsc;$mJ2&jey>AN6$ zDrh9KR%8s`9Ye7zf0HX?-z&5+^_Wgui#wHXs={}ch^G!7(dW>Udk5yF@D!4ZUQd;gV?%LL=#oD5942b8noVeFkKdmZRS-&EC}ET^k^5_+b)l_$|8Z`*Ka>>XC?L< z?wkrcDnZ@lvlMkJz_SLQwlw--;@}g8Vez7=LI4w%vYDj50sV+ zHX&M1YGzU+kdXIIV9@k3YAo?%Y0)&wB+L*26D@T7g1PFvw7XiwN&L7jKfOx;Wd2EW zav+nr(5y+pn6kCI?U-u=evN)|04khU9>Sf zCUcrGQ6k*alzsm4c{=rGaxjoCuUzz10DAeIL*o3TwK{Y}DhOUea8ax@GlDfW<}_Pi zut8Jo#y9X8*>l=n>fvE*O@QIZrHGW5gx(E^^ZSrr~yq=W22gbeWbN zzDq3RKfY-Z94k@G$ZK%|>ZR!!2IoIY1pKIc-2s~{^*}0?^Gw*n9L0wmLK|?*G+q`? zqQG2{)q)~!80PsX+1sO8Rb~4a08<}R%cw?uS$Fz%N+`-k<|St&Of1t;L;OugVaOFn zQ=RN*Z+{7mI+%L;9Bx`Mc3jEo$K1=6X;o&b>i*Y{N!N7H0DPFGN^&xbc`EIUj zzs~o!8@>#m9US1CeUomTFlGXww=HHDodt#}%Z;GS0U|~pW+~M&B6r9RjZR{=tvGXF zmUCUsX9Rldc}rKPt9dPU@T7XYBJIZXZMSip$rgv4EuIC6pDYwqbtDbo?5RCCwp_)?pO%71W$AY@H%v(h`tZ*fS#@zByravolYM z$5m7#^m=QyyyeCMhW1pg_d z@WFja@=R^3S!7hI0{jM@q&zmoh*;Hy*85Ux_fSUnEE#H}+uVVF!E!r_&;%G|oEmo1 zS311~YB{}&&Pqoxd2vm20#dT%1aMkrREkW}M1`o_4mQ+7t?S!{ z6wJo4v;m0bRuA5|QPjupMf28mq@^~7nb8J|*;MYn3dPIQtus&Wh z*F!&KkVOvjA}qd$((!y}sp4k()p(cju2OL{YFWX&dV1NC8Z|gNnBJn2k=C7gBxeS+ zS9jcvd4J~?_P`S2wt42`2>*MCi1a#lp;;*Z399wCtlM8|;`C1VX7!<3Mqt>S=BaJM znMcQ36T}A0vl#`@`V%v1(jfCSo(YsV{629HUh*n~d6t^_og(_B7gqKYB)QCXG=;WJ zIsIud-KwLl*fCKJ251DvjgRQmhs=>*ED3)-np>i# zU5N9FT6^`QT1ZoC zH>VdUPKMZNNG*Q;=YkyxpNIdH>xc39}KsL%(@z*gK>%c%>DuU zg`mtUr$=K3>qJb{^wb$Tbk2%w*e?oJl$O&4b+?<7$Rv$XHVqrjEc;;IeM#S%j@XLe zM8n>(h0wH-^vuBEn76!@6KEPIBU{Jqy$IVVcV_aYNvApLke}j5Z;xL@xukaE^P7Re zVp+?f7-XP3NZTI~weMXVrO!NQ$4f!J_zu|X-z&nVw}W1g`P$onA@XA@ZIle$bFwou z=&`zrL5OcxDIW&*X+B%^+$f3XpTWg3*rm_{qS~SNx>!jJYYgKlrMf;Mkji*0LPTuC zlT$=YOzBCqj4c|b%nUVGYB8KZDw1_kpb)(!N)$wS1;fZx zlc#c4SGXE>UJ~kbwG_DC79U(ypy#fkGwvT2wrNIa-lQEJA)?iT*jAy!xp1Z=m8sKq zWTdQVMzTT!WtY9b+bx)`N-w0i@E814tmBMHdIFA9>Cahg@qoHapjbU6ZJ_f+@q8g7 zhQ&V>6M;JC?uOgQy37$@Dt@2X@8WX}LOk`EhBkp?==jdLcg@e#|Bkay zrut^%5ZxYzaeQ9W+PD>Le=!b93-uHGT`J0Y8>!yu)>CnRe8Xm{t~!0h>2=k*C)2WE z$459yNKO2pVeCO^Fm-iHN_KCaxbOs={j-Io3Pw=j(?`tlw_#T*<4suW z40xAJ&8q0fOBCS}S}&CEsVQvEg%ioiBnO-mol${-bT?_LFNY$BYt=or%%639&`13L5UO75fg z@!`n7&MC9KwJmgn2dnMr_SosaYrNz25Gi@W+mZ-g52vnfD6xA6(C zq#cDVaJR{8yJ6EE>42_K$nay}6 z#;8*>=`dg#jzrYCA1k9GqW*|xniEX~UR1B$*R3%Xd5^R1fxK8Di=q2NQoBaYNdquv zY=KdvG1C!%#icbdddjG+u5Zl>!*|<&lbLtxH^?58&Tcy0i^S#r&;xxmLu{o_ZPF1r zraW6l7w4tssL>NN*O5qOznmj-fBbm*(y2?6WR5>Mh4>^kyvTz;ZC$u9KaQ#m3pfp4 zX%2gP^Du~Ov-0kqsHZcvQZ?XU>!MA>A5UMr(86ZI@`%_zp+U@$mLT;#Vo>S4JiA0@ zIN@o+yB6LrGAwHG8#Y{=oj*hlqc6)e4qbwWD!<(-Yk38%8nlJCQyiyDx}GSoTj49N z)YhBckH#^UeL%r#QHsT{u1qPc{cw+w%;DPALH%j4F2+*+9e5j1tEQF_zAP1xgkD&RH~ZM@iKhf4tB@Jb%B`O9pO#8+yS(%B{M}hlU8pkr=Ge zA8u+Hgu_)fQw7oUnzR*_)C6RqP##xGIH-Vn@ZT29$Gp>T&v(=)E&SxBNGAFH78>)S z+9IxN=m6iv4UP`u<{60#phzgTcMG`zE8gZ(xqB1er2^X)e{plf437ku#zkh^85pno z1f4X0O4hAMXh&KgZYd`BH?=@%8heiLOt!lSqHBv%8OwIu4NvHF zRb=->Xe|mU&~9n&l*x~9!&z{y!pd_Ju9~DX$ur#hO-uTFT{<)sR(5z#1nm_4kYL5z z!$`B*y2BMU>*1m~d44pvmbz9KqBXiHyxwP;g~HoYC7G?qRfc<_45|&!>CkOPv5jq{ z;Wa6m9L9VD@P#tTpPHEl=TXC9F!6HbK z-@tj)*Z}-ZVgk^fDuLI7<=zw4QycQSPo?Z@yVEu?BJ64UyOPjgnXr^{{KDx|ND$<0 z-gkBt`kwif`=e$09oe^9X@!6rYPRQ-yBSE?v8bQ~4%3Am4n(zOjc=i_@$iQR`=pQf z%dPGqnEs4PEb+)gW1^%A1}IBZ?xG!wB}!}LsB(Y zD3ll^Y{~BRL<*WTRxr@(7Gb~Mx(ty?QAS)8?|z7m)0rK{KFLl@9lui=p2Zq`ExQ=d zmOc+gi-Cy7P7RP}M%CvapPcJwWjfy@KmB%v*a`F&1i#7q$o~QTxR(8a@8R9jgJ(iD z1MBMu_==`y2XpuzK=2OZ&f&SbCPfd9te*>hSw_&bpZzyE=`^VvZ@>n~2TSHw7 zC}%*;=x)niJOrT&_kNsNL4WMK;OLU?G43Wv^Jm~XD(Yf)z6+0=owNw739i3@8E|}MciM3hG*m z8JZfK*yFLVGye(TKON}*^rka>9`&2ci{bqq{%6HGBLmxCE6zV%>%S@bU+MdwJ0*Uv z*+1z!>%V)`Kes3RD}Dc@|9=_yr0=Z%tvB7?K_&iTfo6?tZ8OW;pH48y-=39#m<|RQ zh90}i`@!mY^YP>jkqLp9V?2k$ONk(a_L5E;+IBPC$fv@O0Stkiu*HII^Amy|DqG zAs}EvubY;E$n%TLjAiSz&?ex@4w! zVQ&ztfniQ{D!fjgAu!{?(IG*zU?b@ukk3OWto_slV*qaV0X!68y&D*j-$_+=WV?X7 zv}*w`Z>~OIAC&K55n$dqF<^Y~($c!EY0+0vb%5>sf$9>N9_2DV<>hp%&m;(^hoO8) zz>eU(Slvp8-Wv&ifD$z=0CcV*UiAl1{5@&kD%>mR22)XeSm_SQDSOKI5M@5Ugd0gX zED#4p{{qF2AFb8JOL_tz>fGh=uJ)^IbAg35uFBC4j3=;HV>PP;%9|J81ZkSrqCpOs z51ojHfPe_hy9FRC1A%iBw#_Gr5!rfYx061X^YX?{i z+ER`;^W*$+5e1Q#x9ckyKVVr_10CBm@AR}$(Re2F^JNU3tT#D?w2UXf;r_?Nq5>0q zIij^_rB~nwk9JmvZ+2VR=l^*3AAzxPg3dth&QAe=ZQDJs0G@!ig5RY8HXkbKICOq# zOZ&cultMM~1N41-55t+|rEvTpg!^=-A8!GDZg@fk8doFpzR4tF1%~v)I|O(A_>e6D zwv>Ojg6ZUck|p|h@Qq)^!uFaBzIm{IhiCl-xqo=443JW1Nmd8IglK}%^}&4$c`MQh zAR}GGJT`u`(OyDErv_1Dt_xFo*z> zBA*KSW^WW~9`oD{YaAdS4;xTGAb6JBE$}bAXd%`?3J3sS&1vpl4eTkj$hC;L!;fko z9w=!Kx|!$Cx>K`&Cj1x^>~|98mL{(#w? z)Rder;hY2k->`OQJx-Y}waMUHhg8*)rtb=l+`X`QnD$49+F$g$W>4*urp!wuXrKhE z^~EhSSuaMPrj6Cf!kB%#9p#v)%|hI1za>32WR!&UbgUNvs4z^)6L`pZLD|W0;92 z*Vw3lv$U2_`tmZtb;T{F##+La!isqzZ9R|1^|+6!UQHPWj(tnvX^|Y#=?FT#hux?; zokH~KXY#M@l_P!`Z#|M1EmajFqc8F=4a+(X9=&pz0HTdVC$v_yZAqu{Z;fB0!N`|& zsH_{w%EFOqwiH+6e$_48BjjteGq7fC^B^>VvKWmIUG)iNBFYNPN-OjKMH5?`CbyRb+H|HbzFazjnfg4_6x0 zCc`x^*9D6hb^#j7++nof9`5t-!WFa`x96YT77)Int7(+pWrp{+?KYcXH=gJ#5xJst zvEySo*Q#XKQ!{CH)z3O07B91He&;e-J{`eg^SHf}3yIlE5J}_(3dVhx^G3WD=a7%L zauA&;5vN5h?J;)Tlg=VABCh69o`j);+t}H`*U!6-ChBcZiNMM_5(}Jq zc-C{f5V1;n`uxMnRN_n?z}(&)_r$cGdcloW0YP6ri3nqkn+^U}(dr#NGu&8aZ1#Evx^4XzGa2i2E5r6@#lc-~^D4tQyuHK*J5vg!ik zI94R&oH^LGde;tkSw`2%(qj4igWQ?kP8(D4ah}*z%gmJKz|!;R5ve6bXjPYWntuMN zNha<$>GgQX34Z3RU{?p@^&3tcQH7YW=Z_+fkx!7{v`~N$O!6ycUtLEEf`paaIHu(n z;t)l<-0~J5*4Imb?SsM@l<{j1jyBdb9)|2$-D^I>8rR$!aBdkzFNUz%JhID9+#2N zjU~jrYNEZp5{w=r{+Zc>Pv=MIO;oocG(tzsoNrS7F&=ADuIEiOH@J9<#9Ma;G}Vq? z#GTj5rheOfDs8}~W$Wph5LzYok~hTxPmDKF=x$Chj!^(ec6*>d!8Y--rSdEgrGhR0 zy(2T5y6>mta{bj~9FnEL8tb`w4hYS0*FCEZe8_{1?GQVXOL0#>2r->75wTD98Akbl zlkEg8CNYJnO-TdtCaDBjh+7l)7WTHo5*BqcjIH1oZ7#83nCp|A%)Sdc`|S>%L1kpr z`Q%1zcU|V!nN=r95`D(H?)S9%a4&bCq z5%>EY77O%*Hi-Q%v6xikspT>tSQ@QYX3_?4&p1p1Wxl}kE1dbzZ<)#K69?a6H*aB; z0s;y#7A#8gE1I|7iwQ;P4)zbU6@(6I!m6H1@H>8Z?%@w^erX}FlN-c6Pc zldHRLoZIF@N%{q#1hpfN7#9N_E%pAq+p$SUd@+2;xwx%1@LIa8JFbGEhjSHryqAQ- z+KOZ35SVR-;j#NL1(7U*u+temFCYur+L74WNb>5qL=qLX8N7330r$CWpGQma5Fs!O z^(fm7p&0A|!Njsf$iQ`%s(5uv%Zx>*Ah_!jx0jN*J@~F4WIz~VbF5hO&_v+gh66*b z+>w>qQU8rFgxoG~_wMp}bo2JkBRuAj&ky742*aWVmJO#rw1Q&|{^R<#EFDU? zd0QCu7DWJRYC6R6jBQk^OSs~unaCk^py$BIn!JRp$9ONnp4N|n*PYEtu9zLz#tg4I zqs=g2d`4#2qg|3S`}R&2U2bG<)wOQAuUQ)d?>hNd^C%D~0vgU4r>)i8>HQ(?+F;mj zSQJv*?<{B{*XTGTmjp9q5iM=15(XP&c~Oq|{H8(NIy27`u11Q*Ursi2o4LWidc9Db6Mjx91ankb-mP62T<(-GmhFxCw{P>7A+B{i3?CZ#RTvKlrrUe4&N^5>}3j~UTRRignfg1eETW0FErezWm zxFz;j>%@J7(h^HB1?-v1n6jtWtD*ds*f1m+p2aL~dpT*OOe7uuxI`-{as^Rp;u4*n zpwH=a=wYT3niZjPp1ji^=rBYp-7d8r0iLxeabQhlbW9cgGEg{zBdBiKYT=B!YO|;` zN~I{$bip-}XAq&8M>~!)vL|bQ8>2`XZ3}ZinElViWVW4%g{#@fKV@xj7?+-nJ_07}Hh zWBkbEju^FdfA+8XD^&FNRBehD`Z(h=Kb8}nE}Vqc9e9#Ph$C|~)GBVSjXc<6gTx8e z2I?ZM*&OJ+NA6Rv&d<3Ef(!eh9|fcjL}+MZEfeHb8?B8et1AQG+yg@}w_ZcuxlM1} zztS`Q*qc3!yM@}MRY~tHkUZI``{A?K)7_RHHGW2e+e%KbF-VpKVob&g8Mh@dvXE{b zQQ9$Yn{wwR-;De^Lgf!v?3AR+af6R$Y0#gD3>}|a`l5qYc@)a;oM3#41{L$^)gUrlTkoj@ z4OqfbFI|E_BiA*)chGYx)hAvi^+Uv*A%>k55TqiX&Oqdmx7T(+ecYl>@@*hwXP>+@ z`kaAM8ylW5wRFMJ7TFD%5KTgK8F28k!5PSN;<{6DTpW8V3q>6DYLj!Jvi}s)i#ZIR zR!u+g5POVSu)Ogu&eIIbqayujs~cQ5uKS(GBQXE_SxT{ku>k|@J)rKZvFdSmeBmR@4R19m~8+0B6?c6t~!Jw`ytoA1WSlF&?lPQt5& zAyrYo46S>l?CNQUTMaxkG0ig=%TDdkc$o;+4)stE&x#k8?jj1~SyOOF#St3ur($%C z;SvKi(&64~-&?*Q`Z1Pb zJ9tSYoqTn-v74SESqc6En$c^8*X6_1-_|%@s7X=j=2&ZGRk`dz`;PwZObu=3hB8h9 z@SOgRrVZ+npCs-zh*B|**+-HWY{SH}R~ORU+0?*BT&bAjyK2$dYmQtKF}#MrSDMED z^(W1?UE}vzX`}_!{d$P@t=aS?9)&C~&^UMRE*SB>EslG*R^V(S z>7h1R_XxWoCm4=`sTnK4A3af7IQ7+13NDeP@6 z*!|A#Iw!mpQYR4;XOap1G%o?j$iFbnJ*Q73={kZVNH)biQ?8-*x7WIek+=Mh8 zw8W&s%>A}z7vt5sgQJ0%#gG_f7{(pVquqnZJ?5u&$G$L)R_?q+ye{y=(_>Z6rEI5h zV0x1E@zwnNj3?+~l}EY*FEJ2y_aFtk=~?eC>sT;>SRVkXJP!P(CP94z+hG24Eo>W`%swK9Qlw-lz z&5=r;eRM^RmS-rwN{A)yh{O{qYy1Y37gM8FM(bk6 zPAJ=^+j#G_vV(2$(oZLSGjvXdgO3m8{h7)jG>zP+dL!`XxX>VJOwx2P?gk)op^LvV z4{pUjwLS8OX~BvdA$B~Rc)ZeG`n?|yuhzg?vUG2;sSb1ISlE8d_r<+5fA6@dCs*rn zB7b-lZvh0lofF4}Q}pdAZYG_$N!(V3@Fsfi`cW!VtfYhJ$K6@Si<04chG1-ktZ9|` zDS5HqSWEB^2!wUO%V$e_J2u!q#b>fNi?5tLMYDnz39$VD3=xE;WNoP8TzdWn2RL6C zVkA-S3zQBQC*csJy^r&&5J6*e%y-q2`lSB}}TLT9r&#zcBpxsTL)o%P5`1{GQiu_7@n~$GP_aFwo zmB3|+FZA{M)%RvDnYrRA!q|aaUle*_{Thpq^9CluE~51^>PzlBuFlXQEJ#b=7;q>S z&)qx`u8xesjkfG+3}za3avn^lr0b9BIdGOwsa>a=bOu40~dxj~#sb)`t4RfeY z?5VP+09WFk)W;V#?0_$ui*Cza%@q={^j}xzF*(^Ry1}%;p5L|1U(j3H!522!;-&rY z>6-+|c&7=H?lmcvBn7A)X2akVJ(YnNIyzEbH$i7Xqh=D&#zXy7C0OBD-H_!Wq;$jNg12SBNV*sal~g|WY@FGQD~M}* zk}*Q|j0rLqZ=0ckErl*DzgijDz|>@-rEw@uIo!D-@{9T<7>5eAXtJQQp{w<_DJwf7 z-GmZqpk>uIrV>f-Fu_PbSh&OIghS-#u1H1W)R!}-W+$F*@!@cZN1;wtqPVY+wJMol zv&!uc5pdLm??%dkm@IpYst@NvXA9qmFCI!PMhzyR1Ov45u~aY;C*1m^xJ12k)z47E zVD6XO)Ozv{nvw%iBu1nqmm;tv7y6DZt*2M zhDwbKWQU(;oxF~1h2jUQWPG(9Fxv$a4AYr#k_ohn7>_{bRUzi3>OuqzjYT$7pC&5 z_>{M7=I%F;m?>>(@gyV&5a8GwslY|3D)np{c-uraQC7^??_A!kH6KP0SS`czI@RSj z6?J<>R5_=DPy{S78t!=N0bQ|jXnMHW(cdoom1u|s(c&?|1KurS%5_&v#iLyhhR%7h65ZT}c!BLLLt5 zGBX4y5e&;U5QFMV_NZVR@*-r*mRi0<%TJ$;Lwd%LjEjQvL7U!`<$M;iYJq};zJ_MX zo1*=te5O(K^r{|psj!!u484$r5|AJOR*{ygbq4;-BtQi-{E*>LNiix${P>((w)zsj z_Fqy7fW_kv)wvL`+l)`UZi0@q!CbqM5SC7D^%Hz>o)2%|&f+4bEvg983d52SO_oiU zM-r#Wwd{OFJYmOwZtt97Q)#*!t1KFXmh_nG{Yh((I%h7iTg=@wI znmF>YB0G671i_$(x-!sSe7uCI9f+NKG_V}f-I|B%GSNkfvBdFwXuK~Lup!Tbxghzj zDruO?;B1_j)vd_pS7e>Q;-~~DtI&J~(*POD<<)ht+Q*(~sx#d`+AI32EhEAXiH)SqwZrY~ z)taQcHC?EFq@s$?Oub&XJT&>I$-dZyvXbON2_g-(EG!|c$UWyhn{EC*J@>o*g**Y5 zuWo=PB-OI;%1E+crtOX(Z};X8sG~5=nD(E{U$$lL>O3@Ckwjy+FR&Mfg{hVb`tQ!R zZoi#0yYKHK@S2hEEN(XjjNR<(tB%YpG8m&Mx3t3vVc}V=e9O^T#EU>1fVD+t~>#6sL?C6>ic((Bm6(n};Rn0kS)LQikVwZ!_0xX_q zkV>$9UYOlAvq2hH3&x-H-=@f05bpg(__o5IS4ObNW93ix9!af;3d|)Cjz+(%HrNcl z3Ya-=u)~XOpBLwqj{=|1f|`6 zl1-gKUDdH7(*vV;e|d;~o_VCnvP0QpBug$?YxeF@)=OL@{_g8YAeaJAfO~$yCwU%Fku1Gp zb)(P>d;A|;qPMuOSs$>EjGqAB&YMl3TMW4eGTa{TnYQKtl>0xR(LX@oZwmSe;Qwjg z{(}bo9{o&W|7G+aPHsBpzl{Fog1?Xb3xKEp6UzUSlmABQp9IrE&)&t_@RNgozJ3x- z0bM)8zkTvel3!Lx`4hnZ$EI`E|6fw>Kg!Mj0n-1q>imDyXa6zvf6IaY?JECM4*T=j zQ8Tc82Ab*qAJ%8H{tpxPA0vO>=07m-ANv~q#KND~{73t{{GS7#G@JF`P28;iy@^{z z;bfU4xDJn?T}%~E(d@H5FPrr!9RSc5-v@z142>lif=nWz1OWt@zeFs70I!|(NCG9E z#L(Au;{CJu&}#odBMx`iHPg0Jw)x_YRO2*oz;|SVOcWg?pbx?~K*#`4v3*4ckxxiS zN=!%yxv$?4Xb?}wYYdNu5q%jmQefmg2|$qvCbWBLE(={F4F?L+WONlTf>oqh=QYa&-J20_Q-&^&m8KW` z2u2XNX%tYOTC=MQDex7$?1hsL;E@p%fC}WDbv5%88jtN-nPF}ia&HS#7_2L%!W$Y3 z5EurpMF8C^8~{L=LmNZ@ah*(qT~3<}3(%nt^tA*FiZ4C_fXq_FYx%}epqHC|U0~h1 zPdKaxjjoBjlrUZK8x9T~(Ez6Xblz7iSi7FADZrjiRyXjFYeBF#_NK0w2^zFG>-*1b z&cZ$I?mB8_T^9&xkhhKFD1m@PLPA1$27Lg@XaF}(wn!b`tdN)ffM_z80T_$?V$q}{ zNY>rVfY3gzUDmu=cveNUFkM+5I{5sb9_~pb2pF)mEgAGK#C<4H-*=J0pSm=ilTCZM zTkqcW5Rqv*0HO+;7o_S~@af;ggt|7iI`1jV%JVICvPVB!-@F8ii?UvQ@c3;I`Q*L} zfB@{UL5XeQ2)sk;Lj-)7%I{ifQ0GBIML%g$TS|SD{Ca3)16b!h-U5CP$&c!(Mg_Zk zm$t=3ghV7=MSJ{6Iqni3`3T)YBl{qY{V?W7zy;Y}40rZ|J@B#>^CKMb9M|M4G_ep^a&nUrdYK;UIYbi@moDs=H0}ErH-J z!QI{6-QC^Y-JRg>?gR<$?he5nf&_PWza*#M({J~5ojWtPYHB{D`1Zht|K6J_WbNNt zCy~8B`@@lDf}n1?{8fU*$R;{w4Pa{U@w~y5xKj zE))et<{RCaE~W19U8L5}k@}y^dCb$14iBepM$X5U8`)tZ7YY-Gc;Wj`U`K@?qqKRZ zJ2Ti%D_0)RZWd#fHJo(G4I-#XX~EugCaCwMV+jmjY$yEn9VDA>tJC*#bCPrzwbyWg z;m)|fah{Z(=~%(i`{pfG4xb!>b$&ZD!Di(q&gi)cgpWAvm@|T%&2J&0JA77q3WUd? z#{GOLy_*WrE{8{8KrFo!zR}lC9EbFB$}eUdTGBnz{ zWkmq=(b2pLY8;c0KE{>U!K|UR?uWXoR1R`26%uJ0IpM6LK1oR|S(^6YPs2VSZq z;(o9qKu&sA-9D{0m0kxm#~8g#$;PFMu8-$fUt*HKG`=s9`AWyy;@ti#gxxO-P*ylN zpvacDSa~hXL*mx!qE%6ybg7(*xTecn+9yQ0j*fM;r9INla_vX?D}){V+E!^%XKN}& zu^1%{du;N9A*}9Nz{^!G1Ll3ag5>_HNnLM zI1JyK{^+yG6u)$;p^XmtY!I&y1oWFnF=PYV%6}{fi|PpIZ+}=@2-4qb-I4JxFD7y& zUYov-sy2|127!~VP$)G#U)0m9ah)yTk>`iRSMjsD)VwWz$2L=#t@FH=Pi*N%h@_f+_H>|}Ju%^tWAgL(h;6=rv!hmgv%i7p40`I3Zu zc$a9_!ct(0gXbr$0q?A|@+J7@p;JP)zQUhFFX=)!ben@qVDi=)mDeHLeD$}P~X z&XWc7J1`Ar_o~K?#GEM~HT!T=#56^yVq;3{peaiANFH4gqMHDyZVs1sK_m1IBi^)h=7u6qq(7@^>? z>_l-3bO#3lpO3%x)d^Dtcx~7Et9hW0Ps4dn^a%9l4$-$!b{)KT)Ns%obJzM(Nq&B5 zExT8!kHWWGAZ4c}HBq}V@pv8I-#Mk;A^x<_aQ+;=_xZ<_GtM;oCB4^+)5WsM&@FmV zqGpZTWlwSAId7a0$+6G5f(izkW9F^3k|hJ=6A8?nC@(p3dc;#*g}7(UF$Y{SwT@`T zhBi@??G^nbk3toQZE~ z$?jcTuPL?afFYEC5UnOirvyXxk(9zJI-WcHG!r{iHQ#VVKAKY;;$WN4>OjD;VAW_H zGZ0*aQ76Od(T=#z)+xL76o>sRZzUFt2171TB@YPF!4pT6+Z1ANSvIS^tHXh{*R7di zDGP3k>ZqLD5&h{fF~eoz#a@lz6NkN~&8Sv*_4k+ss(wxyLFZ{LbrnWq9z$g9O=Nef zwPavs6=qF#-!nWYd{va2ny|=wk+o(Jd_;l7F@D6D`_Hrz90zx76lt|BtP6uJ^yQ}DqGn`j`#2pQeBh~Sli!SG|xv5qxh{T^RJSy!_aCR_% z6f_wCmb1>FWRcz63_dZhRLGc?LvZP2FM{~A!a)!d6bk6YNU&+tBaiB(42>%xjw`1M zs*FG2=w!2;Wd<-p?%0G(e#B>`g;fPrA1ZO;r}+K6O;d^M?_}<;_)_0DclV+17Q9hR zY7%d-JvX8pMn|NfCw(78_OSf*)__K`O%tTz4&<5=x6?o4w%WoKoN-WP3A zz?~*(9S{$sGVMd>b$;@XEb6GgtIEEe@v5c(tXuD=aVC;WB0aivW%CGLOMpu6xr+@> z!3dkKNJ|@u+Gn{Lgw-Z4reK6;7|srXViJ=~iL4c|sb7z9@pk#Xx6qCVX7r{8=3o|o z{BUiqP@w+s37EFGq5LC+ZC}l#AKYOA!x_(UHNAIzh@i9z{_*?AK8+kf-A`i`wd?$1 zc(J?2wz{i;&64hBbW2f%`cVSVaQB+eyqHg9@Eh86aW8*jH zW`c6;i^*czblxL{#6W)znI(`2K$p7gI*X+&!gxYK(1DHnEANJZQJoM+neKTZHjGz!}EufZDud~}pL*pUiGh5^s z>T=Ns{iJe7K47AKsq{u`5 zXO&iaIijdVUr}BYHl2NBpNUv4pV`ID&q8cFsVSjWFP(2XtBzhRkCQnsVUAxl_SB4G&iwOm^X?lFEYa3s`c@<-LkvJ^e^3l_iDXvbJZ;xuW6toFx<1fE@ufehG=2#S3h|ML>Fb{#s@qPQbhb~xw0nAALWz;H)6H!qLXH-wtdADnE{_z zo_D?b&{tcpvd?K1=jHH9s(=^Q$4e4*I8lx)B)z|%&nzOK$?af{+%0zs5LcIT?k#tm z=ZAOp!4L_hbe=K4phcKBbcgKKNis%%cJosxHbB#QC0PpNCkj#c4zD0t2w?c5Z6iNN zTY{2XAXiDGt6d7;SaSTz7?oY4Ecy#qcryc|YrAqe4_HHVlpQv}e@M zd%~Bk)=kPMYBptj2Lw#9Vh0^$U0hAI%))ipqEfH9or(EJ9%j?B`u70` zk9T2Ocd_arqMFARt9xVmSxbfTgb^At1mi8JWuLjxDgtIeXQn0)@*pJlY$dkERuG+z zn4ixvhYv4M5U)hOBnU^=^5o^xurn~fg%RYvQe|a%-y~8>JIt?HwZertK){w)J+VeO zDH)i!66sspW)v@vCRp%6#w@^}M{y;b(I@Q$!Co@2d1g2(DK}GQ;)z;~4Lc50-i4eX z?$zE|x)xS3y%F0I%)1LSweCJ0nH5L2({PiWxj7957Q2u>r)xF72v!{rUlQloK?|rN zXBtd{irp}91G*DOHMql|1XI!s+=B%uM?GewUc>ZMxT@=Gr$h>Sj`T~^E8dc{72puM zb-^gx$5$`(v_>WeadX`gJAJ(vm({oL@v2bVuA5>TpPO+nTgh{<&jFr|y+5`7kOM`8 zno0Qs-o<=Nj$!TG!mfeawv2<;q(Oz@Hk{kkaHLS8tyRg4q5_}*JV4j5_#AWdy=GKPMz66$i;K@TOcWKjf(Rj* zi;=baJ21zXlmgy&i>UH5g;}SMd`shjbVO0qMUD(e1$YCQ)Ll$+%DzwQ^;avzX_BEV z4Ie?D-y!T1{G9LIh(vUKd94K+^tSTfA!J9?5;&FLGOO|3j~T{L!$_sEvq8f28r7LR zqmV5(z9duBfdMm7jrw426_2h#X27(Qz_ose#{>Z}AEqP}}=oGPp7zPtI<8K=;52cS83KHakDCQhD z#>T05(&-K*imM&8;EC)$g*fLn1PB;aPXkfpAvHcm5~sq06_zJFsh3Idg;Q$kWHE#0@?GqRTPcM2m7P% zNDG_zLIbmw?MwM88;t(oZ2E?=5_#X-3?2=YZl%rJhEgcnnszaG5brS1`$Lp}g|Nx# zdhbIjk?~YyW4j$6Zj&(*vgy4dW-UHt~^T z&E93ePrTTZUKT0?$^x|1{r#+IsUdPnMX-6i>P{X=RH|uL$({BZPf99xRzv`Mkds zj*{O<4L1-Pqh%JiSkktW{;`H$tv0@s(N1YMQoBL+2@=q zBlIw5j?u@B68CPB#vzkc!U$*AudA6`r9Eb(2vC$x`xu$F#(sImZui5_de&QmI_R9Yf2a) zRNcg*@&6m26qs1vgkMc@GO~TXm^zS zs1_u;M6w!nk>5QZ0n>=pd#wf3l=Z$}yhW?^<-#1CvYA|;j9t|Q3KDSdRC)*dItmc^ zo4eR?#Rxkni%KO1BL*EFFpE<&U^dp5%pZCOAuZD|KIf#geiq68zB-2pk%w7Yy9tg_ zOuUT3m<9cEQSsdrBK}Zdicuc^wa>1yBt!O9znn?9Kg?WzuLf6lIhxXWRaB!&f7#vi z9y6$6cecL9re6o!C@2kPoy?&}qtGZ8)<0Nji$K)8THbf85c%YiL9YSx02>P%A%3HX zQ^8ycTa^rRF97?}%xyZKsxgbL)liCL#U+B?eC{dA@z!lL%%y1j29sk!VNaW*I7&RY zI)N};FFz(##Py;(1bSEbMjgvqeU@(--7u!nHo^~9laA-m#`vaq$fOPq*CZf2+Xziq zSwnVmG=oKRm_au>HB-T9Yhyp%SGx6^E^mba6~5y+UF{=`4-iX6fpb0eb<}bCNJ?-T zG3SuMwF_cC`FeOpX16zQeoBa?SH1ncB1*xj+0F8FVMVfk&{fcV^Wn7YPGVMrQWYoo zP;iJJ@EV}k2wz4_sCIbvY_k-$eNjfoCPzS|A>&@q;P>Fm4&zZZnCxMe*2Y7_C)SS; z_R)|0?bq~Rh4Gu+@{DB3J?#MG*ldNiC$uC`@hM%DmO?wm zU+zt_(tx8!JaA~UkApMpqeZeXX=}s2M;37Lo)-NT8Sa5(X)AP?uFK+t9uNn6f|aL%=7vR z83gZ%D~`-f+u)u&pG(KbGm04NFJSoHlT;0fr-DFaM%*HFk#+R?Awp|}+B81hyY{(c z#$}!-v8|zpleE^U6DVNh6|^IOh_>2`Gt&l)8m&T z!?-~X$4&0nEy511&5Db&eksVZX*0{1q#6nKt%I7H&o)8!tGuG`r(ic59`+OOxEG!R z?=fRN5P)Cu>B->8o?s7r0gk>@|5j4}V?%3fWAuxq(X;-goMvJBJ3jquocn=K8UA~4 z`WvPFx)n1U>)%fQnrHqUpZ=nqf3doMPE-FUd@7>EuOcA(3!nan`7+!8BaJoF|J$VT z?=SOzz3jgYseccvW%R8-0Pw$F@P7iS|G!8Ye}LS7+tdC&`RiW(1yVm2y?sepQQ1hr177m@t>sepQQ1hr177m z@t>sepQQ1hr177m@t>sepQQ1hr177m@t>sepQQ1hr177m@t>sepQQ1hr1AgPN#oxH z@D~>Rm!$D;4EXExg9QIGY5bc7{yP0IS^qO>{2K`VI{iBd{%c(Oe}71;sv)5$uk=BJ zrN#df3jTMK^@mE>P{Gz(-{zkpYZ3Fmgw*u(|57ymnDzcsN&Rs@KL92jPtk3_* z8-H-zf7+Gl{@FJEa5MkYuFSyr56klhr8WMby8or@{+nI-_sOp(?eBJFwtpGT{-VME z7|s3{F8-L+vi~OXf9-5P?8@x_@Gt-GX|S`}toJ)@As%Gt*T6_L?SeM`Rz-L;!|qU+ z#%a7zJnR6bP`ovAeEg`dcrcIz_{8KhnR)k)8(sVC`!5rZ&swH!mEK+F9^UJ>PcMvk z1(kp??bN-Xr2&2g?tJYphycRW)Xee#yj^&-yj=kJ@MhqGoPzHPNI+3}VxOS_Qyyqx z!^OzZqNd6Hr_p$+fw6MW&Y%GxfcOXy@#G&4&V%o z6;1$5L7>$UN9PH~w3q7J0knjV1rXcZOm=^6=hqJP8RCoICIB_v3gA%yI|7gkC>kCf z9ofqB2HsL3)|8nl1P_m_tgKEoR5+@CeahxfP`BPGSO9M_$nYD#6`)EeP_r-ExxSEl z#K1t%*m@*yBA%ouS7hblzVIIm@ z0pMv5Y@56CtNisYHhT2Hfj74xgFX9x-T`o?GJei2$RCNg6L9?0ZTG`cw3-ppUmWZN zFqr*|H63ghBiJXUom&7sshBqkI1v6`t!Xly&ts3RLYw5U z-oI7_`=)^Nan$5-U2eDEKZ>k!}(0Nr9l zOBwKt9+5=Q7a;oJ7ErfO9m@bbI&45uJpg(ZcVJ8Sv4M+*p!y~gU|kEZ#E_pJTKI(RD3C>&4JO~Zp z-)-amBE7mZk8tM}a8AonBpwf1Zk0e31cnGQY(u5}G~9M>JF>FkiU}b8vQ)}hjKrlr z0;Mc8FPPq-xuJ?;Vx}+?hG|QESb%B$1g#nf_ied0S<4{DJE9g`c0tB)Cf0%*Kk~l3 zxozpk2CM9f@CMGK(i)+eamp@xx{`WrjEp#VSFamS$OBhdw;|(ccGb8b1Bf#0HGOno zZ*$U(O@eg0-&D9y%KU-yJ!?F+e{{ycKKfP87t2FoF)haOTTo9GpE)ILt}InvqvoUH zL2r*b_C_r`)wB686|3I!CO)l@`;~|We$$9q^*!WRME0pJmf<}^VtBzdPNiJ|cE;6l zov56)5lTirA7It^e!>i1h|8rW$xDF)Ci@Iy;_N`>-4>gqCBYfs}@9~thSNnX9Xzi&C3~a>wXFr z&wgFWpjz;m22bz#iE2CmL&woK+^3IhSjkxa==>gGOX=`yC$G^*G{1t)LAsYboyUB`>L4 zu)&(QnLb}h{=RU>7LF}`SFZ`vBs{-uPZ3f!OtpIMix!?2c5+(HVrMP^DyPtcWtSgG zAR%+>i=GHR0|CzxZioVsgQiJY*;I};X|3vHV%|ef9wuh|C~_^;{n;`@=OHlwSBxF& zJ6EJZGQ;1zM^kUg9?G5_HmJ@9mNbDXgAWsfV5@P$6{{e>jvLU@jryi@mj;y*>xW_J zdqQ$f!PudzThdNtBA*V3bK6~K>721ctkQq%LX47tP*6wZLv3ya9$P{tbk>b6MQ;BBBDDAW#rgzcesxNbfYn zy{K%)0ugp7@r1r(@Alw2-+r>S-b%#G(Cw=c%v*gpO-ran1By@m_dd}g)h!Pkwnm#2 z%lz;?VF7RSDk&Vs-6bMF0tUR5eFO_sFTQNtssohj38PR;j9GQC=yeuW<5W1}%uNdv ztnGz#7;m@9C6WA*9}?v+$QDTj52bJr>~e1sIf7b4?uV&NCUXJPTFB zg&sMqyrhh3Uys&qja{)e=ciaBo|au?dQRS6L=6mwno=G|>|Qs+MpE>()2EtrGOUp- z)l-0bmR+UM%rt@PIc+9co8@!>y;8E%An;g0wUwdQRhN)gdmfV*CuFqbcmtt&f?nGX+XbH;T-6oYcb z%Z@5fljxeV+C!%E_33DaTp+m};Z&NRV-DFVEK7v;Y8@^vlJjP`*nM*is^>N=$><8t z4{~eQIWl{=oN+2CBl#4fAnb);jjFumr z0XypH(TdB$L>zy#=_{5^OOy*wA{aTV&Bo&PQw4I>^Gdq3e9Tg8xK;OKO`LhEHJx0- zTjA|Uk#O{O-zqZ?MKkJxC+pLDz2ho6m}V%pHJopSB%{gYhQMK%e{xI#(-3b6ZWf2b z+F^|3F3zn=218m(AsOVmLrgtmVKGP|R<0K&&niY8KI=04=%K?uXUI955uD&PXIeUp zJuxJJ^1ZwISZK|`R7gwMtr<#;vg^u+{y@@9)6a~5He}%Pi9&S?x#gsaIPakBht@Vd z2>m9p>Zos*)ave9NaA|Xl#9}Xil)6AS=xLgR@ z{wVWju!}~BchO-C1b{0{VDr5k7_*ga!5@r)6jlMzEB-^@3 zA|n~P`xOYb4pv4J%qC=HqsHefY77j;=H&Vq4Lh|WsoNH7xH`Lfl(zyjlE`#m1~+9H8S;Cr z4`K4Qts`SDG7_4s0u+Pwp!zIzpq=splzX5|xa|XVUXB&q2r*g=@z*rVG1Tm80n47= zB1ZFiyPiCP@F zUPrl<2(>7;fryri6GOogy4U@I!`d3<$v-`}&gC-ASz$nF6x`Va?u3Fsj3DN%+IT_~ zm{p+pbk{-&p-1j=$m825EYkdPa_{&~?XXif13=$TvmzO>o!uQUbqjfY=KTY+6E+VN9W@j>uoz z$3SglgW2i@d*~H~Gp_EI@p`r+*sqQ+Ak0lN}PhL z6c@YqZc<$c*BUH!=$eUeW%iLc9Hp?JIb#tm4Uv1cx7RVv3`8v>zCc?=_5?CB9Wo%} ze8+IxR5fPpYx;^9LB)gbCZ2D5V*l2Abpc@8^n!9XovW*gFe$lcUKR2Km9v?cXgciy zu-59qGVacrXEt$SJ_sUjs10+qO4TgHG8OY`7GrmVqBOCPB(0?#vZlR*7{YSP)9^f8i0BE8{yc+L1ONeTL>tx#5yWclX2>^!u& zxNl?%(R##p}QGd(S=ZKQX#}|H1(rk zA9KGhcP)qvNJ8Ymbc8Vv7-*WRz)SayCeL=sW_-uUQ}rwd6>GYO$sLY{iOqOqDZ4axDgCB9 zw9rlrJV$anR>K`+mJ#KiqHQPA66a7WDu*=a{jx`1g9!TH@-LaDbhGXs3b4GpV&O)5 zsY-5lS&8{ku!^5oWglIy$ya8N=eiRN+?I*&31uh_4s^I&=U>Z1$`w!il8Wx6Ik{aF z-Fmyz?<2X&U$*8YBRsSPk)V7VN%Xg}quTt|)d#3@#?(sYU_G}@!|z!SHxMyncatYRbd?d|a9d7!sj}hEs-w>HA$qLi=hVYbi?tu8uA+fz9&0{-->Q zdrNh9y?GVdl^2=bYt1l5sA3u{Z*ww{MJvi-FbM$6aE%_t)!|F70p54%g z6&=)NN_iiR8M-ZqL>G%SZKuqQ0VhxQno&aNHK3;~T0~kdBT80!)d^WBF^Z|csYhSj z+!>1>vQu30+iT)02|1LiWI7p==j=qRu-Y+`S)}-s%K0j|meFbrK*+oDa2;8-y9J+h zV(LayoCrZ1gN<#w=6#IISw)Q)1M2s0lual?7ZD+r09TRT2g2htCRAAagNl=QrSEXLB9-JgWcVoiV1~O-kzhxmv zUIHky1uDIuH4E%7P}d;ICs%?<^8pYXs+CfO(+ytDFPtdC+K0W?T`No0;9|yA zH@Pf2A5W*=3g6L->Dt^Kth#i3JoH!`csWplYNdK%=HSMs=}J4K!R1JmJvJ9u-su3G zbgko+1<%7h5N@%$Jdi@m-g&9lM@2t`Nyze7gW=rEMC8e~q|dgC-5Y^0;B7i;po%v5 z(C=f%k9R4UF>>_f^qP*_^meu|__{IqxLb;7HGCfz(|Zpz#fD0R9)YuJTvPV&-(BZb%qhp%8Bpihlqj0xmmfcErvt36t&RziQl0D2>J@^ki(> z`m=RA-WY)Z146AZ>k?gMk$d8_lpqBC=|Q%VI@NL@hE!*OpMV*7lj zklsdgwd}8cTEx1KYFI0gKg^5njj#6%PfJW@my8xNEsLO#yqoug=`?vIop7EKhvS(9 zSv=eCThC^l0GV-WP2l{b-dXy zCxOpZlU>G!l@jsV3sN^yk!SCTYQDb{wLrB|%b%taXLKE+wp*%ja%(@p6EV8+b_ZY^C5nvarydcU{kTY>lA9 zF)tm3amp>1^m4C{(&LJADn%Z2gerw&&p#2Pr`tyNMcNrvmG$Nqp(aiblcN?TkHfPO?g8H+^={{~kQ_#UAW8;|PelNpWcHR&tkyJ!w z)4c@JF0Dd95PRAZ*AvvB!_1?_WE`Qzedd&_{RE%HrDDRO^%OiCZ_(}n>K4R;K5^cJn7SGmkcksJ3&Iw3DL#J%v1>j>g|)2xJ+8VoC6tfSQRMeB9V{WAGB5wBQR+bJypQ z4%s{5wjSHa-raE;TLl39K%D;uV@MaGq+mx@poLq^_LIpqm@_RlQ1n3wva6SM3G9)_ zemtBbHLGC~kaNlr+)41LtmEY+X1x~9(crv1QW!~s{5dZZb1cNO%gI&yyOo;~Qh9#1 z$0^)gqfUGTNYJSRW3lE5FBNVkCN5JOQ>hrp;0+J-L}Bx^ zg|+00daS_OOG12(ZemHVF1~qDYJvIfs}yPASyZ62a}e>wwPmq|!zDZG`g0L$wesGA zg#?eVT1Uc}I~#|QdF|n{bEjr`@l7g6$8}id64G6YR7%VsO(X+(;E!3R)as$YBxqVV zaQzYTGbXXY{RxWI=r#ppz@j-17oG5pbR=nF8(bp*UUo1NAGdv$DLO~?R*=cg3_h{8 z>6Iza^^{uc<65j`2g9B&*_pYYb{p-SB*el@(=k6kN7Ukjnk8R*lU!J?7u{!l%DP_X zGi1oze8tPCL7cjSJ~Om`XEn`Zy#uo0MPrcyMHzWkp&1B%m zm-}8baC7+V2h&qiyFA)iAl-cRS_EL(C#{s{zNT55w_G0M1U$cj423izH$<#cc>d{r z6)MyQ>fitb?#sC;HirPTf>j!nr7ZkjOjFv5E9>j_akfimGky(vZC{JDxX%8#Z2j`y zJE5`T^PX|sjG>K`(RI^+k)&~$H8rZ@C;3(#Dk{PS2aejL?f|D%>Nt*&-EG)5Q~OO) zY9rt64J2`+V^PpFW)YY@&hVvj9k5a=Gqrq`ak78?iy*?jI`V-`eU4XY&$pU;W#hVYRIRz(Geak)Bg)fwYQJ;X@e$Gyy{U-)Iq+5emXh^LK&yS> zg-_Gbf!XQ3PLxl;^osI`5R>a_X5;}ie92bk( zBlVN01hRcnB?>fDN@N1XNQW-((qY|-A;}bh;o}$}?tXzsNl9F@gK!2!KO?K1Na#tK zg2?M0qJ>rkmNtV)c&v-!mbrJUh;aSQp#LTQhRhLiVaZ^d2aQYh^`=Q|rQ^xhMJU9EIbAsOLav2j6DKChpL$u&fjWD1 zuu(iKnmO+-ysHvmYS>B1zQQo?iYXE#ROhULj4I&>iwIE3fkaMnaE6U`9aro!c)-Ss z#?HE+Mbrm#mpJudznoM=J>)md5~#KHeDC3Bs-mHZt-J!@O``~_I905z&R!^x--3?2 zvqdOt)LfIKT|z!KZVE6_YKZA*-v9L`tN(ChC?vyEN78YsVlL4IYsl zh%=UOYAWsLa*Spi&Y2-&!iVZ*OW!`JiG^;U!2RA>8pfviz+Bm@mUDN{yJvPpCUkT$E}-RXdCL?clYv!J}UhF5|uW<0DWN2X`&3=+0*^aIDeheGcnTt_vraI==^oc!tgg|^l#ev>-6ua`!Bonzar!RY4j{CsUjn< z_#1Wq0@eRsZD#*H%Kcll`F~{HOdq88zn#(a9|`GyqV8YL=)X|+FL3*R{Pr7~{~v#r zkLzG&rH9o1d+qo4eg5^x{_CUopTYaTKYss-ynnQ~|Dm(~FhBnvkoOO){wrUsg7*;? z{%`J1&B*Za9q?c85yNBrAoBl2@AOO`ANcDj{V(*+{$GRYzoGZvCx6}5zlPZC|1z`w zK<^(p<-aYnf1&r^uYmYFdjBt|Py4?`@2(%{-FkyH01qEBRE!b18C)Necx^38EZVv| z)Y>Wm4Idvy!c`ocVhxX+98ZEmOhSxYf^~B4xV37(b>p7B z1QKFM!GSz)N(U|Q3t_a~gl-G~4jC-~6~6ubM3tRi043HJKY>^PZ14$$GYK{XNP9rE zyj*a$iDO)Hx3AdtZ1qI&2b-Jt;PwNM`E;F|D@YN}>Sx-LD z0q+bx5UM}==S7(lIG=J4002Jp;pAJj95hf=AEW^S4X-Ego0K409VB8=po4P|p}pE@ zjy44$ogEo$&?V4YiTi6r&iv-V(?O#B3^INi*NfL-3;6r)|vuy$B{ zpNV`_)wDhXxPI#9&WrBO0Ymf5+w{v3xsYYf1Jku-f`q9itp~gpUh0G3OJorq^R7v9g8StHSj`U{0OS+69LUS7k+2^D zbdb~K(~sB1aQ}NIrZMN+$9JsmE(daod@jIspk4t0Kzw<40BA%6uvKENhd0I;9^gyU zl-w>POT1J0z|f6bM9^E+@v|;;pr4Nkg6)33B(uT@xlmviFHugCv1H&94?yp}+t?S3 zJMW;^IqGkOGw&S)^I$YIU4#ACo;>d%*jwRtmrt`_0M@|RfMA^DfEn=K*XE($5(WWq zu-Tw5yKgrtFxbHTVIjr9fWCrs69nMJZEOqaDSy0zA(aOR%=rZ-W5XjMC(w}}Z}W+a zYHJ@^FqA-xv}@s>7Sq38&a{^~fLQOk2_k?P9_8LLj#qmVSmD(XghGrA@-D$!Am0E0 z9Q4y=J`q(8UKmh&4{&<#&+M)#7yw8Dc{Tx9fIL%OKW<3DN5|=WL;yVh-pbgVBVCMY zcyNH57veWw8HQd2H^83mH|Lwl(Oft>G=ah{c-fLG+Q-E#fDq5#yhNmJvXVK%;!#m) zuw6(h93aUrGhZ{v!R`ZrL9Z)D?6oQSSUx({Y3Kbt#^gdSD?!gi!gIw>|tCw1|{=3Kcb_)F5Zas@W$xbD#E2H%IZ4`X@^Q@NeL$c_qR+Owww)? zSI5A@B?3hK{euTiY zzR70`wUzWv#`d)BS>h)C7(a|>Zx}-2vLG?S&)!-xqI$NH*pe@J=ho2Iw{R7b_%?#9 zH=dF$39{$8?iN?KdYX(Pd?wyhD`v!`{n@9|Vw9Bn{cxHD?V$)GT?3&o@ZK(Kdkol{*j#vH3hcnb+XgoUX%?e||otPE?j zyNW`~fXsf*$u+yQ`^R)HwgvH~;V6R5VBUaM z404BAD5U-{ACBI^{-%fi>e2E|jKoh%ZtF26@)lbk3}x>WI*k$wg_;Fx-({aH<9GvE zUHaNIruEY^?YvFe+SbFUP`g@2+M5S#Z9{l#Rrq|wu6JVWWCH}!ip53fjJGmFK22NM zN!xSQi=v5Diu+blQPn)MUh#7wKdi9outtvyH4J(>EgnxJb@X(Q3!M88?y)Z{c_^!R z#ewHZ_n~JV*lcn-lJ-UnrBD;QB;E&-Av{QEI(4{BpnTCo)?{sJT0$2^Wj`pz`c7L^ zSTf9-z0{F$>DNigS*D@!)kx{PpPNaUwdwm0E~!)=))Gi3*j>vDPPS$`x1TYG@s(bC z2w1|6pez@~4vV7Oz+$>HUIY{B2~jI;Qsf$mPW$LoXc`13%*Ug;)Y;w&EK?uIkRO?7m-`>4YsSxGR^r*;a;+^Q;BSI3-;S>I5c)9!>MM23Z66u9a{XFpyU!;#jZuKTr)YKDuH09NR&Oao0=_vMD;=%n!2BuKt;}yEl6odbAwXdSIqbU zd=LiTvhky!EYFoLAu=a5UZi<|8bZajc$OkQULLbsE$=3;;_;vYTw3<2?4dcDXPKB| zC?zXZ)h&-}W051tNAhm0jLAX*q?aoMl(aQDzRoIn)Q@MTpdrQNmZo>_kLK!l| znTI;2h>(yWWzIZg7Lo>u%!Ck5GSBlI8We?0nT5<5qs*aizwZBkZ|8l#=ljmn^T^M7 z_gZ`Hwbowm*=z6Jqr1B`EU!=akuT@m=#y@g`EN0=vNV4^@ORx7m z!r@6)Y+7Kh&9qW#o ziD!}=KJzWNV9G4wLC4h-py*@aj?dDG(2r}fO-=;oxLL}Q&DyU_*F zL*M0-@0Gp0&@5$uv8WWAvMgU0ycxYfFB2EA$yClO{&Nw(-_F%*Gt@6kAl-$Jbc>C0 z&{!wbJj3I(@RUi)*!>mG0lo8EbJ#2X&%?ha?bY5-h!A+IyjQt|CD>{me@a`uq&+t9 zk3MR}MC`NBD6X)E(}w>zOi#^NTWIAX9w zFiECeoHE|7_K=F~EA zLaK3}8~KkPC4O%me}6Rmu_CZvNJ#43@2lfU$^225+A^&iYhri#iKZ3#-aCZW=b2_? zx$*l5ma}ZLL#x1h&#MD(BsI1AeycBwlX+TH>q@2H9XiuvFCukEQIk?GYe7X= zEW@}l9zYV#`Wg@be~+Y6D)97 zTcA%J&Y@rR?H6TXHat~vsgy}=^XPl;VZW;_g-Y)4yQZVV+o`$>!Cf9tb+^hKJLTx( zohM_CD#g5>*)k8#p1tND#uMVVy1R8VgMVwnjIX(DHRz3&u!K#Qph$C_a;?Hj_NhrZ z`vmz|g^j+7%VMYPUTr)~V3Dz?9`|p}st8k+ER>hJ{L^K|&&?=BEzedYdCV%dqOCXi zL$&m>I#=?yjl-WcI3Eyq43yiEBa*b%Em#yAdY`L3?eZLW-||f*a%am(C5n31`@N6C zsKCbHKtX5W#ZS2s(vCaI?zBkK=W04;R6bPG2)@BP99M-76TNUXAO^2)7;6su<7DF{=fusoVJIi_?)ooL#PQ4Q*@(j||^9k-z7g)->B5 zs^x@dKKJP5E|#Tb>9#q!+m3?TD#=8utsuCCZv$d^*b84Tg z#=NKm&jAiCYSov)oB}4xQWiJ4^!Dq|@1Gf694K}UtX!OH4fl^SZBQ=G-8mS0N1Wi5 zXx%?D&W6roGcONxNlZ3jSvFF*-}PRQ8cd7|oqHxNTN?M?;r?!SMhB9)D_@oqQ?z)C zUUK}i!5F{%KToo-epJk|i@v=wpy=(K`i@mJ<1ph(uL%mnjL+@3-tBx@Sy{wLE^X_9DiNmQW?10SfG$~>xz-*=ai5o_LK}sOpK3`ZpqPVOu7V07cZz$ z@-u&;=A&G7jwws#4hc)AamL*XTH0B0wih(p-&pJ^(W4IV9qXgxx!817Wxth&lZNQU zv84v%NZU|s&|}Mz8_dgGGs9~Z&ao7%c2y_e>#q7wZ5eVdMCOu+^R`tK7u&$BLFdzn zync@r--|z)x@^FfuFb?K{92(zYbo!1Izz;6;^q4CBF)QZCnuSjA1*R1yV$&b|6M%$ zkIyfIC3ZyL6U)ER#_hYHmfBSJlK1PCf{tf&>gxtg#d696H^PLik37t@Z}m>x6El$I z(lxme!Y)raORXOFVqMEEd^m9HP-Mqmg@9Fx0Ou`idZ(>w^tI8Fvi30_<(gkSR9j z$+v2byDh1x%6dAkv;|Y0Wt*I;Pv>{{C+f*HcJ#+c9buopmL9Psv{hrO>v<0K!lM`) zqENrVwM%s?fa028!qxki>M_Ih*Ru{Yk{&$`UWcF9FEabw>Ss8nr&&1im_<#Co7iP* z=5WQ6lcC5mcsZ%k#U+qUW{1Vu-U59If%Xsm?8(t5tnBrkPJ4ZDE3qPFyj!GW^k&q0 zd&Tg#TKntO?SX^19l{jg*oUACwm;M%z_y+ zIL@{Y4^FWz$w)qbAgjzOVeo}cI)!;INI_DC!fXTn|Ti1`px!cy}%pR#|y=XtBuhu0lZcPD<(tMe}K4fl)brX3Z> zEn}v+ixpl`{T-jhQQGd_ahI$|5$K~CnMFpIM3MrAT4l0De`GRdcLZNesg)|#_ro^J zneZlP@Mu%kF@@eo)#IJi7kW6}a$s1WXAV7hB33du$n$9gzxXNES38haJw5+D0$6~)v@p^Zz786nCOgegd(+BsR3~_q?uBCtaOEO;9BSnz+`fci_`0AV7 z8nbDWe&M$#XNx(ExKfrDS>$?B&ZhQXRa4emT1ZetM>5>r6TW+)=C<$U&dY6#tp!d6_Xrl+q7;JLlzmFXsNrcMAEF%3Nt@XY2t7Kf6e~rSRx_@q*LCxZcCBVW zc}#c|j!Dkry2_{WV2;q|XZfzXL`8-6+ud{EjzI^2`wF~IZzlAn`W#po#<>Kd%;!QB zn(QX}-P&ZphpBRMMZm{D896h4<6U{MR>^k7 zs?}&B&e{EiOyZM=iRarI_?p5NvV_fNjt9mjZLKz%mMe}^sN>-h<;bBQnuuY75Egqh4VPtelzuREhx|Hoh1 zkvbo!J)eRK{k>xO*Ieh@EW4X@Pfbcna*2o7SQp-nH%&pWKeo&Dq^uM~-uiyoyZOXD zNlbyka0$;5yRU!PJdCan6SQ}aymR;7SDV?C^)oR$cTRH1=AF@Oe!=~2^=t?K1iIC@ zTWm)4(fWuVS5zU(`rMZF zL)h%|xk()JhPcoj@gc)A8h*i&Wc8Tw;lw!05&xo|!TH-&MMZB|CWL$C8o6EM7!=x9 zzm_hU3CU_S$`<9kZx8!!e}L}jpohTR3JN!Vqkdk;B~x+O%06him_0)G!&1MNp$9AfjMsn_>T&$}Fw5>vj|OllS_k~qfsDbuW8 zV9w=W*QLbLwcQyNEU2K~R}xr;b@7(qkQr{Q)$m|NRF+0Z`%R3^t=5qS$1LqMdwYMQ z_@kx{*A>rDwc8pg355c9ro7Md$6v^@@v$);Q^;}_h`YL_<=XfyCNw8$^&`bwf?Xs> zJcgGT8Z)HJjxQQvJx!H4*RhtG^-lJos;JZQ>OzXjm$$0bw+0-Wr58`lYyPYZcCb@y`3yUJYuP;*aAC2?4$uoe!k2!8<0MO&e4U ztw$3qZbkOPe^o(OkQmo#|Nav%VRAGv81iGnrEf{hu@QhBv&sbFaotJ2CZ! z>n+(F>F~Q=9Lw?T4(h>@Z}tFA`)MM30Qpk6USD==p1=*e39Xv4I4o}6x<$z2_@eg4 zt|cB^g5lbyBU4c(Z@;|Wv{+8JtSd6Ev0|;-&}izbIy6d*;Proa+``wh+|^gKRr)A% zn=@rZ+1=fy$DE(@eSWof>jHh+d@#zXnZ(~-qc8ON_7nm6Sm`!rw zynMxi&Fd~zG^x0Wp0p@^p~(5cbR{I2GmQJE z^Tm}v)gL)XO(jXc6JCqH{Br1O6TR1onQzP{x;&;2Y#j}9k33bIay^K%H#qciGt2)> z(d;d^#WzZMxPq^Dvz^yHq`m|;z4BZ-7D=b3Jfu6)$Q-#+Rx~@`XnaF&eUGt@{#yX|4xD9S#lYF5PbnFlvLXY?DDNDd*!raBL%g6g4M z$EsQD(&!Ve$IZ{)*?BjN?@3M`-Q!5Y{-nJ@>z<`Kzw1R&y3h{@uR|_!#;EXajpzKB zcCBrTd~IakSJfV1%&&T)J77Ovo?$@SstMhcNgpv?lRGo1#hhmN_29zU%tI0VRK@!r z4-h+F?|;$hTV7~zU*PGyI{L<~o%(maUfnbvYJXo*IeNNo=xX;%6*qyFS5~YuddhPdpBqFFySh=@!vh(+v|=H zipJsoT_oRLe1uQ}8c+Clk^H~sh5x!7PKGuSL!>8-93AxyjhvhfoopSfEo@8#{(bPj zhlig8ySTZO)ws04wZkH4vB`#4F2U}xjBNGRJ z{Abs*w1WvGI@jNf0m(LCVQV8}=wt%W?XA!BqDr>LzXHFkYP&j^n1Us9u=krD_0NZk zfX8F;T&7&x7+_DpgSB7i!)5a~hC*S8U^6%jBcL!~Ntl)nP=Z6&ke9V(~cWT5IU@@0f4@MuPz}h7Ks8!M1;a^8h6W(9sOg=l^UEg(blC zj3SY61UL^Y3EX-`+a4O!l0eljG&~46A{K-I8VpAupb<6+$|Yd7fdW^t6X3cBV~Ijy zfC-ETia(Ul2}I~34_Z1R8sQ&!A{GzV9|3e2?jHa{#4vzCi2@A|5F^lV`y+s< z8G+%^Sh##daEu9De*h!Ebq_G;z#1C9z+(`$M#K=H!(U)@B!n-JP#7GX4qybh%m72o zA7HKkHGQ-^NGPBM1V)1H9ifqhM8YEC0dNmQKOmPu$Vb8W8m0$_+a3KRyD;c*he z5P2QI;C=+r!Tkulnrxq&L}Ldy91cEL01HCoQV<5tcA_0ifZ<{O3(>*jJ!FyaxeSfR zpy4qQ4f0}mo&#YR_!t2Uo&!U4@Hh!D0K#PkfdkPGG8tjx1QZ&cCxV_~5qbs~LeJnG z0%02fL)ZqGK@q+Hw193SfwM1u%r|f_EH5ydvTe^Dl@7SVYVrfofy8?g2)C z$18xrb3N#N3;r$yFcKQk9x!|O7?Dw+1OYZ~07JwVkcA=Q3&0RMB_s1h;0S1V4hKRQ z4k0tZ5bt0BLyQN&5aR(bM0^IJ6JZBXI7R4y1SY+Ib>QS+2u@UU*e+97v$zR;4FJl$ zFWK5UaY3(ET;N**c^gw(F7U|q|7EzexhN*!HHlyXUTCj@-kOpP$>666-p~}Jb9hrz j;x%#l|DWXVbLt$Oz_%mYUn>A55eYbYUfy%cvh@E0p<@8* literal 0 HcmV?d00001 diff --git a/docs/source/dev/cppapi/files/thrustXActuatorForcePoints.png b/docs/source/dev/cppapi/files/thrustXActuatorForcePoints.png new file mode 100644 index 0000000000000000000000000000000000000000..5bf845481b977cf2a19a5acfa87273c7d9b5dd0b GIT binary patch literal 41122 zcmd43byQbt)Gqo%ltw^OLIe~Lq*Gc#k&qOWE|G4eL#0z`qy(jh)YO&&d=X`3eVCBaT@o^||P$(4sBUx!x6zUTE6-@*S1O6yy z#x8+BE;~v-QpbXSJh4oI;A3n%*=LR@6oDb~A6kxhwmAxQ6ZJ^?zPfAj>V%8By5@nv z=0+XfbJTs382XPl`Hk)?t4PQ+wvpW@Zk>F?M#Sev|DdF0`+?CnIdxgy2QuN5eD9xf zYFs9Mb^jy197!hgQ|0B}{gXiP^*QGNN)y8F7i?sqq9@~DUnrP%Cwr_{Q4 z1P}G}QdMo7oOnevCaXAtxW7e?-L9&jkfsZrdie z7#Ue;HU{!F69jB;XjRzY>+0&3n)O{u^W4V1A?kjs!{hXj>u*mQfq;Mj1qFrgf}2jQ zYf1lt&wK}IWo4y=k`jTbscC|!2mhC^UuEv)=H^lezq~tIZjFnMj!tp?`nSG5qMDa$ zEPIvnRWH{l#ZFdvN^PfZ93LN>P1fFf5JvH;#$`j}C;_jzpY0ml(|*14^YhKEEuvO9 z9+&kf@9xS_(fIzz$cUY@vy7=JS{^$_~su!WPf<=Et9(ME&IpB zkSL@Gk@EBN%PJ|gWy;5YP-gz{@gu{ZR535g)YR1Cii)<`*3k5#qDVi#%eQXd4nB?y z4t`Zu##dWgYhYsH2Y1%^WPeT2e)h7Fv9Y0r1rF*ay{oJ1O?LLHY2L?ow8|{}Jr33l zJLA{{y^eWprt0xUMMY7KDZ(zr?t2!c76Ujm!Y`%apWGgOIJxF#^z!m@EId4ERn==6 zMS9`z!!s?x#FCT0vz6XOMZKPB4wPbyPXF)$^`blZ8+?U`mNt@?I zo2vJk|BG??GGWgS2`TCAmf6`^S^9UqP5!ttRXnC$A0C8Lsu&p=CAN9OolAWG{#UVK zGs_c~;G7)hS;2@)moE7Y$Fgb$%?Tc_*K9~v3BO#unYys_;~j(KT~^jmy;|4%($bg& zH*Ucv;g~EZl$-{rXHTChYiPs~;$mad!RNaYdFBU&TsI9YdOx6%l9OvL-@8U6BQ33b z|NblHmj~;*zxw*p?dQHfId+AIFS<&CQoG}^zxt}aUJMp*=TA|mMZ)TrYd9Vr9(03Q zid2;~HFJ%x&?Q&rJL89|9GS8dlNdeGyL);#$}UPvc|Yq^T|>Q%jz-UG!DmYnu)T`< z@#6=fQITHVB^0muFX$|+Ryoopra_ny+w9+ zccpt8K5IETIK=3M=4%#Z_*|Tu4HwhF7p9k&Ls&HngB+?|Hm(Lsi+p=wZ2X2m>=0F9 zJH=jM3;SLS_C3q$((i2KsJ-b@GPEIighYk<4H4|R)y$%U1=<3)Zr#FKXyVYX$Mctb z700G+G+b=hJ22p{&f*^$iVG`F#=0j}6xli=?z>plW99yEH}LTAI352gFq7cKmWlYB zQ!gzoRl-(+=Y2V1ZhC#4U1Ty-o*Z_%VPA%fpvyY7s;a8pOw*OaqoZ`~3Y*Q%&74(v ze<}f+55>iVSFc{psLaY@TwPryBqsjY&&a_+0KZbo$cWzibnD^jcop&E$B#4i$b3$> zFx?NQoW8OUA}?a^kdb={Jx|w}M5-%)-)? zz-8R=)9d{79tqBsuCA__8?3>ZpFW{b>yvf3^i8KnJMWT{!zOB67?_!{u(7f2TwL0s znUws>T{b3V?%zj)oycj>h@uwrq)^LJ_y)HPsZ+6KPoF;hVE#L6aj<}jo`Ipne(pgZ z>I1AFLAz-bH#axjhzQf4@6(mi#EOfH8%Msr__h;!F?EZNkCeJC_V`pj^(2YkY8XXK zO#JlOGs9n>9xe8L#FUhhlDP*P!ndYIm|edX@I*#5048L-1qf~nplk)bl;K^uGO`*nc3M( z+S=Mb<{d6yzHBht5={EOuxNFM!|hb@;$j7yBjuy=YL)>6{??jW@cvbcXp)eX-6z; zhHWBs+sygd$=i05j9RFf4BXt;>g(%Ck00o4(-m51)&KcYAC(+6^#+rGEJe%C$;mG^ zHg@s!W&511PbiJ3J8!x5SU^w^RwkOn#$+8D>g;&$O?Gy+o%uLa4K&on=?=m1?$R4r zB*s79(n+%YOcH2=+GxMrpNpfrr<}M@v`i9`nR)vz8ygym;Xznqsrm2enVDCIhpuLp zmbmeovHNJE>v5Tk$ojAkh06J*Sa3pEiLn=Btc&Mi}FWH2gmp^?8hx@v?p;@Gt4zUr&)ZXRh6%^H8ii;-dU^uW(rEAAz55|QKNOY)tCwr+Us#z5Le4DjdCf0*d3jY< zRpsi~T~W7+CY#}B z)18ozkeF>aWZ*l7hfTkJU2}JLHybLXiQ~{ObfB!_4G0LZb95v=L%Mudm%^RG%*@Pw zFz9PIT#*+P0^gx*C6;`zll`}{x8!;nphY@VQNMiok~A+m$WKe& zl%JBL1pZ!_qow9*OAFsP6=<@`aS1y)9sbC|QR&6S#c{4) zWqk4C#jpPUPw)`9$Dk`kM@JL$nf3a@MLoWM|9*eHmj^c|=Lcxh!4AeoMzSoiQE%R$ zLnRJ}y&^3nB*besEs;6bohF_p81WH`y_&2n7XA&91o-Ie$@|ykaO3bKz7K`|6A z*&JU5!3%E3M+<3B#1?$M5;Vev`agAdukP4~EzO9J zk1r=HdoyF`!fR}JSQ$Wxbep=Q8~PP$^LZ>3J82&$n&t6P+m!iiGhKElE*ZRxgsN}^cE9SbX*+S(eZJ} z=)v+ps0nwXS#%t%Qe#U?`ThNUb#?VyEdT`{NlCp~AFpC)(J0h;B+~O6>ZQyYlR|=o zNRQfs2M-d99zA0bLLJVAas(~7g+xYj@MS}rX|Ydcj!R5@1URuD7K>J$JKq%yj3{_c z^78WT$Gf@A2jf+apK@~_!Gq6iY?RRYVuF30f3@B=r81>Yb6X zvENW?%x9YXZ^g=)H~OMw)I!@*hAM9k0Dy#=S^*6Wtsl?^oD-}ph7M7mbCIRxW!0U( zKh2kZWg_1pAJ3jSS?3WAMfa_M$G#OjdFZ=l&;#Vefz_1Rpf=~@^`ihNJU2BBnMJz) zmWa}$M~^bg_xAT0;R-Sjq2|i!>!)q+>;y0F**Ls^|DM<9+*3u*+gl9TQJ$Wje#3xq z)V)!G0Rh)~b~2s?+e}oy`}pyr>ID@1j~WG9*gjL$&Y`e%3bZRiwgI;Q;?$~g$Rtb> z_YvC?;W#!`kp8o<@bFr&pM!&goR?^a+B-A}dwVWE%fT=Jhg$0;uzzA^p+EmwTT{fR z;=cvhX?uJ7T76&r+Um&HKY#v6S65e?SXn6$Gd=#qq?F1$PfAAi>&x@bAF$C%%gS<{ zR|ZP~OsG7D^ZuD4teNnvcW{uAm6i3qkaJ$g1csWb>SDB#SUOxv6!0cMxxKqfzhm`W z=-~mus>-B&(jzV+lB}bnBde(y|DNAk4obG%)MRs0(~sZ3qu=vcJ{TPxH8C@j74_Kv zq+9bc*E0p6o;hGY6C)!@)!dlRpFf-Z`SH$aef%C>+rYq+=i#^i^C|RJ*yJnrhk;^eyK0%^GNEKdJv&WQ7tp8RN{&~G8e$w^`^t=s z1H4l`WMqo(TnH!trej{3ul{-M_h%k5BIAw$c`%8ILY!y(EYm&l~Ies#e{ zlHbM11{{z@GrPeHX)0=8xNGUp4pxQ;I^#Lo5_w+qRyn@-VZt4DLzEKk($lY|;d$|| z{vGhi3Ojn&&z}Xof4O3<<)tOZI;?)F_PMis-BNU`0<50#G?a|3x5mX5kBT1;n0r$& zF;lU_yj;Tj_c-xixDYP>yuTXFSDocQ4$*0!{Odap>By(dj6L<|b4ek)4R9FI~vX{cC$k`4QFR5Hev>zAO)2|6#6XqB3&tWTc75yOt>|Nfo*_6BotsAx*K!S-PR z6)L7&>3A%uEoQKso~lRPG@1-HL$bI}{kXA)>0DA2!FGSYI$%}id1w|mK0XH%F2Fi9 zg>qKkdZ47X7kI32>9LU@f5ZE&}`E z`&4)Ot)Zwk)t{HCSQil(@M#2&>d`h@e7;&%S3g!^YrHyK(sXhloH@xC)FHQz=IXdZ z?k{=2K&y@*WmXZl z?aNT}5%zeEm>6#TRXW@A)1%=sOY$2ct~bXkO<_+yZSWQaZsi9YvT1l2De%nf?B9Q7 z%FCP~921c7;y^xm*5i~A=-7r6)y}XsXpi^TSpPt2Fz8Oc2a6gXieg`xrRM2&CkGY* zK^v4>83B#Ndyb5+-@M@h1aW%MaN#daf8W61CIG=rXtbfn`p|};2qRlQjQZX+0h{qg zs5#Sfa}1+j_BuHlS^&iY(tnNM^KdGG??nygA!^x=zqPdmuB~;07^VJGnAS-Bm1Oz{ z0C4ZBs_s3?RCRE2B3bKxD2?>^U%kD`qy4uT7~Vi_{?XFnx4XC3{_|&e#>bCO_SN1g zYRP@pDhq*PBnuTn$Z1g`Jw2Ue2R7hOr~&Phlc~^s+D*8j83vm@_}HTFb0+f!1D_sf z%df$~EP(XC@}A^N*I?x}nWFL@S{FqI4Lqf>@bHrU{C!z@Y$bn)2Zj2Ond$HAivpe! z^ZqM5fW9yZ1fm0Xq=A*iQ9%nUNT=E1n8gq(Y3%$W==hj9~@k`hcX7xqhufeQX8&KNbLHF=f7#bx{$cy|nZ)`)fA=xXzjB zXvL`WQS^4p&B`#Zzi5y?_S6< zT26kp%-Iv&Obkxc_X=(z zsJVm+5nFw&)bPIT@fA)ywHN=s>BJ*QCk^rS}jQ)hJ)~ZppOszkRhf(_~ry*LPKt z_|h_y>`QPaJc!mfxjnF*$-KGvX}hGUK4lX=;L|2-=Ijz~#6aQg#GysE-Q02Y>uBTc zX)zj@EwZen2T^jl4f&#v1I{+r!YtbAU2iOTF9wqDqSr(VD^sw@9jSJm50usXq4o`A zYfR$5HMGzg4{b}Zx8aET%2S*^gtbexPEaGp{=>YFq&9*q#F5l>Z-un$aLvUzz5_0Y zZ5R)wRzyU!-+JLs;4^V4b#8NPx@XhAv%7a_=wYuwKHa@@a+HL_DWw<%AJ$ZBz8D|q zs5|w!vFN_1r=C!azcn>of|k8FSts1o)Wp)i|38r#I!49^&(}epng-qr@>@b;q9HWB zAKl#=9SroICudkDEHc@TQ;MPH$F?avdi1KILIC)mftgtlom9XyU{4muNE%@b zOiWB*LcF$<)PRX(R8-zEzW{Au+D&ghG9Um$RZWd`x0xNI#%V=lA4hll^Zze5d0%&5=^G9Q=A zy3X+Mu)#ui3WcEEO<)iNOibCTV?;z4SE++Qo-vrLbu$~UP&&mp` z#Z79dRs#t#X(W(3^_5VaW~idR-H9$w^ALTy$g83OQi`bo8&Qt0T1horOO>F(K1d>vh5p5_EX3TK4OOivuM@CL|#z zpPT;n=6U@C5L3~5b}0BP)Dzvpp1yo_=_?0KWBg3urb=h`;hxl1jE~H2^hkymgX8CL z!z45=ydCd+XLMARP6W^kDSdr?l8wQFq)k_I5Q?Q~>ut+_wzuE+^b|o&e-Ec(zI)g2 z&6_vON@{Avz{xZC(1DyI0>M~$!7r|0*&ny*bsD^BbgP|IMtmeCUl-TkWMsskZo9K* zYib$*eLuF^6b%JDbPJT1=8=)>+=-w2MINl~@3c`Iu9zmv)dnlpJ($&Ah`bqVrg1C? zdQ)ikjUZ1?+L>JJjSs3&%HFH2V4x7N*<+cMnD{E_ZB&$MW;x2Q96mQKSlB-HlnohPfG`mawAmdD&hOJJLTROnEnZR%If z(#(klp{&5?!cN>a0nS`6B%}w_?;vhZ-Y@#b;o+x#fq{tL<9fV%M=;_IsBoiYmYC4G zhDV;9;qwa!ki&A2vj<;hW-G7sHhsEv`^GPasnw4edoeCu9e=h$%USfCoSE~YgX3_X_TKl>^?=NXH~G5-7uIm)j=}^ASYyGRxd*+!YoG9`cfyAH z$|8aS2qmSgO!#tb)W4-gnve+iJ(w7m=_MaLzyJjD&7RtX`#PgSg70-6)11?N9kN_? z9Dm7llAg{^;u}SB+7WYp<+nkB@%kDWGN?Am#Tue$uY{T-lDZ-b9dAL*6(L}3?p zJbZka5|xh+2A23PSEObeeLt#mO+LGpW1msmBN=lZHI?tmo-;axWQH?!41lr|RuU@@E3&5uesP{T)`t}X&@87=}wcy=I z%gD?Cx5B!5^*gX8PRqf&o;yDUNZE5r?`%ey?^K+4))eHe%ud;8I|!wh!t>?i;b}hF zS?Cls1-|^Dpg?!#Tz-~}j7+X7A|iq%ZHlAe^!51oxSY}jCI&{H4wVXdUF!A)ZfMaB zDS0X4)Af6}g8_^KlS=J(8!LH)?YQRI-L*>#_r;*aj;VVQg+@eZXwmK$s+-|AwuX|I zcpTV(Fkw9RJ)AsKi!r&3iB&`P1dnN1w;B{_lm1{K6^ZIn+%4@WVh`!Eq|=auCbCr8zWzto@r@mxYGJw!6geCt*{)55OP_+YoY&zKmuf{Un`)2JVrDE z0HUNt?=AMsX?>G=qH-6$4fMMY(F;Z0EGqHlxYhcv((b?8Zn%yRx`96@FM)Fr61jPJ zAc7DG!I9;*Q(#d%Mt*fXhd!ADEN}_xHn6iY2w7QJGQhQb3(E^c$S~-nIiMdR)O%}d zD?!B1JJ{&x}TOj7e#l`LJE~%-kL-9s5C@9BwK(X`m@a&lItXJgcY`?Hw$_<|%TQ@0Pt)k61+h9MF?s=oYtpr!p&BVs$ zF`O7R4Na`rA>-p@SxQRE3^Wvx3T*46!^5}1!PrYHE78!kWgb4vUuF8A#D|RQuLOXN z{ZCLnDmuD-Y%B@vFIfx>j6d`9GT7L8F5$xNyUd^}MXR&ihD(!=yG!)btTq?e4FCs? zT!O@EG1QN)o{xzO2T{-ldBsmT=gI!$XGV0kyR^?@iVN**#%UeDpvYR!X+N-z$T4E# zpyD-C&W-J+ZW~y%c<|s^yHQk5PL5Co*5=?2iGpwi`BGKl;ouU3tCowZHk-7cAu#L5 zhGO1Sr`K!feGL;>^4kyAaP%<_x7uhm7sD0V;~Dt*l}EF(0%CnlVa#cTb&e~K$xiUO7;RhjuG!*_b>u*c7V%<;g= z>Mm3@E-+nvw5ghdO#Uu>+vqT)uJNHE9(~!CQTXPA8a~yDIwsTCI6LmL??P@A=L}z; zqZ^Tu@!{TVw3i$<(x>!CkUiv8Z?$D9x^Olt#_me zj};B*e@}36P2XufG^t0;etSmIIlc*=dLat|3eXsGDDXM|9V+fFzzTw5*Da$=-35xQ zydW&`R+*+9X~JE;vaOnhyLjcxIqP549eB$ml^m%)hhs}|k^Uny3EWTIQ8(i|xlDc# zf{;HAMt76IIn=G@#>Q#g{vZ8niAQdSyOPZHA%d^p6;x0E_;9_LTY2N?eB0A-h}@pz z#$1IoKW-zZ!kWemnuLM^9TuOUAo_xIz#l>3Ksmlv-(e$Py6w*T`7JNcJ) zus*F$n_szTan4HP!L0Vh81?%fy=@uzm*!t^<;Y-~ZCZ@;U71P6KD-@$&+-+qL zpi2XNd2yoVpyu&EVgCxEb}z~ zNwyo|#A_39@w8mZK!E}$bi^G5J&Sl2d=!EeBE^oeKx`y!4Gj(DGVP+cjEQLs_T+%- zO|=8huV#06o7H_-2StcOpM*9P&V)>+^ay)Q-~Y>V8g*0C_^`4Vr$Z46J26)g%sAA3!Xpa&=R*e&Xn{-g9n>TamU9TCLqb8&IO zqu@mOoF6egP8LMt;3)FZRR>A<^z_ug&=3vOHYczu#}xzRYCVsxf$ky`&8YaHs0azh zw6wJ3bk#Y`zmCIc0&m{)MKYKgj&Ye5J z2m;={BSNYWY}oMzAN}X+fV*JBp>owj{{Bod2CY7GJ%x~l246`@iPvVF0`N8XY3RV! zbkc`D@kcE$HyPLwkWg1$LcOJK2>9?MACfIae>?KhtQmOlEc(!>jC)F+K|IMK97h+U z64ZB9T1O|R7H}T=0N#OL{A0eT$Jv28u*z{kBR2<|m~k4yCJ6xfpyd@iE|XPsh9iL}eNW2gv~60dr|u9>}-f zm=sMGw3l=m2Uu_u0xbZ?rQ+Fj?RFPc5D{3Ur+I8l`$uPYcK{GmZXTYQjSYfe>DQpj ze;XJe1yTVvj^sLMnh_u(HvRmG54s%i4}oH^MLuO`vlgTwK^#bo7~0xKLa_tlLJO$^ z`1N_eRgD>PhY7lOJ-L5hK~3&IA;_1-cdk8O$2L?b*C!-8Y!s^N_wxKOnf5Z)<{IrV*AbuUZ)rV@M-dD zKDpR@uM+LIz7Y7td{-ISjs2=1aOtM2p$;~tigtU%FHY4m(c1ruxXv-OfCa(@ZWbh# zZr;0B)n5*9^L1|S9q33bEn(r|Giz(%pxS1D``Wmoy9kO5r_Hz^giWxkAWskozSdQ0 z!J91+)c0ODHA%u2lR`nKi3h?(;F8+_4)yMcv0(b%$m6a3_CL%Ec7<*q!ixRv% zY!t*4?l|K9J!mZ}mGYwT(ie-X(p(HvA@*=CFWw@ZSl8O~erZ+~=2pd>hYUjQNA3nXHpnzlul6weAq`x*A zcgoIo@KcOMOUbS6v%-4P*^B4T>44;dr6vsuHsYj!&ut7U(Qt(=?X_#yVj@(=WHRgO z&l|+9qO2(SzY$srTUC2sb@RWn%pM45@L5t5O(9v3D9z{mo@q}iQs9u%F*$idLqh`+ zQCBwIubcwjum@)3=kGr=r0?So@E_tCopPjLdp>z=y)ZwI9jTeg)@Cm`7B!VQUqA9t zX64RCLTtNNjSmXqI-i(rcNhDH%dM$El#$jH$l(SBj)Iah#0bb@Q;y2V4y%Jg9eEEd zHC^a)Mj5qaMR5zsHtgafj1ZneCRef=Wx&&0DXN>y;3K7MK8l-6v$|8 zSNUzX=Vfg7Qk1pUle|E@oPkW#{Ee?bu)%pOw7a-%kBf_&sq^sR!x>v(nB&#X@=LtZ z&~8vD4!v6C8p9o*-r)3r=C*1pPq|LDVaZZ3$vKOR}IdpmN%k! zfdAjqSXX=r5bQZ$bW=m=KZRa=2;OwD-HfE?c01GIpJ*lI@29)Jm1JdQ8{vr}@L100 z5ZxCj=j`0vyV%&kLd)`XTE^IoW@+qfot&ppd`Eat>eD(1l^TW@G(vPIQh?pPcgWu~>WJKdWnVeZ$(0c%}avEFv5 z8tB|RP^8Vx&HI3Qnt=|0Sk<6wIvs64r+d-lhYj(K+l-7jCE!smLsAXm2fg50!?p)< zZL0*~8xmStj%9}bT_`|q50+`9Yic$SR~00qLdhEh9|0W>-i9{Y{{4FZVpT)PF$)3? zAflR>n?C~FNIHK*+&dX$(jOBODd1MM4-Lh`M`n=6k~>pMFEHquzUarl!u1)}0_=H6jkXAO7e_&51fgAoTR?y* zS6vPynv98~prHS+87?*m{WnDAATKyw$9}Fa~V+U`m3ES zM=R|=b{N;^@?S+|otGqu32miRcjoY&dmP<#9Au_(we(ad_-`d!Ojqk^!Ewg89xW*h&*Ig}Y6*;*ucn~;=lsyVQgx6|S5D}`m z+Ndvy`s-lTS;is30 z10@99xZA~ZFQt##5r4)HAC*8!9J^1*M#&pcQo25Mn9Y56m&(X#rEvK8K*r=hke_TU zCJI8ZO<>LS7U_#a#^5@Faeaq8W{b2du7VeyUrwJ`O~=CaPVpjs_IHHWTeT035!#yn zR_mU0EC%X!(!gE4S_+VRD!tFDi|v)5eimDg@mr0S=4#%VjdU~fx7v>GzmQq4>905a&{f%YVk8jH4&1LX|P@4c7AiZ#6Y5A zUsrR*?z!h+3Bh&<&SrCg9m0?mM3pnqko3{a$_g&Dtk{z(`2QU2-HU3$to0x{k06Zq zqh=Gu!PWA)WeU#toaNyRuWj|3P(U1M>Lma{C)gNp^; z-GB39<#Fe>Ii@CaNC=_B$`^zYWJTovswn}lgGB*fF`|jyfZVB&Tnd#Xf{|UH zE4+QyzFXEbL=HRL+$8t@bu*#Qa_GJg!7+gF9!x6`uImC12t#7xfHs1Hf*OHT=9ek| zJ=^Q)%>JSLr}&C5Dep%qTM`m-hC{}rD+UyQC*G-N_6?U9ze`BK^6~Mxt5ZpcLKIj+ zBG=TmixZy<0;vGJ+(F62gCT$wcGJBhEvgflwd4w)@HtC#2|RsRsna~CFELo_I>)y_ z@=ZMx4TVCE0$OD=0B1XZ;ouB>eBK#%xcD&=h6Z#~__#N!;8vJf_LJb3I`!*zco;tj z)Eg!x4_@=pf1M^J?i>%Sm_~gb4h4}7{(+ttR+cro>Ljh)ny>>oV;V07t08ppah$*& zOm?$RAG6n^;C>tDm15i!5~2idkSTV9gyeFSj^2DmLiL>9LC!BR&9H_>@ z26=ruM9F>vPY6!6xGUWI{BVxo@Z?0ZD(8Rn0zLc%$lQ;%ZzH}txbqT#@@;Hvf`Wrp z59sX{$eIBXFoJMtrO!ou$2f$q zzJU;}noEL2O~LF}fq+>@mEFuG*Hq2pzTRHKa{a=e8NY8_LTRI(UI};F)QSCtN#t6sl? z|M4l%z^7MMLZKNlh>Fs{fCe;Q!ukK;Qa2&)3%wrZA-(}`1T0?gk4G6mXaPwbAf_Ec z6anTy3fh;MLs*y!4p8Z|bPd92B~~Ncz)Tx~MgeRfoIgK5*`N?|Vy5J?@Pn%~1}gcq z#OMlWmQTbgkmU=tps7bm{OmFnRZ>W8vIS{u92PufUfW(-SZncF>LO7Qw%@#CC_r)PI4R}%oz9L9RUsMWBvLYRy1z>d zFV8RZw~rdHXi-vPRomZ3#38jnsKA^+@_>k6LJ&8^<^5biO#a)Q5(=SmBOnh?SY-c$ zI`s~bPw~`4Xr^f{GdMVy$m_6vgrA8C69jaW?|(N$AOdJ@cw{7a5D%~2AP ztgONy^Jf5gq$l+vFxW&2C0@=ROae|HGNU!^62qWah_nZ$R^KtzrrYm9~z&y!6TU zzi;Ju2cTB>NXTP~(eAcntt=q*G-2s_Ud^ol!%4^38z>k@NEUL&Vbdy=fJw4mFl#K> zAjvEV4ruGn_V&MXm=pXTP06@DYP1i~AU3zRo4`1`M6c>5|9A8z3mef{lFx^A?&YvM z<=t5IZr8PKlG{So_5Ss~1D#Av6mkb4Vujp6pphCL_idG4#WN>@4=TX%)%ua%Gi&+B zOfhlr2;lh$LP)f#&8k0#2&4zrai2%yAROEQwh2>ZPm!28P*Nnyp~bOP4zg5JukvZQ zJtXuHBfIKMePAwG(=}%AH5=;l187^wwO{UN=KT7GwF^OKwL|~qIYR2S7CgsYN)#}T zyeF(8UdOw-{pkN?&B@npJ^Gicdy|r)n`jNG)Yw@V`vC4K0|^B*6fn3zX?m5>{15+v z=Q{m?K!PBIN(hrorlQns$XFfAfp{f^8lcDcvtEU14oI$7!6HMnr{01X;%nDn_DpRZ zlwKI=n1$}1k>+wVLr{CZPf(2Sn>Th#n`zP9!gy!T@gFVsF^8*^+xY1o9&YjZf`#pp zPO$+RQsRYO*414^ku?gCwZ!Y>C0$%v8p1p?0An->{B4V*or6q6M&~TzsY1pT5%DCE zNhCqn&6^;NrRN?U>y&~iCL$tI3?^n@w+|$lC11WQH{*d8!vTCPvmg>8`*3_*!F%_D zk1s&)mwxjWe)BXkt3vY|L_OHxtx$;WOG}EtOy`QH*;r@x(yPI__1Oy;gmQbT#f7k*X=*p|0zns%%TzKz><@|n@cQ**hO47 zQQV1mjVlDxhztSool3VIMi8%vNJ#vkPQv_>dVdeht<0>hhCw?qgfS9CwgCe_(EIE- z9WpMGss8>~K)ZPZ!Qz|Z;)39-2&BMG43F#HLp;JO6Z0$fY8U!SmTCToMIrwtZY zR_2my>vMNkwABhTMNNKRZ2V|>DO$X?AwTSNMy+uVpREB62%{cMJ(_y&-3}2ELp510 z>Ipp=5e=HFbntOaE!tj}#_@j*7~mmz=s<7U`}$N$g=vZUU|I%oA|d7|vjv&-?X4|3 zn0$h0IumTl5b(7}KyVSPs;qolSjf(2JsJZrKt>q7-h3eM3BrgVyxI>m9S0x(Nn$)C zZlJ667aK~!Yy`4kApNhL=m8S$mx>C6%5f)##oc`-3Bp=NGBhm}Koaf4!wHZ__|eq# z8e9eCWv;1Dg()aU-0j@f?kl^^KQ}4YD#Wm>y;I+B9ERMechCCATGc>jcaicK=ZF4BIX8`TXu+jimt1AmIztQa|;K;FsYF1G;i4 znfbZ?i8StWjT6kbOvTiYcB4*2WVj#Y5AiznIWJ9fe2HL?59UDed1y4dLOO+@L|-&? zgXhnmu(fh+WCM;~w6em+E=pflT`sk^rYYIm2py(4!5pl{)BJZlNgG44h*RQFTEL9C zj`GZprJD@G9)=Gp&!aVx>wCU}KK7xq@+rxJo8D92wtjJGzns!QiizrcAT~RnqK3Yr zIxmj#)0|h)S<#LEf&6>tZix}P_U{gl^hosPS*Hg-sQQ3WBC51g@_Wr{G!%}4hiuTA>Vuk+{(@;$R(BfN^i z)14X1CHRc5*spu7ne&24RDd{r%g68_C11AP8{32U`ryIt_dqrwiG>1>Pq29y7Lx`j z8l3dP2Q=X~f`A-Tg{|1&eYOelr@XCC6#1!T$c{MTa#_B7DX7tv+dnJg| z)*l|U2{FCHT~Fp}ny3EZB@4ZswWQv(BDig0$-##F`*O7Bx6kML$Wtf<@=LVxdC_|T zv~b(X!1M|(G4a0QC$Z|dxF7XrL!30hjHb@3Z)7whzf~C14)a=N01?WXY-drPj`yQD zr63QkB#$(FZV=|Li(!xuE=s8}i`$pMab|ZsyyfzA=>ou+vIEZtm@hII{QRux#sT<7 zFtE)dDJcn3U9tsROzs)?&JN+hEEi*$Ba3)qt_Fj)OKTj}0uhA=nYMew*og>4D8;v~ zD;2Y{U&GvxVaVpB^&=}$7PG1ntyt$rqJf+&r}U_RI%p~xIPYdpBAG+$vMc@ z9pYgM89FfJZZN^-%Lk4*s&u|f6cRj)@7ph-Ep=%s!sd`=7Ryt(Iz3!P4Ox258u#sq z9*frc!(zTUyCu#!*w^;wr=+3$F&REfDYwLY1W8~u=oXa%j^zu^RC6M?7He$7ZYP~swG5JI$*{1H1U z%%{s#bjml7TK2bYpGBNN*hcr&7{@CLdv1y?j?`((wr@d{C8#Mue6J1h(^oj%D3}yL zf^iUdMB8+iZpk`K6li_%iSDb!H-3~VkD?y>*R}D@*7-M;dm>lL!@CAxYt(Amh$^)f zR?1R84tkZ5LkQ^1H&(Q^x4FN%+iU%a848(r`~2)H1|$k4ngfc+1-sJ38@f*V9H}+` zX1-RKfDsQON@@b(x%V{zu_|kbYRt7yJ=mHo6Lcbokp40~ZxuRk`BSQzS$ZVQYL;i| zyR_zE=#*r`Il!mv;Z>+4PZ&%4v+G6Vdyo`{x`U)F2E~kfl}vGe9^3Ko zyL9Liu~jgs`e$`j0U7%N z+YF{mVq#-6V>ESikh!S;>TQ6nk>2Lk1yqv~uq&U{@LL$P{?XYPiU9c7DtOoksf5u3 zy8j5pq=Waxoi-Ih$_hhD%Rnmc6-X>WA3uU19m~)` z^B?aW2&&%-{Fe~U7zy}4Y6qd`FhTMEz6xQ@+S(eKYk<(OUqVBJIC5P8tJTFCK;eEH z7>HR_T|JnG)|lIpgj|Kgs$jp!22%W64jDAmz>aWHvC%7Sk6)b&;mX?+-tDqnp#shEC(_ezIwajwlJqHSk zid;^M%5X|*A({Pn_&Wvadn7G^Xx&B6l(GmA|1?N6#dx}vH^#;xRS0w%prFPfn(8X>G+m-T(y(21(SPudlCzu9WlPC%lFMR;?kdq3NTGGb9WB zL7k-p9$neOKEUKzXv{FzZ2hK3U;ERQkzy{cH+4(VUoUBRd}!NASP&&?nE%93wHa6b z+c1G&?M~6R^DgNyu`f3me2#H^=5?FL#qJA|SEE+aQZD->6)H`Hc`GiCqi(|MQ9ueL z3~hbw0MhBe9R8!nkI8C}U=8W%MS#C?2?Z&By7*3zkXeIxI5~a6cLC+*$`PnGP0h_x z1&Z{lt=EX4dtix+H@KhlbaY5QdzQ$e6fxI-94~td@rri|P;!~qfFCBn439h9is_x9 zxR#5_i=K0-rPMxMkLH0|9x)};m6x1K4N13Uo_e2C9D5yLPoA%MBwVL3w(QLpq`Kx` zaV&yqse);poulStvnH9SfDtV1_38?&40=guQy-nvy!J=jS1u78uq;BL64JYZ5thYi zh(k46TB4$_S!a`kQdU>@%gf8d82cRV?Ck8Xz(^b;PI$S*oxh67LYW?8bsDUH zWUHdzT&c&mCHQF;d8218rT$w2O$}!7l@Y5HjK8@bm05_AJV=Fq&)Ksup_>Lgz;fPe z&R<8f<9|`}i~qp_28xuFl#^SvAr@4vr+bx*&cU)zD)v33N}Ny3EW{!$zuqgkefxG^ zT4+cJl2$_iW^rk$dgxF&s|>gLojEnRW#~Z=Df6$P$Z6ER~6L>DjNPbs}aK#9Aur$5; zlP9^cni?8;H-c99_y3aH#4^vs;r(mbeCu%Oy9|ne!?A#ho5)Mp z*)X0iDYqRR1!Log-wUZo^IgS5V4N_|^-xYOA!e+JQ zw*6?8W-ANXFs8Y0HRpQwaEB9bM25OJ_Q_biayhx$EUhX2lrl-I9*u^SnD`ASard9W zbi~;0-u|&G(9oc+FT)Ep;FS#OYg<5-k?M|QOJU}nM$k^; zC+6c9)kR?Aaj~<3;Cu(R&gis)*lI{K;7D6?gALr-YWnv11aMw~n#pJbqpTCJOav(>ksE27V)8zm9 z7+yxy4}*U9&qke5(9nW|kf{_W5P!?yggBN*%UEf|JQE;0*FRliwI=>)Jj%nQ!CH)_ zrqAwb*t#-H?Cxo#<()qZildMH4JmJFGA|y6%kv(&@{ZUhDe2W*DAJ~#B-)5neq8Gx z_3OTh3JS8Yut4UR5g7ms*laX(44A0t2aiea(IfMBpFlQi@9ljHDmgMIjJ)LlCVojg zN8!y$LVyzhm*jCnNE{sl4;C`}$hBUXC(z3D%9lvUqArP{-qxsc^5I3YkDZy673#ngrd}_-Svr+68nO)z+J;}I?BVd?1EqXzlCDt zZikEP-mdf9wM@~)4mTHvPo&hG3COgprx%WqN9{z&>~`xR7>z>S?t;V!Ve=3G$U~Gd82ECMS5hNlvbvVY{EG( zl+3ou69*l)H7HG!$6wVoPqo|>Cb!ORE|q%D_vDa{^@{MXxwkJj_^V$QH#zm3W7%){ z`@ah=|NT2}(0igVznv9rvc`qLwss2xiTb>MPf0EAO%3<$J0e`bJ6E1+X&Hg!<$5$9 zPo-NJ?{LIJmexgi-%Vp9?Qfki=ihSV0yOUg5OWO0I9P zHQTzmyW0Xz-4?u3qeAXi*uHLM68e=pBbOwUVAy@rX38+(b{XpOn>?Z0<4 zKB`X-C21D(h~9W%@~oJfzZI|NRl@QOln2+CxOCEc5frShMi`}oQSE0Nb0R&)P=(<& zI3kEJ=rZLMkB>?^s_ExfqJ|w<=PI(P5PFJ`iPXJEx}Z;>jCb^u2mlT z3OiU51m#*e-R5P6!=N#1=bJz148r>LI?45?qi?yI;rXj?FAFzUR{eUSlnjFEsDyDF z%|3sszJ~cFs)R@Ms^$iHW9v92?NNg-A-R6SbxKQN(JZu85xn14L$u@H&hi}i(KfN$ z?5WQOTqqdNuZ64KyG}9MI=2-IW_fAG81$P!^k?lksz11za+%`xXhUC>cUwsuT{eIK z!wA5<>BjV;vX97#q)R+FvGaa{mAS(JL()5)qYBC{hUx zO;WO28l*kYj;2aW(LjYnq(Mui5^YVD#5-xHG!#uOEt$?6KCjK{n6wR!cf75M_E~lfY zyxzI#>-9G`m}PS2*m@4G9iQGBum-H_%5*W=@ixVd-TR~kGpFTUjpYL6&elDB`HYR) zHag4U{duMR@u--MHiZ^9~e+Pem(9bC@{=!*B zi}1DWYGGDKIhge({A{!Xm%`ZM*sN90?(dfxH~NnnWTCWEmYz9p zK^5aDdFtlNJ=>|SW}ZB)trLLTE@-XC#&Sd1xH|rs97c{}r@F{})UtKkF%u;YTX}hb zm^@Tse1ULPvo(=jE$ces5&-<+J5#@*jrncNf>E z4DRml__9XvXXi`)A3Kz#+_Ms6V%N_JetbEu$5&Dtbj6(NDCUcK6%bCB;X2!jmpAqrCBBd8mOIO%z{MMbjMNl=ol0+LU(p=4a| zVa~!M&xAD{FU4HOwC3JUaH#wuVMMnLyEFE#K)gBTPm@1i*Y(1lPgR;*_=MgaX0Om= z<7#W|x+EK2yGCW0@R0W;bF$||Gfc7UWbb-gR9fQSeI>T1F~PW}^~;(-qoA^^eV0t{ z=^vWy@BTFOy=no&BO)Uuu8<(Jyu{GyHitMvR#q0Y%O?IaL94+5Is!8Z)C;8CCR13D zDKPmuf(lP33;cFWOO(O8dU>&y1JpJX%oW~4Qvv1 zH-?y)_C{3q0Z?eiB_z=Bcur8kqaX{qE2b^`Y4E0SWz(qQmT_g;TRgoU*az`}Oh`)V zMUScs-7I#+%$wknD_dFZhK803!@m0u9}?TZ%?BlqT4wWx&P9_8 zLM^Tyw?%lFYkoMkmw3rws!zOsYM?GggRV}z5(^A6tX|*0a|gP#dXV6CF2Meb)H=Z0 zLs~k4hNGeaV67biFPeLpJgGj~e{`J;U^~oHk{cQ{bfp(0R!+Sdhzt@W0YjqDXbv8a#YA>lAPgMq%?(S{dd_e?6H8|Xnw|8c= zAm3C~0`unvc(8qKAsm z9YMaNacFLCCWENQQcg*!woCIf=pNuRhW^UT49$zQQ~&K$qU(nGyJ?;WKpr5QRPPdK zF>s1ei?aP^AMuMW);t~eU+aRwh;_}OgpLbUq&i%3UV3}T{+9dxe-36v(~TM*6=$fW zpH>;Uw})-|)a-@FiyzOt>XwN07+aPUmbr3&S)>Ft^=9UrAC$xKPFLYca|GUr#9aiI zfPA}muK^?ml4cp)pHQn1y;R7j;|U1~WsokIWld;Dl$MqbPX<6oT2WnnEd48l`RH`W z7@4vSR0R;^fLQt+gpHBg)vJvCOypOgBj@JkwzgY;SMWj5<;mWout{j{@PRRfwYP$! zmgl=|rrC%T;<z-qM~K+SOWbu05?HjT4ss0YX=6g=mgRY`0n}!-Ff)1)w0tf)+@KG zu&iQ@2e?t!Rrsl^9hhgG=BKR`q9i1SZH!v&Hc)`TY3S%Qn?&VgfxrY?LBC(e%tx+< zj+ZQmNZ7U0PWzv@C=823zfr?&h}2~>g%f&Ik$uE z=w9A{g7)&Xvf#ncih~34k^TE9UTu{I%GB7_;6m9kDC~>#39rhAT~BY`WZ1kVB~#qa z*7k*mL3p83LaP2k@zb_KFER1h>YOi6+R*vt{DPy3DF`0GhbvGC(!-iDHB~StzlBfu z{l&bM97VEKO$C-zUVCv~<+9G9H&xjszaCq26~){p3y9_p#n!cFbbDl0^%;7Znx20) zIvptxsZ32l*9)Ud-BG5)>6k1qUi>PFEirX2B>mMZO#-<{g=#gYFLe=6;ql|TzIIzR zTd%r$+)6;aD8A7Bn?XEI);7?yo6UH{!LE&rVmwr!{uee-^{_RhpfbDbA<1qYy&$$b z#@%E3Wp>3bfxVu09U1ms8UL8;WvBRPj*-;F-4^`MRE$DQ=vlxb4K8;Tv5k0_tOOY# z^#3#$s;a8&T1tU>K-K~5m!5FwJ1&)`dzgQC|Gw;@u{Z3P)J&kd;Mm#pdG|znV?S&G zLR!*8Y+l%p{g*FLTOqrfP-}HUi=Huw-XtNphs#P4Gp*d*6*Ku=) z+O%ds`jb=NhP$^(M)FyTNN4TQ9L@4ilx(f3BL96qKkIqMJ_@R_Uv5_$NZ~&#I5AQy z_VajH#g=oMUffpQ*Xcw_Dx@z{u$}x(7b$Ski>DH9LrwjGIh#W0DYUe-g!Jb9=LdVa zIpiCJ4Jir(w2<|`W@m{i^yH~iv>T}U`ud=rFDfqPOxK^A_v$RfkRkQj&4&-!vCM){ z$hv<0vzuutDGIPL#CUs~r4vXaXjj=)XgtMuKsW(=2(}_Q%OHXD{QSwJrKP14r9^`j zI8tm^cny4N{r`5d$?YFk+wIf4zv;YU!X=9OsTnE8e;Vr=8#cwinSJ+=U5z*44GYtZ zv*VvT0(#zms4ETR!VI^p$v0f4EJ@3JODo^7FEx$*cH87dy^n_qZouI64lb4@OgxBd z+|A%%GPLk<);|Jt0>rO^)EB9#H^H;8!ayK(KQMmyZTN}PgVk{iT{-4+G*Wu-H~U@_ zPP-(QyS5A#L#cuvYifA0OnZ!^=h4i>y7zAxMx`0vN~N2B`Dt7U+GQ;GXEjP)w_>Mp z);R}z-}Zf}DJi_zgZ7JyCz6_{+9s!IbjPLT-0&mbUDILhCNZ{K=Ip~Oa%rdS^onw| z+^u&-oRr@4@!5pdo0_4hxta?D^lUEk6vM*sG%U8l4S!rHdioGzY~kS0#LUI6tLPD2 zQ;vfL?~H{+=O5Hj;2nMdZ75j#wB$Gv_3H)`0cMQFk+)7et$Ot0~vdbJcf31fOEOD(7lp`>C`;X z^ctAL;hiD7m+;`y?`6SeuGt+KW_4pa|DBzvdSFoZoJOhF%F~nXAviP7fw{kPXLIS}FOXhYLh4RT=m5g7ZP~K>;C78x47i?y{zokH zialnYMMg$?^g$D}8$NqvR|kWO2p>Lt_>d|&izyhveDJ9#O03Y6Tc_&Od>@mY3< zu_O`RL(ek}sYxT?oMF4y84rFde(=8h@Mm6a@&?IF%dd1(&iSr;V+%cB`=T4Ml8F$| z)Vq7T>(Byq!RR7Hjqb5si*^FhpNjbpGQJnJlcMwl1!cRh@w1Z42|odLi+Bu;o9Lb` zcYVexs!s5{ZD`BBao~K6*rlZ`c89#ozUe*V<&mRnCUu(`q(Uu>--S-Q?fAYD^6A;y z$e&|jSVC-7nUjo!Cks2ZZC%$iKCkq%b(YM#cxjo5ViGf_!8QMFm03niwT&D{S7ci8 z$31)AjoqdpPodw<_0xHy0U?U~=J{Icu6uUI6Hg|qrV3hLuAFGP`0Y<>((bjmDW0{5fAp{zy&^}_pa^)=RmeZBdb{l(~slXE3)cjoB@zl*o4 z9kUVXu2pP$+_buDg*POjhLTV2bky$c<X)&|@wwRHPHmmsy z{=~mNf%!+ZXzjDfoxTBGJv_2*zQ*2vXrrZF8V>GOmL!F_`DkU!R*R;CE-&A@vGcqr z{Y{^gPg_=5rqQuGC-q6g)!!0wXfmU#J3s7~H6QR3R?ymqPQGL3U3W9_KM_mdXG!AD zhZ1+ysQ&SP=K|2f&DUjEySdJ#6s|%O7;2gUOG|$w+4$jpf|BMpRSBv)R-Z9r$~V>l z#uC{q8OVk}kVse8u9 z!>}=~Vkl)ae#>$AYTx3+KrC=$DRT9-n!|F!0PS`{AO46xRx{L*4ZUbg&E|B`){>! zI5<5=yN=c9XA7tC+O;=;HAOX6%0`Girk<#k?9O)Pz8!i(@E>Is#u}}ulu)a!v%R5_ z-&8`Q9UU<)yO{XciZ(iqy5{5(aRQ(P1ME*G|p(0 zwXfVzNM_~0->I2YG0!Gt{x)vetrkYXZ=ZB2wnZIk6tQ%sGeHM@*>S!*N)f#$_BP@N znV+BE1ADydP;DTnpxZ2XKjv$%nDBVGy{Xf%OMWX$^;4yGUrj9!`6^pts6Ur~*6rBc zeCnxoueO>rV3q9>bAr+wk4*g1c#K?F4xc@+huoodYVlNuAxAZG|FN;Tj))0}RUcG+ z<&~8*n8gztK~9S7(|Zh;R#Dzi`&zw{Dh@Om&zWj-{lV1lG15{tX@6n2S;on%J=?jZ z66fjxf}UYvC?B-zP3d2KYb z@sS5C*1~UM+ooIJ@Xthv4*dk+jK>7d%6q*b>d!x7A6I6${Z8KC($9QSuebJxcypW6 z43{$3@_O?y?~qErsK{{{u7=NZS@Vx3f7ZsD4)ZY!oqI(@1?c+1U%x&8gPI0x=-OfG zk)qdt-ejI=RQl_TNX$)f78+rDwo6o$5J3h}9qg>z>oGJY2W$yj;v!}zaETTS22iK+oAL& z3ijP>q+KMKmOLM%m5%u?^o{^tI3^VO~TW)QGPxv`0^g za(t!@h!ar`E>Fd-Sl-t-a%2^{Y>e2?MChD3a}N;)uu+!Ky8;$0)QejoPtZA|t9u-V zOkz+UDEtIKMd%hNv2`xg*VmIlAglp&9z;c*B6>y?AkPoM&Xb&vM9maI{Q}3GFaiEu zm6)6yj*%SLEXOrULChgF2Se40QJnnm9%?cb0>f43oPhyXb5qmmVWT&$A-E1h&1a46 zrrj)m1>V!zZD)E7#TfZ2xS>;tTfgu&g8i9#Jl9~$qiwbc!7PS%*7;5 z2TyPA^t_zcyl^qH<=GUqZ_70Bi@V@YN8G=^`op0=-#1`n2rf9s3r-G>lce316%xAr zuOa9L)_T~tye}*B-6W*DEhsG`BWdkcX+oFLxj=|DF$24Wg;m#aZrGqGTgUk6B;-z7 zhY$Pet)TxCzxFyX^PCeAAaKq<>LWvkFRovRx)8&F3hHx# zp%K&(J^lT3S-NgK8UG_7;TxDI3>^{?UG(CSfNn}S@&H`cR-v1LTKjp<38hqBzPFgw ze;XJ$duatKp430IfId+pr2Bx>Ku;e?Hz3p$5gXer$SJaO)A{%-0`!}Qtcujx8b8&} zaxl^E&id0}EZoA+%DX)4qEtC{ZRJX=iI=sIAD8T9&wum}PMgsfjdeX-s@<=0z-szX z{|uI2Tc&CUXx(jIcRZ*$k7daE2guk;*Rgmgk04*>^-K#bx7z2C|H_}pvdUKN`Bqu| zU&s?3ZB8`4pnMZeJ1lw~;vLAUWA24=Fg|3`B4HJ~|Xdbyn1HWJ!eQBT{g(>H5U(p7r2yzfkpa*{7c; zs?$akGZWLs#L|h9?$!4nJTPm2A^Fm2>P*h-t1|@hCPSh-5!V^qnPaX@SC&#MZ`Wvu z?u>pbDy#&|4ob9P;mnkjatym(Vg(`&9r4$d_*ijjnm)k$S|`j#^I_jXozC`g=Bk#_ z_>@1g8MXbD64P8$Q&W>~8TXa}sD^!{*R9fZ{L5FUwi(;x(uhvgfoss4!%dwv`r+I^ zzc{W-ISp*fJrZ#4Qt1u3`kC>anwY@3&0atOp}06&YAU?GFNFJAWG^>GMr%sKn~rH} z+NS>2MYQGQt7jM#_<_bjJS}VO#5VXH-q8H|Y_OJu!|aDlvYE9t*V)1a#UjUlCY z>IlprWr& zR?o6B=goF+)pBLkJx@~f?Ul?d(^co;6_Iyqjz1(T^jJRsLZraCe?wUKgYq7nDPZh@ z^dR-ZwWvKvv;dk3yB6#Yn43W2j`E^(c*7K=H5mW!>Pqd!OQ80FN+mA!Cx$0&a00~$ zo|@V}aKsy)j=TpCZiY~0{fossc+r5y$%_Gjjs)6I(7(;m+55@DC3!Vyn((R7_`HHG z90sWgf**lM0UM*Sn;opD2GU2^)IrB}N=z&0CS>=vStz7v^I?1fbs9dgbl5)V!5QAn z@*i*9ClKb9M4MA8=Ty2FMZ&E(F-shvTnfD6r3a(XD7@d4a@qV0(mhUFgrBws19E z$=He#fdYXIG1Tc9{C&AW4=Q~^)^9bs$_yfmGI6iP5d#@P6{GaI4&)ow&6|VZ-C_=g zUB1i6CK4$1ts>C8?d3{zOg6Hu0LX<9duV{>L?7z?`y2feDJMFVZL9`?Xi$iuw5WB{ zuEi1K6>^W^eW+o!bEV7u*yj}}#6@vxiM={8_CSG+aY`6K0tWeSrC`Glvj|ZbLP5<; zkKzBO>;u@;LqezGMY?LPJ-KhYYFne3x19T`0Y>{W%gb?bU&|WT{5bK*tvg$QuUhp& z`21#NeX(=0@Y(Swg}p+Gaj7>V1o+Dt+-r6IuMiB9xS-*^vh0N!0RK6C{cy|)P>=$Y zNzID|4V$?25jShVGrRWh*L=C(#Bk4<7jYzO0LGjU=G+1%HXQP?wl)z4*u!mE+X*%V zSbX=MJ!xHSpefyjP6y;N0_tEh3pWs9uf)6wh2y1(w0*VbG|W10bl2Do1nxNdGEwW% zgKr1iwtdN1K7_G=@#sg_nU%YBJ=faR?wUHQ>5I@*vNlW6*UIWxXYPc5gS_k7vJrtR zaYs)3qh-uJ?fOsSSZlbzME~PNjR2ZdxpzK3bo$+fw@nrObM9=x@TtGZenqP`hFatF z>8H}dwX$3P&hp90eHO#Q9dNi~>`rp``uiUnFPYwnW<>wFS=eTla(KsjQ#dQ(HoFw! zxmo!4Lb)NEPDIukUzJ-OzpA8z)C~h(z2ZQ>@%%`j*4dZtqi6L#!F4`lY}LffOcjFC z^rYF9Phmn{eoe7k%{J3H=|XUoneFfM8>hpb&{GC^?wVEH)KS%gA#`L*Vm-xVv^}To z&6T}yR0Ok9Us@n3INv+#k1GA|*zcU58^$or3_4BZ>n-P2yLNN-NK?oz>|X zURrhCT`nF2_vA=jp?BqS3)#_hh-0!8qddQ4=hPmjfex{1-1L?2WM5n%! z-r?_m|GjtqeC-fe~L0DjkU*Lr$N1dKbFnulvvK7tVP3jONSED_=-pVN&rk{+@%O z7~g^Jy4?Ahy>3d?s?Z2eBpaApXgGkD?!tTzrfBsEg;?W~u_D|@0+CXAK1p zS*o1t&v!e?l+N+gxMYejxzaP@vxS`vkDcjyAlkardHVf!xN?S~A}|A~=dyzX5!CO) zQV5N&8PIU%mhF6G!VURm(9N5E5fK{+l7l()HjMPp^_;CrN=Vp-{Rq?5GN_mdf)9~6 z?|}mw(2#7*ego$m5)S}l=ZUE)V!0p+C%y^UFf2Jb2ItOgAEVQ4jj1rP zeZzEb_1J@hu0J;uq?m@5mIMmGwYaL9$LBUwIWLS$jW%8x__S3>KbHvuQ<%otXX$KC z#0czwcwqGIsE_5MOpPMqE(sI(4MgiH>Y=P~?gDy=F$n6+v&YPy5Z|_5ApOreH+s zE4Z#B%Ej-lzK4f2h@y?4+tSQH38;X}mY}gq`vRHSqeOvMX+Y|W!otTS9wrFliR*gDd5L5% z;&7N-Y6d(W%0)9V<#)gJFm}kNV=o%cg_dqe{ ztC>=Xqtdy6vUCu8Umtz?qf|CWgQBR9t`smFvfLG!yZfz{6^+kt)$5gLCiI0kvckf>H_(F=d%Z0z}anW3R z9+ZLr_`~d8KYzX&54P%9slB`TQeFVi?#&}x;sO&rR$wTjvheu@)nR?x&042VQ^6o3 z$I;x}yt(gj(@wts(g)0P>HDE<_L7z=^F3SY5>6H`p2y-8k~#*!;_-B1X66@Vf4;lq z^Q?b>{*YQNo`Oi0RQu66G7GG4^5ky4=w!xuHFSlIRbjq+D`gATu-UY8;|*})z-hEe zH=u}lG8D~b7eJvM?_$%(k*0rD>M0q`9^Y}#<5Ka}Y*lO$h#wO#SZQ}8+e(|SuP%kQDadi8 zqBIwefn0#{8g2)mnnCm$(jwt+{*XeB!pzy5irh2|=4i{mChfIT6lJq6+<9p{UGR)0=*DfS)Sh`gIuA znS-U9`U-prVzr6!`&lnDIEhF=+ex#)dj0x!sF;mkI!{8*@)80JY{0mEk*y2vE;00k z2WRS|KNMo|h_ZUkrnxOhZ6#D26r2h%;7wcyU){v?83aGbw&BJapZW?Q3tRCb?Nd9xt8SY14eKgh`vIzl&P1)02hcVRNkU+ss^{n z3_BB1eZbd$iYg?W3-2rnh-0~>t528c`Vk)Ff3!2j-KI((C#AjHw_y&UXVN# zOLhGWn)j?Z^$dqpqSA^V+=rzQMzK%sUNC(-Dg4{+t8Bjh^GrLEUToPKpV^UqVxXTQ znl6yFjq_r_yUU}N>6jv5eHJ#S_H|VPmyE~e*aX)?&H)rLSAIsvMQhw!A51Ixh2}6` zL`UJIWOJUYx}srV2(BicFeZuw#Zr>+KBd-nwHRhc!}E+Op1O?^7fq_M#uLR}gTlo34>8p8El#=MJIZxJ*ciMw@ z+M4gEPG@s>bEw%V!29?jgRAkO^cifO0hu}BCVhNld+{R2zpZcC?(aGoz-ofO#+~G~ z_?yM7?2EUiD(2W(^y25=GLk7?k-V|SyQH_e-G@7@@TQ{DN&@s0v{I1}&LL&f)XdBe z8$lnYb6X>1Z zBIN)JBB{zyd5+i}fVmG6c1X}DvU-R?5J-k^y4nB)Rv?2EFU5whi{v>rhNHK*SwQ4y z>Ot%9n5zy4mrb4EPmI%mo08NuGIs{{dJlU_G?-HL9w!s;kpcNuX=h^TQ4eDXB5g#m zwd=qEt#wgQ^kZlX7#{9$s?&Hx?x9sesMg8!PWZIK+zx~zH9)jt9@CZpAWSPFxyx;7$$>W4<)?~GO z-f?m&31kfAJ}eEJM^n8z)l^h$XG)yyDR=&VA@jUBbDzb!&L;j!1}ol2^>0)VC&oE*2fH$91z94@$mm0EqXXy@l*2#;;8%_tht>i6 z3Cht;|7-y~bq%E!%te~ockt;5v3`T~II7^ZycMJeH!u2OP67jbKujtI8=bqy&{xV~{%{2%C_1%c{W?~NKgCiR59^%e55LxzPiGGH5d413&8ONV zpf>~Kq51pr$b&-}KB{5W@l0w4WjDi?JHNZ(w(1{BbfWhC7p-gj+@=4C)}^aD@5ALj zFU<7Hsr=>Ba@Cs_SdwDw=iAkKPXFJRE#gC^@;Uzgk2(LWi+vLsRI3l%smY`$myMl$ zILa%}%=$VIB6N zppXzR+bD3D5%_NHxRUb&R#4VikS_Zzi_38X@1jt?b~|v*QOQpIbAb7sbw~UZuX9Mo z0R2nUWdHextmo2NCMMfvc|2S|?*AQkEFksC7j5?Yo9J0ZJLj-iT&L z*@9%|(^VL!5OpO2jMilrxQv{^^TEi!O8zkma$S*umY|uUM=YK$ySkp~biju&^Z98D zZdBp8UvnPzy$YBS;N~L$70Qi4jPv3x7|71j32fsUY77%_*V4PsrFC1jspQNR!{~`_MmCh}J%J zqK2*q{REi=A|R|Ch#@oA!8=62g_D#T2|hF?c=w~D(*?EQVu^rim}tfWI7vOTN(^!; z48a)YL4PJ}B0QKRQBp74k`<^D2b^g2U@`>YcJm5`#l z?onjqosbY_LNWfdx+w?TF`^3G!pW%x>&RXF{7GH;XxSl{PekK=4?bQYTV);~>2^4T zsF%qSdVB{TT134fx2&Gq%1)v5*s3eU=#MEi&9ifmYaUR)Q#x-grO_E$bKN4heafL+ zYcOX(gN)*@g)<8I)R=$AVO0cm|1EIA%gD((Q>!i*VFuKMK;pVW0m$kl4)q`i4k>w4 zF2nZ^lzC!;gas4v!s0Prv*);^9F;5_J)3}*mQTqd!90C~)H0S)Bzlb^WtIhR+vwr# z0`ZwC>N27ez|sXE{RV8Khm=Ayi)ZzUtFvZxTZ$`=>q}ucPgo*@4T+3|%P}+*jNLS) z^Hox9w-ac;2!N#m>zM?Q;a<)M22h-p9&KS$tb7SbJ)i>L<2(G24c*>-Su5)RMg1kf zU+0k)W^C+uXb9b~3={ zCZA&DZXt3c9wD~G5RTA}F-_p(<)y-heYVC)L5lNVQ5Yz2aHP_J1RBpw4-`k0Xo@DG z$F!EKE(D+J+t}FJm;n+}Xi(&KdLmN7aS^XbbebP1fEy-b*uQ zNe6)&J5tni6$YKS_C(r^8zp@p^3EMpsX_`{Sa~7rfLB3kcTTS3KUe^8^T0d*8iwFd zi1DF~CzcWKLbu)mGOdvIhl+*Xjp!qAzoQX?IT?YwfjWIdmknQeovPfUG3k>W#Q=$k zoj&}=tKnH326ZJP!OdalG>N&a_+Eu{BVUu{yXb{J)YS>_@xhSjUl37KFZAlFAS>Jt z504j=asRag<7$Wrt#THzi#|_EQr19rlK6fJiKMf}UOFRx#FbLC??E2!?%^?P5Q>{E z4&@BT{`0E=rJS0G%yqO2S31hvOD$Gj6`u?KTy{*~ zzm&27!8Y8-_$L}m7n~Ms#1HX3BZk3%mw+j$>+pxyJjX3>UAmC_{&k{pJo0OvBU(TV zD7(TECK#Gii@s(f&jcD$xt{o) z6~>vUpD)t6*oAb7OcTdQ`vb{Y0x&lh+`G5c+FMBpPsGgZ5(1S;#fZK>mt(8>3`y}^hrsvP^mODxsUm!sZ3 zK2rS>1JJIcb!hcT_Xxo*)#vnX7bnM*rMdV$Td+0y4g9${knXgHYQOM^gAB{2jT=c7 zhyU#E)ge0dPE^z_fK9r|zpf(qH4Aqxg;F==_9No#1PZ(%l~5=-#fkqHu5$B2zJwF3 zm6g!(BE0ej;$Xkwo+hoUC|D3rpdLc6P(Qz~$aRzhYz#7-`R9q$1`Ib2la&Lyc$6FF z(A((MO`e7cTs2NO@$%PsB;kbi^dN>k0V|6GhYo^q;~TgqPDC$zHNH}_hc~5XY%CPQ z&2_8?L#Zb&-)Oylorc1anKN=E#zkC!9livJRcxkzu7@v%CDOWO>?ImK*_p?%gVJAo ziqvRxtjepIn6y>>>LV7hvIJsP+Kz^%+iPws8^ev^@Ta*>LV|*CQ3+1gALB{kZ<0G1 zC51>o3KYZ|ON+RHdLzynDIim05<;gwu##Hl_hBrAeTI3j7gLNQr=)sd`YGZQ?eSZ1?J8Z7-KSj&)BLvkw z^0bWLst6iQo6lGVbu%ze`>Z7-12{$a~E4XXYBa{ z6f$M@Cc(G@Sa?GBnZMg6FK;v=Mb0Z|u9#V?`R{B0GD0dlrx|+)Qp0(id=Eos8PPe8j>1^H`h_)2USTG-4WxY=hA*6r|Mq9zJnL?cQ^7<*yLObBAcu|4hYhKD*M==N62Q=h zS^LbHXSmCu0mm`MsBu?gq7YYD$br3FuP)QIRRyM43hvlhsSXc>eghARl;7n;K8N3| z7?XA8_wV1&qf@ydQ~2=lBLL4A8>%nEd7Fg7pssR&pk>F79fzN4P<*ZLWHP$9SgVPE z(t)TtJ1<|TjlULO&8zP;9jU;@k%FX4S6{#N&8cr_F*!O_U+#n_#5YKSu`=<8a?3Gb zX^j4m$(xhhaP!u!oX6()8bPapV-KRD!61ST!aIE0w(Z-gu~q5j+CIYf!S=P8lM~uK z8@bZ<6IwZ~zBbK92SyP?+~V}Y22U7zd?5eXaRyOR{R0DOUB^ejaHnEb5P3NA&pyT)8yf75^-M z?4YlY#U|5-fwvg>f>wR3pjS|d&@HFGrMDx_kLJ0DL`kq+yljiO)MECEJK-@nWeK}8%EZCl9e8`nb!P_xML98KPZpvC%AGr zI5;ff?@OjQ#UsoSeUJ(veN9tGCt?>jxNLBKtZUl$a}X*+kj3o2ygJI})9ya|?&>sd zAcXFo@rb21!Nv1fR#1N_KsD>M)q5c5$!MCpfUlZ4tUD=DtiwQIP zP}o86%E}T67eb?zk?2PT`VdFTZjf441{8&L>(&q$`kM+`9}D;}i8=>KNYWq&k;oI2 z!$ju}S<(?0lOjye?(<@{6wIC~pb^9QKzX?eAQK7sWo*@S1${2&x~|Mlw= ze7dkfz6Q3^E;Mw~wIKuUr_U*VKc+<7D1Ob&3E+uCg~X4;!{3rog^k=7*AAV3t}Xa$ zdb%l?ldl@Se#CIHroH_!c4tEIgIYRa?yM-YJ5xt{`z|S|N01gUkjkD5QQP;`^Wji@4k5> zQ#|>OQ(Aq8*JF42;JHCaI>VtfRYhbT;x(pYs^!X+{}t%WV^psGF40~zMv)usOZwV5eoV9|M^R%{m@YP4!EP?sQjEVeca1S4s&2Qt1|=n!-Ari zJnf?pU*A*bvwVPyi)$OiPaGW9gZG(ECTb$sy6&@;Xtc>zN>bhX+FIJWDT4XHz0{>8 zOHxvhYHh)fL=##rm6I*!mjrP8vwT}<`fOCfikZZL^F<^nDSe42)eq&Ck}=kHz0 zI0OAMc7d3A`X;b&_M!L?(#wYOeP-;<__LxSgWo3xlAq@1ZwBK=(Zge2D{bnW>#y%M z)!ym6?U|*f+bJrsQ{b&`hy6J42~lT3^-h#s-FrGxGBX1WM8+fRW&}7w=nlaUIe7&C znOa$Wv6*3IMOWHw({Z((IaU_pILO8^W+MLxDPH(wiYhlpqB zMV~u25UIDn=4VFG+@V&BJClYtTZ8@Q1;Pye)e`<4kC4a_KzSZcjh15YoD#;JhQ%Zl z*t=;{_)3fMeop`dCj{CW}NP}tJbpuZ-rQh-q)H1qg~y`rzRbXgp@E3zGl z&AZQH9}k6+s2Pj}1b!X3f6xL0gbkjZF~wR7nIkHw=yh1@HbYTPi*W{IWN?w@0}cbN z+>tHtBO+|QgY?LF#t`LY$rf+q&vR3b7MhuL-h)ZI~9I{@Y<@cMtuz5Ev1wSspJ4&vu63{-P;#;_tms0FG(b2uU35I0ESOJuUYfVki ztT15fp@)f9HRq+GYZ%{bM=Ofvt_(>24ZFWq;b5oWT}~Sthk@taBU$=~nb?70C8Ch< z3DB-qWA67&l`xwlkrBH5r_Ki#`P6;zU=IQWxCRcFtNWv;B_-UL8Cu%ekxVo!tmw0m zp~HohjZg=$D-a%-UU~q=VMrfs8_lYL*VyIDqD|J~F#q$#pdH%URiu;$U2oU@Q;^dm z5C=Ebb?hO?9o~#Zk;I)r+kOpXK0-JExf<{~axo#le_JyA=6d|znDB6FuDD$ z7nqOlQ1_4o2n2Slq1=g#3`$DkN4dugnHMcT4k2|s=stYmeSjKYEe6M{jEFpti9a_q_yOZw$BKm*u_PF=6Rr!0 z>E_^ekR1)=Y(g3zbf!U@b7QXSDhmt%t^>1q^5hAHg5v%twtBRPAP5EL=1M$~xv~~@ z$v*7L^c2E}z&9YNb7a_t8y-w!@Rp9EhQ^Si%}T~5%n5e<*kb^JPXO#e@-8D>;?d!; zeh>k30&(Lcha+}*8aCt)%&^%bBjMh2r?xK_3UJuOg`%qJX-di(@c8}o(%*rkQ)pKT zutw?FvF*4b;B?}mRuPpexG3-g%WPaSpWYTQv>h8VWa#r){Zc@7KpNL!y!Nd}#L1&1 z!~6m6f1*pQt!@6Y3Gm_l`#Xd(jZ0(D9CxoQ&mB>Tum23MZYbbC8?VftD#s6~>CYJ-8PL0fAei=XsLkx?!TR=Vs~ra2nuKFL)m*DNUpF z$GnQ@T~EW#`XHG3Ksl~QVtL5Pn_c-{Fc1@uZ_FDL5kY*Y+}#V-jl5XGZs#1jZ_2H0 zCnZT8#1>**MB=!=7P-GZn_J_+h2EK8XiAm^kNrB<2O@@ol|LM%09pnEWs0`L_P83? z>8&FiEU>d&H~kGg7WxoVn1cY9%bfr|C#MoCZ@78?SY#s*A&>h$u%`fcNdd;ki%L7- ztdToyPEHQILkGWHa|?3)zKX)Z$>{*9j|$8n#HJU~75fKWKgF-ES?&2aD#~GD){eMj zfOIW~_N!@h1dlkDy*=}}yHHwe+<2qE|02kq%G&ZmLMr2V%P|POx{kB>>HQI)1??Rj zr*(CA-9&Y9n@dWQZO^V<045B%yZ!uDtz*RwcXZ$Z5MUHg8X!j4WgvANfW^itD7k3) z)_?j2MyPM!!D!Co=pGc54q`N(H$!~YorkQjPj2HYUeRKC4Tk|#;ger1VqNqf3~{`n zDVshASqhn~6H*P9*69xtTe-NDK7tsmnW8;F4I)Ed>B>^(rx65f&b+g>v7w@%j;8Zf z3+!@_Ii{r*K1e5*sQD%S>&Wmh8OTTHyKXMb$XJUdUatMjF)WqGFp|Pzy{mB3*U86T zE-vD3G3>)0_n@Z1OpydHqkTLZOcm zYf*dNK<};Q)jreNd=~HzNL;S&{@<{Q)pvDe%yE4`xE3rnxes&STHoa7W9$CLwTud> zY^q4D0LT&m2u%y0=`He}`Ihb=rBZx>QaUfR6B7n#0SIym={52#!%$$9RaYl>v|=lx z#yP^hYMsLY9J>n4GUt{nu1i^cwPq}hR}>8_Bx~x;RTdgsiruF!-bT2>r7fd5YQm3H zX5Y_DKL9pNIMRX<44_H-0sbd(fWX8!F>xHs@sPIJ6QaCb&mK94H~0XTi(-XM%%(}>Qqwa^1YQ5R0mIAy;@H; zrei!_*CCfSLAUR=G}AhXdg2iL_gGOzd+7lZ#|m;Is#LncJI&J8maXdQFXkT(-~bI( ziWrv&dA8xiA(%)=Na@P4IXX-X04)qx=3Ggak(QSKB>^S%sz)jTC^_n#GxEATPHBIt zsv>m{c}#wpsziHPT6PR0{qPxQb9T3M4xV((3APfyRK(-0@7+4SZ9GE+Z%ZI>=}BY9 zCxyL(gFyh>o?;CZW0=@AgEgXO+-F4w51Y(ZS`Y!LSj%f_PK@t5td7GBc5Db0vOM+- zx`P+(8>i8trxJ;b0fXrCNO^~V&Fcobj_LwbcNkb1H?*<=>C^xa(>ph|sy{vejz z=grorIF1bzP_R3{%*|~n$S47+L}2!F90Wap3m88Jvhch^xlbw!3b7c2$qwdGp-7U8 zZpFNHBx?lIyGr!0ez>c6Td=)CxOOB(TfSuiL@=sq2Ly_2Fv9|ZteNM}4FDk`1{s^t z!|q-bo6geb%j$THwsxfAYg<^y5MEet$q>X<(T;9P(gO-#jXYn(H0FvLw9KalYJ{oDw#BYRB zhRGsG6mLOgA)6NNn`hbCY$&vFenxZFYFmsBAjubDZ7Q%Lfq+l}xUTEZwre2G%y@Jx zbzg07T)Vm7!Q~0v@0SpP!i)0z(9rIiEBFp%$Vn_03k=lop~!=WGEx4Wd{N&f!G`=z=ID6EkR=!s<-<4uL1(-5UIT7OIsVDSQ=x0 zB>t=K-w)P1@HNQomF{29$$1KG`E~-DV9?w(>e?)V^)eez9fm|Cn}diqA(uc;wjtu` z%F>(_NbMwZ3ro}Yu`x9~3wXSmFO0QI6eBkbt`+2K0PG-O5=wFsa5ZH{+6URS&`i))n>iPM#t}Oo}DlsS1AJv%|+A4>p4{0QPa&}gWk;A`HP8?NJ$~a=;_rCxvk3v-d literal 0 HcmV?d00001 diff --git a/docs/source/dev/cppapi/files/torqueXActuatorForcePoints.png b/docs/source/dev/cppapi/files/torqueXActuatorForcePoints.png new file mode 100644 index 0000000000000000000000000000000000000000..fa751ad1be01b6d25e9e308c9e8e6897d342d860 GIT binary patch literal 29483 zcma&O2Rzn~`#$>EGRodtN>)fBdlVruvNDs%mYFSEgv`p!3fV&T$OvU-&t&htIrqEo z_xJywb6)4X&gu2}l;nBd>mJvAUDy4DJW`e;#G}DOp-_YmFE=%T30c*^&o?g4RhGnW+_;gzXM+7f&>GKI5`}|_ z>$n#&G4bZ^u76#fxRR0*@5{gP-&n4g*^GoE0 z`_BBs-PI9NXJ=>auNLH?Z{8Gpo;bU{dL_k0k?yoIs8Cq%w4y2MzOS^jhsGo>&LHNt zi;8G#HcRoue)8nW)oa(JxhObSU6u!K5YP$|=vO3p=Z(o)3+2ZaKR?{&ifA(_G^{sR@@i~s z2r5LyTc4>#3`Gwtu|(+)Hqew?TIxXRnWfMI2Nx}iY7T65_u8_6YF zN=mKu%E?;yQgmORpFe&?RU9227G-5+S-H7Y)o|aq5ptWC*GMjmDsA^zEhpwSKmR+! zip{ePU!b!5YC(TCvg}5vW@dtqyuN(bvX3x(~zQ%ELaS>d;eA&*$rO;6#(3qp9 z`SG=zH?JHW9sT}gVrHh5e|E=e7!_yA=Y8&xIkvX8*84@L^yOM}Afb$xmpHsDhi&!C zIlSZDB@9+p)>j{6W69n2mIKtYm6@+!&mMn;j)5`r_pd)ZOpe;~=AbL~^Ig*WbT2-H1WJC{CxVtGm6goOHMG$B#=vm+5m4gCOqqP~@oFMcx-) z1Pr27*x1;^mG-Q0Hx1w7TwzEx>rM`S^G5w>&t|GF9KNA(IMec2ULJRMZ;zP>x2Mk2 z-9I28XZO_f&!0a<#?9DPg+6ddUnR=dF<#P6l5~r^*%wuTfD%q{_VSWBpyd|@f`Kf&CS`V0vjR! zG@O;MT)BdLSLoID)w+vwcXLZilhxtk!~R48R<~; zXR8DyCo^~*FI~49E<)2P(36^~^Nfm*$3Yd9mH9_S5ucy#s07TWNO<#Xpt+qK`xB|9 z^e{=jWnp27eE&YAH(hS_XlG&DIna1|ef{kl%9|Zy3JMC3paf;^XgZp8m2h2V6c6Lk zuVPO^i;Rl${qyJP(Nt+k2}+Wg_K};*@x1=ZTxUFa`N`2yV@nH`VjNdv#)Ifw&uoJz zc(Xs>LrCYa`)ct!OQ>!=C*Z$ztJr!>Fu?kj*{|iRvKI>&hB#wIx#Vf`Wp$SFXfYjE#;q!5x60@J~r$gu5L^eXGcR z_CA+R38t5qS9@32_fPlU{Jj{oHAo?nUZ!0}oBq72yybUA+~?c3Z>OD2P3TYy-cC`(4>_BIW1#j zWAmvxvAZtoVF?LTNS>gWNJ3CC6f(%YY6`$NHZf6O+JpF`3cN9-$OqLKqGfjZciwh6 zbP1D=m>a`oFG%U=>1XEWvFYjQ508#+=pk3fidlYoFm+LNlV^8FP?>+WPR zViFRy%$?=MMRscmyJ=KeSs7AxGsmtlh<>(fd$qr+V>MYrz0jSawa8-I`>93bRt#a2 z`_`X(vHbO&P{Fnqds$bK;I#K21y1Pis#m(KD`;(w2~r7=(9*q_=uQ!9AR#o?Y_b!GpvS z4FST<_9#{;=~l9`nAtm;a!}_it*pABVOMmt`TP49i84g=@0DARX=dgG+U8o(On1a` z>M%sK@e`zPJ|1kH-5QR*uEIgLvsN)xLeN|U3H<8oPW{28`0+tl1_f3m;Ep|ar~50yRrLG-o5?arGsb90$? zZHD_|HNsD8ufY#RMMb4;_g-}HKQ}cs?u_H+y>-hkFE6j=3^G$*LE-h+ueYH=sO7I5 z9v^e)Ynu-j8B+B7^Gx2-92;*FUqg z6atN2Q`p7yGMx|#?ykpfuN;T4;rorclgm*2Zv_%iql<`$0AOGd5~6}&lrcB|EUoJB z=ldn4WKn8nW@fxR?7+Z47KqQ0kr9-S#Q7lxAT|t?QUWg;U<1GO^z<5$b8G0URQ%6^ zPdB{J_9(9@C7^EIy5+Iih$Cb-?bCD)@Fdb(+px}qI!~+ce!bTjV2@C!Y|K}$Vv384 z<0%rrNi>g)=*)g(%Ujh0=42$F{L;`2In1#tEhj_rDJc0i670`PKr zxY%Udi3v)!-R`2Q(nmo;NWZ+MdK6%qsH$qF$$O7Ex88sFpjml0k^kq%J7%v$lluxw zes5^UnO+>uUU8mo@cmL;%*RQFHv-{R3YBsde#|naq6@M}C+$)DTRPzq-L}Vb#FCI8 zWAG#fTU!I?c8!{z1DC3u*K!@F%E|;1#oQ_24rx`@iNN%rHuloN zfjLUP2X0L4&#QUze%vTX@<6Y%<3_;gGcz+iLqmm*7o}$1nw1?4$SdNdWn>{$L@v`O_yB=rbJpIUCmS-Z+nrWn5mq%$@Vkr6eNqNlj&PYWpns@F$_Ujr0Hd z{n38aKES9j+B?eU?=?Q=>Z2fp{|p&=w?G97IXT#1<>n?NXm050B2ZRV-rU@5m~Qkl zwzPag`-=SP_3Ny+ZjnOid{-YWcKtdIM3StU8VL(4YhKwd_vZ1}0(i}DgTgv-UIBrO zaVI79QcDXPNeAS2pOQR9ebLZ@muPn9r>~H1LCK>hX>ZR5qeUnMw{EIV>2rV|OG`_^ zVPUd>e4slL+S=N3X&0e9k9TLtzHs1gVPa!H1vC;Vf3>Kz6a$6SawKiCl-|FFjxhs` zX4@fDmW6=+Zj3quGL$jrsG&iG1;9f$hL|0$cDZ@HzlQJN;E;I&K>E-4HwPiNU3P3j z8h;oC*lTDias_QC!zwFt6?dL~K zN2j+oi;Rb@1qxWGAt^Gb2>q34R3AEqhO{P#g?b0ZedeDJ{m<_xQ``3CGqnb%x%rN#FLCUL^9}yHCrakT$qE7>PEsa^W-q zuV15=*-X%2U=v98XFZ&=+=@4*!lo6pdh|dZj^h8BA{%`gkV(QFTZWR761%_c#F;0L z{@u<2!$dqE2nyfsg;~f+0eob-?v;dZ23=u%dUm{rl+D~7B=IsX+tFYy{{4&jUMXvt z>)-KN;pYfx1&!deDjgQy{;!{N!z^-GP^O}xY5M(}T))cE7rJeq4hr5<^Z#^4fI0qy z<%1(4YP!r{4o9^|mVIzS%+OhGJ%1UmGd z!a)bmKx3v@1>pb|!Y2Tdp7R*^ut?Z$qR6hShw8kc{G(aXxyuf>VOc&F-v@$SD+lGe zIgJL7Nzo7WARw#zBZkh#e$QY(7HSjI#3rMWoWxdOA^^Pe9c&)Q|o+*mmt+TVR-K4ddS5Fc?G0w>s0sA70K6M1oZs|kuh z)D;DBgcLR?QQDPu%uk;_E%G{Zd;FJ`uhI{`mP-!uDfR&NK&uBfNK`3pTTPb9u``#LWHz%D;I~>r?d+ zFh``Dw7oq9d{ksNBYlKZ9}*IxAZ==9X3`Q$P9$L0-qYo=DFA*OfpLT^!Qiu3qXGUhGF=Xc9!IbyR>Z)EoS^!sPQ(GGjOr1?o zI*MQPU(3kKYU=F7S4kFCeWBd+v%t3Q-j5OUn7`yGl)}rMMhS1qBR{?3!_jUd9nGJY zVECKK+h%HjWI;zICM6LQ5ur#)N%iWzYWqwe(1Zd?ii@RSY~kYKBBG}c2RvBV(Z(SB z5_70PzZqdWJPz$p4S+po78irbIW+;O$EaWXbQiAL`aa?J+F7ksiB{UtY#XD4EZaz9 zvoIe{IU^n-V_!uHr?#v9k=XeiSdt_9BYxwGSu_W$YK$q(VgD9sm0fj zMSi@$j)9Wzj5eMK@8|v9A7m&J;gSgPjjQ#T2c?`MuK!V3V;;}~a631K*5~H~fnAw_ z#|*2jLTU5NZbVCU;d}Y zH`L-(y|?xJqxTsZR{`ba=~YADM=|m7Md6`tlPa2|7UsVxaL%_oH9FF|f78>Jsc-w) zX8kE?*r9Zd?U*j%4R{pBmUbKH?LU8FrF7pMD#*^pi8GD*_%Sa~b>M z-frL}z(kiyGGi$ukB^zYABvgc>{{P<=IE+>IOA7L<+(2xCP5jNg5w!V5jgJ@^A0kl zj)M{f4L?q$Ew4j>JJ5JQ4W<3$3G0m;IeP9oAH%~RX13vAVm9>jJWBfsBWqnl{&&T4u)xOdG`0;2S<3FpqczyYwh-X-lQ;`aaoN-T7C_nwT!lQg7lN; z&z~ph*LPr{P@6{{2wP&(8s-}vt!{0aOKfIlruXe-rryck$`CUd9t4^8(w3BzlmZSh z$?xEIt&&06SZ1ZqACFFHt1#jm9~qk;UJetfz-hz&<-?rfW{=DKL1pCU9H5bzvC z4~z}l<$##z#N5ajy$+clqG{YJ)_DEv`9tQOg5!F>@OE6B;}d4#1-5I3!*9kvHR&qJ z11gh&l6aZ^t`Rf_fCqpf{Hv=)>W-H=hsVa6AwdC&!9Y~i@!IoX!Ugi19(X!J)Ztvb zVUf+m-7ilnF6-#%pnMt{B!z^90lrIljRzC6A{54t=<6m>1OPJQh#yX4#KgoH&2_|b zbjsyMnCb*)l2qyl7Va0ny&pF`X2!Cf#b%`WSBfmw?uiK${&r3)LNW@9lKS&w&Xtvw z&gGSrQV;Qzv#mBp%a;n@pqrP9GN>$RSy^!bgDCQ%@2aMvqT=}hKQ%S=YT1i^Z9poT zS4oPYq9FjAv(~`T5jtV`+qaqzywoQ9yEF!!yIJ-<#xZ^^2r(Y`e8o5DI^WnPF3-r2 z4OqfumOc9~Jox(cD-1Q4Zr;3EW;?}zg@vVnGi?ue#1H6~OhcecQ9jetMr7pVKQ0Vf zVe%GnS(jB%z(acSOcR#lQr|tcZ@4Z`b1(_0ATJg?-cJ4;{bSipEOdH^EjTWk*W?JC zc%_CVk#Hlm6fdbz+EJPMIDcLx6QIRMG$h>A(6N_-aFT*>qP%G!sij4E zus+cYfS?#|g2I6r6}DPVSu5IuW~R7Slw>RgDwiYBxTts5q^7;Iv204l-nBu%k*{#{ z7#(iN@Z)c&!@toge>u@e)bv%=F0B$OY1F+-xvYXe<;{y-XXaueEz9f0uuHAm_pZ^O zXj>UdB}B2tM`3x4>v64iA1(~Z(XI6{58ek8*Pr?DnYqj^NToFDPHj%$KvJ^~PETUX zFQ>#~y{f!mp|*+3T{-vu$Y&UQc6QqEx~0;=Ju)gq-ExS0AQ!T>^D6)g(iN3#+!^#@Tb0v!*Yp$ihL23R?kJH~|xk<~}l8v-o-IHXeWM6nYPUQ`dw!~8+fR4}M$A97T zUG0+WU5~O`#hRUa+2sea76k-(-)DGxNoQu`cGcLWanURup@`JTRr{zab%$l%WYoN*ViG zx0Ul>!Ow}OqWcVdz*&0G&e2u)l^m5P^D#SMqoy@AJ%{_6tpBwA{m?2_V(DOARWwP9 zhcO!H`pFcDKbPC^-7rV*4)?pGb75gqx!c?!F{NI9D~ro)A%lg=xeWy&>E{P&l_zo& zs(+!i(k)70i3T=S28+pOv-w?O4kyb-Zvemqgc7+;z2g!IV4TY5EQF}el0pNN#zFtZ zWQ)QuCeF!2DP0@EYxn$nAPpk#hp403fd&Ahsb;0vjT@JMz@MWFHLpvE?}k**qwKzj zePL|=*33qlY4COH?IrPPM*CPsLwFq^@vX z9^l1Ft{w^)Z5+TBXb2E60pbq0GuM19)(?swc1VhKx__6POK5qmiAKh8HjmQQH!7t@ z5a;XtMurLt^6X5X=y&fllKcdi;3=V&*H8_iTy{%AWi?hFUUO7oN5_j3U-FS>E}x&% zdlx}2hamoJ0v7;cS^UYL+|*PQ(1@?|^SS+{nX8;u0(Ta=wU&k#7tImW04g0XFRvu9 zXb1xz6Vrn#tRi6x_pSB4!4>dufId?f*!1{`pie5Lwc`|C||NHiHk)-k6w} zNO=zk2$(A`<-!j%ex%oBZSfnD)c*9)9{x2IR59F3m!b;AdY~NOMO44qxh5(qIt{=V zx-@QpbRx)AKq$H%@7{R*`nAv;^KaHTg@HP_C!?a=9z&g!Cf#d|-*=dW)^~1I+N}qDvIkpVOeBp`m=>38u>gT}FnS0=;i) zGsRQh7h-TlzD#-yTl^@0Y&zstKFZtJHQ=Te{j+-o z$rt6zA1*zKimEb!+){vTz<}lBg+_qBY5Do#FZ#27j2(K2BP2$qVmzW6l$Vz) zMEvaNc%7V_eA-+e25k)3iHz+p88x&wij5ivJ0X9YBX3HYOGpslPx%%vIL}sgXY=-^ zf91wyCdA3+L%F%Rng7m>%`HWtK=dM%lamXUWeIS;bLY;{ekkanGjJUU0egOSVEDbI zW#(j~zO7s0B8*KjZa~4{lRQ^!gC5gs8B%p8xg0)4V^X@sJ6KCc!U?Y8n8E>N&v;>u znFjLU`1lWubgE7isLWdgU-I)izk-VDXF8$~&y)-|2qw#bTK9ubfb`8LYY++K4YZ)A z`>P{g-^H_YJh`YZiDkL{0AJ?T>V^n)L|s8(_jY&xj&U~4ZuOLyDiTmpUtzobKVAS{6mVIH*zM0O6KI4S zP_rmP-UO-`?ty6vM{RQXIThJjaR|$MNcFSIb=Wj$bb+z*XT+u$COvUc+l)_bwC@SIw z74k-z>GS7F=iu5~MM$(ARQ(uzIKNk}?0>*mIW}!C=3u@{qcMd;RwL!z2(R5q9O+ zs_yRnFe+c*ED<4SQuEOxAHZ{tD}xWkv3P;Q2MSl?u))RAQ5G0uP}*16%?OIf#(~ zv~+BgyrQB^h0O#9J?$fENPsXpVG>XhTS3<=vK-<;$oAmy@D`}_b0=8X*iE1+!!JB* z@K5-B{75TkJ?d{;e?|eh2&4i9Xw_+%nJs%`Y#VkL_eh=v91+@}Qu#9#v9HKTh+Oxe zdG+Xg9RrxEs}R9(GDZ*;piW5{88LzWY76YX9}wp-eEbw10Pca$c2d+oFc2A#T3T8_ zk_>`h9*lv;9fXUtAaDZp<_B41yfgn(yT}Ob<;$0w@YtDnc_SSdwrv0$EN++ejC{$d zN*}ny&2VLGl9723jwi;K(R^70=*vaaW+!oV*eJglp` zI|gd7K>rP7D6^oZgF%*>;3mu6yC1O8UhRW1*WOS32W``~oI;72gFwU~3 zO{EwBq%c(%o!+H@-Z%v>n)JT#T%D?CWMiAtl7*qE86<>Y@V^WS(e)Al)TZKHv@kAQ zXSe9D3ArJC@~}0!OGD{Ij0~$qU@nG8tsZJII8^+yRZ>0yW<;1_sP2IFik;VV9ao2m zp&x34;FeqZ&P{^x(nIYWh09>6Sdc;-L};+_0kZOvqzhao(g5E5&({) zqa!caAd0x&fZfFSXnW4i&aMFlUnz%m+Ni#Ti}2Eu3u}f!?&7aQ=BL}cJev2D(1ZBO z;i9e!e zCSmCx|DnCtKup45u96~t4~FBuf?w}%nGOEkmBo;KVA3<*Kt>^r0S&+fJ<)v@CL~`i zl?MO92(l!POF7W^Gs+wjs?T`-hdhz{wcmLOG^@RX0djO5 zvl0MbkoNKMoNYSrP*qJisLh=nKi~wxrvhX4Wf{;n7FcMQZb?vHF}P}?0PNAmxcrMP z*Wu%HcBNq4z^MRFp}Th2qwfW}hS*4@1@M77hU02~d&vgwiS%VrS-)}l5G?$1)dG|@ zy$84T>7p1zO5#X>{lfkpPH&-0s4{78;(q zB76@kfryxZnwwe)SCv({Vk`ZAxU`fMnr?+nI2s0aDs=juzCN|#AY&?+RHWFLADl&N zX#|VB*gE_p#^@y1%f62db;SF0>`H>0vBds<5@sF6UKX+RGDG&1s8*ptOUZV}J^T5GIPl$aSaNKb2-9iW!OWlpp|&c9_j z$OU{4GMNMA0;CuBL2Pt%`tp|y24Y1v-kzECd_HdUmU}LF6o=(Q=KgKx;ebeytB<_f z2KhbH9Hd?EB?h`DQ2eqofL|9adK1_6ER9kK@J|LRvQ5*&TOkfMo+ ziA>SG?DMU;l^K}5H;NM`eke|;3QP_Q+Q@hQY|45<%u5=~TM%B2#3IclGL;N+wpc@oOzSK9~+^KPOLKd@ik@Z<6lOnHsFd$65UYF>*JRobSkT= zK7q{wWFhst_|qUbb6k3`9MArO;81sT(dxdfmqtJzn_tlMJp;jcy}OtuViJ!329&R1 zFlsFIvGEdM0M+unt&LS&ylz}v;7-j9i6Wbwpru0pkVbIZCegqSsnT6W^!gold&g;l zvO8Z@UAUy>F_OVz7e>GsE>KXZe=9c*5SW>+=sMYwBF} zA0VM=dYH>LZ%PAfWZAhlH}TSDF+^Li<1X*~Dg(6891#-c4BuQ;MjH(cGEkz4X=(9M zMHLlosZxH^>&mR}X>-|gFhv8UwD8@X5&#UZgrk#FF$fHZURdk4*982i&;oN|NG8ehc_HhX(ih@! zcNUwB?@!k=o7s78sJdL0mX~RIISn>C2&3|*HINWY>FMYy6F-E9hCZbZG`>K5jgxWl z@onW6zeD#nH$U%chsZYJ1xO1rF{O?U0k!rVtqA;)zs1XoK*(^VV-ts|OE45XHwrRo{!kei=<(Ufw4tNG@PZOjI;7A)!5oNf?C1vaetH ztVac2(WZ2_#oSQ0TN}N7_3Bj(*Ht*XM`~)XVZ=d0!JQE{W$FltHbJ4*2QVIGAA{{h zODxc2s(y&r@#Hmf7#dtS8;K)kWy4UBN%i9h7&tSM}PUNYUVBu4$-!S z?ciJKDYt$Crm}PZr7)r)bOku!ly5#!^@Z5E{IJW2hxd_7%zd-4bXtmUyKNT};t^*T z23jt35YP=dD5^U)bf9T1>!c_Ks_wJpMwY7f11ax_>PR-F$ z1Pj9q(b(O61uT6n5LVN(vwmRK{PX5!-E>S)4KPGKJKncHO#Hz2QWh)vJNh8;-D&>1 zkUtS&+Y6fM?YU0GA7nLAMLt$;?f1|4(R;$x`4rUkLs`AA{SYTeEGH6Rp|n{1kFa7Cq|;(-L2yi zmm9UUP**-`B019gC=m|@UK+Z)j<^>mQx}_Kw)Ho@V8Ge4ZWJs?GZ8UKNYv}O8yF;e zxSO`k|NUzOE)l#nVBUq?_ql8)s<2d4j#0CJ{&8u$=uEd~`9v{ay_LOha5?L=j!_Or zSq?}2iBlV(?Nl0W%)j&Vn(0^EO<_)ob>6uS-a^St6MQQxt4)|K8=*6#O@MyI)d}vU zv!tObxVSzb$4Y;M_6nqV9!Y&;=)2YiH6xTe1}UWeuH)CT;(m8Jap6+@*Z*k2besqvz}NsobeVqiEIYfT#SBNb0+l$Q6q zb*cAihYgSIWX&Zlt)aW$ykc?C;wIL#_TH?#Y+$_~CaJ1Q3?=%8Ehjs>Bv>wiM!LSWC&$HC*hZjkt(vyg;2I{}v${_bu zHa24j6!0f1<&$F|b7+ZaClL(|BF_I;JH>l*1#~xtLJyo)AS<_8C=HRGg@Dk}vKM~f ztB9eclFwC6r1QI0^*o3%sQ<~NQmuz>>&G0rQN z{)ISaH>aiOL|ush&;>+CleWI4f5T_e+AwKQI(1oVf1C}FeJiTQbaiB+=g$`4oM%pQ z%(212)e$-MK~Ei53J!DI>}U$5g0XWuyFXb>TmuOLJ5Mve2`FFtz2(O+E|`Fk$h`Lx z7SccvGZZ9WVg46c!cc`!dseo%tcw>ub`T&jIuD7+3z>{u&HZ;CQ zWE?EBc6pr5-#p9W0QC&~Y~asEyzf@l)&wvH`FhO`FxNM$__|k3~T;eTFuMMLUln}-i&w+=w^I7<<7r<+aX>Y$}X%jA(0-)&^@aH z21UqumFg{{1dpw|I|XwyFAQn~&Fo+L202$B%HwmEK@X zb;_jaS6koG6Cw-YmRM_+!@z0Qog%s`%6&T%5Y=s((T6b#9lvA~SFvhQpV72yp0nWv zIr)}EI8XW%;OdoS6^jBNIbj2M6ZmeM-&VNq8Z(yVxi09XU2*BBz6gs!obUHlg72Mu#5X%79Tm9V zl^A|X;Evj`?V@bbocdfQ>H3&zxQ>GiIaC*AAIW!rb6gHou-elX1iAuze&2j1`3jeg z_m=P@iZCh4;%=1? z{3WOCIG{9NNzJL_vy#1Uo@={Xbw}!1Sl03VA~L}=N^)W~6)?`kguYW)T(3tP+51^x zciuoM{FA$}zyIC?8*u`!`iLaTn_6y(f-3mspZY|+T-e5R;#%IET79qQAW(28Qn>KA z&do4We8I#jAy-#V(d_rti!{K%?+)Xg;YHfsm9R@WtQx4um;Bofo4op=)NAg!B6zCA zQS$z4D|db{VwtB@`K}pS=WdZn1{xdXUVojFjGM%%&2zV!*U*6M>N7JYsW{)mRmbno zYa3D?s4)Hff&ONwKjbGC%kX0T`fb+}dp~BwN9kSuk!oKxQP0fGWDE`K%av6udc$LY z{Fr(ETW>-&7%x@~Pw1rcF+tIbfV$d~fgetLPKV|uRw06|aS9cbWR%P|u9LzIyIR9R zqHvMu>)uTom5}87`rVLaDAnR7L_lDEUGIui=y4$q=LdY*X};YA-$<7k4b<-X1TDbM zqEhub$u8hC-h$uv50t9gcya@*96IPggARu%4bTUC9tN97i~o{(kwd4TlU!8)@4i5w zy+PcIwYh1m82N!Sni6-b(2ba+q@S2AmTBe(_cQYOdT~Y-e8KHxzac-ePCQJ@G-k)8 z2?~EZ&VN2D0EB;FccXP6M}2M$(i35OoL7f^!EKhubv5S+M9?_*$A0s5Z27AsGlz}M z%WqY=MFVl*q_puqHvE=8dMNkYiwBN4`_-4;mk*gGMU}9zR%sKo&m|6Y0tY zRLje0)>s(jxG#dsTt$b2!;Dz@)pSowxZdoZ(jBopFpZ!kc}9JB@(NwK?c8q{FH2;! zPM1`w?$f7sD#7FXL_LmjpPmET2h`>ly>BG2oh1u>&i-iI6jpr@vs(kuO5mVJcX2T- z4Se7UghS8oPr~7!uKh)5CNudX1aKwgM+J{PYM$ z_S)Q?ce)xHYGI2p+Ffg_`RnZd=5(I);&kC$Gv*mJ2VaUZs2+^G-0o#cy$38zlz@`8%MSqE|c5 zIZy&!wUiIqc{qHkGyR}<^i3~rmKm8Dp^IS5^;;?qlVr?2@5J}JL#ceM$kEt6LhY&( zd40+-J{!x@GkwU9{GKgO@-qTj&kyVJ9Br>?QXjEvR6PU%9=U^ZjGh|lMj7iNnS9fh zFVdsm=OYJL+@xaQ^2aVBqG@Q+J92CT9lX$u$l&2Ck3Fxzw)Z!Jm0bN}#<`B_2&lAi z3IFEZh67j{HI06??9Eo$)8zRG zDh80X;m9r&C>=A2*~P(NJ$Uo#R+S}FMzY1HyddXmgXU&W^Bvun9NUxvZWDK8NlYq- z%RO}tY;u&7(U;0BrB>QAuQHL*yy@Mq0wZr*1fv`bRJva+0)PRBZ8j!;eiCqcf9?}T zBybQ+q?uBkn)6